add haddock, reorder the fields in binop and jointref to be more natural
This commit is contained in:
parent
65610af74e
commit
c28db4d470
6 changed files with 107 additions and 77 deletions
Language/SQL/SimpleSQL
|
@ -1,6 +1,5 @@
|
|||
|
||||
The parser code
|
||||
|
||||
> -- | This is the module with the parser functions.
|
||||
> module Language.SQL.SimpleSQL.Parser
|
||||
> (parseQueryExpr
|
||||
> ,parseScalarExpr
|
||||
|
@ -363,7 +362,7 @@ associativity.
|
|||
|
||||
> binaryOperatorSuffix :: Bool -> ScalarExpr -> P ScalarExpr
|
||||
> binaryOperatorSuffix bExpr e0 =
|
||||
> BinOp <$> opSymbol <*> return e0 <*> factor
|
||||
> BinOp e0 <$> opSymbol <*> factor
|
||||
> where
|
||||
> opSymbol = choice
|
||||
> (map (try . symbol) binOpSymbolNames
|
||||
|
@ -492,17 +491,16 @@ tref
|
|||
> in option j (JoinAlias j <$> try tableAlias <*> try columnAliases)
|
||||
> joinTrefSuffix t = (do
|
||||
> nat <- option False $ try (True <$ (try $ keyword_ "natural"))
|
||||
> JoinTableRef <$> joinType
|
||||
> <*> return t
|
||||
> <*> nonJoinTref
|
||||
> <*> optionMaybe (joinCondition nat))
|
||||
> JoinTableRef t <$> joinType
|
||||
> <*> nonJoinTref
|
||||
> <*> optionMaybe (joinCondition nat))
|
||||
> >>= optionSuffix joinTrefSuffix
|
||||
> joinType = choice
|
||||
> [Cross <$ try (keyword_ "cross")
|
||||
> ,Inner <$ try (keyword_ "inner")
|
||||
> [JCross <$ try (keyword_ "cross")
|
||||
> ,JInner <$ try (keyword_ "inner")
|
||||
> ,choice [JLeft <$ try (keyword_ "left")
|
||||
> ,JRight <$ try (keyword_ "right")
|
||||
> ,Full <$ try (keyword_ "full")]
|
||||
> ,JFull <$ try (keyword_ "full")]
|
||||
> <* optional (try $ keyword_ "outer")]
|
||||
> <* keyword "join"
|
||||
> joinCondition nat =
|
||||
|
|
|
@ -2,6 +2,7 @@
|
|||
This is the pretty printer code which takes AST values and turns them
|
||||
back into SQL source text. It attempts to format the output nicely.
|
||||
|
||||
> -- | These is the pretty printing functions, which produce SQL source from ASTs. The code attempts to format the output in a readable way.
|
||||
> module Language.SQL.SimpleSQL.Pretty
|
||||
> (prettyQueryExpr
|
||||
> ,prettyScalarExpr
|
||||
|
@ -12,14 +13,17 @@ back into SQL source text. It attempts to format the output nicely.
|
|||
> import Text.PrettyPrint
|
||||
> import Data.Maybe
|
||||
|
||||
> -- | Convert a query expr ast to concrete syntax.
|
||||
> prettyQueryExpr :: QueryExpr -> String
|
||||
> prettyQueryExpr = render . queryExpr
|
||||
|
||||
> -- | Convert a scalar expr ast to concrete syntax.
|
||||
> prettyScalarExpr :: ScalarExpr -> String
|
||||
> prettyScalarExpr = render . scalarExpr
|
||||
|
||||
> -- | Convert a list of query exprs to concrete syntax. A semi colon is inserted following each query expr.
|
||||
> prettyQueryExprs :: [QueryExpr] -> String
|
||||
> prettyQueryExprs = render . vcat . map ((<> text ";") . queryExpr)
|
||||
> prettyQueryExprs = render . vcat . map ((<> text ";\n") . queryExpr)
|
||||
|
||||
= scalar expressions
|
||||
|
||||
|
@ -75,9 +79,9 @@ back into SQL source text. It attempts to format the output nicely.
|
|||
|
||||
> scalarExpr (PrefixOp f e) = text f <+> scalarExpr e
|
||||
> scalarExpr (PostfixOp f e) = scalarExpr e <+> text f
|
||||
> scalarExpr (BinOp "and" e0 e1) =
|
||||
> scalarExpr (BinOp e0 "and" e1) =
|
||||
> sep [scalarExpr e0, text "and" <+> scalarExpr e1]
|
||||
> scalarExpr (BinOp f e0 e1) =
|
||||
> scalarExpr (BinOp e0 f e1) =
|
||||
> scalarExpr e0 <+> text f <+> scalarExpr e1
|
||||
|
||||
> scalarExpr (Case t ws els) =
|
||||
|
@ -171,7 +175,7 @@ back into SQL source text. It attempts to format the output nicely.
|
|||
> <+> maybe empty (parens . commaSep . map text) cs
|
||||
> tr (JoinParens t) = parens $ tr t
|
||||
> tr (JoinQueryExpr q) = parens $ queryExpr q
|
||||
> tr (JoinTableRef jt t0 t1 jc) =
|
||||
> tr (JoinTableRef t0 jt t1 jc) =
|
||||
> sep [tr t0
|
||||
> ,joinText jt jc
|
||||
> ,tr t1
|
||||
|
@ -181,11 +185,11 @@ back into SQL source text. It attempts to format the output nicely.
|
|||
> Just JoinNatural -> text "natural"
|
||||
> _ -> empty
|
||||
> ,case jt of
|
||||
> Inner -> text "inner"
|
||||
> JInner -> text "inner"
|
||||
> JLeft -> text "left"
|
||||
> JRight -> text "right"
|
||||
> Full -> text "full"
|
||||
> Cross -> text "cross"
|
||||
> JFull -> text "full"
|
||||
> JCross -> text "cross"
|
||||
> ,text "join"]
|
||||
> joinCond (Just (JoinOn e)) = text "on" <+> scalarExpr e
|
||||
> joinCond (Just (JoinUsing es)) = text "using" <+> parens (commaSep $ map text es)
|
||||
|
|
|
@ -1,21 +1,25 @@
|
|||
|
||||
> -- | The AST for SQL queries
|
||||
> module Language.SQL.SimpleSQL.Syntax
|
||||
> (ScalarExpr(..)
|
||||
> (-- * Scalar expressions
|
||||
> ScalarExpr(..)
|
||||
> ,TypeName(..)
|
||||
> ,SubQueryExprType(..)
|
||||
> ,InThing(..)
|
||||
> ,QueryExpr(..)
|
||||
> ,makeSelect
|
||||
> ,Duplicates(..)
|
||||
> ,Direction(..)
|
||||
> ,InThing(..)
|
||||
> ,SubQueryExprType(..)
|
||||
> -- * Query expressions
|
||||
> ,QueryExpr(..)
|
||||
> ,makeSelect
|
||||
> ,CombineOp(..)
|
||||
> ,Corresponding(..)
|
||||
> -- ** From
|
||||
> ,TableRef(..)
|
||||
> ,JoinType(..)
|
||||
> ,JoinCondition(..)
|
||||
> ) where
|
||||
|
||||
|
||||
> -- | Represents a scalar expression
|
||||
> data ScalarExpr = NumLit String
|
||||
> | StringLit String
|
||||
> | IntervalLit String -- text of interval
|
||||
|
@ -34,7 +38,7 @@
|
|||
> -- are used for symbol and keyword operators
|
||||
> -- these are used even for the multiple keyword
|
||||
> -- operators
|
||||
> | BinOp String ScalarExpr ScalarExpr
|
||||
> | BinOp ScalarExpr String ScalarExpr
|
||||
> | PrefixOp String ScalarExpr
|
||||
> | PostfixOp String ScalarExpr
|
||||
> -- the special op is used for ternary, mixfix and other non orthodox operators
|
||||
|
@ -51,13 +55,23 @@
|
|||
> deriving (Eq,Show)
|
||||
|
||||
> data TypeName = TypeName String deriving (Eq,Show)
|
||||
|
||||
|
||||
> -- Represents '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
|
||||
> 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).
|
||||
> data QueryExpr
|
||||
> = Select
|
||||
> {qeDuplicates :: Duplicates
|
||||
|
@ -84,11 +98,20 @@ TODO: add queryexpr parens to deal with e.g.
|
|||
(select 1 union select 2) union select 3
|
||||
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'
|
||||
> 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'
|
||||
> data CombineOp = Union | Except | Intersect deriving (Eq,Show)
|
||||
> -- | 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
|
||||
> makeSelect :: QueryExpr
|
||||
> makeSelect = Select {qeDuplicates = All
|
||||
> ,qeSelectList = []
|
||||
|
@ -100,21 +123,22 @@ I'm not sure if this is valid syntax or not
|
|||
> ,qeLimit = Nothing
|
||||
> ,qeOffset = Nothing}
|
||||
|
||||
|
||||
> data TableRef = SimpleTableRef String
|
||||
> | JoinTableRef JoinType TableRef TableRef (Maybe JoinCondition)
|
||||
> | JoinParens TableRef
|
||||
> | JoinAlias TableRef String (Maybe [String])
|
||||
> | JoinQueryExpr QueryExpr
|
||||
> -- | 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)
|
||||
> deriving (Eq,Show)
|
||||
|
||||
TODO: add function table ref
|
||||
|
||||
|
||||
> data JoinType = Inner | JLeft | JRight | Full | Cross
|
||||
> -- | The type of a join
|
||||
> data JoinType = JInner | JLeft | JRight | JFull | JCross
|
||||
> deriving (Eq,Show)
|
||||
|
||||
> data JoinCondition = JoinOn ScalarExpr
|
||||
> | JoinUsing [String]
|
||||
> | JoinNatural
|
||||
> -- | The join condition.
|
||||
> data JoinCondition = JoinOn ScalarExpr -- ^ on expr
|
||||
> | JoinUsing [String] -- ^ using (column list)
|
||||
> | JoinNatural -- ^ natural join was specified
|
||||
> deriving (Eq,Show)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue