move the typed literal parser around

implement unique predicate, match predicate
change the representation of quantified comparison predicates

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

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")

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.

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)
 

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