add create, alter, drop domain

Language/SQL/SimpleSQL/Parser.lhs

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

Language/SQL/SimpleSQL/Pretty.lhs

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

Language/SQL/SimpleSQL/Syntax.lhs

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

tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs

@@ -1152,6 +1152,40 @@ defintely skip
   [ <constraint name definition> ] <check constraint definition> [
       <constraint characteristics> ]
 
+>     ,(TestStatement SQL2011
+>       "create domain my_int int"
+>      $ CreateDomain [Name "my_int"]
+>           (TypeName [Name "int"])
+>           Nothing [])
+
+>     ,(TestStatement SQL2011
+>       "create domain my_int as int"
+>      $ CreateDomain [Name "my_int"]
+>           (TypeName [Name "int"])
+>           Nothing [])
+
+>     ,(TestStatement SQL2011
+>       "create domain my_int int default 0"
+>      $ CreateDomain [Name "my_int"]
+>           (TypeName [Name "int"])
+>           (Just (NumLit "0")) [])
+
+>     ,(TestStatement SQL2011
+>       "create domain my_int int check (value > 5)"
+>      $ CreateDomain [Name "my_int"]
+>           (TypeName [Name "int"])
+>           Nothing [(Nothing
+>                    ,BinOp (Iden [Name "value"]) [Name ">"] (NumLit "5"))])
+
+>     ,(TestStatement SQL2011
+>       "create domain my_int int constraint gt5 check (value > 5)"
+>      $ CreateDomain [Name "my_int"]
+>           (TypeName [Name "int"])
+>           Nothing [(Just [Name "gt5"]
+>                    ,BinOp (Iden [Name "value"]) [Name ">"] (NumLit "5"))])
+
+
+
 11.35 <alter domain statement>
 
 <alter domain statement> ::=
@@ -1168,26 +1202,66 @@ defintely skip
 <set domain default clause> ::=
   SET <default clause>
 
+>     ,(TestStatement SQL2011
+>       "alter domain my_int set default 0"
+>      $ AlterDomain [Name "my_int"]
+>        $ ADSetDefault $ NumLit "0")
+
+
 11.37 <drop domain default clause>
 
 <drop domain default clause> ::=
   DROP DEFAULT
 
+>     ,(TestStatement SQL2011
+>       "alter domain my_int drop default"
+>      $ AlterDomain [Name "my_int"]
+>        $ ADDropDefault)
+
+
 11.38 <add domain constraint definition>
 
 <add domain constraint definition> ::=
   ADD <domain constraint>
 
+>     ,(TestStatement SQL2011
+>       "alter domain my_int add check (value > 6)"
+>      $ AlterDomain [Name "my_int"]
+>        $ ADAddConstraint Nothing
+>          $ BinOp (Iden [Name "value"]) [Name ">"] (NumLit "6"))
+
+>     ,(TestStatement SQL2011
+>       "alter domain my_int add constraint gt6 check (value > 6)"
+>      $ AlterDomain [Name "my_int"]
+>        $ ADAddConstraint (Just [Name "gt6"])
+>          $ BinOp (Iden [Name "value"]) [Name ">"] (NumLit "6"))
+
+
 11.39 <drop domain constraint definition>
 
 <drop domain constraint definition> ::=
   DROP CONSTRAINT <constraint name>
 
+>     ,(TestStatement SQL2011
+>       "alter domain my_int drop constraint gt6"
+>      $ AlterDomain [Name "my_int"]
+>        $ ADDropConstraint [Name "gt6"])
+
 11.40 <drop domain statement>
 
 <drop domain statement> ::=
   DROP DOMAIN <domain name> <drop behavior>
 
+>     ,(TestStatement SQL2011
+>       "drop domain my_int"
+>      $ DropDomain [Name "my_int"] DefaultDropBehaviour)
+
+>     ,(TestStatement SQL2011
+>       "drop domain my_int cascade"
+>      $ DropDomain [Name "my_int"] Cascade)
+
+
+
 11.41 <character set definition>
 
 <character set definition> ::=