Added support for 'CREATE UNLOGGED TABLE' syntax in sql files

Author: mpscholten

IHP/IDE/SchemaDesigner/Compiler.hs

@@ -22,7 +22,7 @@ compileSql statements = statements
     |> unlines
 
 compileStatement :: Statement -> Text
-compileStatement (StatementCreateTable CreateTable { name, columns, primaryKeyConstraint, constraints }) = "CREATE TABLE " <> compileIdentifier name <> " (\n" <> intercalate ",\n" (map (\col -> "    " <> compileColumn primaryKeyConstraint col) columns <> maybe [] ((:[]) . indent) (compilePrimaryKeyConstraint primaryKeyConstraint) <> map (indent . compileConstraint) constraints) <> "\n);"
+compileStatement (StatementCreateTable CreateTable { name, columns, primaryKeyConstraint, constraints, unlogged }) = "CREATE" <> (if unlogged then " UNLOGGED" else "") <> " TABLE " <> compileIdentifier name <> " (\n" <> intercalate ",\n" (map (\col -> "    " <> compileColumn primaryKeyConstraint col) columns <> maybe [] ((:[]) . indent) (compilePrimaryKeyConstraint primaryKeyConstraint) <> map (indent . compileConstraint) constraints) <> "\n);"
 compileStatement CreateEnumType { name, values } = "CREATE TYPE " <> compileIdentifier name <> " AS ENUM (" <> intercalate ", " (values |> map TextExpression |> map compileExpression) <> ");"
 compileStatement CreateExtension { name, ifNotExists } = "CREATE EXTENSION " <> (if ifNotExists then "IF NOT EXISTS " else "") <> compileIdentifier name <> ";"
 compileStatement AddConstraint { tableName, constraint = UniqueConstraint { name = Nothing, columnNames } } = "ALTER TABLE " <> compileIdentifier tableName <> " ADD UNIQUE (" <> intercalate ", " columnNames <> ")" <> ";"

IHP/IDE/SchemaDesigner/Parser.hs

@@ -88,6 +88,7 @@ createExtension = do
 
 createTable = do
     lexeme "CREATE"
+    unlogged <- isJust <$> optional (lexeme "UNLOGGED")
     lexeme "TABLE"
     name <- qualifiedIdentifier
 
@@ -115,7 +116,7 @@ createTable = do
             _ -> Prelude.fail ("Primary key defined in both column and table constraints on table " <> cs name)
         _ -> Prelude.fail "Multiple columns with PRIMARY KEY constraint"
 
-    pure CreateTable { name, columns, primaryKeyConstraint, constraints }
+    pure CreateTable { name, columns, primaryKeyConstraint, constraints, unlogged }
 
 createEnumType = do
     lexeme "CREATE"

IHP/IDE/SchemaDesigner/SchemaOperations.hs

@@ -29,6 +29,7 @@ addTable tableName list = list <> [StatementCreateTable CreateTable
             }]
     , primaryKeyConstraint = PrimaryKeyConstraint ["id"]
     , constraints = []
+    , unlogged = False
     }]
 
 

IHP/IDE/SchemaDesigner/Types.hs

@@ -82,6 +82,7 @@ data CreateTable
       , columns :: [Column]
       , primaryKeyConstraint :: PrimaryKeyConstraint
       , constraints :: [Constraint]
+      , unlogged :: !Bool
       }
   deriving (Eq, Show)
 

Test/IDE/CodeGeneration/ControllerGenerator.hs

@@ -30,6 +30,7 @@ tests = do
                         ]
                         , primaryKeyConstraint = PrimaryKeyConstraint ["id"]
                         , constraints = []
+                        , unlogged = False
                     },
                     StatementCreateTable CreateTable {
                         name = "people"
@@ -63,6 +64,7 @@ tests = do
                         ]
                         , primaryKeyConstraint = PrimaryKeyConstraint ["id"]
                         , constraints = []
+                        , unlogged = False
                     }
                 ]
         it "should build a controller with name \"pages\"" do

Test/IDE/CodeGeneration/MailGenerator.hs

@@ -31,6 +31,7 @@ tests = do
                         ]
                         , primaryKeyConstraint = PrimaryKeyConstraint ["id"]
                         , constraints = []
+                        , unlogged = False
                         }
                     ]
         it "should build a mail with name \"PurchaseConfirmationMail\"" do

Test/IDE/CodeGeneration/ViewGenerator.hs

@@ -31,6 +31,7 @@ tests = do
                         ]
                         , primaryKeyConstraint = PrimaryKeyConstraint ["id"]
                         , constraints = []
+                        , unlogged = False
                         }
                     ]
         it "should build a view with name \"EditView\"" do

Test/IDE/SchemaDesigner/CompilerSpec.hs

@@ -15,7 +15,7 @@ import Test.IDE.SchemaDesigner.ParserSpec (col, parseSql)
 tests = do
     describe "The Schema.sql Compiler" do
         it "should compile an empty CREATE TABLE statement" do
