diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs index 54367ec..a7aeffa 100644 --- a/Language/SQL/SimpleSQL/Parser.lhs +++ b/Language/SQL/SimpleSQL/Parser.lhs @@ -1442,10 +1442,12 @@ TODO: change style > statement :: Parser Statement > statement = choice > [keyword_ "create" *> choice [createSchema -> ,createTable] +> ,createTable +> ,createView] > ,keyword_ "alter" *> choice [alterTable] > ,keyword_ "drop" *> choice [dropSchema -> ,dropTable] +> ,dropTable +> ,dropView] > ,delete > ,truncateSt > ,insert @@ -1618,6 +1620,28 @@ slightly hacky parser for signed integers > dropTable = keyword_ "table" >> > DropTable <$> names <*> dropBehaviour +> createView :: Parser Statement +> createView = +> CreateView +> <$> (option False (True <$ keyword_ "recursive") <* keyword_ "view") +> <*> names +> <*> optionMaybe (parens (commaSep1 name)) +> <*> (keyword_ "as" *> queryExpr) +> <*> optionMaybe (choice [ +> -- todo: left factor +> DefaultCheckOption <$ try (keywords_ ["with", "check", "option"]) +> ,CascadedCheckOption <$ try (keywords_ ["with", "cascaded", "check", "option"]) +> ,LocalCheckOption <$ try (keywords_ ["with", "local", "check", "option"]) +> ]) + +> dropView :: Parser Statement +> dropView = keyword_ "view" >> +> DropView <$> names <*> dropBehaviour + + +----------------- + += dml > delete :: Parser Statement > delete = keywords_ ["delete","from"] >> diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index 5d0e8c0..9779c87 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/Language/SQL/SimpleSQL/Pretty.lhs @@ -505,6 +505,22 @@ which have been changed to try to improve the layout of the output. > statement _ (DropTable n b) = > text "drop" <+> text "table" <+> names n <+> dropBehav b +> statement d (CreateView r nm al q co) = +> text "create" <+> (if r then text "recursive" else empty) +> <+> text "view" <+> names nm +> <+> (maybe empty (\al' -> parens $ commaSep $ map name al')) al +> <+> text "as" +> <+> queryExpr d q +> <+> case co of +> Nothing -> empty +> Just DefaultCheckOption -> texts ["with", "check", "option"] +> Just CascadedCheckOption -> texts ["with", "cascaded", "check", "option"] +> Just LocalCheckOption -> texts ["with", "local", "check", "option"] + +> statement _ (DropView n b) = +> text "drop" <+> text "view" <+> names n <+> dropBehav b + + == access control == transactions diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index 44b2f36..ef679f8 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/Language/SQL/SimpleSQL/Syntax.lhs @@ -47,6 +47,7 @@ > ,ReferenceMatch(..) > ,ReferentialAction(..) > ,AlterTableAction(..) +> ,CheckOption(..) > -- * Dialect > ,Dialect(..) > -- * Comment @@ -406,9 +407,10 @@ I'm not sure if this is valid syntax or not. > | CreateTable [Name] [TableElement] > | AlterTable [Name] AlterTableAction > | DropTable [Name] DropBehaviour -> {- | CreateView -> | DropView -> | CreateDomain +> | CreateView Bool [Name] (Maybe [Name]) +> QueryExpr (Maybe CheckOption) +> | DropView [Name] DropBehaviour +> {- | CreateDomain > | AlterDomain > | DropDomain > | CreateCharacterSet @@ -617,11 +619,12 @@ I'm not sure if this is valid syntax or not. > | SGONoCycle > deriving (Eq,Show,Read,Data,Typeable) -> {-data ColumnConstraintDef = -> | NotNullConstraint -> | UniqueConstraint -> | ReferencesConstraint -> | CheckConstraint-} +> data CheckOption = +> DefaultCheckOption +> | CascadedCheckOption +> | LocalCheckOption +> deriving (Eq,Show,Read,Data,Typeable) + -------------------------- diff --git a/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs b/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs index 6727347..075c124 100644 --- a/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs +++ b/tools/Language/SQL/SimpleSQL/SQL2011Schema.lhs @@ -1078,11 +1078,68 @@ defintely skip ::= +> ,(TestStatement SQL2011 +> "create view v as select * from t" +> $ CreateView False [Name "v"] Nothing (makeSelect +> {qeSelectList = [(Star, Nothing)] +> ,qeFrom = [TRSimple [Name "t"]] +> }) Nothing) + + +> ,(TestStatement SQL2011 +> "create recursive view v as select * from t" +> $ CreateView True [Name "v"] Nothing (makeSelect +> {qeSelectList = [(Star, Nothing)] +> ,qeFrom = [TRSimple [Name "t"]] +> }) Nothing) + +> ,(TestStatement SQL2011 +> "create view v(a,b) as select * from t" +> $ CreateView False [Name "v"] (Just [Name "a", Name "b"]) +> (makeSelect +> {qeSelectList = [(Star, Nothing)] +> ,qeFrom = [TRSimple [Name "t"]] +> }) Nothing) + + +> ,(TestStatement SQL2011 +> "create view v as select * from t with check option" +> $ CreateView False [Name "v"] Nothing (makeSelect +> {qeSelectList = [(Star, Nothing)] +> ,qeFrom = [TRSimple [Name "t"]] +> }) (Just DefaultCheckOption)) + +> ,(TestStatement SQL2011 +> "create view v as select * from t with cascaded check option" +> $ CreateView False [Name "v"] Nothing (makeSelect +> {qeSelectList = [(Star, Nothing)] +> ,qeFrom = [TRSimple [Name "t"]] +> }) (Just CascadedCheckOption)) + +> ,(TestStatement SQL2011 +> "create view v as select * from t with local check option" +> $ CreateView False [Name "v"] Nothing +> (makeSelect +> {qeSelectList = [(Star, Nothing)] +> ,qeFrom = [TRSimple [Name "t"]] +> }) (Just LocalCheckOption)) + + 11.33 ::= DROP VIEW + +> ,(TestStatement SQL2011 +> "drop view v" +> $ DropView [Name "v"] DefaultDropBehaviour) + +> ,(TestStatement SQL2011 +> "drop view v cascade" +> $ DropView [Name "v"] Cascade) + + 11.34 ::=