From bae817defd5b943bc8b225874d37f884c1d32cf8 Mon Sep 17 00:00:00 2001 From: prescientmoon 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 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 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)