From b00127633705432eafc832bdd2f30125552c61c5 Mon Sep 17 00:00:00 2001 From: Jake Wheat Date: Sat, 14 Dec 2013 14:10:46 +0200 Subject: [PATCH] work on haddock and a few renames --- Language/SQL/SimpleSQL/Parser.lhs | 16 ++-- Language/SQL/SimpleSQL/Pretty.lhs | 10 +-- Language/SQL/SimpleSQL/Syntax.lhs | 130 +++++++++++++++++++++++------- Tests.lhs | 70 ++++++++-------- 4 files changed, 151 insertions(+), 75 deletions(-) diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs index d42e18e..7bdc0cd 100644 --- a/Language/SQL/SimpleSQL/Parser.lhs +++ b/Language/SQL/SimpleSQL/Parser.lhs @@ -24,12 +24,14 @@ The public api functions. > -> Either ParseError QueryExpr > parseQueryExpr = wrapParse topLevelQueryExpr +> -- | Parses a list of query exprs, with semi colons between them. The final semicolon is optional. > parseQueryExprs :: FilePath -- ^ filename to use in errors > -> Maybe (Int,Int) -- ^ line number and column number to use in errors > -> String -- ^ the sql source to parse > -> Either ParseError [QueryExpr] > parseQueryExprs = wrapParse queryExprs +> -- | Parses a scalar expression. > parseScalarExpr :: FilePath -- ^ filename to use in errors > -> Maybe (Int,Int) -- ^ line number and column number to use in errors > -> String -- ^ the sql source to parse @@ -480,20 +482,20 @@ tref > from = try (keyword_ "from") *> commaSep1 tref > where > tref = nonJoinTref >>= optionSuffix joinTrefSuffix -> nonJoinTref = choice [try (JoinQueryExpr <$> parens queryExpr) -> ,JoinParens <$> parens tref -> ,SimpleTableRef <$> identifierString] +> nonJoinTref = choice [try (TRQueryExpr <$> parens queryExpr) +> ,TRParens <$> parens tref +> ,TRSimple <$> identifierString] > >>= optionSuffix aliasSuffix > aliasSuffix j = > let tableAlias = optional (try $ keyword_ "as") *> identifierString > columnAliases = optionMaybe $ try $ parens > $ commaSep1 identifierString -> in option j (JoinAlias j <$> try tableAlias <*> try columnAliases) +> in option j (TRAlias j <$> try tableAlias <*> try columnAliases) > joinTrefSuffix t = (do > nat <- option False $ try (True <$ (try $ keyword_ "natural")) -> JoinTableRef t <$> joinType -> <*> nonJoinTref -> <*> optionMaybe (joinCondition nat)) +> TRJoin t <$> joinType +> <*> nonJoinTref +> <*> optionMaybe (joinCondition nat)) > >>= optionSuffix joinTrefSuffix > joinType = choice > [JCross <$ try (keyword_ "cross") diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index 857052b..0fc572f 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/Language/SQL/SimpleSQL/Pretty.lhs @@ -169,13 +169,13 @@ back into SQL source text. It attempts to format the output nicely. > sep [text "from" > ,nest 4 $ commaSep $ map tr ts] > where -> tr (SimpleTableRef t) = text t -> tr (JoinAlias t a cs) = +> tr (TRSimple t) = text t +> tr (TRAlias t a cs) = > tr t <+> text "as" <+> text a > <+> maybe empty (parens . commaSep . map text) cs -> tr (JoinParens t) = parens $ tr t -> tr (JoinQueryExpr q) = parens $ queryExpr q -> tr (JoinTableRef t0 jt t1 jc) = +> tr (TRParens t) = parens $ tr t +> tr (TRQueryExpr q) = parens $ queryExpr q +> tr (TRJoin t0 jt t1 jc) = > sep [tr t0 > ,joinText jt jc > ,tr t1 diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index 57b05aa..cb4a3b5 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/Language/SQL/SimpleSQL/Syntax.lhs @@ -20,62 +20,133 @@ > ) where > -- | Represents a scalar expression -> data ScalarExpr = NumLit String +> data ScalarExpr = -- | a numeric literal optional decimal point, e+- +> -- integral exponent, e.g +> -- +> -- * 10 +> -- +> -- * 10. +> -- +> -- * .1 +> -- +> -- * 10.1 +> -- +> -- * 1e5 +> -- +> -- * 12.34e-6 +> NumLit String + +> -- | string literal, currently only basic strings +> -- between single quotes without escapes (no +> -- single quotes in strings then) > | StringLit String -> | IntervalLit String -- text of interval -> String -- units of interval -> (Maybe Int) -- precision +> -- | text of interval literal, units of interval +> -- precision, e.g. interval 3 days (3) +> | IntervalLit String +> String +> (Maybe Int) +> -- | identifier without dots > | Iden String +> -- | identifier with one dot > | Iden2 String String +> -- | star > | Star +> -- | star with qualifier, e.g t.* > | Star2 String +> -- | function application (anything that looks +> -- like c style function application syntactically) > | App String [ScalarExpr] +> -- | aggregate application, which adds distinct or +> -- all, and order by, to regular function +> -- application > | AggregateApp String (Maybe Duplicates) > [ScalarExpr] > [(ScalarExpr,Direction)] +> -- | window application, which adds over +> -- (partition by a order by b) to regular function +> -- application. Explicit frames are not currently +> -- supported > | WindowApp String [ScalarExpr] [ScalarExpr] [(ScalarExpr,Direction)] -> -- the binop, prefixop and postfix op -> -- are used for symbol and keyword operators -> -- these are used even for the multiple keyword -> -- operators +> -- | 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 ScalarExpr String ScalarExpr +> -- | Prefix unary operators. This is used for +> -- symbol operators, keyword operators and +> -- multiple keyword operators > | PrefixOp String ScalarExpr +> -- | Postfix unary operators. This is used for +> -- symbol operators, keyword operators and multiple +> -- keyword operators > | PostfixOp String ScalarExpr -> -- the special op is used for ternary, mixfix and other non orthodox operators +> -- | Used for ternary, mixfix and other non +> -- orthodox operators, including the function +> -- looking calls which use keywords instead of +> -- commas to separate the arguments, +> -- e.g. substring(t from 1 to 5) > | SpecialOp String [ScalarExpr] +> -- | case expression. both flavours +> -- supported. Multiple condition when branches not +> -- currently supported (case when a=4,b=5 then x +> -- end) > | Case (Maybe ScalarExpr) -- test value > [(ScalarExpr,ScalarExpr)] -- when branches > (Maybe ScalarExpr) -- else value > | Parens ScalarExpr +> -- | cast(a as typename) > | Cast ScalarExpr TypeName +> -- | prefix 'typed literal', e.g. int '42' > | CastOp TypeName String +> -- | exists, all, any, some subqueries > | SubQueryExpr SubQueryExprType QueryExpr +> -- | in list literal and in subquery, if the bool +> -- is false it means not in was used ('a not in +> -- (1,2)') > | In Bool -- true if in, false if not in > ScalarExpr InThing > deriving (Eq,Show) +> -- | Represents a type name, used in casts. > data TypeName = TypeName String deriving (Eq,Show) -> -- Represents 'expr in (scalar expression list)', and 'expr in -> -- (subquery)' syntax +> -- | Used for 'expr in (scalar expression list)', and 'expr in +> -- | (subquery)' syntax > data InThing = InList [ScalarExpr] > | InQueryExpr QueryExpr > deriving (Eq,Show) > -- | A subquery in a scalar expression -> data SubQueryExprType = SqExists | SqSq | SqAll | SqSome | SqAny +> data SubQueryExprType +> = -- | exists (query expr) +> SqExists +> -- | a scalar subquery +> | SqSq +> -- | all (query expr) +> | SqAll +> -- | some (query expr) +> | SqSome +> -- | any (query expr) +> | SqAny > deriving (Eq,Show) -> -- | Represents a query expression, which can be a select, a 'set -> -- operator' (union/except/intersect), a common table expression -> -- (with), a values expression (not yet supported) or the table -> -- syntax - 'table t', shorthand for 'select * from t' (not yet -> -- supported). +> -- | Represents a query expression, which can be: +> -- +> -- * a regular select; +> -- +> -- * a set operator (union, except, intersect); +> -- +> -- * a common table expression (with); +> -- +> -- * a values expression (not yet supported); +> -- +> -- * or the table syntax - 'table t', shorthand for 'select * from +> -- t' (not yet supported). > data QueryExpr > = Select > {qeDuplicates :: Duplicates -> ,qeSelectList :: [(Maybe String,ScalarExpr)] +> ,qeSelectList :: [(Maybe String,ScalarExpr)] -- ^ the column aliases and the expressions > ,qeFrom :: [TableRef] > ,qeWhere :: Maybe ScalarExpr > ,qeGroupBy :: [ScalarExpr] @@ -101,14 +172,14 @@ I'm not sure if this is valid syntax or not > -- | represents the Distinct or All keywords, which can be used > -- before a select list, in an aggregate/window function -> -- application, or in a query expression 'set operator' +> -- application, or in a query expression set operator > data Duplicates = Distinct | All deriving (Eq,Show) > -- | The direction for a column in order by. > data Direction = Asc | Desc deriving (Eq,Show) -> -- | Query expression 'set operators' +> -- | Query expression set operators > data CombineOp = Union | Except | Intersect deriving (Eq,Show) -> -- | Corresponding, an option for the 'set operators' +> -- | Corresponding, an option for the set operators > data Corresponding = Corresponding | Respectively deriving (Eq,Show) > -- | helper/'default' value for query exprs to make creating query expr values a little easier @@ -124,11 +195,16 @@ I'm not sure if this is valid syntax or not > ,qeOffset = Nothing} > -- | Represents a entry in the csv of tables in the from clause. -> data TableRef = SimpleTableRef String -- from t -> | JoinTableRef TableRef JoinType TableRef (Maybe JoinCondition) -- from a join b -> | JoinParens TableRef -- from (a) -> | JoinAlias TableRef String (Maybe [String]) -- from a as b(c,d) -> | JoinQueryExpr QueryExpr -- from (query expr) +> data TableRef = -- | from t +> TRSimple String +> -- | from a join b +> | TRJoin TableRef JoinType TableRef (Maybe JoinCondition) +> -- | from (a) +> | TRParens TableRef +> -- | from a as b(c,d) +> | TRAlias TableRef String (Maybe [String]) +> -- | from (query expr) +> | TRQueryExpr QueryExpr > deriving (Eq,Show) TODO: add function table ref @@ -140,5 +216,5 @@ TODO: add function table ref > -- | The join condition. > data JoinCondition = JoinOn ScalarExpr -- ^ on expr > | JoinUsing [String] -- ^ using (column list) -> | JoinNatural -- ^ natural join was specified +> | JoinNatural -- ^ natural join was used > deriving (Eq,Show) diff --git a/Tests.lhs b/Tests.lhs index 75de0a9..c6f8e5f 100644 --- a/Tests.lhs +++ b/Tests.lhs @@ -143,7 +143,7 @@ > where > ms = makeSelect > {qeSelectList = [(Nothing,Iden "a")] -> ,qeFrom = [SimpleTableRef "t"] +> ,qeFrom = [TRSimple "t"] > } > miscOps :: TestItem @@ -240,7 +240,7 @@ > ms d = makeSelect > {qeDuplicates = d > ,qeSelectList = [(Nothing,Iden "a")] -> ,qeFrom = [SimpleTableRef "t"]} +> ,qeFrom = [TRSimple "t"]} > selectLists :: TestItem > selectLists = Group "selectLists" $ map (uncurry TestQueryExpr) @@ -266,50 +266,48 @@ > from :: TestItem > from = Group "from" $ map (uncurry TestQueryExpr) > [("select a from t" -> ,ms [SimpleTableRef "t"]) +> ,ms [TRSimple "t"]) > ,("select a from t,u" -> ,ms [SimpleTableRef "t", SimpleTableRef "u"]) +> ,ms [TRSimple "t", TRSimple "u"]) > ,("select a from t inner join u on expr" -> ,ms [JoinTableRef (SimpleTableRef "t") JInner (SimpleTableRef "u") +> ,ms [TRJoin (TRSimple "t") JInner (TRSimple "u") > (Just $ JoinOn $ Iden "expr")]) > ,("select a from t left join u on expr" -> ,ms [JoinTableRef (SimpleTableRef "t") JLeft (SimpleTableRef "u") +> ,ms [TRJoin (TRSimple "t") JLeft (TRSimple "u") > (Just $ JoinOn $ Iden "expr")]) > ,("select a from t right join u on expr" -> ,ms [JoinTableRef (SimpleTableRef "t") JRight (SimpleTableRef "u") +> ,ms [TRJoin (TRSimple "t") JRight (TRSimple "u") > (Just $ JoinOn $ Iden "expr")]) > ,("select a from t full join u on expr" -> ,ms [JoinTableRef (SimpleTableRef "t") JFull (SimpleTableRef "u") +> ,ms [TRJoin (TRSimple "t") JFull (TRSimple "u") > (Just $ JoinOn $ Iden "expr")]) > ,("select a from t cross join u" -> ,ms [JoinTableRef (SimpleTableRef "t") -> JCross (SimpleTableRef "u") Nothing]) +> ,ms [TRJoin (TRSimple "t") +> JCross (TRSimple "u") Nothing]) > ,("select a from t natural inner join u" -> ,ms [JoinTableRef (SimpleTableRef "t") JInner (SimpleTableRef "u") +> ,ms [TRJoin (TRSimple "t") JInner (TRSimple "u") > (Just JoinNatural)]) > ,("select a from t inner join u using(a,b)" -> ,ms [JoinTableRef (SimpleTableRef "t") JInner (SimpleTableRef "u") +> ,ms [TRJoin (TRSimple "t") JInner (TRSimple "u") > (Just $ JoinUsing ["a", "b"])]) > ,("select a from (select a from t)" -> ,ms [JoinQueryExpr $ ms [SimpleTableRef "t"]]) +> ,ms [TRQueryExpr $ ms [TRSimple "t"]]) > ,("select a from t as u" -> ,ms [JoinAlias (SimpleTableRef "t") "u" Nothing]) +> ,ms [TRAlias (TRSimple "t") "u" Nothing]) > ,("select a from t u" -> ,ms [JoinAlias (SimpleTableRef "t") "u" Nothing]) +> ,ms [TRAlias (TRSimple "t") "u" Nothing]) > ,("select a from t u(b)" -> ,ms [JoinAlias (SimpleTableRef "t") "u" $ Just ["b"]]) +> ,ms [TRAlias (TRSimple "t") "u" $ Just ["b"]]) > ,("select a from (t cross join u) as u" -> ,ms [JoinAlias (JoinParens $ -> JoinTableRef (SimpleTableRef "t") -> JCross -> (SimpleTableRef "u") Nothing) -> "u" Nothing]) +> ,ms [TRAlias (TRParens $ +> TRJoin (TRSimple "t") JCross (TRSimple "u") Nothing) +> "u" Nothing]) > -- todo: not sure if the associativity is correct > ,("select a from t cross join u cross join v", -> ms [JoinTableRef -> (JoinTableRef (SimpleTableRef "t") -> JCross (SimpleTableRef "u") Nothing) -> JCross (SimpleTableRef "v") Nothing]) +> ms [TRJoin +> (TRJoin (TRSimple "t") +> JCross (TRSimple "u") Nothing) +> JCross (TRSimple "v") Nothing]) > ] > where > ms f = makeSelect {qeSelectList = [(Nothing,Iden "a")] @@ -319,7 +317,7 @@ > whereClause = Group "whereClause" $ map (uncurry TestQueryExpr) > [("select a from t where a = 5" > ,makeSelect {qeSelectList = [(Nothing,Iden "a")] -> ,qeFrom = [SimpleTableRef "t"] +> ,qeFrom = [TRSimple "t"] > ,qeWhere = Just $ BinOp (Iden "a") "=" (NumLit "5")}) > ] @@ -328,14 +326,14 @@ > [("select a,sum(b) from t group by a" > ,makeSelect {qeSelectList = [(Nothing, Iden "a") > ,(Nothing, App "sum" [Iden "b"])] -> ,qeFrom = [SimpleTableRef "t"] +> ,qeFrom = [TRSimple "t"] > ,qeGroupBy = [Iden "a"] > }) > ,("select a,b,sum(c) from t group by a,b" > ,makeSelect {qeSelectList = [(Nothing, Iden "a") > ,(Nothing, Iden "b") > ,(Nothing, App "sum" [Iden "c"])] -> ,qeFrom = [SimpleTableRef "t"] +> ,qeFrom = [TRSimple "t"] > ,qeGroupBy = [Iden "a",Iden "b"] > }) > ] @@ -345,7 +343,7 @@ > [("select a,sum(b) from t group by a having sum(b) > 5" > ,makeSelect {qeSelectList = [(Nothing, Iden "a") > ,(Nothing, App "sum" [Iden "b"])] -> ,qeFrom = [SimpleTableRef "t"] +> ,qeFrom = [TRSimple "t"] > ,qeGroupBy = [Iden "a"] > ,qeHaving = Just $ BinOp (App "sum" [Iden "b"]) > ">" (NumLit "5") @@ -365,7 +363,7 @@ > ] > where > ms o = makeSelect {qeSelectList = [(Nothing,Iden "a")] -> ,qeFrom = [SimpleTableRef "t"] +> ,qeFrom = [TRSimple "t"] > ,qeOrderBy = o} > limit :: TestItem @@ -378,7 +376,7 @@ > where > ms l o = makeSelect > {qeSelectList = [(Nothing,Iden "a")] -> ,qeFrom = [SimpleTableRef "t"] +> ,qeFrom = [TRSimple "t"] > ,qeLimit = l > ,qeOffset = o} @@ -401,10 +399,10 @@ > where > ms1 = makeSelect > {qeSelectList = [(Nothing,Iden "a")] -> ,qeFrom = [SimpleTableRef "t"]} +> ,qeFrom = [TRSimple "t"]} > ms2 = makeSelect > {qeSelectList = [(Nothing,Iden "b")] -> ,qeFrom = [SimpleTableRef "u"]} +> ,qeFrom = [TRSimple "u"]} > withQueries :: TestItem @@ -419,7 +417,7 @@ > where > ms c t = makeSelect > {qeSelectList = [(Nothing,Iden c)] -> ,qeFrom = [SimpleTableRef t]} +> ,qeFrom = [TRSimple t]} > ms1 = ms "a" "t" > ms2 = ms "a" "u" > ms3 = ms "a" "x" @@ -430,7 +428,7 @@ > [("select count(*) from t" > ,makeSelect > {qeSelectList = [(Nothing, App "count" [Star])] -> ,qeFrom = [SimpleTableRef "t"] +> ,qeFrom = [TRSimple "t"] > } > ) > ,("select a, sum(c+d) as s\n\ @@ -444,7 +442,7 @@ > ,(Just "s" > ,App "sum" [BinOp (Iden "c") > "+" (Iden "d")])] -> ,qeFrom = [SimpleTableRef "t", SimpleTableRef "u"] +> ,qeFrom = [TRSimple "t", TRSimple "u"] > ,qeWhere = Just $ BinOp (Iden "a") ">" (NumLit "5") > ,qeGroupBy = [Iden "a"] > ,qeHaving = Just $ BinOp (App "count" [NumLit "1"])