From bae817defd5b943bc8b225874d37f884c1d32cf8 Mon Sep 17 00:00:00 2001
From: prescientmoon <git@moonythm.dev>
Date: Thu, 11 Jul 2024 21:59:58 +0200
Subject: [PATCH 1/2] Implement sqlite "without rowid" clauses
---
Language/SQL/SimpleSQL/Dialect.hs | 7 +++-
Language/SQL/SimpleSQL/Parse.hs | 32 ++++++++-------
Language/SQL/SimpleSQL/Pretty.hs | 5 ++-
Language/SQL/SimpleSQL/Syntax.hs | 2 +-
expected-parse-errors/golden | 2 +-
tests/Language/SQL/SimpleSQL/Oracle.hs | 3 +-
tests/Language/SQL/SimpleSQL/SQL2011Schema.hs | 39 +++++++++++++++++++
7 files changed, 69 insertions(+), 21 deletions(-)
diff --git a/Language/SQL/SimpleSQL/Dialect.hs b/Language/SQL/SimpleSQL/Dialect.hs
index 6d9566d..0e1f9ee 100644
--- a/Language/SQL/SimpleSQL/Dialect.hs
+++ b/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
diff --git a/Language/SQL/SimpleSQL/Parse.hs b/Language/SQL/SimpleSQL/Parse.hs
index 0eb0d38..1dcb5e4 100644
--- a/Language/SQL/SimpleSQL/Parse.hs
+++ b/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)
diff --git a/Language/SQL/SimpleSQL/Pretty.hs b/Language/SQL/SimpleSQL/Pretty.hs
index 7ff71a2..f1abd42 100644
--- a/Language/SQL/SimpleSQL/Pretty.hs
+++ b/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)
diff --git a/Language/SQL/SimpleSQL/Syntax.hs b/Language/SQL/SimpleSQL/Syntax.hs
index 9aa99d7..e2955a4 100644
--- a/Language/SQL/SimpleSQL/Syntax.hs
+++ b/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]
diff --git a/expected-parse-errors/golden b/expected-parse-errors/golden
index 1a7a17e..8fff1a9 100644
--- a/expected-parse-errors/golden
+++ b/expected-parse-errors/golden
@@ -5668,7 +5668,7 @@ statement
ansi2011
create table t (
)
-CreateTable [ Name Nothing "t" ] []
+CreateTable [ Name Nothing "t" ] [] False
statement
ansi2011
diff --git a/tests/Language/SQL/SimpleSQL/Oracle.hs b/tests/Language/SQL/SimpleSQL/Oracle.hs
index c3eefba..79edf1e 100644
--- a/tests/Language/SQL/SimpleSQL/Oracle.hs
+++ b/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
]
-
+
diff --git a/tests/Language/SQL/SimpleSQL/SQL2011Schema.hs b/tests/Language/SQL/SimpleSQL/SQL2011Schema.hs
index a1e1da2..02724c2 100644
--- a/tests/Language/SQL/SimpleSQL/SQL2011Schema.hs
+++ b/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
{-
From 0a3c672cd555942b0c255cd4001825d337137000 Mon Sep 17 00:00:00 2001
From: hanjoosten <han.joosten@ordina.nl>
Date: Sat, 5 Oct 2024 17:54:31 +0200
Subject: [PATCH 2/2] Bugfix for issue Bug: Brackets required in generated
select statement. #57
---
Language/SQL/SimpleSQL/Pretty.hs | 1 +
Language/SQL/SimpleSQL/Syntax.hs | 1 +
2 files changed, 2 insertions(+)
diff --git a/Language/SQL/SimpleSQL/Pretty.hs b/Language/SQL/SimpleSQL/Pretty.hs
index f1abd42..c3a2921 100644
--- a/Language/SQL/SimpleSQL/Pretty.hs
+++ b/Language/SQL/SimpleSQL/Pretty.hs
@@ -406,6 +406,7 @@ queryExpr d (Values vs) =
pretty "values"
<+> nest 7 (commaSep (map (parens . commaSep . map (scalarExpr d)) vs))
queryExpr _ (Table t) = pretty "table" <+> names t
+queryExpr d (QueryExprParens qe) = parens (queryExpr d qe)
queryExpr d (QEComment cmt v) =
vsep $ map comment cmt <> [queryExpr d v]
diff --git a/Language/SQL/SimpleSQL/Syntax.hs b/Language/SQL/SimpleSQL/Syntax.hs
index e2955a4..26b82fc 100644
--- a/Language/SQL/SimpleSQL/Syntax.hs
+++ b/Language/SQL/SimpleSQL/Syntax.hs
@@ -373,6 +373,7 @@ This would make some things a bit cleaner?
,qeQueryExpression :: QueryExpr}
| Values [[ScalarExpr]]
| Table [Name]
+ | QueryExprParens QueryExpr
| QEComment [Comment] QueryExpr
deriving (Eq,Show,Read,Data,Typeable)