Implement sqlite "without rowid" clauses

Author: prescientmoon

Language/SQL/SimpleSQL/Dialect.hs

@@ -80,7 +80,7 @@ data Dialect = Dialect
     ,diAtIdentifier :: Bool
      -- | allow identifiers with a leading \# \#example
     ,diHashIdentifier :: Bool
-     -- | allow positional identifiers like this: $1 
+     -- | allow positional identifiers like this: $1
     ,diPositionalArg :: Bool
      -- | allow postgres style dollar strings
     ,diDollarString :: Bool
@@ -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)
 
@@ -117,9 +119,10 @@ ansi2011 = Dialect {diKeywords = ansi2011ReservedKeywords
                    ,diEString = False
                    ,diPostgresSymbols = False
                    ,diSqlServerSymbols = False
-                   ,diConvertFunction = False                     
+                   ,diConvertFunction = False
                    ,diAutoincrement = False
                    ,diNonCommaSeparatedConstraints = False
+                   ,diWithoutRowidTables = False
                    }
 
 -- | mysql dialect

Language/SQL/SimpleSQL/Parse.hs

@@ -198,7 +198,7 @@ import Text.Megaparsec
     ,hidden
     ,failure
     ,ErrorItem(..)
-    
+
     ,(<|>)
     ,token
     ,choice
@@ -233,11 +233,11 @@ 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
 
-import Language.SQL.SimpleSQL.Syntax 
+import Language.SQL.SimpleSQL.Syntax
 import Language.SQL.SimpleSQL.Dialect
 import qualified Language.SQL.SimpleSQL.Lex as L
 --import Text.Megaparsec.Debug (dbg)
@@ -332,7 +332,7 @@ wrapParse :: Parser a
           -> Either ParseError a
 wrapParse parser d f p src = do
     lx <- either (Left . LexError) Right $ L.lexSQLWithPositions d True f p src
-    either (Left . ParseError) Right $ 
+    either (Left . ParseError) Right $
         runReader (runParserT (parser <* (hidden eof)) (T.unpack f)
                    $ L.SQLStream (T.unpack src) $ filter notSpace lx) d
   where
@@ -584,7 +584,7 @@ typeName' hideArg =
     reservedTypeNames = do
         stn <- askDialect diSpecialTypeNames
         (:[]) . Name Nothing . T.unwords <$> makeKeywordTree stn
-        
+
 
 {-
 = Scalar expressions
@@ -1589,7 +1589,7 @@ queryExpr :: Parser QueryExpr
 queryExpr = label "query expr" $ E.makeExprParser qeterm qeOpTable
   where
     qeterm = label "query expr" (with <|> select <|> table <|> values)
-    
+
     select = keyword_ "select" >>
         mkSelect
         <$> hoption SQDefault duplicates
@@ -1615,7 +1615,7 @@ queryExpr = label "query expr" $ E.makeExprParser qeterm qeOpTable
     cq o d c q0 q1 = QueryExprSetOp q0 o d c q1
     corr = hoption Respectively (Corresponding <$ keyword_ "corresponding")
 
-    
+
 {-
 local data type to help with parsing the bit after the select list,
 called 'table expression' in the ansi sql grammar. Maybe this should
@@ -1707,21 +1707,25 @@ createSchema = keyword_ "schema" >>
     CreateSchema <$> names "schema name"
 
 createTable :: Parser Statement
-createTable = do 
+createTable = do
   d <- askDialect id
-  let 
-    parseColumnDef = TableColumnDef <$> columnDef 
+  let
+    parseColumnDef = TableColumnDef <$> columnDef
     parseConstraintDef = uncurry TableConstraintDef <$> tableConstraintDef
     separator = if diNonCommaSeparatedConstraints d
       then optional comma
       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 =
@@ -1804,9 +1808,9 @@ colConstraintDef =
     notNull = ColNotNullConstraint <$ keywords_ ["not", "null"]
     unique = ColUniqueConstraint <$ keyword_ "unique"
     primaryKey = do
-      keywords_ ["primary", "key"] 
+      keywords_ ["primary", "key"]
       d <- askDialect id
-      autoincrement <- if diAutoincrement d 
+      autoincrement <- if diAutoincrement d
         then optional (keyword_ "autoincrement")
         else pure Nothing
       pure $ ColPrimaryKeyConstraint $ isJust autoincrement
@@ -1998,7 +2002,7 @@ delete = keywords_ ["delete","from"] >>
     <*> optional (hoptional (keyword_ "as") *> name "alias")
     <*> optional (keyword_ "where" *> scalarExpr)
 
-truncateSt :: Parser Statement 
+truncateSt :: Parser Statement
 truncateSt = keywords_ ["truncate", "table"] >>
     Truncate
     <$> names "table name"
@@ -2011,7 +2015,7 @@ insert = keywords_ ["insert", "into"] >>
     Insert
     <$> names "table name"
     <*> (hoptional (parens $ commaSep1 $ name "column name"))
-    <*> 
+    <*>
         -- slight hack
         (DefaultInsertValues <$ label "values" (keywords_ ["default", "values"])
          <|> InsertQuery <$> queryExpr)

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
@@ -723,7 +724,7 @@ columnDef d (ColumnDef n t mdef cons) =
     pcon ColNotNullConstraint = texts ["not","null"]
     pcon ColNullableConstraint = texts ["null"]
     pcon ColUniqueConstraint = pretty "unique"
-    pcon (ColPrimaryKeyConstraint autoincrement) = 
+    pcon (ColPrimaryKeyConstraint autoincrement) =
       texts $ ["primary","key"] <> ["autoincrement"|autoincrement]
     --pcon ColPrimaryKeyConstraint = texts ["primary","key"]
     pcon (ColCheckConstraint v) = pretty "check" <+> parens (scalarExpr d v)

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
     ]
-    
+