Merge pull request #52 from Airsequel/without-rowid

Implement sqlite "without rowid" clauses

Language/SQL/SimpleSQL/Dialect.hs

@@ -96,6 +96,8 @@ data Dialect = Dialect
     ,diAutoincrement :: Bool
      -- | allow omitting the comma between constraint clauses
     ,diNonCommaSeparatedConstraints :: Bool
+     -- | allow marking tables as "without rowid"
+    ,diWithoutRowidTables :: Bool
     }
                deriving (Eq,Show,Read,Data,Typeable)
 
@@ -120,6 +122,7 @@ ansi2011 = Dialect {diKeywords = ansi2011ReservedKeywords
                    ,diConvertFunction = False
                    ,diAutoincrement = False
                    ,diNonCommaSeparatedConstraints = False
+                   ,diWithoutRowidTables = False
                    }
 
 -- | mysql dialect

Language/SQL/SimpleSQL/Parse.hs

@@ -233,7 +233,7 @@ import Control.Applicative ((<**>))
 import Data.Char (isDigit)
 import Data.List (sort,groupBy)
 import Data.Function (on)
-import Data.Maybe (catMaybes, isJust, mapMaybe)
+import Data.Maybe (catMaybes, isJust, mapMaybe, fromMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
 
@@ -1717,11 +1717,15 @@ createTable = do
       else Just <$> comma
     constraints = sepBy parseConstraintDef (hidden separator)
     entries = ((:) <$> parseColumnDef <*> ((comma >> entries) <|> pure [])) <|> constraints
+    withoutRowid = if diWithoutRowidTables d
+      then fromMaybe False <$> optional (keywords_ ["without", "rowid"] >> pure True)
+      else pure False
 
   keyword_ "table" >>
     CreateTable
     <$> names  "table name"
     <*> parens entries
+    <*> withoutRowid
 
 createIndex :: Parser Statement
 createIndex =

Language/SQL/SimpleSQL/Pretty.hs

@@ -491,9 +491,10 @@ statement :: Dialect -> Statement -> Doc a
 statement _ (CreateSchema nm) =
     pretty "create" <+> pretty "schema" <+> names nm
 
-statement d (CreateTable nm cds) =
+statement d (CreateTable nm cds withoutRowid) =
     pretty "create" <+> pretty "table" <+> names nm
     <+> parens (commaSep $ map cd cds)
+    <+> (if withoutRowid then texts [ "without", "rowid" ] else mempty)
   where
     cd (TableConstraintDef n con) =
         maybe mempty (\s -> pretty "constraint" <+> names s) n

Language/SQL/SimpleSQL/Syntax.hs

@@ -443,7 +443,7 @@ data Statement =
     -- ddl
     CreateSchema [Name]
   | DropSchema [Name] DropBehaviour
-  | CreateTable [Name] [TableElement]
+  | CreateTable [Name] [TableElement] Bool
   | AlterTable [Name] AlterTableAction
   | DropTable [Name] DropBehaviour
   | CreateIndex Bool [Name] [Name] [Name]

expected-parse-errors/golden

@@ -5668,7 +5668,7 @@ statement
 ansi2011
 create table t (
 )
-CreateTable [ Name Nothing "t" ] []
+CreateTable [ Name Nothing "t" ] [] False
 
 statement
 ansi2011

tests/Language/SQL/SimpleSQL/Oracle.hs

@@ -27,5 +27,6 @@ oracleLobUnits = Group "oracleLobUnits"
        [TableColumnDef $ ColumnDef (Name Nothing "a")
         (PrecLengthTypeName [Name Nothing "varchar2"] 55 Nothing (Just PrecOctets))
         Nothing []]
+       False
     ]
 

tests/Language/SQL/SimpleSQL/SQL2011Schema.hs

@@ -109,6 +109,7 @@ add schema element support:
      $ CreateTable [Name Nothing "t"]
        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []
        ,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []]
+       False
 
 
 {-
@@ -328,30 +329,35 @@ todo: constraint characteristics
      $ CreateTable [Name Nothing "t"]
        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
         [ColConstraintDef Nothing ColNotNullConstraint]]
+       False
 
     ,s
       "create table t (a int constraint a_not_null not null);"
      $ CreateTable [Name Nothing "t"]
        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
         [ColConstraintDef (Just [Name Nothing "a_not_null"]) ColNotNullConstraint]]
