start adding basic dml
parser and pretty printer for statements add query statement add support for insert update delete truncate bonus ddl: limited create schema drop schema add grammar notes to the new test files
This commit is contained in:
parent
6fc8869f73
commit
dfa84072dc
13 changed files with 684 additions and 2238 deletions
Language/SQL/SimpleSQL
|
@ -179,7 +179,8 @@ fixing them in the syntax but leaving them till the semantic checking
|
|||
> module Language.SQL.SimpleSQL.Parser
|
||||
> (parseQueryExpr
|
||||
> ,parseValueExpr
|
||||
> ,parseQueryExprs
|
||||
> ,parseStatement
|
||||
> ,parseStatements
|
||||
> ,ParseError(..)) where
|
||||
|
||||
> import Control.Monad.Identity (Identity)
|
||||
|
@ -220,9 +221,23 @@ fixing them in the syntax but leaving them till the semantic checking
|
|||
> -> Either ParseError QueryExpr
|
||||
> parseQueryExpr = wrapParse topLevelQueryExpr
|
||||
|
||||
> -- | Parses a list of query expressions, with semi colons between
|
||||
> -- | Parses a statement, trailing semicolon optional.
|
||||
> parseStatement :: Dialect
|
||||
> -- ^ dialect of SQL to use
|
||||
> -> FilePath
|
||||
> -- ^ filename to use in error messages
|
||||
> -> Maybe (Int,Int)
|
||||
> -- ^ line number and column number of the first character
|
||||
> -- in the source to use in error messages
|
||||
> -> String
|
||||
> -- ^ the SQL source to parse
|
||||
> -> Either ParseError Statement
|
||||
> parseStatement = wrapParse statement
|
||||
|
||||
|
||||
> -- | Parses a list of statements, with semi colons between
|
||||
> -- them. The final semicolon is optional.
|
||||
> parseQueryExprs :: Dialect
|
||||
> parseStatements :: Dialect
|
||||
> -- ^ dialect of SQL to use
|
||||
> -> FilePath
|
||||
> -- ^ filename to use in error messages
|
||||
|
@ -231,8 +246,8 @@ fixing them in the syntax but leaving them till the semantic checking
|
|||
> -- in the source to use in error messages
|
||||
> -> String
|
||||
> -- ^ the SQL source to parse
|
||||
> -> Either ParseError [QueryExpr]
|
||||
> parseQueryExprs = wrapParse queryExprs
|
||||
> -> Either ParseError [Statement]
|
||||
> parseStatements = wrapParse statements
|
||||
|
||||
> -- | Parses a value expression.
|
||||
> parseValueExpr :: Dialect
|
||||
|
@ -701,7 +716,15 @@ all the value expressions which start with an identifier
|
|||
> idenExpr =
|
||||
> -- todo: work out how to left factor this
|
||||
> try (TypedLit <$> typeName <*> stringTokExtend)
|
||||
> <|> multisetSetFunction
|
||||
> <|> (names <**> option Iden app)
|
||||
> where
|
||||
> -- this is a special case because set is a reserved keyword
|
||||
> -- and the names parser won't parse it
|
||||
> multisetSetFunction =
|
||||
> App [Name "set"] . (:[]) <$>
|
||||
> (try (keyword_ "set" *> openParen)
|
||||
> *> valueExpr <* closeParen)
|
||||
|
||||
=== special
|
||||
|
||||
|
@ -1409,16 +1432,93 @@ TODO: change style
|
|||
> topLevelQueryExpr :: Parser QueryExpr
|
||||
> topLevelQueryExpr = queryExpr <??> (id <$ semi)
|
||||
|
||||
wrapper to parse a series of query exprs from a single source. They
|
||||
must be separated by semicolon, but for the last expression, the
|
||||
trailing semicolon is optional.
|
||||
-------------------------
|
||||
|
||||
= Statements
|
||||
|
||||
> statement :: Parser Statement
|
||||
> statement = choice
|
||||
> [keyword_ "create"
|
||||
> *> choice
|
||||
> [createSchema
|
||||
> ]
|
||||
> ,keyword_ "drop"
|
||||
> *> choice
|
||||
> [dropSchema
|
||||
> ]
|
||||
> ,delete
|
||||
> ,truncateSt
|
||||
> ,insert
|
||||
> ,update
|
||||
> ,SelectStatement <$> queryExpr
|
||||
> ]
|
||||
|
||||
> createSchema :: Parser Statement
|
||||
> createSchema = keyword_ "schema" >>
|
||||
> CreateSchema <$> names
|
||||
|
||||
> dropSchema :: Parser Statement
|
||||
> dropSchema = keyword_ "schema" >>
|
||||
> DropSchema <$> names
|
||||
> <*> dropBehaviour
|
||||
|
||||
> delete :: Parser Statement
|
||||
> delete = keywords_ ["delete","from"] >>
|
||||
> Delete
|
||||
> <$> names
|
||||
> <*> optionMaybe (optional (keyword_ "as") *> name)
|
||||
> <*> optionMaybe (keyword_ "where" *> valueExpr)
|
||||
|
||||
> truncateSt :: Parser Statement
|
||||
> truncateSt = keywords_ ["truncate", "table"] >>
|
||||
> Truncate
|
||||
> <$> names
|
||||
> <*> option DefaultIdentityRestart
|
||||
> (ContinueIdentity <$ keywords_ ["continue","identity"]
|
||||
> <|> RestartIdentity <$ keywords_ ["restart","identity"])
|
||||
|
||||
> insert :: Parser Statement
|
||||
> insert = keywords_ ["insert", "into"] >>
|
||||
> Insert
|
||||
> <$> names
|
||||
> <*> optionMaybe (parens $ commaSep1 name)
|
||||
> <*> (DefaultInsertValues <$ keywords_ ["default", "values"]
|
||||
> <|> InsertQuery <$> queryExpr)
|
||||
|
||||
> update :: Parser Statement
|
||||
> update = keywords_ ["update"] >>
|
||||
> Update
|
||||
> <$> names
|
||||
> <*> optionMaybe (optional (keyword_ "as") *> name)
|
||||
> <*> (keyword_ "set" *> commaSep1 setClause)
|
||||
> <*> optionMaybe (keyword_ "where" *> valueExpr)
|
||||
> where
|
||||
> setClause = multipleSet <|> singleSet
|
||||
> multipleSet = SetMultiple
|
||||
> <$> parens (commaSep1 names)
|
||||
> <*> (symbol "=" *> parens (commaSep1 valueExpr))
|
||||
> singleSet = Set
|
||||
> <$> names
|
||||
> <*> (symbol "=" *> valueExpr)
|
||||
|
||||
> dropBehaviour :: Parser DropBehaviour
|
||||
> dropBehaviour =
|
||||
> option DefaultDropBehaviour
|
||||
> (Restrict <$ keyword_ "restrict"
|
||||
> <|> Cascade <$ keyword_ "cascade")
|
||||
|
||||
----------------------------
|
||||
|
||||
wrapper to parse a series of statements. They must be separated by
|
||||
semicolon, but for the last statement, the trailing semicolon is
|
||||
optional.
|
||||
|
||||
TODO: change style
|
||||
|
||||
> queryExprs :: Parser [QueryExpr]
|
||||
> queryExprs = (:[]) <$> queryExpr
|
||||
> statements :: Parser [Statement]
|
||||
> statements = (:[]) <$> statement
|
||||
> >>= optionSuffix ((semi *>) . pure)
|
||||
> >>= optionSuffix (\p -> (p++) <$> queryExprs)
|
||||
> >>= optionSuffix (\p -> (p++) <$> statements)
|
||||
|
||||
----------------------------------------------
|
||||
|
||||
|
@ -1884,7 +1984,7 @@ means).
|
|||
> ,"select"
|
||||
> ,"sensitive"
|
||||
> --,"session_user"
|
||||
> --,"set"
|
||||
> ,"set"
|
||||
> ,"similar"
|
||||
> ,"smallint"
|
||||
> --,"some"
|
||||
|
|
|
@ -5,7 +5,8 @@
|
|||
> module Language.SQL.SimpleSQL.Pretty
|
||||
> (prettyQueryExpr
|
||||
> ,prettyValueExpr
|
||||
> ,prettyQueryExprs
|
||||
> ,prettyStatement
|
||||
> ,prettyStatements
|
||||
> ) where
|
||||
|
||||
TODO: there should be more comments in this file, especially the bits
|
||||
|
@ -26,10 +27,14 @@ which have been changed to try to improve the layout of the output.
|
|||
> prettyValueExpr :: Dialect -> ValueExpr -> String
|
||||
> prettyValueExpr d = render . valueExpr d
|
||||
|
||||
> -- | Convert a list of query exprs to concrete syntax. A semi colon
|
||||
> -- is inserted after each query expr.
|
||||
> prettyQueryExprs :: Dialect -> [QueryExpr] -> String
|
||||
> prettyQueryExprs d = render . vcat . map ((<> text ";\n") . queryExpr d)
|
||||
> -- | Convert a statement ast to concrete syntax.
|
||||
> prettyStatement :: Dialect -> Statement -> String
|
||||
> prettyStatement d = render . statement d
|
||||
|
||||
> -- | Convert a list of statements to concrete syntax. A semi colon
|
||||
> -- is inserted after each statement.
|
||||
> prettyStatements :: Dialect -> [Statement] -> String
|
||||
> prettyStatements d = render . vcat . map ((<> text ";\n") . statement d)
|
||||
|
||||
= value expressions
|
||||
|
||||
|
@ -438,6 +443,67 @@ which have been changed to try to improve the layout of the output.
|
|||
> NullsFirst -> text "nulls" <+> text "first"
|
||||
> NullsLast -> text "nulls" <+> text "last")
|
||||
|
||||
= statements
|
||||
|
||||
> statement :: Dialect -> Statement -> Doc
|
||||
|
||||
|
||||
== ddl
|
||||
|
||||
> statement _ (CreateSchema nm) =
|
||||
> text "create" <+> text "schema" <+> names nm
|
||||
|
||||
> statement _ (DropSchema nm db) =
|
||||
> text "drop" <+> text "schema" <+> names nm <+> dropBehav db
|
||||
|
||||
== dml
|
||||
|
||||
> statement d (SelectStatement q) = queryExpr d q
|
||||
|
||||
> statement d (Delete t a w) =
|
||||
> text "delete" <+> text "from"
|
||||
> <+> names t <+> maybe empty (\x -> text "as" <+> name x) a
|
||||
> <+> maybeValueExpr d "where" w
|
||||
|
||||
> statement _ (Truncate t ir) =
|
||||
> text "truncate" <+> text "table" <+> names t
|
||||
> <+> case ir of
|
||||
> DefaultIdentityRestart -> empty
|
||||
> ContinueIdentity -> text "continue" <+> text "identity"
|
||||
> RestartIdentity -> text "restart" <+> text "identity"
|
||||
|
||||
> statement d (Insert t cs s) =
|
||||
> text "insert" <+> text "into" <+> names t
|
||||
> <+> maybe empty (\cs' -> parens (commaSep $ map name cs')) cs
|
||||
> <+> case s of
|
||||
> DefaultInsertValues -> text "default" <+> text "values"
|
||||
> InsertQuery q -> queryExpr d q
|
||||
|
||||
> statement d (Update t a sts whr) =
|
||||
> text "update" <+> names t
|
||||
> <+> maybe empty (\x -> text "as" <+> name x) a
|
||||
> <+> text "set" <+> commaSep (map sc sts)
|
||||
> <+> maybeValueExpr d "where" whr
|
||||
> where
|
||||
> sc (Set tg v) = names tg <+> text "=" <+> valueExpr d v
|
||||
> sc (SetMultiple ts vs) = parens (commaSep $ map names ts) <+> text "="
|
||||
> <+> parens (commaSep $ map (valueExpr d) vs)
|
||||
|
||||
== access control
|
||||
|
||||
== transactions
|
||||
|
||||
== sessions
|
||||
|
||||
|
||||
== extras
|
||||
|
||||
> dropBehav :: DropBehaviour -> Doc
|
||||
> dropBehav DefaultDropBehaviour = empty
|
||||
> dropBehav Cascade = text "cascade"
|
||||
> dropBehav Restrict = text "restrict"
|
||||
|
||||
|
||||
= utils
|
||||
|
||||
> commaSep :: [Doc] -> Doc
|
||||
|
|
|
@ -30,9 +30,15 @@
|
|||
> ,TableRef(..)
|
||||
> ,JoinType(..)
|
||||
> ,JoinCondition(..)
|
||||
> -- * dialect
|
||||
> -- * Statements
|
||||
> ,Statement(..)
|
||||
> ,DropBehaviour(..)
|
||||
> ,IdentityRestart(..)
|
||||
> ,InsertSource(..)
|
||||
> ,SetClause(..)
|
||||
> -- * Dialect
|
||||
> ,Dialect(..)
|
||||
> -- * comment
|
||||
> -- * Comment
|
||||
> ,Comment(..)
|
||||
> ) where
|
||||
|
||||
|
@ -380,6 +386,107 @@ I'm not sure if this is valid syntax or not.
|
|||
> | JoinUsing [Name] -- ^ using (column list)
|
||||
> deriving (Eq,Show,Read,Data,Typeable)
|
||||
|
||||
---------------------------
|
||||
|
||||
> data Statement =
|
||||
> -- ddl
|
||||
> CreateSchema [Name] -- XXX
|
||||
> | DropSchema [Name] DropBehaviour -- XXX
|
||||
> {- | CreateTable -- XXX
|
||||
> | AlterTable -- XXX
|
||||
> | DropTable -- XXX
|
||||
> | CreateView -- XXX
|
||||
> | DropView -- XXX
|
||||
> | CreateDomain -- XXX
|
||||
> | AlterDomain
|
||||
> | DropDomain -- XXX
|
||||
> | CreateCharacterSet
|
||||
> | DropCharacterSet
|
||||
> | CreateCollation
|
||||
> | DropCollation
|
||||
> | CreateTranslation
|
||||
> | DropTranslation
|
||||
> | CreateAssertion
|
||||
> | DropAssertion
|
||||
> | CreateTrigger
|
||||
> | DropTrigger
|
||||
> | CreateType
|
||||
> | AlterType
|
||||
> | DropType
|
||||
> -- routine stuff?
|
||||
> | CreateCast
|
||||
> | DropCast
|
||||
> | CreateOrdering
|
||||
> | DropOrdering
|
||||
> -- transforms
|
||||
> | CreateSequence -- XXX
|
||||
> | AlterSequence -- XXX
|
||||
> | DropSequence -- XXX -}
|
||||
> -- dml
|
||||
> | SelectStatement QueryExpr
|
||||
> {- | DeclareCursor
|
||||
> | OpenCursor
|
||||
> | FetchCursor
|
||||
> | CloseCursor
|
||||
> | SelectInto -}
|
||||
> -- | DeletePositioned
|
||||
> | Delete [Name] (Maybe Name) (Maybe ValueExpr)
|
||||
> | Truncate [Name] IdentityRestart
|
||||
> | Insert [Name] (Maybe [Name]) InsertSource
|
||||
> -- | Merge
|
||||
> | Update [Name] (Maybe Name) [SetClause] (Maybe ValueExpr)
|
||||
> {- | TemporaryTable
|
||||
> | FreeLocator
|
||||
> | HoldLocator -}
|
||||
> -- access control
|
||||
> {- | GrantPrivilege
|
||||
> | GrantRole
|
||||
> | CreateRole
|
||||
> | DropRole
|
||||
> | RevokePrivilege
|
||||
> | RevokeRole -}
|
||||
> -- transaction management
|
||||
> {- | StartTransaction
|
||||
> | SetTransaction
|
||||
> | SetContraints
|
||||
> | SavePoint
|
||||
> | ReleaseSavePoint
|
||||
> | Rollback -}
|
||||
> -- session
|
||||
> {- | SetSessionCharacteristics
|
||||
> | SetSessionAuthorization
|
||||
> | SetRole
|
||||
> | SetTimeZone
|
||||
> | SetCatalog
|
||||
> | SetSchema
|
||||
> | SetNames
|
||||
> | SetTransform
|
||||
> | SetCollation -}
|
||||
> deriving (Eq,Show,Read,Data,Typeable)
|
||||
|
||||
> data DropBehaviour =
|
||||
> Restrict
|
||||
> | Cascade
|
||||
> | DefaultDropBehaviour
|
||||
> deriving (Eq,Show,Read,Data,Typeable)
|
||||
|
||||
> data IdentityRestart =
|
||||
> ContinueIdentity
|
||||
> | RestartIdentity
|
||||
> | DefaultIdentityRestart
|
||||
> deriving (Eq,Show,Read,Data,Typeable)
|
||||
|
||||
> data InsertSource =
|
||||
> InsertQuery QueryExpr
|
||||
> | DefaultInsertValues
|
||||
> deriving (Eq,Show,Read,Data,Typeable)
|
||||
|
||||
> data SetClause =
|
||||
> Set [Name] ValueExpr
|
||||
> | SetMultiple [[Name]] [ValueExpr]
|
||||
> deriving (Eq,Show,Read,Data,Typeable)
|
||||
|
||||
--------------------------
|
||||
|
||||
> -- | Used to set the dialect used for parsing and pretty printing,
|
||||
> -- very unfinished at the moment.
|
||||
|
@ -388,7 +495,8 @@ I'm not sure if this is valid syntax or not.
|
|||
> deriving (Eq,Show,Read,Data,Typeable)
|
||||
|
||||
|
||||
> -- | Comment. Useful when generating SQL code programmatically.
|
||||
> -- | Comment. Useful when generating SQL code programmatically. The
|
||||
> -- parser doesn't produce these.
|
||||
> data Comment = BlockComment String
|
||||
> deriving (Eq,Show,Read,Data,Typeable)
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue