diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index 65d9812..43d9d80 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -123,10 +123,6 @@ which parses as a typed literal
> mkIt val Nothing = TypedLit (TypeName "interval") val
> mkIt val (Just (a,b)) = IntervalLit val a b
-> typedLiteral :: Parser ValueExpr
-> typedLiteral = TypedLit <$> typeName
-> <*> stringToken
-
> literal :: Parser ValueExpr
> literal = number <|> stringValue <|> interval
@@ -245,10 +241,12 @@ all the value expressions which start with an identifier
(todo: really put all of them here instead of just some of them)
> idenPrefixTerm :: Parser ValueExpr
-> idenPrefixTerm = do
-> n <- name
-> choice [app n
-> ,return $ Iden n]
+> idenPrefixTerm =
+> -- todo: work out how to left factor this
+> try (TypedLit <$> typeName <*> stringToken)
+> <|> (name >>= iden)
+> where
+> iden n = app n <|> return (Iden n)
== case expression
@@ -428,16 +426,41 @@ and operator. This is the call to valueExprB.
> makeOp n b c = \a -> SpecialOp n [a,b,c]
subquery expression:
-[exists|all|any|some] (queryexpr)
+[exists|unique] (queryexpr)
> subquery :: Parser ValueExpr
> subquery = SubQueryExpr <$> sqkw <*> parens queryExpr
> where
> sqkw = choice
> [SqExists <$ keyword_ "exists"
-> ,SqAll <$ keyword_ "all"
-> ,SqAny <$ keyword_ "any"
-> ,SqSome <$ keyword_ "some"]
+> ,SqUnique <$ keyword_ "unique"]
+
+
+a = any (select * from t)
+
+> quantifiedComparison :: Parser (ValueExpr -> ValueExpr)
+> quantifiedComparison = do
+> c <- comp
+> cq <- compQuan
+> q <- parens queryExpr
+> return $ \v -> QuantifiedComparison v c cq q
+> where
+> comp = Name <$> choice (map symbol
+> ["=", "<>", "<=", "<", ">", ">="])
+> compQuan = choice
+> [CPAny <$ keyword_ "any"
+> ,CPSome <$ keyword_ "some"
+> ,CPAll <$ keyword_ "all"]
+
+a match (select a from t)
+
+> matchPredicate :: Parser (ValueExpr -> ValueExpr)
+> matchPredicate = do
+> keyword_ "match"
+> u <- option False (True <$ keyword_ "unique")
+> q <- parens queryExpr
+> return $ \v -> Match v u q
+
typename: used in casts. Special cases for the multi keyword typenames
that SQL supports.
@@ -500,7 +523,12 @@ TODO: carefully review the precedences and associativities.
> opTable :: Bool -> [[E.Operator String () Identity ValueExpr]]
> opTable bExpr =
-> [[binarySym "." E.AssocLeft]
+> [-- parse match and quantified comparisons as postfix ops
+> -- todo: left factor the quantified comparison with regular
+> -- binary comparison, somehow
+> [E.Postfix $ try quantifiedComparison
+> ,E.Postfix matchPredicate]
+> ,[binarySym "." E.AssocLeft]
> ,[prefixSym "+", prefixSym "-"]
> ,[binarySym "^" E.AssocLeft]
> ,[binarySym "*" E.AssocLeft
@@ -562,7 +590,6 @@ TODO: carefully review the precedences and associativities.
> prefix p nm = prefix' (p >> return (PrefixOp (Name nm)))
> postfixKeywords nm = postfix (try $ mapM_ keyword_ (words nm)) nm
> postfix p nm = postfix' (p >> return (PostfixOp (Name nm)))
-
> -- hack from here
> -- http://stackoverflow.com/questions/10475337/parsec-expr-repeated-prefix-postfix-operator-not-supported
> -- not implemented properly yet
@@ -592,7 +619,6 @@ fragile and could at least do with some heavy explanation.
> ,caseValue
> ,cast
> ,specialOpKs
-> ,try typedLiteral
> ,parensTerm
> ,subquery
> ,star
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index 9a53d71..62ef117 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@@ -144,11 +144,25 @@ which have been changed to try to improve the layout of the output.
> (case ty of
> SqSq -> empty
> SqExists -> text "exists"
-> SqAll -> text "all"
-> SqSome -> text "some"
-> SqAny -> text "any"
+> SqUnique -> text "unique"
> ) <+> parens (queryExpr qe)
+> valueExpr (QuantifiedComparison v c cp sq) =
+> valueExpr v
+> <+> name c
+> <+> (text $ case cp of
+> CPAny -> "any"
+> CPSome -> "some"
+> CPAll -> "all")
+> <+> parens (queryExpr sq)
+
+> valueExpr (Match v u sq) =
+> valueExpr v
+> <+> text "match"
+> <+> (if u then text "unique" else empty)
+> <+> parens (queryExpr sq)
+
+
> valueExpr (In b se x) =
> valueExpr se <+>
> (if b then empty else text "not")
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index 052a18b..dec1802 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -12,6 +12,7 @@
> ,NullsOrder(..)
> ,InPredValue(..)
> ,SubQueryExprType(..)
+> ,CompPredQuantifier(..)
> ,Frame(..)
> ,FrameRows(..)
> ,FramePos(..)
@@ -126,6 +127,13 @@
> -- Maybe String is for the
> -- indicator, e.g. :var
> -- indicator :nl
+> | QuantifiedComparison
+> ValueExpr
+> Name -- operator
+> CompPredQuantifier
+> QueryExpr
+> | Match ValueExpr Bool -- true if unique
+> QueryExpr
> deriving (Eq,Show,Read,Data,Typeable)
> -- | Represents an identifier name, which can be quoted or unquoted.
@@ -146,18 +154,22 @@
> | InQueryExpr QueryExpr
> deriving (Eq,Show,Read,Data,Typeable)
+not sure if scalar subquery and aexists and unique should be represented like this
+
> -- | A subquery in a value expression.
> data SubQueryExprType
> = -- | exists (query expr)
> SqExists
+> -- | unique (query expr)
+> | SqUnique
> -- | a scalar subquery
> | SqSq
-> -- | all (query expr)
-> | SqAll
-> -- | some (query expr)
-> | SqSome
-> -- | any (query expr)
-> | SqAny
+> deriving (Eq,Show,Read,Data,Typeable)
+
+> data CompPredQuantifier
+> = CPAny
+> | CPSome
+> | CPAll
> deriving (Eq,Show,Read,Data,Typeable)
> -- | Represents one field in an order by list.
diff --git a/tools/Language/SQL/SimpleSQL/SQL2003.lhs b/tools/Language/SQL/SimpleSQL/SQL2003.lhs
index 334a697..b3f6ab0 100644
--- a/tools/Language/SQL/SimpleSQL/SQL2003.lhs
+++ b/tools/Language/SQL/SimpleSQL/SQL2003.lhs
@@ -40,6 +40,9 @@ large amount of the SQL.
> --,groupbyClause
> --,querySpecification
> --,queryExpressions
+> ,quantifiedComparisonPredicate
+> ,uniquePredicate
+> ,matchPredicate
> --,sortSpecificationList
> ]
@@ -2492,7 +2495,23 @@ Specify a quantified comparison.
<some> ::= SOME | ANY
-TODO: quantified comparison predicate
+> quantifiedComparisonPredicate :: TestItem
+> quantifiedComparisonPredicate = Group "quantified comparison predicate" $ map (uncurry TestValueExpr)
+
+> [("a = any (select * from t)"
+> ,QuantifiedComparison (Iden "a") "=" CPAny qe)
+> ,("a <= some (select * from t)"
+> ,QuantifiedComparison (Iden "a") "<=" CPSome qe)
+> ,("a > all (select * from t)"
+> ,QuantifiedComparison (Iden "a") ">" CPAll qe)
+> ,("(a,b) <> all (select * from t)"
+> ,QuantifiedComparison
+> (SpecialOp "rowctor" [Iden "a",Iden "b"]) "<>" CPAll qe)
+> ]
+> where
+> qe = makeSelect
+> {qeSelectList = [(Star,Nothing)]
+> ,qeFrom = [TRSimple "t"]}
== 8.9 <exists predicate> (p399)
@@ -2508,7 +2527,16 @@ Specify a test for the absence of duplicate rows
<unique predicate> ::= UNIQUE <table subquery>
-TODO: unique predicate
+> uniquePredicate :: TestItem
+> uniquePredicate = Group "unique predicate" $ map (uncurry TestValueExpr)
+> [("unique(select * from t where a = 4)"
+> ,SubQueryExpr SqUnique
+> $ makeSelect
+> {qeSelectList = [(Star,Nothing)]
+> ,qeFrom = [TRSimple "t"]
+> ,qeWhere = Just (BinOp (Iden "a") "=" (NumLit "4"))
+> }
+> )]
== 8.11 <normalized predicate> (p401)
@@ -2526,7 +2554,20 @@ Specify a test for matching rows.
<match predicate part 2> ::= MATCH [ UNIQUE ] [ SIMPLE | PARTIAL | FULL ] <table subquery>
-TODO: match predicate
+> matchPredicate :: TestItem
+> matchPredicate = Group "match predicate" $ map (uncurry TestValueExpr)
+> [("a match (select a from t)"
+> ,Match (Iden "a") False qe)
+> ,("(a,b) match (select a,b from t)"
+> ,Match (SpecialOp "rowctor" [Iden "a", Iden "b"]) False qea)
+> ,("(a,b) match unique (select a,b from t)"
+> ,Match (SpecialOp "rowctor" [Iden "a", Iden "b"]) True qea)
+> ]
+> where
+> qe = makeSelect
+> {qeSelectList = [(Iden "a",Nothing)]
+> ,qeFrom = [TRSimple "t"]}
+> qea = qe {qeSelectList = qeSelectList qe ++ [(Iden "b",Nothing)]}
== 8.13 <overlaps predicate> (p405)
diff --git a/tools/Language/SQL/SimpleSQL/ValueExprs.lhs b/tools/Language/SQL/SimpleSQL/ValueExprs.lhs
index 0c4aeba..c86bd3d 100644
--- a/tools/Language/SQL/SimpleSQL/ValueExprs.lhs
+++ b/tools/Language/SQL/SimpleSQL/ValueExprs.lhs
@@ -172,14 +172,14 @@ Tests for parsing value expressions
> ,("a not in (select a from t)"
> ,In False (Iden "a") (InQueryExpr ms))
-> ,("a > all (select a from t)"
-> ,BinOp (Iden "a") ">" (SubQueryExpr SqAll ms))
+> --,("a > all (select a from t)"
+> -- ,BinOp (Iden "a") ">" (SubQueryExpr SqAll ms))
-> ,("a = some (select a from t)"
-> ,BinOp (Iden "a") "=" (SubQueryExpr SqSome ms))
+> --,("a = some (select a from t)"
+> -- ,BinOp (Iden "a") "=" (SubQueryExpr SqSome ms))
-> ,("a <= any (select a from t)"
-> ,BinOp (Iden "a") "<=" (SubQueryExpr SqAny ms))
+> --,("a <= any (select a from t)"
+> -- ,BinOp (Iden "a") "<=" (SubQueryExpr SqAny ms))
> ]
> where
> ms = makeSelect