diff --git a/IHP/IDE/Defaults/TableColumnDefaults.hs b/IHP/IDE/Defaults/TableColumnDefaults.hs new file mode 100644 index 000000000..d4dc209f1 --- /dev/null +++ b/IHP/IDE/Defaults/TableColumnDefaults.hs @@ -0,0 +1,232 @@ +{-| +Module: IHP.IDE.Defaults.TableColumnDefaults +Copyright: (c) digitally induced GmbH, 2020 +-} +module IHP.IDE.Defaults.TableColumnDefaults where + +import Test.Hspec +import IHP.Prelude +import qualified IHP.IDE.CodeGen.ControllerGenerator as ControllerGenerator +import IHP.ViewPrelude (cs, plain) +import qualified Text.Megaparsec as Megaparsec +import IHP.IDE.CodeGen.Types +import IHP.IDE.SchemaDesigner.Types +import IHP.NameSupport +import IHP.IDE.SchemaDesigner.Types + + +{- | Takes a 'Text' value for the name and creates a default column where all values are empty lists, +'Nothing' or 'False'; and for 'ColumnType', the default is 'PUUID'. + +Add a new field to the 'Column' type in the +"IHP.IDE.SchemaDesigner.Types" file and then +set its default value here + +Defined as: + +@ +emptyColumn :: Column +emptyColumn = Column { + name = "" + , columnType = PUUID + , defaultValue = Nothing + , notNull = False + , isUnique = False + , generator = Nothing + } +@ + +If you want a different 'PostgresType' you will need to +specify with like so by either using a function: + +@setColumnType pgt = emptyColumn {columnType = pgt}@ + +Or + +Just as part of where you're calling it: + +@someDefaultColumnType = emptyColumn {columnType = PDate}@ +-} +emptyColumn :: Column +emptyColumn = + Column + { name = "" + , columnType = PUUID + , defaultValue = Nothing + , notNull = False + , isUnique = False + , generator = Nothing + } + + +{- | Creates an empty table with all values empty. @unlogged@ is set to 'False'. + +Defined as such: + +@ +emptyTable :: CreateTable +emptyTable = CreateTable { + name = "" + , columns = [] + , primaryKeyConstraint = PrimaryKeyConstraint [] + , constraints = [] + , unlogged = False + } +@ + +-} +emptyTable :: CreateTable +emptyTable = CreateTable + { name = "" + , columns = [] + , primaryKeyConstraint = PrimaryKeyConstraint [] + , constraints = [] + , unlogged = False + } + +-- | Takes a name for our table and a list of column and inserts the list +-- into to our empty table. +defCreateTable :: Text -> [Column] -> CreateTable +defCreateTable tablename columns = emptyTable { name = tablename + , columns = columns } + + + + +{- | Creates one default table with a singleton list of one 'setColumn'. + +Uses both `defCreateTable` and `setColumn`. + +@ +defCreateTableWSetCol :: Text -- The name of the table + -> Text -- The name of the column + -> PostgresType -- The type of the column + -> CreateTable -- The returned table +@ + +-} +defCreateTableWSetCol :: Text -> Text -> PostgresType -> CreateTable +defCreateTableWSetCol tablename columnname pgt = defCreateTable tablename [setColumn columnname pgt] + +{- | Same as its progenitor `defCreateTableWSetCol` except it uses `setColumnN` +-} +defCreateTableWSetColN :: Text -> Text -> PostgresType -> CreateTable +defCreateTableWSetColN tablename columnname pgt = defCreateTable tablename [setColumnN columnname pgt] + + +{- | Takes the name of the table, the items you want inside the 'primaryKeyConstraint' and a list of columns +to return a table where the primary key constraint is set. + +__Example:__ + +@ +let orderTrucksTable = defCreateTablePKID "orderTrucks" ["order_id","truck_id"] cols + where cols = map mkColumn ["order_id","truck_id"] + mkColumn x = (setColumnN x PBigserial) +@ + +>>> orderTrucksTable +CreateTable { name = "orderTrucks" + , columns = [ Column { name = "order_id", + columnType = PBigserial, + defaultValue = Nothing, + notNull = True, + isUnique = False, + generator = Nothing} + , Column { name = "truck_id", + columnType = PBigserial, + defaultValue = Nothing, + notNull = True, + isUnique = False, + generator = Nothing} + ] + , primaryKeyConstraint = PrimaryKeyConstraint {primaryKeyColumnNames = ["order_id","truck_id"]} + , constraints = [] + , unlogged = False} +-} +defCreateTablePKID :: Text -> [Text] -> [Column] -> CreateTable +defCreateTablePKID name items cols = (defCreateTable name cols) {primaryKeyConstraint = PrimaryKeyConstraint items} + + +{- | Allows you to set the name and columnType. Uses `emptyColumn` as its base + +If other values need to be changed, this can be done using: +@(setColumn a b){..}@ + +__Example:__ + +>>> setColumn "user_id" PTrigger +Column {name = "user_id", columnType = PTrigger, defaultValue = Nothing, notNull = False, isUnique = False, generator = Nothing} + +-} +setColumn :: Text -> PostgresType -> Column +setColumn name pgt = emptyColumn { name = name + , columnType = pgt + } + +-- | A version of `setColumn` where @notNull = True@ +setColumnN :: Text -> PostgresType -> Column +setColumnN n p = (setColumn n p) {notNull = True} + +-- | Sets a column to have a default value. Would recommend using in conjunction with `setColumn` +setColumnDefaultVal :: Maybe Expression -> Column -> Column +setColumnDefaultVal expression column = column {defaultValue = expression} + + +{- | A recurring unit as found in many tests and files. + +Defined as such: + +>>> idColumn +Column {name = "id", columnType = PUUID, defaultValue = Just (CallExpression "uuid_generate_v4" []), notNull = True, isUnique = False, generator = Nothing} + +-} +idColumn :: Column +idColumn = setColumnDefaultVal (Just (CallExpression "uuid_generate_v4" [])) $ setColumnN "id" PUUID + +{- | Give a column the text defined by 'text' and sets its 'columnType' to 'PText'. Uses `setColumnN`. + +__Example:__ + +>>> colText "example" +Column {name = "example", columnType = PText, defaultValue = Nothing, notNull = True, isUnique = False, generator = Nothing} + +-} +colText :: Text -> Column +colText text = setColumnN text PText + + +{- | A recurring table that appears in many tests. + +This is its current definition: + +@ +compilerSpecTable :: CreateTable +compilerSpecTable = defCreateTablePKID "users" ["id"] cols + + where cols = [ idColumn + , colText "firstname" + , colText "lastname" + , colText "password_hash" + , colText "email" + , setColumnN "company_id" PUUID + , setColumn "picture_url" PText + , setColumnDefaultVal (Just (CallExpression "NOW" [])) $ setColumnN "created_at" PTimestampWithTimezone + ] +@ +-} +compilerSpecTable :: CreateTable +compilerSpecTable = defCreateTablePKID "users" ["id"] cols + + where cols = [ idColumn + , colText "firstname" + , colText "lastname" + , colText "password_hash" + , colText "email" + , setColumnN "company_id" PUUID + , setColumn "picture_url" PText + , setColumnDefaultVal (Just (CallExpression "NOW" [])) $ setColumnN "created_at" PTimestampWithTimezone + ] + + + diff --git a/IHP/IDE/SchemaDesigner/SchemaOperations.hs b/IHP/IDE/SchemaDesigner/SchemaOperations.hs index 10bf06a60..0684c238e 100644 --- a/IHP/IDE/SchemaDesigner/SchemaOperations.hs +++ b/IHP/IDE/SchemaDesigner/SchemaOperations.hs @@ -10,28 +10,14 @@ import IHP.IDE.SchemaDesigner.Types import Data.Maybe (fromJust) import qualified Data.List as List import qualified Data.Text as Text +import IHP.IDE.Defaults.TableColumnDefaults -- | A Schema.sql basically is just a list of sql DDL statements type Schema = [Statement] -- | Creates a new tables with a 'id' columns as the primary key addTable :: Text -> Schema -> Schema -addTable tableName list = list <> [StatementCreateTable CreateTable - { name = tableName - , columns = - [Column - { name = "id" - , columnType = PUUID - , defaultValue = Just (CallExpression "uuid_generate_v4" []) - , notNull = True - , isUnique = False - , generator = Nothing - }] - , primaryKeyConstraint = PrimaryKeyConstraint ["id"] - , constraints = [] - , unlogged = False - }] - +addTable tableName list = list <> [StatementCreateTable (defCreateTablePKID tableName ["id"] [idColumn])] data AddColumnOptions = AddColumnOptions { tableName :: !Text diff --git a/Test/IDE/CodeGeneration/ControllerGenerator.hs b/Test/IDE/CodeGeneration/ControllerGenerator.hs index dc7c5d308..6726fee29 100644 --- a/Test/IDE/CodeGeneration/ControllerGenerator.hs +++ b/Test/IDE/CodeGeneration/ControllerGenerator.hs @@ -12,61 +12,14 @@ import qualified Text.Megaparsec as Megaparsec import IHP.IDE.CodeGen.Types import IHP.IDE.SchemaDesigner.Types import IHP.NameSupport +import IHP.IDE.Defaults.TableColumnDefaults tests = do describe "Controller Generator Tests:" do let schema = [ - StatementCreateTable CreateTable { - name = "pages" - , columns = [ - Column - { name = "id" - , columnType = PUUID - , defaultValue = Just (CallExpression "uuid_generate_v4" []) - , notNull = True - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint ["id"] - , constraints = [] - , unlogged = False - }, - StatementCreateTable CreateTable { - name = "people" - , columns = [ - Column - { name = "id" - , columnType = PUUID - , defaultValue = Just (CallExpression "uuid_generate_v4" []) - , notNull = True - , isUnique = False - , generator = Nothing - } - , - Column - { name = "name" - , columnType = PText - , defaultValue = Nothing - , notNull = True - , isUnique = False - , generator = Nothing - } - , - Column - { name = "email" - , columnType = PText - , defaultValue = Nothing - , notNull = True - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint ["id"] - , constraints = [] - , unlogged = False - } - ] + StatementCreateTable (defCreateTablePKID "pages" ["id"] [idColumn]) + , StatementCreateTable (defCreateTablePKID "people" ["id"] [idColumn, colText "name" , colText "email"]) + ] it "should build a controller with name \"pages\"" do let rawControllerName = "pages" let controllerName = tableNameToControllerName rawControllerName diff --git a/Test/IDE/CodeGeneration/MailGenerator.hs b/Test/IDE/CodeGeneration/MailGenerator.hs index cba2cd72d..20597ea08 100644 --- a/Test/IDE/CodeGeneration/MailGenerator.hs +++ b/Test/IDE/CodeGeneration/MailGenerator.hs @@ -1,5 +1,5 @@ {-| -Module: Test.IDE.CodeGeneration.MailGenerator +Module: Test.IDE.CodeGeneration.MailGenerator/ID Copyright: (c) digitally induced GmbH, 2020 -} module Test.IDE.CodeGeneration.MailGenerator where @@ -12,27 +12,12 @@ import qualified Text.Megaparsec as Megaparsec import IHP.IDE.CodeGen.Types import IHP.IDE.SchemaDesigner.Types import IHP.NameSupport - +import IHP.IDE.Defaults.TableColumnDefaults tests = do describe "Mail Generator Tests:" do let schema = [ - StatementCreateTable CreateTable { - name = "users" - , columns = [ - Column - { name = "id" - , columnType = PUUID - , defaultValue = Just (CallExpression "uuid_generate_v4" []) - , notNull = True - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint ["id"] - , constraints = [] - , unlogged = False - } + StatementCreateTable $ defCreateTablePKID "users" ["id"] [idColumn] ] it "should build a mail with name \"PurchaseConfirmationMail\"" do let mailName = "PurchaseConfirmationMail" diff --git a/Test/IDE/CodeGeneration/ViewGenerator.hs b/Test/IDE/CodeGeneration/ViewGenerator.hs index c229172f9..84bff1aaa 100644 --- a/Test/IDE/CodeGeneration/ViewGenerator.hs +++ b/Test/IDE/CodeGeneration/ViewGenerator.hs @@ -12,27 +12,13 @@ import qualified Text.Megaparsec as Megaparsec import IHP.IDE.CodeGen.Types import IHP.IDE.SchemaDesigner.Types import IHP.NameSupport +import IHP.IDE.Defaults.TableColumnDefaults (compilerSpecTable) tests = do describe "View Generator Tests:" do let schema = [ - StatementCreateTable CreateTable { - name = "pages" - , columns = [ - Column - { name = "id" - , columnType = PUUID - , defaultValue = Just (CallExpression "uuid_generate_v4" []) - , notNull = True - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint ["id"] - , constraints = [] - , unlogged = False - } + StatementCreateTable compilerSpecTable ] it "should build a view with name \"EditView\"" do let viewName = "EditView" diff --git a/Test/IDE/SchemaDesigner/CompilerSpec.hs b/Test/IDE/SchemaDesigner/CompilerSpec.hs index 544e12ef5..b9045eb49 100644 --- a/Test/IDE/SchemaDesigner/CompilerSpec.hs +++ b/Test/IDE/SchemaDesigner/CompilerSpec.hs @@ -10,12 +10,27 @@ import IHP.IDE.SchemaDesigner.Compiler (compileSql) import IHP.IDE.SchemaDesigner.Types import IHP.ViewPrelude (cs, plain) import qualified Text.Megaparsec as Megaparsec -import Test.IDE.SchemaDesigner.ParserSpec (col, parseSql) +import Test.IDE.SchemaDesigner.ParserSpec (parseSql) +import IHP.IDE.Defaults.TableColumnDefaults + ( emptyTable, + emptyColumn, + defCreateTableWSetCol, + defCreateTablePKID, + setColumn, + setColumnN, + setColumnDefaultVal, + idColumn, + colText, + compilerSpecTable ) tests = do describe "The Schema.sql Compiler" do + let userTable = emptyTable {name = "users"} :: CreateTable it "should compile an empty CREATE TABLE statement" do - compileSql [StatementCreateTable CreateTable { name = "users", columns = [], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [], unlogged = False }] `shouldBe` "CREATE TABLE users (\n\n);\n" + compileSql [StatementCreateTable userTable] + `shouldBe` "CREATE TABLE users (\n\n);\n" + + it "should compile a CREATE EXTENSION for the UUID extension" do compileSql [CreateExtension { name = "uuid-ossp", ifNotExists = True }] `shouldBe` "CREATE EXTENSION IF NOT EXISTS \"uuid-ossp\";\n" @@ -38,82 +53,14 @@ tests = do created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL ); |] - let statement = StatementCreateTable CreateTable - { name = "users" - , columns = [ - Column - { name = "id" - , columnType = PUUID - , defaultValue = Just (CallExpression "uuid_generate_v4" []) - , notNull = True - , isUnique = False - , generator = Nothing - } - , Column - { name = "firstname" - , columnType = PText - , defaultValue = Nothing - , notNull = True - , isUnique = False - , generator = Nothing - } - , Column - { name = "lastname" - , columnType = PText - , defaultValue = Nothing - , notNull = True - , isUnique = False - , generator = Nothing - } - , Column - { name = "password_hash" - , columnType = PText - , defaultValue = Nothing - , notNull = True - , isUnique = False - , generator = Nothing - } - , Column - { name = "email" - , columnType = PText - , defaultValue = Nothing - , notNull = True - , isUnique = False - , generator = Nothing - } - , Column - { name = "company_id" - , columnType = PUUID - , defaultValue = Nothing - , notNull = True - , isUnique = False - , generator = Nothing - } - , Column - { name = "picture_url" - , columnType = PText - , defaultValue = Nothing - , notNull = False - , isUnique = False - , generator = Nothing - } - , Column - { name = "created_at" - , columnType = PTimestampWithTimezone - , defaultValue = Just (CallExpression "NOW" []) - , notNull = True - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint ["id"] - , constraints = [] - , unlogged = False - } + let statement = StatementCreateTable compilerSpecTable compileSql [statement] `shouldBe` sql it "should compile a CREATE TABLE with quoted identifiers" do - compileSql [StatementCreateTable CreateTable { name = "quoted name", columns = [], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [], unlogged = False }] `shouldBe` "CREATE TABLE \"quoted name\" (\n\n);\n" + + let quotedTable = emptyTable { name = "quoted name"} :: CreateTable + + compileSql [StatementCreateTable quotedTable] `shouldBe` "CREATE TABLE \"quoted name\" (\n\n);\n" it "should compile ALTER TABLE .. ADD FOREIGN KEY .. ON DELETE CASCADE" do let statement = AddConstraint @@ -463,22 +410,17 @@ tests = do it "should compile a CREATE TABLE with text default value in columns" do let sql = cs [plain|CREATE TABLE a (\n content TEXT DEFAULT 'example text' NOT NULL\n);\n|] - let statement = StatementCreateTable CreateTable - { name = "a" - , columns = [ - Column - { name = "content" - , columnType = PText - , defaultValue = Just (TextExpression "example text") - , notNull = True - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + aTable = emptyTable { name = "a" + , columns = [colExampleCont] } :: CreateTable + + colExampleCont = emptyColumn { name = "content" + , columnType = PText + , defaultValue = Just (TextExpression "example text") + , notNull = True + } + + statement = StatementCreateTable aTable + compileSql [statement] `shouldBe` sql it "should compile a CREATE TYPE .. AS ENUM" do @@ -491,130 +433,101 @@ tests = do it "should compile a CREATE TABLE with (deprecated) NUMERIC, NUMERIC(x), NUMERIC (x,y), VARYING(n) columns" do let sql = cs [plain|CREATE TABLE deprecated_variables (\n a NUMERIC,\n b NUMERIC(1),\n c NUMERIC(1,2),\n d CHARACTER VARYING(10)\n);\n|] - let statement = StatementCreateTable CreateTable - { name = "deprecated_variables" - , columns = - [ Column - { name = "a" - , columnType = (PNumeric Nothing Nothing) - , defaultValue = Nothing - , notNull = False - , isUnique = False - , generator = Nothing - } - , Column - { name = "b" - , columnType = (PNumeric (Just 1) Nothing) - , defaultValue = Nothing - , notNull = False - , isUnique = False - , generator = Nothing - } - , Column - { name = "c" - , columnType = (PNumeric (Just 1) (Just 2)) - , defaultValue = Nothing - , notNull = False - , isUnique = False - , generator = Nothing - } - , Column - { name = "d" - , columnType = (PVaryingN (Just 10)) - , defaultValue = Nothing - , notNull = False - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } - compileSql [statement] `shouldBe` sql + deprecVarTable = let depVars = [a,b,c,d] + a = setColumn "a" (PNumeric Nothing Nothing) + b = setColumn "b" (PNumeric (Just 1) Nothing) + c = setColumn "c" (PNumeric (Just 1) (Just 2)) + d = setColumn "d" (PVaryingN (Just 10)) + + in emptyTable { name = "deprecated_variables" + , columns = depVars} :: CreateTable + + compileSql [StatementCreateTable deprecVarTable] `shouldBe` sql it "should compile a CREATE TABLE statement with a multi-column UNIQUE (a, b) constraint" do let sql = cs [plain|CREATE TABLE user_followers (\n id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,\n user_id UUID NOT NULL,\n follower_id UUID NOT NULL,\n UNIQUE(user_id, follower_id)\n);\n|] - let statement = StatementCreateTable CreateTable - { name = "user_followers" - , columns = - [ col { name = "id", columnType = PUUID, defaultValue = Just (CallExpression "uuid_generate_v4" []), notNull = True } - , col { name = "user_id", columnType = PUUID, notNull = True } - , col { name = "follower_id", columnType = PUUID, notNull = True } - ] - , primaryKeyConstraint = PrimaryKeyConstraint ["id"] - , constraints = [ UniqueConstraint { name = Nothing, columnNames = [ "user_id", "follower_id" ] } ] - , unlogged = False - } - compileSql [statement] `shouldBe` sql + followerTable = let followFields = [idColumn, user_id, follower_id] + user_id = emptyColumn { name = "user_id" + , columnType = PUUID + , notNull = True + } + follower_id = emptyColumn { name = "follower_id" + , columnType = PUUID + , notNull = True + } + consts = [ UniqueConstraint { name = Nothing, columnNames = [ "user_id", "follower_id" ] } ] + + in emptyTable { name = "user_followers" + , primaryKeyConstraint = PrimaryKeyConstraint ["id"] + , columns = followFields + , constraints = consts + } + + compileSql [StatementCreateTable followerTable] `shouldBe` sql it "should compile a CREATE TABLE statement with a serial id" do let sql = cs [plain|CREATE TABLE orders (\n id SERIAL PRIMARY KEY NOT NULL\n);\n|] - let statement = StatementCreateTable CreateTable - { name = "orders" - , columns = [ col { name = "id", columnType = PSerial, notNull = True} ] - , primaryKeyConstraint = PrimaryKeyConstraint ["id"] - , constraints = [] - , unlogged = False - } - compileSql [statement] `shouldBe` sql + ordersSerialTable = let serCol = emptyColumn { name = "id" + , columnType = PSerial + , notNull = True + } + + + in defCreateTablePKID "orders" ["id"] [serCol] + + compileSql [StatementCreateTable ordersSerialTable] `shouldBe` sql it "should compile a CREATE TABLE statement with a bigserial id" do let sql = cs [plain|CREATE TABLE orders (\n id BIGSERIAL PRIMARY KEY NOT NULL\n);\n|] - let statement = StatementCreateTable CreateTable - { name = "orders" - , columns = [ col { name = "id", columnType = PBigserial, notNull = True} ] - , primaryKeyConstraint = PrimaryKeyConstraint ["id"] - , constraints = [] - , unlogged = False - } - compileSql [statement] `shouldBe` sql + ordersBigSerialTable =defCreateTablePKID "orders" ["id"] bigSerCol + where bigSerCol =[ (setColumnN "id" PBigserial) + ] + + compileSql [StatementCreateTable ordersBigSerialTable] `shouldBe` sql it "should compile a CREATE TABLE statement with a composite primary key" do let sql = cs [plain|CREATE TABLE orderTrucks (\n order_id BIGSERIAL NOT NULL,\n truck_id BIGSERIAL NOT NULL,\n PRIMARY KEY(order_id, truck_id)\n);\n|] - let statement = StatementCreateTable CreateTable - { name = "orderTrucks" - , columns = - [ col { name = "order_id", columnType = PBigserial, notNull = True} - , col { name = "truck_id", columnType = PBigserial, notNull = True} - ] - , primaryKeyConstraint = PrimaryKeyConstraint ["order_id", "truck_id"] - , constraints = [] - , unlogged = False - } + let statement = StatementCreateTable $ let cols = map mkColumn ["order_id","truck_id"] + mkColumn x = (setColumnN x PBigserial) + + in defCreateTablePKID "orderTrucks" ["order_id","truck_id"] cols compileSql [statement] `shouldBe` sql it "should compile a CREATE TABLE statement with an array column" do let sql = cs [plain|CREATE TABLE array_tests (\n pay_by_quarter INT[]\n);\n|] - let statement = StatementCreateTable CreateTable - { name = "array_tests" - , columns = [ col { name = "pay_by_quarter", columnType = PArray PInt } ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + + let statement = StatementCreateTable $ let arrayCol = emptyColumn { name = "pay_by_quarter" + , columnType = (PArray PInt) } + + + in emptyTable { name ="array_tests" + , columns = [arrayCol] + } compileSql [statement] `shouldBe` sql it "should compile a CREATE TABLE statement with an point column" do let sql = cs [plain|CREATE TABLE point_tests (\n pos POINT\n);\n|] - let statement = StatementCreateTable CreateTable - { name = "point_tests" - , columns = [ col { name = "pos", columnType = PPoint } ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + let statement = StatementCreateTable $ + emptyTable { name = "point_tests" + , columns = [ emptyColumn { name = "pos" + , columnType = PPoint + } + ] + } + + compileSql [statement] `shouldBe` sql it "should compile a CREATE TABLE statement with an polygon column" do let sql = cs [plain|CREATE TABLE polygon_tests (\n poly POLYGON\n);\n|] - let statement = StatementCreateTable CreateTable - { name = "polygon_tests" - , columns = [ col { name = "poly", columnType = PPolygon } ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + let statement = StatementCreateTable $ + emptyTable { name = "polygon_tests" + , columns = [ emptyColumn { name = "poly" + , columnType = PPolygon + } + ] + } + compileSql [statement] `shouldBe` sql it "should compile a CREATE INDEX statement" do @@ -787,12 +700,31 @@ tests = do it "should compile a decimal default value with a type-cast" do let sql = "CREATE TABLE a (\n electricity_unit_price DOUBLE PRECISION DEFAULT 0.17::DOUBLE PRECISION NOT NULL\n);\n" - let statement = StatementCreateTable CreateTable { name = "a", columns = [Column {name = "electricity_unit_price", columnType = PDouble, defaultValue = Just (TypeCastExpression (DoubleExpression 0.17) PDouble), notNull = True, isUnique = False, generator = Nothing}], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [], unlogged = False } + + eupCol = emptyColumn { name = "electricity_unit_price" + , columnType = PDouble + , defaultValue = Just (TypeCastExpression (DoubleExpression 0.17) PDouble) + , notNull = True + } + + let statement = StatementCreateTable $ emptyTable { name = "a" + , columns = [eupCol] + } + compileSql [statement] `shouldBe` sql it "should compile a integer default value" do let sql = "CREATE TABLE a (\n electricity_unit_price INT DEFAULT 0 NOT NULL\n);\n" - let statement = StatementCreateTable CreateTable { name = "a", columns = [Column {name = "electricity_unit_price", columnType = PInt, defaultValue = Just (IntExpression 0), notNull = True, isUnique = False, generator = Nothing}], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [], unlogged = False } + let statement = StatementCreateTable $ emptyTable { name = "a" + , columns = [eupCol] + } + + where eupCol = emptyColumn { name = "electricity_unit_price" + , columnType = PInt + , defaultValue = Just (IntExpression 0) + , notNull = True + } + compileSql [statement] `shouldBe` sql it "should compile a partial index" do @@ -1005,17 +937,13 @@ tests = do ts TSVECTOR GENERATED ALWAYS AS (setweight(to_tsvector('english', sku), ('A'::"char")) || setweight(to_tsvector('english', name), 'B') || setweight(to_tsvector('english', description), 'C')) STORED ); |] <> "\n" - let statements = [ - StatementCreateTable CreateTable - { name = "products" - , columns = [ - Column - { name = "ts" - , columnType = PTSVector - , defaultValue = Nothing - , notNull = False - , isUnique = False - , generator = Just $ ColumnGenerator + let statements = pure . StatementCreateTable $ emptyTable + { name = "products" + , columns = [colTs']} + + where colTs' = emptyColumn { name = "ts" + , columnType = PTSVector + , generator = Just $ ColumnGenerator { generate = ConcatenationExpression (ConcatenationExpression @@ -1025,14 +953,10 @@ tests = do (CallExpression "setweight" [CallExpression "to_tsvector" [TextExpression "english",VarExpression "description"],TextExpression "C"]) , stored = True } - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } - ] + } + compileSql statements `shouldBe` sql + it "should compile 'DROP FUNCTION ..;' statements" do let sql = "DROP FUNCTION my_function;\n" let statements = [ DropFunction { functionName = "my_function" } ] @@ -1044,12 +968,8 @@ tests = do ); |] <> "\n" let statements = [ - StatementCreateTable CreateTable - { name = "pg_large_notifications" - , columns = [] - , constraints = [] - , unlogged = True - , primaryKeyConstraint = PrimaryKeyConstraint [] - } + StatementCreateTable $ emptyTable { name = "pg_large_notifications" + , unlogged = True + } ] compileSql statements `shouldBe` sql \ No newline at end of file diff --git a/Test/IDE/SchemaDesigner/Controller/HelperSpec.hs b/Test/IDE/SchemaDesigner/Controller/HelperSpec.hs index f9d9c05d0..d3e60befd 100644 --- a/Test/IDE/SchemaDesigner/Controller/HelperSpec.hs +++ b/Test/IDE/SchemaDesigner/Controller/HelperSpec.hs @@ -4,6 +4,7 @@ import Test.Hspec import IHP.Prelude import IHP.IDE.SchemaDesigner.Controller.Helper import IHP.IDE.SchemaDesigner.Types +import IHP.IDE.Defaults.TableColumnDefaults tests :: SpecWith () tests = do @@ -13,15 +14,13 @@ tests = do getAllObjectNames [] `shouldBe` [] getAllObjectNames [ CreateExtension { name ="a", ifNotExists = True } ] `shouldBe` [] getAllObjectNames [ CreateEnumType { name = "first_enum", values=["a", "b", "c"] }] `shouldBe` ["first_enum"] - getAllObjectNames [ StatementCreateTable CreateTable - { name = "table_name", columns = [], primaryKeyConstraint = PrimaryKeyConstraint [], constraints=[], unlogged = False } + getAllObjectNames [ StatementCreateTable (defCreateTable "table_name" []) ] `shouldBe` ["table_name"] getAllObjectNames [ CreateEnumType {name = "first_enum", values = ["a", "b"]} , CreateExtension {name = "extension", ifNotExists = True} - , StatementCreateTable CreateTable - { name = "table_name", columns = [], primaryKeyConstraint = PrimaryKeyConstraint [], constraints=[], unlogged = False } + , StatementCreateTable (defCreateTable "table_name" []) , CreateEnumType {name = "second_enum", values = []} ] `shouldBe` ["first_enum","table_name","second_enum"] diff --git a/Test/IDE/SchemaDesigner/ParserSpec.hs b/Test/IDE/SchemaDesigner/ParserSpec.hs index e7b558022..58fd35f27 100644 --- a/Test/IDE/SchemaDesigner/ParserSpec.hs +++ b/Test/IDE/SchemaDesigner/ParserSpec.hs @@ -11,11 +11,12 @@ import IHP.IDE.SchemaDesigner.Types import IHP.ViewPrelude (cs, plain) import qualified Text.Megaparsec as Megaparsec import GHC.IO (evaluate) +import IHP.IDE.Defaults.TableColumnDefaults tests = do describe "The Schema.sql Parser" do it "should parse an empty CREATE TABLE statement" do - parseSql "CREATE TABLE users ();" `shouldBe` StatementCreateTable CreateTable { name = "users", columns = [], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [], unlogged = False } + parseSql "CREATE TABLE users ();" `shouldBe` StatementCreateTable (emptyTable {name = "users"}) it "should parse an CREATE EXTENSION for the UUID extension" do parseSql "CREATE EXTENSION IF NOT EXISTS \"uuid-ossp\";" `shouldBe` CreateExtension { name = "uuid-ossp", ifNotExists = True } @@ -43,78 +44,7 @@ tests = do picture_url TEXT, created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL ); |] - parseSql sql `shouldBe` StatementCreateTable CreateTable - { name = "users" - , columns = [ - Column - { name = "id" - , columnType = PUUID - , defaultValue = Just (CallExpression "uuid_generate_v4" []) - , notNull = True - , isUnique = False - , generator = Nothing - } - , Column - { name = "firstname" - , columnType = PText - , defaultValue = Nothing - , notNull = True - , isUnique = False - , generator = Nothing - } - , Column - { name = "lastname" - , columnType = PText - , defaultValue = Nothing - , notNull = True - , isUnique = False - , generator = Nothing - } - , Column - { name = "password_hash" - , columnType = PText - , defaultValue = Nothing - , notNull = True - , isUnique = False - , generator = Nothing - } - , Column - { name = "email" - , columnType = PText - , defaultValue = Nothing - , notNull = True - , isUnique = False - , generator = Nothing - } - , Column - { name = "company_id" - , columnType = PUUID - , defaultValue = Nothing - , notNull = True - , isUnique = False - , generator = Nothing - } - , Column - { name = "picture_url" - , columnType = PText - , defaultValue = Nothing - , notNull = False - , isUnique = False - , generator = Nothing - } - , Column - { name = "created_at" - , columnType = PTimestampWithTimezone - , defaultValue = Just (CallExpression "NOW" []) - , notNull = True - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint ["id"] - , constraints = [] - , unlogged = False - } + parseSql sql `shouldBe` StatementCreateTable compilerSpecTable it "should parse a CREATE TABLE with a generated column" do let sql = cs [plain| @@ -122,37 +52,34 @@ tests = do ts tsvector GENERATED ALWAYS AS (setweight(to_tsvector('english', sku), 'A') || setweight(to_tsvector('english', name), 'B') || setweight(to_tsvector('english', description), 'C')) STORED ); |] - parseSql sql `shouldBe` StatementCreateTable CreateTable - { name = "products" - , columns = [ - Column - { name = "ts" - , columnType = PTSVector - , defaultValue = Nothing - , notNull = False - , isUnique = False - , generator = Just $ ColumnGenerator + parseSql sql `shouldBe` StatementCreateTable ( + let colTs = [ emptyColumn { name = "ts" + , columnType = PTSVector + , generator = gen + } + ] + gen = Just $ ColumnGenerator { generate = - ConcatenationExpression - (ConcatenationExpression - (CallExpression "setweight" [CallExpression "to_tsvector" [TextExpression "english",VarExpression "sku"],TextExpression "A"]) - (CallExpression "setweight" [CallExpression "to_tsvector" [TextExpression "english",VarExpression "name"],TextExpression "B"]) - ) - (CallExpression "setweight" [CallExpression "to_tsvector" [TextExpression "english",VarExpression "description"],TextExpression "C"]) + ConcatenationExpression + ( ConcatenationExpression + (CallExpression "setweight" [CallExpression "to_tsvector" [TextExpression "english",VarExpression "sku"],TextExpression "A" ]) + (CallExpression "setweight" [CallExpression "to_tsvector" [TextExpression "english",VarExpression "name"],TextExpression "B"]) + ) + ( CallExpression "setweight" [CallExpression "to_tsvector" [TextExpression "english",VarExpression "description"],TextExpression "C"]) , stored = True } - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + + + in emptyTable { name ="products" + , columns = colTs + } + ) it "should parse a CREATE TABLE with quoted identifiers" do - parseSql "CREATE TABLE \"quoted name\" ();" `shouldBe` StatementCreateTable CreateTable { name = "quoted name", columns = [], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [], unlogged = False } + parseSql "CREATE TABLE \"quoted name\" ();" `shouldBe` StatementCreateTable (emptyTable { name = "quoted name" }) it "should parse a CREATE TABLE with public schema prefix" do - parseSql "CREATE TABLE public.users ();" `shouldBe` StatementCreateTable CreateTable { name = "users", columns = [], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [], unlogged = False } + parseSql "CREATE TABLE public.users ();" `shouldBe` StatementCreateTable (emptyTable { name = "users" }) it "should parse ALTER TABLE .. ADD FOREIGN KEY .. ON DELETE CASCADE" do parseSql "ALTER TABLE users ADD CONSTRAINT users_ref_company_id FOREIGN KEY (company_id) REFERENCES companies (id) ON DELETE CASCADE;" `shouldBe` AddConstraint @@ -499,102 +426,99 @@ tests = do parseSql "ALTER TYPE colors ADD VALUE IF NOT EXISTS 'blue';" `shouldBe` AddValueToEnumType { enumName = "colors", newValue = "blue", ifNotExists = True } it "should parse a CREATE TABLE with INTEGER / INT / INT4 / SMALLINT / INT2 / BIGINT / INT8 columns" do - parseSql "CREATE TABLE ints (int_a INTEGER, int_b INT, int_c int4, smallint_a SMALLINT, smallint_b INT2, bigint_a BIGINT, bigint_b int8);" `shouldBe` StatementCreateTable CreateTable - { name = "ints" - , columns = - [ col { name = "int_a", columnType = PInt } - , col { name = "int_b", columnType = PInt } - , col { name = "int_c", columnType = PInt } - , col { name = "smallint_a", columnType = PSmallInt } - , col { name = "smallint_b", columnType = PSmallInt } - , col { name = "bigint_a", columnType = PBigInt } - , col { name = "bigint_b", columnType = PBigInt } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + parseSql "CREATE TABLE ints (int_a INTEGER, int_b INT, int_c int4, smallint_a SMALLINT, smallint_b INT2, bigint_a BIGINT, bigint_b int8);" + `shouldBe` StatementCreateTable ( + let intCols = map mkPintCol ["int_a","int_b","int_c"] + <> map mkPSmallInt ["smallint_a","smallint_b"] + <> map mkBigInt ["bigint_a","bigint_b"] + + mkPintCol x = setColumn x PInt -- I don't have desire to rewrite these as an instance of empty column + mkPSmallInt x = setColumn x PSmallInt + mkBigInt x = setColumn x PBigInt + + in emptyTable { name = "ints" + , columns = intCols + } + ) it "should parse a CREATE TABLE with TIMESTAMP WITH TIMEZONE / TIMESTAMPZ columns" do - parseSql "CREATE TABLE timestamps (a TIMESTAMP WITH TIME ZONE, b TIMESTAMPZ);" `shouldBe` StatementCreateTable CreateTable - { name = "timestamps" - , columns = - [ col { name = "a", columnType = PTimestampWithTimezone } - , col { name = "b", columnType = PTimestampWithTimezone } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + parseSql "CREATE TABLE timestamps (a TIMESTAMP WITH TIME ZONE, b TIMESTAMPZ);" + `shouldBe` StatementCreateTable ( + let ts = map mkTimeStamp ["a","b"] + mkTimeStamp x = setColumn x PTimestampWithTimezone + + in emptyTable { name ="timestamps" + , columns = ts + } + ) it "should parse a CREATE TABLE with BOOLEAN / BOOL columns" do - parseSql "CREATE TABLE bools (a BOOLEAN, b BOOL);" `shouldBe` StatementCreateTable CreateTable - { name = "bools" - , columns = - [ col { name = "a", columnType = PBoolean } - , col { name = "b", columnType = PBoolean } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + parseSql "CREATE TABLE bools (a BOOLEAN, b BOOL);" + `shouldBe` StatementCreateTable ( + let bs = map mkBool ["a","b"] + mkBool x = setColumn x PBoolean + + in emptyTable { name = "bools" + , columns = bs + } + ) it "should parse a CREATE TABLE with REAL, FLOAT4, DOUBLE, FLOAT8 columns" do - parseSql "CREATE TABLE bools (a REAL, b FLOAT4, c DOUBLE PRECISION, d FLOAT8);" `shouldBe` StatementCreateTable CreateTable - { name = "bools" - , columns = - [ col { name = "a", columnType = PReal } - , col { name = "b", columnType = PReal } - , col { name = "c", columnType = PDouble } - , col { name = "d", columnType = PDouble } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + parseSql "CREATE TABLE realfloat (a REAL, b FLOAT4, c DOUBLE PRECISION, d FLOAT8);" + `shouldBe` StatementCreateTable + ( + let reals = map mkReal ["a","b"] + doubles = map mkDouble ["c","d"] + mkReal x = setColumn x PReal + mkDouble x = setColumn x PDouble + + in emptyTable { name = "realfloat" + , columns = (reals <> doubles) + } + ) it "should parse a CREATE TABLE with (deprecated) NUMERIC, NUMERIC(x), NUMERIC (x,y), VARYING(n) columns" do - parseSql ("CREATE TABLE deprecated_variables (a NUMERIC, b NUMERIC(1), c NUMERIC(1,2), d CHARACTER VARYING(10));") `shouldBe` StatementCreateTable CreateTable - { name = "deprecated_variables" - , columns = - [ col { name = "a", columnType = PNumeric Nothing Nothing} - , col { name = "b", columnType = (PNumeric (Just 1) Nothing) } - , col { name = "c", columnType = (PNumeric (Just 1) (Just 2)) } - , col { name = "d", columnType = (PVaryingN (Just 10)) } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + parseSql ("CREATE TABLE deprecated_variables (a NUMERIC, b NUMERIC(1), c NUMERIC(1,2), d CHARACTER VARYING(10));") + `shouldBe` StatementCreateTable ( + let depVars = [a,b,c,d] + a = setColumn "a" (PNumeric Nothing Nothing) + b = setColumn "b" (PNumeric (Just 1) Nothing) + c = setColumn "c" (PNumeric (Just 1) (Just 2)) + d = setColumn "d" (PVaryingN (Just 10)) + + in emptyTable {name = "deprecated_variables", columns = depVars} + ) it "should parse a CREATE TABLE statement with a multi-column UNIQUE (a, b) constraint" do - parseSql "CREATE TABLE user_followers (id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, user_id UUID NOT NULL, follower_id UUID NOT NULL, UNIQUE(user_id, follower_id));" `shouldBe` StatementCreateTable CreateTable - { name = "user_followers" - , columns = - [ col { name = "id", columnType = PUUID, defaultValue = Just (CallExpression "uuid_generate_v4" []), notNull = True } - , col { name = "user_id", columnType = PUUID, notNull = True } - , col { name = "follower_id", columnType = PUUID, notNull = True } - ] - , primaryKeyConstraint = PrimaryKeyConstraint ["id"] - , constraints = [ UniqueConstraint { name = Nothing, columnNames = [ "user_id", "follower_id" ] } ] - , unlogged = False - } + parseSql "CREATE TABLE user_followers (id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, user_id UUID NOT NULL, follower_id UUID NOT NULL, UNIQUE(user_id, follower_id));" + `shouldBe` StatementCreateTable ( + let followFields = [idColumn, user_id, follower_id] + user_id = setColumnN "user_id" PUUID + follower_id = setColumnN "follower_id" PUUID + + in emptyTable { name = "user_followers" + , primaryKeyConstraint = PrimaryKeyConstraint ["id"] + , columns = followFields + , constraints = [ UniqueConstraint { name = Nothing + , columnNames = [ "user_id", "follower_id" ] + } + ] + } + + ) it "should fail to parse a CREATE TABLE statement with an empty UNIQUE () constraint" do (evaluate (parseSql "CREATE TABLE user_followers (id UUID, UNIQUE());")) `shouldThrow` anyException pure () it "should parse a CREATE TABLE statement with a multi-column PRIMARY KEY (a, b) constraint" do - parseSql "CREATE TABLE user_followers (user_id UUID NOT NULL, follower_id UUID NOT NULL, PRIMARY KEY (user_id, follower_id));" `shouldBe` StatementCreateTable CreateTable - { name = "user_followers" - , columns = - [ col { name = "user_id", columnType = PUUID, notNull = True } - , col { name = "follower_id", columnType = PUUID, notNull = True } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [ "user_id", "follower_id" ] - , constraints = [] - , unlogged = False - } + parseSql "CREATE TABLE user_followers (user_id UUID NOT NULL, follower_id UUID NOT NULL, PRIMARY KEY (user_id, follower_id));" + `shouldBe` StatementCreateTable ( let fields = map mkField ["user_id","follower_id"] + mkField x = setColumnN x PUUID + + in defCreateTablePKID "user_followers" [ "user_id", "follower_id" ] fields + ) + it "should fail to parse a CREATE TABLE statement with PRIMARY KEY column and table constraints" do (evaluate (parseSql "CREATE TABLE user_followers (id UUID PRIMARY KEY, PRIMARY KEY(id));")) `shouldThrow` anyException @@ -605,49 +529,39 @@ tests = do pure () it "should parse a CREATE TABLE statement with a serial id" do - parseSql "CREATE TABLE orders (\n id SERIAL PRIMARY KEY NOT NULL\n);\n" `shouldBe` StatementCreateTable CreateTable - { name = "orders" - , columns = [ col { name = "id", columnType = PSerial, notNull = True} ] - , primaryKeyConstraint = PrimaryKeyConstraint ["id"] - , constraints = [] - , unlogged = False - } + parseSql "CREATE TABLE orders (\n id SERIAL PRIMARY KEY NOT NULL\n);\n" + `shouldBe` StatementCreateTable ( let serCol = pure $ setColumnN "id" PSerial + in defCreateTablePKID "orders" ["id"] serCol + ) it "should parse a CREATE TABLE statement with a bigserial id" do - parseSql "CREATE TABLE orders (\n id BIGSERIAL PRIMARY KEY NOT NULL\n);\n" `shouldBe` StatementCreateTable CreateTable - { name = "orders" - , columns = [ col { name = "id", columnType = PBigserial, notNull = True} ] - , primaryKeyConstraint = PrimaryKeyConstraint ["id"] - , constraints = [] - , unlogged = False - } - + parseSql "CREATE TABLE orders (\n id BIGSERIAL PRIMARY KEY NOT NULL\n);\n" + `shouldBe` StatementCreateTable ( let bigSerCol = pure $ (setColumnN "id" PBigserial) + in defCreateTablePKID "orders" ["id"] bigSerCol + ) + it "should parse a CREATE TABLE statement with an array column" do - parseSql "CREATE TABLE array_tests (\n pay_by_quarter integer[]\n);\n" `shouldBe` StatementCreateTable CreateTable - { name = "array_tests" - , columns = [ col { name = "pay_by_quarter", columnType = PArray PInt } ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + parseSql "CREATE TABLE array_tests (\n pay_by_quarter integer[]\n);\n" + `shouldBe` StatementCreateTable (let arrayCol = [setColumn "pay_by_quarter" (PArray PInt)] + + in emptyTable { name = "array_tests" + , columns = arrayCol + } + ) it "should parse a CREATE TABLE statement with a point column" do - parseSql "CREATE TABLE points (\n pos POINT\n);\n" `shouldBe` StatementCreateTable CreateTable - { name = "points" - , columns = [ col { name = "pos", columnType = PPoint } ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + parseSql "CREATE TABLE points (\n pos POINT\n);\n" + `shouldBe` StatementCreateTable emptyTable { name = "points" + , columns = [setColumn "pos" PPoint] + } + it "should parse a CREATE TABLE statement with a polygon column" do - parseSql "CREATE TABLE polygons (\n poly POLYGON\n);\n" `shouldBe` StatementCreateTable CreateTable - { name = "polygons" - , columns = [ col { name = "poly", columnType = PPolygon } ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + parseSql "CREATE TABLE polygons (\n poly POLYGON\n);\n" + `shouldBe` StatementCreateTable ( emptyTable { name = "polygons" + , columns = [setColumn "poly" PPolygon] + } + ) it "should parse a CREATE INDEX statement" do parseSql "CREATE INDEX users_index ON users (user_name);\n" `shouldBe` CreateIndex @@ -804,16 +718,33 @@ $$; it "should parse a decimal default value with a type-cast" do let sql = "CREATE TABLE a(electricity_unit_price DOUBLE PRECISION DEFAULT 0.17::double precision NOT NULL);" - let statements = - [ StatementCreateTable CreateTable { name = "a", columns = [Column {name = "electricity_unit_price", columnType = PDouble, defaultValue = Just (TypeCastExpression (DoubleExpression 0.17) PDouble), notNull = True, isUnique = False, generator = Nothing}], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [], unlogged = False } - ] - parseSqlStatements sql `shouldBe` statements + eupCol = [ emptyColumn { defaultValue = (Just (TypeCastExpression (DoubleExpression 0.17) PDouble)) + , name = "electricity_unit_price" + , columnType = PDouble + , notNull = True + } + ] + + parseSqlStatements sql `shouldBe` [StatementCreateTable $ emptyTable { name = "a" + , columns = eupCol} + ] it "should parse a integer default value" do let sql = "CREATE TABLE a(electricity_unit_price INT DEFAULT 0 NOT NULL);" let statements = - [ StatementCreateTable CreateTable { name = "a", columns = [Column {name = "electricity_unit_price", columnType = PInt, defaultValue = Just (IntExpression 0), notNull = True, isUnique = False, generator = Nothing}], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [], unlogged = False } + [ StatementCreateTable $ emptyTable { name = "a" + , columns = eupCol + } ] + + + + where eupCol = pure $ emptyColumn { defaultValue = (Just (IntExpression 0)) + , name = "electricity_unit_price" + , columnType = PInt + , notNull = True + } + parseSqlStatements sql `shouldBe` statements it "should parse a partial index" do @@ -900,7 +831,11 @@ $$; let sql = cs [plain| CREATE TABLE a(id UUID DEFAULT public.uuid_generate_v4() NOT NULL); |] - let statement = StatementCreateTable CreateTable { name = "a", columns = [Column {name = "id", columnType = PUUID, defaultValue = Just (CallExpression "uuid_generate_v4" []), notNull = True, isUnique = False, generator = Nothing}], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [], unlogged = False } + let statement = StatementCreateTable (emptyTable { name = "a" + , columns = [idColumn] + } + ) + parseSql sql `shouldBe` statement @@ -910,21 +845,13 @@ $$; a character varying(510) DEFAULT NULL::character varying ); |] - let statement = StatementCreateTable CreateTable - { name = "a" - , columns = [ Column - {name = "a" - , columnType = PVaryingN (Just 510) - , defaultValue = Just (TypeCastExpression (VarExpression "NULL") (PVaryingN Nothing)) - , notNull = False - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + let statement = StatementCreateTable $ emptyTable {name = "a", columns = [tcCol]} + + where tcCol = emptyColumn { defaultValue = Just (TypeCastExpression (VarExpression "NULL") (PVaryingN Nothing)) + , name = "a" + , columnType = (PVaryingN (Just 510)) + } + parseSql sql `shouldBe` statement it "should parse empty binary strings" do @@ -933,21 +860,16 @@ $$; a bytea DEFAULT '\\x'::bytea NOT NULL ); |] - let statement = StatementCreateTable CreateTable - { name = "a" - , columns = [ Column - {name = "a" - , columnType = PBinary - , defaultValue = Just (TypeCastExpression (TextExpression "") PBinary) - , notNull = True - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + let statement = StatementCreateTable $ emptyTable { name = "a" + , columns = [ebCol] + } + + where ebCol = emptyColumn { defaultValue = Just (TypeCastExpression (TextExpression "") PBinary) + , name = "a" + , columnType = PBinary + , notNull = True + } + parseSql sql `shouldBe` statement it "should parse a pg_dump header" do let sql = cs [plain| @@ -1134,21 +1056,17 @@ COMMENT ON EXTENSION "uuid-ossp" IS 'generate universally unique identifiers (UU it "should parse 'CREATE TABLE ..' statements when the table name starts with public" do let sql = cs [plain|CREATE TABLE public_variables (id UUID);|] - parseSql sql `shouldBe` StatementCreateTable {unsafeGetCreateTable = CreateTable {name = "public_variables", columns = [Column {name = "id", columnType = PUUID, defaultValue = Nothing, notNull = False, isUnique = False, generator = Nothing}], primaryKeyConstraint = PrimaryKeyConstraint {primaryKeyColumnNames = []}, constraints = [], unlogged = False}} + parseSql sql `shouldBe` StatementCreateTable {unsafeGetCreateTable = emptyTable { name = "public_variables" + , columns = [ emptyColumn { name ="id" + , columnType = PUUID } + ] + } + } it "should parse an 'CREATE UNLOGGED TABLE' statement" do - parseSql "CREATE UNLOGGED TABLE pg_large_notifications ();" `shouldBe` StatementCreateTable CreateTable { name = "pg_large_notifications", columns = [], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [], unlogged = True } - - -col :: Column -col = Column - { name = "" - , columnType = PCustomType "" - , defaultValue = Nothing - , notNull = False - , isUnique = False - , generator = Nothing - } + parseSql "CREATE UNLOGGED TABLE pg_large_notifications ();" + `shouldBe` + StatementCreateTable emptyTable {name = "pg_large_notifications" , unlogged = True} parseSql :: Text -> Statement parseSql sql = let [statement] = parseSqlStatements sql in statement diff --git a/Test/IDE/SchemaDesigner/SchemaOperationsSpec.hs b/Test/IDE/SchemaDesigner/SchemaOperationsSpec.hs index b4eff8b7b..ead1f8c44 100644 --- a/Test/IDE/SchemaDesigner/SchemaOperationsSpec.hs +++ b/Test/IDE/SchemaDesigner/SchemaOperationsSpec.hs @@ -6,11 +6,12 @@ import IHP.IDE.SchemaDesigner.Types import qualified IHP.IDE.SchemaDesigner.SchemaOperations as SchemaOperations import qualified IHP.IDE.SchemaDesigner.Parser as Parser import qualified Text.Megaparsec as Megaparsec +import IHP.IDE.Defaults.TableColumnDefaults tests = do describe "IHP.IDE.SchemaDesigner.SchemaOperations" do - let tableA = StatementCreateTable CreateTable { name = "a", columns = [], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [], unlogged = False } - let tableB = StatementCreateTable CreateTable { name = "b", columns = [], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [], unlogged = False } + let tableA = StatementCreateTable $ emptyTable {name = "a"} + let tableB = StatementCreateTable $ emptyTable {name = "b"} let enumA = CreateEnumType { name = "enumA", values = [] } let enumB = CreateEnumType { name = "enumB", values = [] } let comment = Comment { content = "comment" } @@ -103,16 +104,14 @@ tests = do describe "suggestPolicy" do it "should suggest a policy if a user_id column exists" do - let table = StatementCreateTable CreateTable - { - name = "posts" - , columns = - [ Column { name = "user_id", columnType = PUUID, defaultValue = Nothing, notNull = True, isUnique = False, generator = Nothing } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + let table = StatementCreateTable $ + emptyTable { name = "posts" + , columns = [emptyColumn { name = "user_id" + , columnType = PUUID + } + ] + } + let schema = [table] let expectedPolicy = CreatePolicy { name = "Users can manage their posts" @@ -125,16 +124,9 @@ tests = do SchemaOperations.suggestPolicy schema table `shouldBe` expectedPolicy it "should suggest an empty policy if no user_id column exists" do - let table = StatementCreateTable CreateTable - { - name = "posts" - , columns = - [ Column { name = "title", columnType = PText, defaultValue = Nothing, notNull = True, isUnique = False, generator = Nothing } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + let table = StatementCreateTable $ emptyTable { name = "posts" + , columns = [colText "title"] + } let schema = [table] let expectedPolicy = CreatePolicy { name = "" @@ -147,24 +139,22 @@ tests = do SchemaOperations.suggestPolicy schema table `shouldBe` expectedPolicy it "should suggest a policy if it can find a one hop path to a user_id column" do - let tasksTable = StatementCreateTable CreateTable - { name = "tasks" - , columns = - [ Column { name = "task_list_id", columnType = PUUID, defaultValue = Nothing, notNull = True, isUnique = False, generator = Nothing } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } - let taskListsTable = StatementCreateTable CreateTable - { name = "task_lists" - , columns = - [ Column { name = "user_id", columnType = PUUID, defaultValue = Nothing, notNull = True, isUnique = False, generator = Nothing } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + let tasksTable = StatementCreateTable $ emptyTable { name = "tasks" + , columns = [t_l_idcol] + } + + where t_l_idcol = emptyColumn { name = "task_list_id" + , columnType = PUUID + , notNull = True + } + + let taskListsTable = StatementCreateTable $ emptyTable + { name = "task_lists" + , columns = pure $ emptyColumn { name = "user_id" + , columnType = PUUID + } + } + let schema = [ tasksTable , taskListsTable @@ -182,23 +172,16 @@ tests = do describe "addColumn" do it "should add an index if withIndex = true" do let inputSchema = [tableA] + colCreatedAt = emptyColumn { defaultValue = (Just (CallExpression "NOW" [])) + , name = "created_at" + , columnType = PTimestampWithTimezone + , notNull = True + } + + let tableAWithCreatedAt = StatementCreateTable $ emptyTable { name = "a" + , columns = [colCreatedAt] + } - let tableAWithCreatedAt = StatementCreateTable CreateTable - { name = "a" - , columns = [ - Column - { name = "created_at" - , columnType = PTimestampWithTimezone - , defaultValue = Just (CallExpression "NOW" []) - , notNull = True - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } let index = CreateIndex { indexName = "a_created_at_index", unique = False, tableName = "a", columns = [IndexColumn { column = VarExpression "created_at", columnOrder = [] }], whereClause = Nothing, indexType = Nothing } let expectedSchema = [tableAWithCreatedAt, index] @@ -223,22 +206,7 @@ tests = do it "should add a trigger to updated_at columns" do let inputSchema = [tableA] - let tableAWithCreatedAt = StatementCreateTable CreateTable - { name = "a" - , columns = [ - Column - { name = "updated_at" - , columnType = PTimestampWithTimezone - , defaultValue = Just (CallExpression "NOW" []) - , notNull = True - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + let tableAWithCreatedAt = StatementCreateTable tableAWithCreatedAtTable let function = CreateFunction { functionName = "set_updated_at_to_now" @@ -281,22 +249,15 @@ tests = do it "should add a policy if autoPolicy = true" do let inputSchema = [tableA] - let tableAWithCreatedAt = StatementCreateTable CreateTable - { name = "a" - , columns = [ - Column - { name = "user_id" - , columnType = PUUID - , defaultValue = Nothing - , notNull = True - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + let tableAWithCreatedAt = StatementCreateTable $ + emptyTable { name = "a" + , columns = [ emptyColumn { name = "user_id" + , columnType = PUUID + , notNull = True + } + ] + } + let index = CreateIndex { indexName = "a_user_id_index" @@ -342,22 +303,7 @@ tests = do describe "deleteColumn" do it "should delete an referenced index" do - let tableAWithCreatedAt = StatementCreateTable CreateTable - { name = "a" - , columns = [ - Column - { name = "created_at" - , columnType = PTimestampWithTimezone - , defaultValue = Just (CallExpression "NOW" []) - , notNull = True - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + let tableAWithCreatedAt = StatementCreateTable tableAWithCreatedAtTable let index = CreateIndex { indexName = "a_created_at_index", unique = False, tableName = "a", columns = [IndexColumn { column = VarExpression "created_at", columnOrder = [] }], whereClause = Nothing, indexType = Nothing } let inputSchema = [tableAWithCreatedAt, index] @@ -372,22 +318,7 @@ tests = do (SchemaOperations.deleteColumn options inputSchema) `shouldBe` expectedSchema it "should delete a updated_at trigger" do - let tableAWithCreatedAt = StatementCreateTable CreateTable - { name = "a" - , columns = [ - Column - { name = "updated_at" - , columnType = PTimestampWithTimezone - , defaultValue = Just (CallExpression "NOW" []) - , notNull = True - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + let tableAWithCreatedAt = StatementCreateTable $ tableAWithCreatedAtTable let function = CreateFunction { functionName = "set_updated_at_to_now" @@ -420,22 +351,12 @@ tests = do (SchemaOperations.deleteColumn options inputSchema) `shouldBe` expectedSchema it "should delete an referenced policy" do - let tableAWithUserId = StatementCreateTable CreateTable - { name = "a" - , columns = [ - Column - { name = "user_id" - , columnType = PUUID - , defaultValue = Just (CallExpression "ihp_user_id" []) - , notNull = True - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + let tableAWithUserId = StatementCreateTable $ emptyTable {name = "a", columns = ihpuser} + + where ihpuser = [ setColumnDefaultVal (Just (CallExpression "ihp_user_id" ([]))) $ + setColumn "user_id" PUUID + ] + let policy = CreatePolicy { name = "a_policy", tableName = "a", action = Nothing, using = Just (EqExpression (VarExpression "user_id") (CallExpression "ihp_user_id" [])), check = Nothing } let inputSchema = [tableAWithUserId, policy] @@ -450,39 +371,17 @@ tests = do (SchemaOperations.deleteColumn options inputSchema) `shouldBe` expectedSchema describe "update" do it "update a column's name, type, default value and not null" do - let tableAWithCreatedAt = StatementCreateTable CreateTable - { name = "a" - , columns = [ - Column - { name = "updated_at" - , columnType = PTimestampWithTimezone - , defaultValue = Just (CallExpression "NOW" []) - , notNull = True - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } - - let tableAWithUpdatedColumn = StatementCreateTable CreateTable - { name = "a" - , columns = [ - Column - { name = "created_at2" - , columnType = PText - , defaultValue = Nothing - , notNull = False - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + let tableAWithCreatedAt = StatementCreateTable $ tableAWithCreatedAtTable + + let tableAWithUpdatedColumn = StatementCreateTable + $ emptyTable { name = "a" + , columns = [ emptyColumn { name = "created_at2" + , columnType = PText + , notNull = False + } + ] + } + let inputSchema = [tableAWithCreatedAt] let expectedSchema = [tableAWithUpdatedColumn] @@ -501,39 +400,18 @@ tests = do (SchemaOperations.updateColumn options inputSchema) `shouldBe` expectedSchema it "updates a primary key" do - let tableWithPK = StatementCreateTable CreateTable - { name = "a" - , columns = [ - Column - { name = "id2" - , columnType = PUUID - , defaultValue = Nothing - , notNull = True - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint ["id"] - , constraints = [] - , unlogged = False - } - - let tableWithoutPK = StatementCreateTable CreateTable - { name = "a" - , columns = [ - Column - { name = "id" - , columnType = PUUID - , defaultValue = Nothing - , notNull = True - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + let tableWithPK = StatementCreateTable $ + defCreateTablePKID "a" ["id"] + [setColumnN "id2" PUUID + ] + + let tableWithoutPK = StatementCreateTable $ + emptyTable { name = "a" + , columns = [ emptyColumn { name = "id" + , columnType = PUUID + } + ] + } let inputSchema = [tableWithoutPK] let expectedSchema = [tableWithPK] @@ -552,39 +430,30 @@ tests = do (SchemaOperations.updateColumn options inputSchema) `shouldBe` expectedSchema it "updates referenced foreign key constraints" do - let tasksTable = StatementCreateTable CreateTable - { name = "tasks" - , columns = - [ Column { name = "task_list_id", columnType = PUUID, defaultValue = Nothing, notNull = True, isUnique = False, generator = Nothing } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } - let taskListsTable = StatementCreateTable CreateTable - { name = "task_lists" - , columns = - [ Column { name = "user_id", columnType = PUUID, defaultValue = Nothing, notNull = True, isUnique = False, generator = Nothing } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + let tasksTable = StatementCreateTable $ + emptyTable { name = "tasks" + , columns = [setColumnN "task_list_id" PUUID + ] + } + + let taskListsTable = StatementCreateTable $ + emptyTable { name = "tasks" + , columns = [ setColumnN "list_id" PUUID + ] + } + let inputSchema = [ tasksTable , taskListsTable , AddConstraint { tableName = "tasks", constraint = ForeignKeyConstraint { name = "tasks_ref_task_lists", columnName = "task_list_id", referenceTable = "task_lists", referenceColumn = Nothing, onDelete = Nothing }, deferrable = Nothing, deferrableType = Nothing } ] - let tasksTable' = StatementCreateTable CreateTable - { name = "tasks" - , columns = - [ Column { name = "list_id", columnType = PUUID, defaultValue = Nothing, notNull = True, isUnique = False, generator = Nothing } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + let tasksTable' = StatementCreateTable $ + emptyTable { name = "tasks" + , columns = [setColumnN "list_id" PUUID + ] + } + let expectedSchema = [ tasksTable' , taskListsTable @@ -605,40 +474,16 @@ tests = do (SchemaOperations.updateColumn options inputSchema) `shouldBe` expectedSchema it "update a column's indexes" do - let tableAWithCreatedAt = StatementCreateTable CreateTable - { name = "a" - , columns = [ - Column - { name = "updated_at" - , columnType = PTimestampWithTimezone - , defaultValue = Just (CallExpression "NOW" []) - , notNull = True - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + let tableAWithCreatedAt = StatementCreateTable $ tableAWithCreatedAtTable + let index = CreateIndex { indexName = "a_updated_at_index", unique = False, tableName = "a", columns = [IndexColumn { column = VarExpression "updated_at", columnOrder = [] }], whereClause = Nothing, indexType = Nothing } - let tableAWithUpdatedColumn = StatementCreateTable CreateTable - { name = "a" - , columns = [ - Column - { name = "created_at" - , columnType = PText - , defaultValue = Nothing - , notNull = False - , isUnique = False - , generator = Nothing - } - ] - , primaryKeyConstraint = PrimaryKeyConstraint [] - , constraints = [] - , unlogged = False - } + let tableAWithUpdatedColumn = StatementCreateTable $ + emptyTable { name = "a" + , columns = [setColumn "created_at" PText + ] + } + let indexUpdated = CreateIndex { indexName = "a_created_at_index", unique = False, tableName = "a", columns = [IndexColumn { column = VarExpression "created_at", columnOrder = [] }], whereClause = Nothing, indexType = Nothing } let inputSchema = [tableAWithCreatedAt, index] @@ -683,3 +528,23 @@ parseSqlStatements sql = case Megaparsec.runParser Parser.parseDDL "input" sql of Left parserError -> error (cs $ Megaparsec.errorBundlePretty parserError) -- For better error reporting in hspec Right statements -> statements + + +-- Repeated Values in Tests: + + +{- | A common table that appears in test: + +Defined as: + +@ +tableAWithCreatedAtTable :: CreateTable +tableAWithCreatedAtTable = defCreateTable "a" [ setColumnDefaultVal (Just (CallExpression "NOW" ([]))) $ + setColumnN "updated_at" PTimestampWithTimezone + ] +@ +-} +tableAWithCreatedAtTable :: CreateTable +tableAWithCreatedAtTable = defCreateTable "a" [ setColumnDefaultVal (Just (CallExpression "NOW" ([]))) $ + setColumnN "updated_at" PTimestampWithTimezone + ] diff --git a/Test/SchemaCompilerSpec.hs b/Test/SchemaCompilerSpec.hs index 57f4fce86..6acd43f3f 100644 --- a/Test/SchemaCompilerSpec.hs +++ b/Test/SchemaCompilerSpec.hs @@ -9,6 +9,7 @@ import IHP.Prelude import IHP.SchemaCompiler import IHP.IDE.SchemaDesigner.Types import qualified Data.Text as Text +import IHP.IDE.Defaults.TableColumnDefaults tests = do describe "SchemaCompiler" do @@ -118,13 +119,10 @@ tests = do instance IHP.Controller.Param.ParamReader PropertyType where readParameter = IHP.Controller.Param.enumParamReader; readParameterJSON = IHP.Controller.Param.enumParamReaderJSON |] describe "compileCreate" do - let statement = StatementCreateTable $ CreateTable { - name = "users", - columns = [ Column "id" PUUID Nothing False False Nothing ], - primaryKeyConstraint = PrimaryKeyConstraint ["id"], - constraints = [], - unlogged = False - } + let statement = StatementCreateTable $ + defCreateTablePKID "users" ["id"] [ setColumn "id" PUUID + ] + let compileOutput = compileStatementPreview [statement] statement |> Text.strip it "should compile CanCreate instance with sqlQuery" $ \statement -> do @@ -145,13 +143,12 @@ tests = do |] it "should compile CanUpdate instance with an array type with an explicit cast" do - let statement = StatementCreateTable $ CreateTable { - name = "users", - columns = [ Column "id" PUUID Nothing False True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing], - primaryKeyConstraint = PrimaryKeyConstraint ["id"], - constraints = [] - , unlogged = False - } + let statement = StatementCreateTable $ + defCreateTablePKID "users" ["id"] idCols + where idCols = [a,b] + a = setColumnN "id" PUUID + b = setColumn "ids" (PArray PUUID) + let compileOutput = compileStatementPreview [statement] statement |> Text.strip getInstanceDecl "CanUpdate" compileOutput `shouldBe` [trimming| @@ -160,16 +157,14 @@ tests = do List.head <$> sqlQuery "UPDATE users SET id = ?, ids = ? :: UUID[] WHERE id = ? RETURNING id, ids" ((fieldWithUpdate #id model, fieldWithUpdate #ids model, get #id model)) |] it "should deal with double default values" do - let statement = StatementCreateTable CreateTable - { name = "users" - , columns = - [ Column "id" PUUID Nothing False True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing - , Column {name = "electricity_unit_price", columnType = PDouble, defaultValue = Just (TypeCastExpression (DoubleExpression 0.17) PDouble), notNull = True, isUnique = False, generator = Nothing} - ] - , primaryKeyConstraint = PrimaryKeyConstraint ["id"] - , constraints = [] - , unlogged = False - } + let statement = StatementCreateTable $ + defCreateTablePKID "users" ["id"] idCols + where idCols = [a,b,c] + a = setColumnN "id" PUUID + b = setColumn "ids" (PArray PUUID) + c = setColumnDefaultVal (Just (TypeCastExpression (DoubleExpression 0.17) PDouble) ) $ + setColumnN "electricity_unit_price" PDouble + let compileOutput = compileStatementPreview [statement] statement |> Text.strip compileOutput `shouldBe` [trimming| @@ -220,16 +215,15 @@ tests = do {-# INLINABLE primaryKeyCondition #-} |] it "should deal with integer default values for double columns" do - let statement = StatementCreateTable CreateTable - { name = "users" - , columns = - [ Column "id" PUUID Nothing False True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing - , Column {name = "electricity_unit_price", columnType = PDouble, defaultValue = Just (IntExpression 0), notNull = True, isUnique = False, generator = Nothing} - ] - , primaryKeyConstraint = PrimaryKeyConstraint ["id"] - , constraints = [] - , unlogged = False - } + let statement = StatementCreateTable $ + let cols = [a,b,c] + a = setColumnN "id" PUUID + b = setColumn "ids" (PArray PUUID) + c = setColumnDefaultVal (Just (IntExpression 0)) $ + setColumnN "electricity_unit_price" PDouble + + in defCreateTablePKID "users" ["id"] cols + let compileOutput = compileStatementPreview [statement] statement |> Text.strip compileOutput `shouldBe` [trimming| @@ -280,16 +274,17 @@ tests = do {-# INLINABLE primaryKeyCondition #-} |] it "should not touch GENERATED columns" do - let statement = StatementCreateTable CreateTable - { name = "users" - , columns = - [ Column "id" PUUID Nothing False True Nothing - , Column {name = "ts", columnType = PTSVector, defaultValue = Nothing, notNull = True, isUnique = False, generator = Just (ColumnGenerator { generate = VarExpression "someResult", stored = False }) } - ] - , primaryKeyConstraint = PrimaryKeyConstraint ["id"] - , constraints = [] - , unlogged = False - } + let statement = StatementCreateTable $ + defCreateTablePKID "users" ["id"] cols + where cols = [a,b] + a = setColumnN "id" PUUID + b = (setColumn "ts" PTSVector) { generator = + Just (ColumnGenerator { generate = VarExpression "someResult" + , stored = False + } + ) + } + let compileOutput = compileStatementPreview [statement] statement |> Text.strip compileOutput `shouldBe` [trimming| diff --git a/ihp.cabal b/ihp.cabal index 789728c4a..cf506103d 100644 --- a/ihp.cabal +++ b/ihp.cabal @@ -346,6 +346,7 @@ library , IHP.IDE.Data.View.ShowQuery , IHP.IDE.Data.View.ShowTableRows , IHP.IDE.Data.View.ShowForeignKeyHoverCard + , IHP.IDE.Defaults.TableColumnDefaults , IHP.IDE.CodeGen.View.Generators , IHP.IDE.CodeGen.View.NewAction , IHP.IDE.CodeGen.View.NewApplication