From 211174cfb4910b87566cc6bb4f7ac8944c45bc03 Mon Sep 17 00:00:00 2001 From: Jake Wheat Date: Thu, 17 Apr 2014 22:57:33 +0300 Subject: [PATCH] work on array constructors and expressions --- Language/SQL/SimpleSQL/Parser.lhs | 23 ++++++++++++ Language/SQL/SimpleSQL/Pretty.lhs | 10 ++++- Language/SQL/SimpleSQL/Syntax.lhs | 8 +++- tools/Language/SQL/SimpleSQL/SQL2003.lhs | 47 +++++++++++++++++------- 4 files changed, 71 insertions(+), 17 deletions(-) diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs index 43d9d80..7a13c21 100644 --- a/Language/SQL/SimpleSQL/Parser.lhs +++ b/Language/SQL/SimpleSQL/Parser.lhs @@ -462,6 +462,17 @@ a match (select a from t) > return $ \v -> Match v u q +> arrayPostfix :: Parser (ValueExpr -> ValueExpr) +> arrayPostfix = do +> es <- brackets (commaSep valueExpr) +> return $ \v -> Array v es + +> arrayCtor :: Parser ValueExpr +> arrayCtor = keyword_ "array" >> +> choice +> [ArrayCtor <$> parens queryExpr +> ,Array (Iden (Name "array")) <$> brackets (commaSep valueExpr)] + typename: used in casts. Special cases for the multi keyword typenames that SQL supports. @@ -529,6 +540,7 @@ TODO: carefully review the precedences and associativities. > [E.Postfix $ try quantifiedComparison > ,E.Postfix matchPredicate] > ,[binarySym "." E.AssocLeft] +> ,[postfix' arrayPostfix] > ,[prefixSym "+", prefixSym "-"] > ,[binarySym "^" E.AssocLeft] > ,[binarySym "*" E.AssocLeft @@ -618,6 +630,7 @@ fragile and could at least do with some heavy explanation. > ,hostParameter > ,caseValue > ,cast +> ,arrayCtor > ,specialOpKs > ,parensTerm > ,subquery @@ -961,6 +974,13 @@ todo: work out the symbol parsing better > closeParen :: Parser Char > closeParen = lexeme $ char ')' +> openBracket :: Parser Char +> openBracket = lexeme $ char '[' + +> closeBracket :: Parser Char +> closeBracket = lexeme $ char ']' + + > comma :: Parser Char > comma = lexeme $ char ',' @@ -1005,6 +1025,9 @@ todo: work out the symbol parsing better > parens :: Parser a -> Parser a > parens = between openParen closeParen +> brackets :: Parser a -> Parser a +> brackets = between openBracket closeBracket + > commaSep :: Parser a -> Parser [a] > commaSep = (`sepBy` comma) diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index 62ef117..3969845 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/Language/SQL/SimpleSQL/Pretty.lhs @@ -14,7 +14,7 @@ which have been changed to try to improve the layout of the output. > import Language.SQL.SimpleSQL.Syntax > import Text.PrettyPrint (render, vcat, text, (<>), (<+>), empty, parens, > nest, Doc, punctuate, comma, sep, quotes, -> doubleQuotes) +> doubleQuotes, brackets) > import Data.Maybe (maybeToList, catMaybes) > -- | Convert a query expr ast to concrete syntax. @@ -162,7 +162,6 @@ which have been changed to try to improve the layout of the output. > <+> (if u then text "unique" else empty) > <+> parens (queryExpr sq) - > valueExpr (In b se x) = > valueExpr se <+> > (if b then empty else text "not") @@ -172,6 +171,13 @@ which have been changed to try to improve the layout of the output. > InList es -> commaSep $ map valueExpr es > InQueryExpr qe -> queryExpr qe) +> valueExpr (Array v es) = +> valueExpr v <> brackets (commaSep $ map valueExpr es) + +> valueExpr (ArrayCtor q) = +> text "array" <> parens (queryExpr q) + + > unname :: Name -> String > unname (QName n) = "\"" ++ n ++ "\"" > unname (Name n) = n diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index dec1802..256e7b5 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/Language/SQL/SimpleSQL/Syntax.lhs @@ -134,6 +134,12 @@ > QueryExpr > | Match ValueExpr Bool -- true if unique > QueryExpr +> | Array ValueExpr [ValueExpr] -- ^ represents an array +> -- access expression, or an array ctor +> -- e.g. a[3]. The first +> -- valueExpr is the array, the +> -- second is the subscripts/ctor args +> | ArrayCtor QueryExpr -- ^ this is used for the query expression version of array constructors, e.g. array(select * from t)> deriving (Eq,Show,Read,Data,Typeable) > deriving (Eq,Show,Read,Data,Typeable) > -- | Represents an identifier name, which can be quoted or unquoted. @@ -154,7 +160,7 @@ > | InQueryExpr QueryExpr > deriving (Eq,Show,Read,Data,Typeable) -not sure if scalar subquery and aexists and unique should be represented like this +not sure if scalar subquery, exists and unique should be represented like this > -- | A subquery in a value expression. > data SubQueryExprType diff --git a/tools/Language/SQL/SimpleSQL/SQL2003.lhs b/tools/Language/SQL/SimpleSQL/SQL2003.lhs index b3f6ab0..c347c62 100644 --- a/tools/Language/SQL/SimpleSQL/SQL2003.lhs +++ b/tools/Language/SQL/SimpleSQL/SQL2003.lhs @@ -27,13 +27,13 @@ large amount of the SQL. > --,typeNames > --,parenthesizedValueExpression > ,targetSpecification -> --,contextuallyTypeValueSpec +> ,contextuallyTypeValueSpec > --,nextValueExpression -> --,arrayElementReference +> ,arrayElementReference > --,multisetElementReference > --,numericValueExpression > --,booleanValueExpression -> --,arrayValueConstructor +> ,arrayValueConstructor > --,tableValueConstructor > --,fromClause > --,whereClause @@ -1076,7 +1076,7 @@ TODO: review how the special keywords are parsed and add tests for these > ,(":hostparam indicator :another_host_param" > ,HostParameter "hostparam" $ Just "another_host_param") > ,("?", Parameter) -> --,(":h[3]", Array (HostParameter "h" Nothing) [NumLit "3"]) +> ,(":h[3]", Array (HostParameter "h" Nothing) [NumLit "3"]) > ] TODO: modules stuff, not sure what current_collation is @@ -1102,10 +1102,10 @@ for or how it works > contextuallyTypeValueSpec :: TestItem > contextuallyTypeValueSpec = Group "ontextually typed value specification" $ map (uncurry TestValueExpr) -> [("null", undefined) -> ,("array[]", undefined) -> ,("multiset[]", undefined) -> ,("default", undefined) +> [("null", Iden "null") +> ,("array[]", Array (Iden "array") []) +> --,("multiset[]", undefined) +> ,("default", Iden "default") > ] todo: trigraphs? @@ -1352,8 +1352,16 @@ TODO: reference resolution > arrayElementReference :: TestItem > arrayElementReference = Group "array element reference" $ map (uncurry TestValueExpr) -> [("something[3]", undefined) -> ,("(something(a))[x][y] ", undefined) +> [("something[3]" +> ,Array (Iden "something") [NumLit "3"]) +> ,("(something(a))[x]" +> ,Array (Parens (App "something" [Iden "a"])) +> [Iden "x"]) +> ,("(something(a))[x][y] " +> ,Array ( +> Array (Parens (App "something" [Iden "a"])) +> [Iden "x"]) +> [Iden "y"]) > ] TODO: work out the precendence of the array element reference suffix @@ -1765,10 +1773,21 @@ operator is ||, same as the string concatenation operator. > arrayValueConstructor :: TestItem > arrayValueConstructor = Group "array value constructor" $ map (uncurry TestValueExpr) -> [("array[1,2,3]", undefined) -> ,("array[a,b,c]", undefined) -> ,("array(select * from t)", undefined) -> ,("array(select * from t order by a)", undefined) +> [("array[1,2,3]" +> ,Array (Iden "array") +> [NumLit "1", NumLit "2", NumLit "3"]) +> ,("array[a,b,c]" +> ,Array (Iden "array") +> [Iden "a", Iden "b", Iden "c"]) +> ,("array(select * from t)" +> ,ArrayCtor (makeSelect +> {qeSelectList = [(Star,Nothing)] +> ,qeFrom = [TRSimple "t"]})) +> ,("array(select * from t order by a)" +> ,ArrayCtor (makeSelect +> {qeSelectList = [(Star,Nothing)] +> ,qeFrom = [TRSimple "t"] +> ,qeOrderBy = [SortSpec (Iden "a") Asc NullsOrderDefault] })) > ] == 6.37 (p286)