From b14af4777378c27bc76360be25c3c66903fff7bd Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Fri, 13 Dec 2013 21:41:50 +0200
Subject: [PATCH] add support for a bunch of keyword binary operators
---
Language/SQL/SimpleSQL/Parser.lhs | 28 ++++++++++++++++++++++------
Tests.lhs | 14 +++++++-------
2 files changed, 29 insertions(+), 13 deletions(-)
diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index 9a8806b..b2d2994 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -227,7 +227,18 @@ to be.
> ,"||"]
> binOpKeywordNames :: [String]
-> binOpKeywordNames = ["and", "or", "like"]
+> binOpKeywordNames = ["and", "or", "like"
+> ,"overlaps"]
+
+> binOpMultiKeywordNames :: [[String]]
+> binOpMultiKeywordNames = map words
+> ["not like"
+> ,"not similar"
+> ,"is similar to"
+> ,"is not similar to"
+> ,"is distinct from"
+> ,"is not distinct from"]
+
used for between parsing
@@ -296,11 +307,16 @@ postgresql handles this
> ,betweenSuffix e0
> ,postfixOp e0
> ] >>= trysuffix
-> opSymbol = choice (map (try . symbol) binOpSymbolNames
-> ++ map (try . keyword)
-> (if bExpr
-> then binOpKeywordNamesNoAnd
-> else binOpKeywordNames))
+> opSymbol = choice
+> (map (try . symbol) binOpSymbolNames
+> ++ map (try . keywords) binOpMultiKeywordNames
+> ++ map (try . keyword)
+> (if bExpr
+> then binOpKeywordNamesNoAnd
+> else binOpKeywordNames))
+> keywords ks = intercalate " " <$> keywords' ks
+> keywords' [] = return []
+> keywords' (k:ks) = (:) <$> keyword k <*> keywords' ks
> sparens :: P ScalarExpr
> sparens = Parens <$> parens scalarExpr'
diff --git a/Tests.lhs b/Tests.lhs
index ffcf6db..2401516 100644
--- a/Tests.lhs
+++ b/Tests.lhs
@@ -161,13 +161,13 @@
> ,("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 like b", Op "not" [])
-> --,("a not like b", Op "not" [])
-> --,("a is similar to b", Op "not" [])
-> --,("a is not similar to b", Op "not" [])
-> --,("a overlaps b", Op "not" [])
+> ,("a is distinct from b", BinOp "is distinct from" (Iden "a") (Iden "b"))
+> ,("a is not distinct from b", BinOp "is not distinct from" (Iden "a") (Iden "b"))
+> ,("a like b", BinOp "like" (Iden "a") (Iden "b"))
+> ,("a not like b", BinOp "not like" (Iden "a") (Iden "b"))
+> ,("a is similar to b", BinOp "is similar to" (Iden "a") (Iden "b"))
+> ,("a is not similar to b", BinOp "is not similar to" (Iden "a") (Iden "b"))
+> ,("a overlaps b", BinOp "overlaps" (Iden "a") (Iden "b"))
> --,("extract(day from t)", Op "not" [])
> ]