diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index 092064d..222c44e 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -144,6 +144,12 @@ which parses as a typed literal
> name = choice [QName <$> quotedIdentifier
> ,Name <$> identifierBlacklist blacklist]
+> names :: Parser [Name]
+> names = ((:[]) <$> name) >>= optionSuffix another
+> where
+> another n =
+> (((n++) . (:[])) <$> try (symbol "." *> name)) >>= optionSuffix another
+
== star
used in select *, select x.*, and agg(*) variations, and some other
@@ -181,7 +187,7 @@ The parsing for the aggregate extensions is here as well:
aggregate([all|distinct] args [order by orderitems])
-> aggOrApp :: Name -> Parser ValueExpr
+> aggOrApp :: [Name] -> Parser ValueExpr
> aggOrApp n =
> makeApp n
> <$> parens ((,,) <$> (fromMaybe SQDefault <$> duplicates)
@@ -243,7 +249,7 @@ always used with the optionSuffix combinator.
> mkFrame rs c = c rs
> windowSuffix _ = fail ""
-> app :: Name -> Parser ValueExpr
+> app :: [Name] -> Parser ValueExpr
> app n = aggOrApp n >>= optionSuffix windowSuffix
== iden prefix term
@@ -256,7 +262,7 @@ all the value expressions which start with an identifier
> idenPrefixTerm =
> -- todo: work out how to left factor this
> try (TypedLit <$> typeName <*> stringToken)
-> <|> (name >>= iden)
+> <|> (names >>= iden)
> where
> iden n = app n <|> return (Iden n)
@@ -308,7 +314,7 @@ operatorname(firstArg keyword0 arg0 keyword1 arg1 etc.)
> -- check we haven't parsed the first
> -- keyword as an identifier
> guard (case (e,kws) of
-> (Iden (Name i), (k,_):_) | map toLower i == k -> False
+> (Iden [Name i], (k,_):_) | map toLower i == k -> False
> _ -> True)
> return e
> fa <- case firstArg of
@@ -317,7 +323,7 @@ operatorname(firstArg keyword0 arg0 keyword1 arg1 etc.)
> SOKMandatory -> Just <$> pfa
> as <- mapM parseArg kws
> void closeParen
-> return $ SpecialOpK (Name opName) fa $ catMaybes as
+> return $ SpecialOpK [Name opName] fa $ catMaybes as
> where
> parseArg (nm,mand) =
> let p = keyword_ nm >> valueExpr
@@ -389,7 +395,7 @@ in the source
> ,"trailing" <$ keyword_ "trailing"
> ,"both" <$ keyword_ "both"]
> mkTrim fa ch fr =
-> SpecialOpK (Name "trim") Nothing
+> SpecialOpK [Name "trim"] Nothing
> $ catMaybes [Just (fa,StringLit ch)
> ,Just ("from", fr)]
@@ -426,14 +432,14 @@ and operator. This is the call to valueExprB.
> betweenSuffix :: Parser (ValueExpr -> ValueExpr)
> betweenSuffix =
-> makeOp <$> (Name <$> opName)
+> makeOp <$> Name <$> opName
> <*> valueExprB
> <*> (keyword_ "and" *> valueExprB)
> where
> opName = choice
> ["between" <$ keyword_ "between"
> ,"not between" <$ try (keyword_ "not" <* keyword_ "between")]
-> makeOp n b c = \a -> SpecialOp n [a,b,c]
+> makeOp n b c = \a -> SpecialOp [n] [a,b,c]
subquery expression:
[exists|unique] (queryexpr)
@@ -453,7 +459,7 @@ a = any (select * from t)
> c <- comp
> cq <- compQuan
> q <- parens queryExpr
-> return $ \v -> QuantifiedComparison v c cq q
+> return $ \v -> QuantifiedComparison v [c] cq q
> where
> comp = Name <$> choice (map symbol
> ["=", "<>", "<=", "<", ">", ">="])
@@ -481,7 +487,7 @@ a match (select a from t)
> arrayCtor = keyword_ "array" >>
> choice
> [ArrayCtor <$> parens queryExpr
-> ,Array (Iden (Name "array")) <$> brackets (commaSep valueExpr)]
+> ,Array (Iden [Name "array"]) <$> brackets (commaSep valueExpr)]
> escape :: Parser (ValueExpr -> ValueExpr)
> escape = do
@@ -545,7 +551,7 @@ todo: timestamp types:
> ,ctor <$> commaSep1 valueExpr]
> where
> ctor [a] = Parens a
-> ctor as = SpecialOp (Name "rowctor") as
+> ctor as = SpecialOp [Name "rowctor"] as
== operator parsing
@@ -624,12 +630,12 @@ TODO: carefully review the precedences and associativities.
> -- somehow
> binaryKeywords nm assoc = binary (try $ mapM_ keyword_ (words nm)) nm assoc
> binary p nm assoc =
-> E.Infix (p >> return (\a b -> BinOp a (Name nm) b)) assoc
+> E.Infix (p >> return (\a b -> BinOp a [Name nm] b)) assoc
> prefixKeyword nm = prefix (keyword_ nm) nm
> prefixSym nm = prefix (symbol_ nm) nm
-> prefix p nm = prefix' (p >> return (PrefixOp (Name nm)))
+> 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)))
+> 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
@@ -705,12 +711,10 @@ tref
> ,TRLateral <$> (keyword_ "lateral"
> *> nonJoinTref)
> ,do
-> n <- name
+> n <- names
> choice [TRFunction n
> <$> parens (commaSep valueExpr)
-> ,do
-> choice [TRQualified n <$> (symbol "." >> name)
-> ,return $ TRSimple n]]]
+> ,return $ TRSimple n]]
> >>= optionSuffix aliasSuffix
> aliasSuffix j = option j (TRAlias j <$> alias)
> joinTrefSuffix t = (do
@@ -842,7 +846,7 @@ and union, etc..
> Select d sl f w g h od ofs fe
> values = keyword_ "values"
> >> Values <$> commaSep (parens (commaSep valueExpr))
-> table = keyword_ "table" >> Table <$> name
+> table = keyword_ "table" >> Table <$> names
local data type to help with parsing the bit after the select list,
called 'table expression' in the ansi sql grammar. Maybe this should
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index 20715fb..98cc3e1 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@@ -14,8 +14,9 @@ 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, brackets)
+> doubleQuotes, brackets,hcat)
> import Data.Maybe (maybeToList, catMaybes)
+> import Data.List (intercalate)
> -- | Convert a query expr ast to concrete syntax.
> prettyQueryExpr :: QueryExpr -> String
@@ -40,7 +41,7 @@ which have been changed to try to improve the layout of the output.
> text "interval" <+> quotes (text v)
> <+> text u
> <+> maybe empty (parens . text . show ) p
-> valueExpr (Iden i) = name i
+> valueExpr (Iden i) = names i
> valueExpr Star = text "*"
> valueExpr Parameter = text "?"
> valueExpr (HostParameter p i) =
@@ -49,10 +50,10 @@ which have been changed to try to improve the layout of the output.
> (\i' -> text "indicator" <+> text (':':i'))
> i
-> valueExpr (App f es) = name f <> parens (commaSep (map valueExpr es))
+> valueExpr (App f es) = names f <> parens (commaSep (map valueExpr es))
> valueExpr (AggregateApp f d es od) =
-> name f
+> names f
> <> parens ((case d of
> Distinct -> text "distinct"
> All -> text "all"
@@ -61,7 +62,7 @@ which have been changed to try to improve the layout of the output.
> <+> orderBy od)
> valueExpr (WindowApp f es pb od fr) =
-> name f <> parens (commaSep $ map valueExpr es)
+> names f <> parens (commaSep $ map valueExpr es)
> <+> text "over"
> <+> parens ((case pb of
> [] -> empty
@@ -83,40 +84,40 @@ which have been changed to try to improve the layout of the output.
> fpd (Preceding e) = valueExpr e <+> text "preceding"
> fpd (Following e) = valueExpr e <+> text "following"
-> valueExpr (SpecialOp nm [a,b,c]) | nm `elem` [Name "between"
-> ,Name "not between"] =
+> valueExpr (SpecialOp nm [a,b,c]) | nm `elem` [[Name "between"]
+> ,[Name "not between"]] =
> sep [valueExpr a
-> ,name nm <+> valueExpr b
-> ,nest (length (unname nm) + 1) $ text "and" <+> valueExpr c]
+> ,names nm <+> valueExpr b
+> ,nest (length (unnames nm) + 1) $ text "and" <+> valueExpr c]
-> valueExpr (SpecialOp (Name "rowctor") as) =
+> valueExpr (SpecialOp [Name "rowctor"] as) =
> parens $ commaSep $ map valueExpr as
> valueExpr (SpecialOp nm es) =
-> name nm <+> parens (commaSep $ map valueExpr es)
+> names nm <+> parens (commaSep $ map valueExpr es)
> valueExpr (SpecialOpK nm fs as) =
-> name nm <> parens (sep $ catMaybes
+> names nm <> parens (sep $ catMaybes
> (fmap valueExpr fs
> : map (\(n,e) -> Just (text n <+> valueExpr e)) as))
-> valueExpr (PrefixOp f e) = name f <+> valueExpr e
-> valueExpr (PostfixOp f e) = valueExpr e <+> name f
-> valueExpr e@(BinOp _ op _) | op `elem` [Name "and", Name "or"] =
+> valueExpr (PrefixOp f e) = names f <+> valueExpr e
+> valueExpr (PostfixOp f e) = valueExpr e <+> names f
+> valueExpr e@(BinOp _ op _) | op `elem` [[Name "and"], [Name "or"]] =
> -- special case for and, or, get all the ands so we can vcat them
> -- nicely
> case ands e of
> (e':es) -> vcat (valueExpr e'
-> : map ((name op <+>) . valueExpr) es)
+> : map ((names op <+>) . valueExpr) es)
> [] -> empty -- shouldn't be possible
> where
> ands (BinOp a op' b) | op == op' = ands a ++ ands b
> ands x = [x]
> -- special case for . we don't use whitespace
-> valueExpr (BinOp e0 (Name ".") e1) =
+> valueExpr (BinOp e0 [Name "."] e1) =
> valueExpr e0 <> text "." <> valueExpr e1
> valueExpr (BinOp e0 f e1) =
-> valueExpr e0 <+> name f <+> valueExpr e1
+> valueExpr e0 <+> names f <+> valueExpr e1
> valueExpr (Case t ws els) =
> sep $ [text "case" <+> maybe empty valueExpr t]
@@ -146,7 +147,7 @@ which have been changed to try to improve the layout of the output.
> valueExpr (QuantifiedComparison v c cp sq) =
> valueExpr v
-> <+> name c
+> <+> names c
> <+> (text $ case cp of
> CPAny -> "any"
> CPSome -> "some"
@@ -197,10 +198,17 @@ which have been changed to try to improve the layout of the output.
> unname (QName n) = "\"" ++ n ++ "\""
> unname (Name n) = n
+> unnames :: [Name] -> String
+> unnames ns = intercalate "." $ map unname ns
+
+
> name :: Name -> Doc
> name (QName n) = doubleQuotes $ text n
> name (Name n) = text n
+> names :: [Name] -> Doc
+> names ns = hcat $ punctuate (text ".") $ map name ns
+
> typeName :: TypeName -> Doc
> typeName (TypeName t) = text t
> typeName (PrecTypeName t a) = text t <+> parens (text $ show a)
@@ -250,7 +258,7 @@ which have been changed to try to improve the layout of the output.
> queryExpr (Values vs) =
> text "values"
> <+> nest 7 (commaSep (map (parens . commaSep . map valueExpr) vs))
-> queryExpr (Table t) = text "table" <+> name t
+> queryExpr (Table t) = text "table" <+> names t
> alias :: Alias -> Doc
@@ -270,11 +278,10 @@ which have been changed to try to improve the layout of the output.
> sep [text "from"
> ,nest 5 $ vcat $ punctuate comma $ map tr ts]
> where
-> tr (TRSimple t) = name t
-> tr (TRQualified s t) = name s <> text "." <> name t
+> tr (TRSimple t) = names t
> tr (TRLateral t) = text "lateral" <+> tr t
> tr (TRFunction f as) =
-> name f <> parens (commaSep $ map valueExpr as)
+> names f <> parens (commaSep $ map valueExpr as)
> tr (TRAlias t a) = sep [tr t, alias a]
> tr (TRParens t) = parens $ tr t
> tr (TRQueryExpr q) = parens $ queryExpr q
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index c6560d2..1c26f3a 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -60,17 +60,17 @@
> ,ilUnits :: String -- ^ units
> ,ilPrecision :: Maybe Integer -- ^ precision
> }
-> -- | identifier without dots
-> | Iden Name
+> -- | identifier with parts separated by dots
+> | Iden [Name]
> -- | star, as in select *, t.*, count(*)
> | Star
> -- | function application (anything that looks like c style
> -- function application syntactically)
-> | App Name [ValueExpr]
+> | App [Name] [ValueExpr]
> -- | aggregate application, which adds distinct or all, and
> -- order by, to regular function application
> | AggregateApp
-> {aggName :: Name -- ^ aggregate function name
+> {aggName :: [Name] -- ^ aggregate function name
> ,aggDistinct :: SetQuantifier -- ^ distinct
> ,aggArgs :: [ValueExpr]-- ^ args
> ,aggOrderBy :: [SortSpec] -- ^ order by
@@ -79,7 +79,7 @@
> -- by b) to regular function application. Explicit frames are
> -- not currently supported
> | WindowApp
-> {wnName :: Name -- ^ window function name
+> {wnName :: [Name] -- ^ window function name
> ,wnArgs :: [ValueExpr] -- ^ args
> ,wnPartition :: [ValueExpr] -- ^ partition by
> ,wnOrderBy :: [SortSpec] -- ^ order by
@@ -88,23 +88,23 @@
> -- | Infix binary operators. This is used for symbol operators
> -- (a + b), keyword operators (a and b) and multiple keyword
> -- operators (a is similar to b)
-> | BinOp ValueExpr Name ValueExpr
+> | BinOp ValueExpr [Name] ValueExpr
> -- | Prefix unary operators. This is used for symbol
> -- operators, keyword operators and multiple keyword operators.
-> | PrefixOp Name ValueExpr
+> | PrefixOp [Name] ValueExpr
> -- | Postfix unary operators. This is used for symbol
> -- operators, keyword operators and multiple keyword operators.
-> | PostfixOp Name ValueExpr
+> | PostfixOp [Name] ValueExpr
> -- | Used for ternary, mixfix and other non orthodox
> -- operators. Currently used for row constructors, and for
> -- between.
-> | SpecialOp Name [ValueExpr]
+> | SpecialOp [Name] [ValueExpr]
> -- | Used for the operators which look like functions
> -- except the arguments are separated by keywords instead
> -- of commas. The maybe is for the first unnamed argument
> -- if it is present, and the list is for the keyword argument
> -- pairs.
-> | SpecialOpK Name (Maybe ValueExpr) [(String,ValueExpr)]
+> | SpecialOpK [Name] (Maybe ValueExpr) [(String,ValueExpr)]
> -- | case expression. both flavours supported
> | Case
> {caseTest :: Maybe ValueExpr -- ^ test value
@@ -129,7 +129,7 @@
> -- indicator :nl
> | QuantifiedComparison
> ValueExpr
-> Name -- operator
+> [Name] -- operator
> CompPredQuantifier
> QueryExpr
> | Match ValueExpr Bool -- true if unique
@@ -254,7 +254,7 @@ This would make some things a bit cleaner?
> ,qeViews :: [(Alias,QueryExpr)]
> ,qeQueryExpression :: QueryExpr}
> | Values [[ValueExpr]]
-> | Table Name
+> | Table [Name]
> deriving (Eq,Show,Read,Data,Typeable)
TODO: add queryexpr parens to deal with e.g.
@@ -309,10 +309,8 @@ I'm not sure if this is valid syntax or not.
> deriving (Eq,Show,Read,Data,Typeable)
> -- | Represents a entry in the csv of tables in the from clause.
-> data TableRef = -- | from t
-> TRSimple Name
-> -- | from s.t
-> | TRQualified Name Name
+> data TableRef = -- | from t / from s.t
+> TRSimple [Name]
> -- | from a join b
> | TRJoin TableRef JoinType TableRef (Maybe JoinCondition)
> -- | from (a)
@@ -322,7 +320,7 @@ I'm not sure if this is valid syntax or not.
> -- | from (query expr)
> | TRQueryExpr QueryExpr
> -- | from function(args)
-> | TRFunction Name [ValueExpr]
+> | TRFunction [Name] [ValueExpr]
> -- | from lateral t
> | TRLateral TableRef
> deriving (Eq,Show,Read,Data,Typeable)
diff --git a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs b/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
index 811eedb..f206db7 100644
--- a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
+++ b/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
@@ -67,8 +67,8 @@ These are a few misc tests which don't fit anywhere else.
> ,("select a + b * c"
> ,makeSelect {qeSelectList =
-> [(BinOp (Iden (Name "a")) (Name "+")
-> (BinOp (Iden (Name "b")) (Name "*") (Iden (Name "c")))
+> [(BinOp (Iden "a") "+"
+> (BinOp (Iden "b") "*" (Iden "c"))
> ,Nothing)]})
> ]
diff --git a/tools/Language/SQL/SimpleSQL/TableRefs.lhs b/tools/Language/SQL/SimpleSQL/TableRefs.lhs
index c75212e..91bd35d 100644
--- a/tools/Language/SQL/SimpleSQL/TableRefs.lhs
+++ b/tools/Language/SQL/SimpleSQL/TableRefs.lhs
@@ -21,7 +21,7 @@ expression
> ,ms [TRSimple "t", TRSimple "u"])
> ,("select a from s.t"
-> ,ms [TRQualified "s" "t"])
+> ,ms [TRSimple ["s","t"]])
these lateral queries make no sense but the syntax is valid
diff --git a/tools/Language/SQL/SimpleSQL/TestTypes.lhs b/tools/Language/SQL/SimpleSQL/TestTypes.lhs
index 8254c9c..8a3d6da 100644
--- a/tools/Language/SQL/SimpleSQL/TestTypes.lhs
+++ b/tools/Language/SQL/SimpleSQL/TestTypes.lhs
@@ -2,6 +2,7 @@
This is the types used to define the tests as pure data. See the
Tests.lhs module for the 'interpreter'.
+> {-# LANGUAGE FlexibleInstances #-}
> module Language.SQL.SimpleSQL.TestTypes where
> import Language.SQL.SimpleSQL.Syntax
@@ -24,3 +25,6 @@ hack to make the tests a bit simpler
> instance IsString Name where
> fromString = Name
+
+> instance IsString [Name] where
+> fromString = (:[]) . Name
diff --git a/tools/Language/SQL/SimpleSQL/ValueExprs.lhs b/tools/Language/SQL/SimpleSQL/ValueExprs.lhs
index e4b1c2b..f974e1c 100644
--- a/tools/Language/SQL/SimpleSQL/ValueExprs.lhs
+++ b/tools/Language/SQL/SimpleSQL/ValueExprs.lhs
@@ -47,7 +47,7 @@ Tests for parsing value expressions
> identifiers = Group "identifiers" $ map (uncurry TestValueExpr)
> [("iden1", Iden "iden1")
> --,("t.a", Iden2 "t" "a")
-> ,("\"quoted identifier\"", Iden $ QName "quoted identifier")
+> ,("\"quoted identifier\"", Iden [QName "quoted identifier"])
> ]
> star :: TestItem
@@ -65,9 +65,9 @@ Tests for parsing value expressions
> dots :: TestItem
> dots = Group "dot" $ map (uncurry TestValueExpr)
-> [("t.a", BinOp (Iden "t") "." (Iden "a"))
+> [("t.a", Iden ["t","a"])
> ,("t.*", BinOp (Iden "t") "." Star)
-> ,("a.b.c", BinOp (BinOp (Iden "a") "." (Iden "b")) "." (Iden "c"))
+> ,("a.b.c", Iden ["a","b","c"])
> ,("ROW(t.*,42)", App "ROW" [BinOp (Iden "t") "." Star, NumLit "42"])
> ]