starlitcanopy/simple-sql-parser
1
Fork 0
Code Activity

work on haddock and a few renames

Browse source
This commit is contained in:
Jake Wheat 2013-12-14 14:10:46 +02:00
parent c28db4d470
commit b001276337
4 changed files with 151 additions and 75 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
Language/SQL/SimpleSQL/Parser.lhs
View file

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

10
Language/SQL/SimpleSQL/Pretty.lhs
View file

@ -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

130
Language/SQL/SimpleSQL/Syntax.lhs
View file

@ -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)

70
Tests.lhs
View file

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