+       False
 
     ,s
       "create table t (a int unique);"
      $ CreateTable [Name Nothing "t"]
        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
         [ColConstraintDef Nothing ColUniqueConstraint]]
+       False
 
     ,s
       "create table t (a int primary key);"
      $ CreateTable [Name Nothing "t"]
        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
         [ColConstraintDef Nothing (ColPrimaryKeyConstraint False)]]
+       False
 
     ,testStatement ansi2011{ diAutoincrement = True }
       "create table t (a int primary key autoincrement);"
      $ CreateTable [Name Nothing "t"]
        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
         [ColConstraintDef Nothing (ColPrimaryKeyConstraint True)]]
+       False
 
 {-
 references t(a,b)
@@ -367,6 +373,7 @@ references t(a,b)
         [ColConstraintDef Nothing $ ColReferencesConstraint
          [Name Nothing "u"] Nothing DefaultReferenceMatch
          DefaultReferentialAction DefaultReferentialAction]]
+       False
 
     ,s
       "create table t (a int references u(a));"
@@ -375,6 +382,7 @@ references t(a,b)
         [ColConstraintDef Nothing $ ColReferencesConstraint
          [Name Nothing "u"] (Just $ Name Nothing "a") DefaultReferenceMatch
          DefaultReferentialAction DefaultReferentialAction]]
+       False
 
     ,s
       "create table t (a int references u match full);"
@@ -383,6 +391,7 @@ references t(a,b)
         [ColConstraintDef Nothing $ ColReferencesConstraint
          [Name Nothing "u"] Nothing MatchFull
          DefaultReferentialAction DefaultReferentialAction]]
+       False
 
     ,s
       "create table t (a int references u match partial);"
@@ -391,6 +400,7 @@ references t(a,b)
         [ColConstraintDef Nothing $ ColReferencesConstraint
          [Name Nothing "u"] Nothing MatchPartial
          DefaultReferentialAction DefaultReferentialAction]]
+       False
 
     ,s
       "create table t (a int references u match simple);"
@@ -399,6 +409,7 @@ references t(a,b)
         [ColConstraintDef Nothing $ ColReferencesConstraint
          [Name Nothing "u"] Nothing MatchSimple
          DefaultReferentialAction DefaultReferentialAction]]
+       False
 
     ,s
       "create table t (a int references u on update cascade );"
@@ -407,6 +418,7 @@ references t(a,b)
         [ColConstraintDef Nothing $ ColReferencesConstraint
          [Name Nothing "u"] Nothing DefaultReferenceMatch
          RefCascade DefaultReferentialAction]]
+       False
 
     ,s
       "create table t (a int references u on update set null );"
@@ -415,6 +427,7 @@ references t(a,b)
         [ColConstraintDef Nothing $ ColReferencesConstraint
          [Name Nothing "u"] Nothing DefaultReferenceMatch
          RefSetNull DefaultReferentialAction]]
+       False
 
     ,s
       "create table t (a int references u on update set default );"
@@ -423,6 +436,7 @@ references t(a,b)
         [ColConstraintDef Nothing $ ColReferencesConstraint
          [Name Nothing "u"] Nothing DefaultReferenceMatch
          RefSetDefault DefaultReferentialAction]]
+       False
 
     ,s
       "create table t (a int references u on update no action );"
@@ -431,6 +445,7 @@ references t(a,b)
         [ColConstraintDef Nothing $ ColReferencesConstraint
          [Name Nothing "u"] Nothing DefaultReferenceMatch
          RefNoAction DefaultReferentialAction]]
+       False
 
     ,s
       "create table t (a int references u on delete cascade );"
@@ -439,6 +454,7 @@ references t(a,b)
         [ColConstraintDef Nothing $ ColReferencesConstraint
          [Name Nothing "u"] Nothing DefaultReferenceMatch
          DefaultReferentialAction RefCascade]]
+       False
 
 
     ,s
@@ -448,6 +464,7 @@ references t(a,b)
         [ColConstraintDef Nothing $ ColReferencesConstraint
          [Name Nothing "u"] Nothing DefaultReferenceMatch
          RefCascade RefRestrict]]
+       False
 
     ,s
       "create table t (a int references u on delete restrict on update cascade );"
