From 211174cfb4910b87566cc6bb4f7ac8944c45bc03 Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
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 <multiset value expression> (p286)