-            compileSql [StatementCreateTable CreateTable { name = "users", columns = [], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [] }] `shouldBe` "CREATE TABLE users (\n\n);\n"
+            compileSql [StatementCreateTable CreateTable { name = "users", columns = [], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [], unlogged = False }] `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"
@@ -108,11 +108,12 @@ tests = do
                         ]
                     , primaryKeyConstraint = PrimaryKeyConstraint ["id"]
                     , constraints = []
+                    , unlogged = False
                     }
             compileSql [statement] `shouldBe` sql
 
         it "should compile a CREATE TABLE with quoted identifiers" do
-            compileSql [StatementCreateTable CreateTable { name = "quoted name", columns = [], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [] }] `shouldBe` "CREATE TABLE \"quoted name\" (\n\n);\n"
+            compileSql [StatementCreateTable CreateTable { name = "quoted name", columns = [], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [], unlogged = False }] `shouldBe` "CREATE TABLE \"quoted name\" (\n\n);\n"
 
         it "should compile ALTER TABLE .. ADD FOREIGN KEY .. ON DELETE CASCADE" do
             let statement = AddConstraint
@@ -476,6 +477,7 @@ tests = do
                         ]
                     , primaryKeyConstraint = PrimaryKeyConstraint []
                     , constraints = []
+                    , unlogged = False
                     }
             compileSql [statement] `shouldBe` sql
 
@@ -527,6 +529,7 @@ tests = do
                         ]
                     , primaryKeyConstraint = PrimaryKeyConstraint []
                     , constraints = []
+                    , unlogged = False
                     }
             compileSql [statement] `shouldBe` sql
 
@@ -541,6 +544,7 @@ tests = do
                         ]
                     , primaryKeyConstraint = PrimaryKeyConstraint ["id"]
                     , constraints = [ UniqueConstraint { name = Nothing, columnNames = [ "user_id", "follower_id" ] } ]
+                    , unlogged = False
                     }
             compileSql [statement] `shouldBe` sql
 
@@ -551,6 +555,7 @@ tests = do
                     , columns = [ col { name = "id", columnType = PSerial, notNull = True} ]
                     , primaryKeyConstraint = PrimaryKeyConstraint ["id"]
                     , constraints = []
+                    , unlogged = False
                     }
             compileSql [statement] `shouldBe` sql
 
@@ -561,6 +566,7 @@ tests = do
                     , columns = [ col { name = "id", columnType = PBigserial, notNull = True} ]
                     , primaryKeyConstraint = PrimaryKeyConstraint ["id"]
                     , constraints = []
+                    , unlogged = False
                     }
             compileSql [statement] `shouldBe` sql
 
@@ -574,6 +580,7 @@ tests = do
                         ]
                     , primaryKeyConstraint = PrimaryKeyConstraint ["order_id", "truck_id"]
                     , constraints = []
+                    , unlogged = False
                     }
             compileSql [statement] `shouldBe` sql
 
@@ -584,6 +591,7 @@ tests = do
                     , columns = [ col { name = "pay_by_quarter", columnType = PArray PInt } ]
                     , primaryKeyConstraint = PrimaryKeyConstraint []
                     , constraints = []
+                    , unlogged = False
                     }
             compileSql [statement] `shouldBe` sql
 
@@ -594,6 +602,7 @@ tests = do
                     , columns = [ col { name = "pos", columnType = PPoint } ]
                     , primaryKeyConstraint = PrimaryKeyConstraint []
                     , constraints = []
+                    , unlogged = False
                     }
             compileSql [statement] `shouldBe` sql
 
@@ -604,6 +613,7 @@ tests = do
                     , columns = [ col { name = "poly", columnType = PPolygon } ]
                     , primaryKeyConstraint = PrimaryKeyConstraint []
                     , constraints = []
+                    , unlogged = False
                     }
             compileSql [statement] `shouldBe` sql
 
@@ -777,12 +787,12 @@ 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 = [] }
+            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 }
             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 = [] }
+            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 }
             compileSql [statement] `shouldBe` sql
 
         it "should compile a partial index" do
@@ -1019,10 +1029,27 @@ tests = do
                                 ]
                             , 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" } ]
             compileSql statements `shouldBe` sql
+        it "should compile 'CREATE UNLOGGED TABLE' statements" do
+            let sql = [trimming|
+                CREATE UNLOGGED TABLE pg_large_notifications (
+                
+                );
+            |] <> "\n"
+            let statements = [
+                        StatementCreateTable CreateTable
+                            { name = "pg_large_notifications"
+                            , columns = []
+                            , constraints = []
+                            , unlogged = True
+                            , primaryKeyConstraint = PrimaryKeyConstraint []
+                            }
+                        ]
+            compileSql statements `shouldBe` sql

Test/IDE/SchemaDesigner/Controller/HelperSpec.hs

@@ -14,14 +14,14 @@ tests = do
                 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=[]}
+                                        { name = "table_name", columns = [], primaryKeyConstraint = PrimaryKeyConstraint [], constraints=[], unlogged = False }
                                   ]
                     `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=[]}
+                        { name = "table_name", columns = [], primaryKeyConstraint = PrimaryKeyConstraint [], constraints=[], unlogged = False }
                     , CreateEnumType {name = "second_enum", values = []}
                     ]
                     `shouldBe` ["first_enum","table_name","second_enum"]