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 | 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 (p399) @@ -2508,7 +2527,16 @@ Specify a test for the absence of duplicate rows ::= UNIQUE -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 (p401) @@ -2526,7 +2554,20 @@ Specify a test for matching rows. ::= MATCH [ UNIQUE ] [ SIMPLE | PARTIAL | FULL ]
-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 (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