1
Fork 0

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:
Jake Wheat 2015-08-01 20:26:00 +03:00
parent 6fc8869f73
commit dfa84072dc
13 changed files with 684 additions and 2238 deletions
Language/SQL/SimpleSQL

View file

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

View file

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

View file

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