@@ -456,6 +473,7 @@ references t(a,b)
         [ColConstraintDef Nothing $ ColReferencesConstraint
          [Name Nothing "u"] Nothing DefaultReferenceMatch
          RefCascade RefRestrict]]
+       False
 
 {-
 TODO: try combinations and permutations of column constraints and
@@ -469,6 +487,7 @@ options
        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
         [ColConstraintDef Nothing
          (ColCheckConstraint $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5"))]]
+       False
 
 
 
@@ -484,11 +503,13 @@ options
      $ CreateTable [Name Nothing "t"]
        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])
         (Just $ IdentityColumnSpec GeneratedAlways []) []]
+       False
 
     ,s "create table t (a int generated by default as identity);"
      $ CreateTable [Name Nothing "t"]
        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])
         (Just $ IdentityColumnSpec GeneratedByDefault []) []]
+       False
 
 
     ,s
@@ -502,6 +523,7 @@ options
          ,SGOMaxValue 500
          ,SGOMinValue 5
          ,SGOCycle]) []]
+       False
 
     ,s
       "create table t (a int generated always as identity\n\
@@ -513,6 +535,7 @@ options
          ,SGONoMaxValue
          ,SGONoMinValue
          ,SGONoCycle]) []]
+       False
 
 {-
 I think <common sequence generator options> is supposed to just
@@ -541,6 +564,7 @@ generated always (valueexpr)
        ,TableColumnDef $ ColumnDef (Name Nothing "a2") (TypeName [Name Nothing "int"])
         (Just $ GenerationClause
          (BinOp (Iden [Name Nothing "a"]) [Name Nothing "*"] (NumLit "2"))) []]
+       False
 
 
 
@@ -569,6 +593,7 @@ generated always (valueexpr)
      $ CreateTable [Name Nothing "t"]
        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])
         (Just $ DefaultClause $ NumLit "0") []]
+       False
 
 
 
@@ -605,6 +630,7 @@ generated always (valueexpr)
        [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []
        ,TableConstraintDef Nothing $ TableUniqueConstraint [Name Nothing "a"]
         ]
+       False
 
     ,s
       "create table t (a int, constraint a_unique unique (a));"
@@ -613,6 +639,7 @@ generated always (valueexpr)
        ,TableConstraintDef (Just [Name Nothing "a_unique"]) $
             TableUniqueConstraint [Name Nothing "a"]
         ]
+       False
 
 -- todo: test permutations of column defs and table constraints
 
@@ -624,6 +651,7 @@ generated always (valueexpr)
        ,TableConstraintDef Nothing $
             TableUniqueConstraint [Name Nothing "a", Name Nothing "b"]
         ]
+       False
 
     ,s
       "create table t (a int, b int, primary key (a,b));"
@@ -633,6 +661,7 @@ generated always (valueexpr)
        ,TableConstraintDef Nothing $
             TablePrimaryKeyConstraint [Name Nothing "a", Name Nothing "b"]
         ]
+       False
 
 
 {-
@@ -664,6 +693,7 @@ defintely skip
                 (Just [Name Nothing "c", Name Nothing "d"])
                 MatchFull RefCascade RefRestrict
        ]
+       False
 
     ,s
       "create table t (a int,\n\
@@ -677,6 +707,7 @@ defintely skip
                 Nothing DefaultReferenceMatch
                 DefaultReferentialAction DefaultReferentialAction
        ]
+       False
 
     ,testStatement ansi2011{ diNonCommaSeparatedConstraints = True }
       "create table t (a int, b int,\n\
@@ -700,6 +731,12 @@ defintely skip
                 DefaultReferenceMatch
                 DefaultReferentialAction DefaultReferentialAction
        ]
+       False
+    ,testStatement ansi2011{ diWithoutRowidTables = True }
+      "create table t (a int) without rowid;"
+     $ CreateTable [Name Nothing "t"]
+       [TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []]
+       True
 
 
 {-
@@ -767,6 +804,7 @@ defintely skip
             TableCheckConstraint
             (BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (Iden [Name Nothing "b"]))
        ]
+       False
 
 
     ,s
@@ -779,6 +817,7 @@ defintely skip
             TableCheckConstraint
             (BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (Iden [Name Nothing "b"]))
        ]
+       False
 
 
 {-