1
Fork 0

add create, alter, drop domain

This commit is contained in:
Jake Wheat 2015-08-04 22:08:32 +03:00
parent c2810cddd2
commit 9aab04b189
4 changed files with 151 additions and 8 deletions
Language/SQL/SimpleSQL

View file

@ -189,7 +189,7 @@ fixing them in the syntax but leaving them till the semantic checking
> import Data.Char (toLower, isDigit)
> import Text.Parsec (setPosition,setSourceColumn,setSourceLine,getPosition
> ,option,between,sepBy,sepBy1
> ,try,many1,(<|>),choice,eof
> ,try,many,many1,(<|>),choice,eof
> ,optionMaybe,optional,runParser
> ,chainl1, chainr1,(<?>))
> -- import Text.Parsec.String (Parser)
@ -1443,11 +1443,14 @@ TODO: change style
> statement = choice
> [keyword_ "create" *> choice [createSchema
> ,createTable
> ,createView]
> ,keyword_ "alter" *> choice [alterTable]
> ,createView
> ,createDomain]
> ,keyword_ "alter" *> choice [alterTable
> ,alterDomain]
> ,keyword_ "drop" *> choice [dropSchema
> ,dropTable
> ,dropView]
> ,dropView
> ,dropDomain]
> ,delete
> ,truncateSt
> ,insert
@ -1638,6 +1641,35 @@ slightly hacky parser for signed integers
> dropView = keyword_ "view" >>
> DropView <$> names <*> dropBehaviour
> createDomain :: Parser Statement
> createDomain = keyword_ "domain" >>
> CreateDomain
> <$> names
> <*> (optional (keyword_ "as") *> typeName)
> <*> optionMaybe (keyword_ "default" *> valueExpr)
> <*> many con
> where
> con = (,) <$> optionMaybe (keyword_ "constraint" *> names)
> <*> (keyword_ "check" *> parens valueExpr)
> alterDomain :: Parser Statement
> alterDomain = keyword_ "domain" >>
> AlterDomain
> <$> names
> <*> (setDefault <|> constraint
> <|> (keyword_ "drop" *> (dropDefault <|> dropConstraint)))
> where
> setDefault = keywords_ ["set", "default"] >> ADSetDefault <$> valueExpr
> constraint = keyword_ "add" >>
> ADAddConstraint
> <$> optionMaybe (keyword_ "constraint" *> names)
> <*> (keyword_ "check" *> parens valueExpr)
> dropDefault = ADDropDefault <$ keyword_ "default"
> dropConstraint = keyword_ "constraint" >> ADDropConstraint <$> names
> dropDomain :: Parser Statement
> dropDomain = keyword_ "domain" >>
> DropDomain <$> names <*> dropBehaviour
-----------------

View file

@ -469,6 +469,34 @@ which have been changed to try to improve the layout of the output.
> statement _ (DropSchema nm db) =
> text "drop" <+> text "schema" <+> names nm <+> dropBehav db
> statement d (CreateDomain nm ty def cs) =
> text "create" <+> text "domain" <+> names nm
> <+> typeName ty
> <+> maybe empty (\def' -> text "default" <+> valueExpr d def') def
> <+> sep (map con cs)
> where
> con (cn, e) =
> maybe empty (\cn' -> text "constraint" <+> names cn') cn
> <+> text "check" <> parens (valueExpr d e)
> statement d (AlterDomain nm act) =
> texts ["alter","domain"]
> <+> names nm
> <+> a act
> where
> a (ADSetDefault v) = texts ["set","default"] <+> valueExpr d v
> a (ADDropDefault) = texts ["drop","default"]
> a (ADAddConstraint nm e) =
> text "add"
> <+> maybe empty (\nm' -> text "constraint" <+> names nm') nm
> <+> text "check" <> parens (valueExpr d e)
> a (ADDropConstraint nm) = texts ["drop", "constraint"]
> <+> names nm
> statement _ (DropDomain nm db) =
> text "drop" <+> text "domain" <+> names nm <+> dropBehav db
== dml
> statement d (SelectStatement q) = queryExpr d q

View file

@ -48,6 +48,7 @@
> ,ReferentialAction(..)
> ,AlterTableAction(..)
> ,CheckOption(..)
> ,AlterDomainAction(..)
> -- * Dialect
> ,Dialect(..)
> -- * Comment
@ -410,10 +411,11 @@ I'm not sure if this is valid syntax or not.
> | CreateView Bool [Name] (Maybe [Name])
> QueryExpr (Maybe CheckOption)
> | DropView [Name] DropBehaviour
> {- | CreateDomain
> | AlterDomain
> | DropDomain
> | CreateCharacterSet
> | CreateDomain [Name] TypeName (Maybe ValueExpr)
> [(Maybe [Name], ValueExpr)]
> | AlterDomain [Name] AlterDomainAction
> | DropDomain [Name] DropBehaviour
> {- | CreateCharacterSet
> | DropCharacterSet
> | CreateCollation
> | DropCollation
@ -625,6 +627,13 @@ I'm not sure if this is valid syntax or not.
> | LocalCheckOption
> deriving (Eq,Show,Read,Data,Typeable)
> data AlterDomainAction =
> ADSetDefault ValueExpr
> | ADDropDefault
> | ADAddConstraint (Maybe [Name]) ValueExpr
> | ADDropConstraint [Name]
> deriving (Eq,Show,Read,Data,Typeable)
--------------------------