change the names in the ast to be lists so can support qualified names

everywhere:
  TRSimple: replaces the TRQualified
  Iden
  App name
  AggregateApp name
  WindowApp name
  operator names (not sure if this is used in ansi sql)
  explicit table
  function in from clause

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
+>                 ,return $ TRSimple n]]
->                  choice [TRQualified n <$> (symbol "." >> name)
->                         ,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

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"
+> valueExpr (SpecialOp nm [a,b,c]) | nm `elem` [[Name "between"]
->                                               ,Name "not between"] =
+>                                              ,[Name "not between"]] =
 >   sep [valueExpr a
->       ,name nm <+> valueExpr b
+>       ,names nm <+> valueExpr b
->       ,nest (length (unname nm) + 1) $ text "and" <+> valueExpr c]
+>       ,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 (PrefixOp f e) = names f <+> valueExpr e
-> valueExpr (PostfixOp f e) = valueExpr e <+> name f
+> valueExpr (PostfixOp f e) = valueExpr e <+> names f
-> valueExpr e@(BinOp _ op _) | op `elem` [Name "and", Name "or"] =
+> 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 (TRSimple t) = names t
->     tr (TRQualified s t) = name s <> text "." <> name 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

Language/SQL/SimpleSQL/Syntax.lhs

@@ -60,17 +60,17 @@
 >       ,ilUnits :: String -- ^ units
 >       ,ilPrecision :: Maybe Integer -- ^ precision
 >       }
->       -- | identifier without dots
+>       -- | identifier with parts separated by dots
->     | Iden Name
+>     | 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
+> data TableRef = -- | from t / from s.t
->                 TRSimple Name
+>                 TRSimple [Name]
->                 -- | from s.t
->               | TRQualified Name 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)

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 "a") "+"
->         (BinOp (Iden (Name "b")) (Name "*") (Iden (Name "c")))
+>         (BinOp (Iden "b") "*" (Iden "c"))
 >        ,Nothing)]})
 
 >     ]

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
 

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

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