diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index eb046b1..13d219b 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -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"
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index 0351fa9..039db76 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@@ -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
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index c1e076b..b9d1adf 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -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)
diff --git a/simple-sql-parser.cabal b/simple-sql-parser.cabal
index ea9d9f2..bd30a22 100644
--- a/simple-sql-parser.cabal
+++ b/simple-sql-parser.cabal
@@ -4,9 +4,8 @@ synopsis: A parser for SQL.
description: A parser for SQL. Parses most SQL:2011
queries, DML, schema/DDL, transaction control,
- session and connection management, access
- control. Please see the homepage for more
- information
+ session and access control. Please see the
+ homepage for more information
.
homepage: http://jakewheat.github.io/simple-sql-parser/
diff --git a/tools/Language/SQL/SimpleSQL/QueryExprs.lhs b/tools/Language/SQL/SimpleSQL/QueryExprs.lhs
index 3c62a3b..f7eaf4d 100644
--- a/tools/Language/SQL/SimpleSQL/QueryExprs.lhs
+++ b/tools/Language/SQL/SimpleSQL/QueryExprs.lhs
@@ -8,11 +8,11 @@ query expressions from one string.
> import Language.SQL.SimpleSQL.Syntax
> queryExprsTests :: TestItem
-> queryExprsTests = Group "query exprs" $ map (uncurry (TestQueryExprs SQL2011))
+> queryExprsTests = Group "query exprs" $ map (uncurry (TestStatements SQL2011))
> [("select 1",[ms])
> ,("select 1;",[ms])
> ,("select 1;select 1",[ms,ms])
> ,(" select 1;select 1; ",[ms,ms])
> ]
> where
-> ms = makeSelect {qeSelectList = [(NumLit "1",Nothing)]}
+> ms = SelectStatement $ makeSelect {qeSelectList = [(NumLit "1",Nothing)]}
diff --git a/tools/Language/SQL/SimpleSQL/SQL2011AccessControl.lhs b/tools/Language/SQL/SimpleSQL/SQL2011AccessControl.lhs
index f443d81..463b423 100644
--- a/tools/Language/SQL/SimpleSQL/SQL2011AccessControl.lhs
+++ b/tools/Language/SQL/SimpleSQL/SQL2011AccessControl.lhs
@@ -10,3 +10,110 @@ grant, etc
> sql2011AccessControlTests :: TestItem
> sql2011AccessControlTests = Group "sql 2011 access control tests" []
+
+12 Access control
+
+12.1
+
+ ::=
+
+ |
+
+12.2
+
+ ::=
+ GRANT TO [ { }... ]
+ [ WITH HIERARCHY OPTION ]
+ [ WITH GRANT OPTION ]
+ [ GRANTED BY ]
+
+12.3
+ ::=
+