From 546d9b023da08bdc1e1a9ce3b9e18450c48f0954 Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Fri, 13 Dec 2013 21:34:59 +0200
Subject: [PATCH] add support for more is ... postfix ops

---
 Language/SQL/SimpleSQL/Parser.lhs | 18 ++++++++++++++++--
 Language/SQL/SimpleSQL/Syntax.lhs |  2 ++
 Tests.lhs                         | 14 +++++++-------
 3 files changed, 25 insertions(+), 9 deletions(-)

diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index 70b4628..9a8806b 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -251,8 +251,22 @@ used for between parsing
 
 > postfixOp :: ScalarExpr -> P ScalarExpr
 > postfixOp e =
->     try $ choice
->     [PostfixOp "is null" e <$ keyword_ "is" <* keyword_ "null"]
+>     try $ choice $ map makeOp opPairs
+>   where
+>     -- could left factor here?
+>     ops = ["is null"
+>           ,"is not null"
+>           ,"is true"
+>           ,"is not true"
+>           ,"is false"
+>           ,"is not false"
+>           ,"is unknown"
+>           ,"is not unknown"]
+>     opPairs = flip map ops $ \o -> (o, words o)
+>     makeOp (o,ws) =
+>       try $ PostfixOp o e <$ keywords_ ws
+>     keywords_ [] = return ()
+>     keywords_ (k:ks) = keyword_ k <* keywords_ ks
 
 > scalarExpr' :: P ScalarExpr
 > scalarExpr' = scalarExpr'' False
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index a7e9ea1..4708ccd 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -23,6 +23,8 @@
 >                 | App String [ScalarExpr]
 >                   -- the binop, prefixop and postfix op
 >                   -- are used for symbol and keyword operators
+>                   -- these are used even for the multiple keyword
+>                   -- operators
 >                 | BinOp String ScalarExpr ScalarExpr
 >                 | PrefixOp String ScalarExpr
 >                 | PostfixOp String ScalarExpr
diff --git a/Tests.lhs b/Tests.lhs
index 192cc3e..ffcf6db 100644
--- a/Tests.lhs
+++ b/Tests.lhs
@@ -154,15 +154,15 @@
 >                                                        ,Iden "b"
 >                                                        ,Iden "c"])
 >     ,("a is null", PostfixOp "is null" (Iden "a"))
->     --,("a is not null", Op "not" [])
+>     ,("a is not null", PostfixOp "is not null" (Iden "a"))
+>     ,("a is true", PostfixOp "is true" (Iden "a"))
+>     ,("a is not true", PostfixOp "is not true" (Iden "a"))
+>     ,("a is false", PostfixOp "is false" (Iden "a"))
+>     ,("a is not false", PostfixOp "is not false" (Iden "a"))
+>     ,("a is unknown", PostfixOp "is unknown" (Iden "a"))
+>     ,("a is not unknown", PostfixOp "is not unknown" (Iden "a"))
 >     --,("a is distinct from b", Op "not" [])
 >     --,("a is not distinct from b", Op "not" [])
->     --,("a is true", Op "not" [])
->     --,("a s not true", Op "not" [])
->     --,("a is false", Op "not" [])
->     --,("a is not false", Op "not" [])
->     --,("a is unknown", Op "not" [])
->     --,("a is not unknown", Op "not" [])
 >     --,("a like b", Op "not" [])
 >     --,("a not like b", Op "not" [])
 >     --,("a is similar to b", Op "not" [])