Fixed generated columns not normalized in migration generator causing bad migrations being generated

Author: mpscholten

IHP/IDE/CodeGen/MigrationGenerator.hs

@@ -395,7 +395,7 @@ normalizeConstraint ForeignKeyConstraint { name, columnName, referenceTable, ref
 normalizeConstraint otherwise = otherwise
 
 normalizeColumn :: CreateTable -> Column -> (Column, [Statement])
-normalizeColumn table Column { name, columnType, defaultValue, notNull, isUnique, generator } = (Column { name = normalizeName name, columnType = normalizeSqlType columnType, defaultValue = normalizedDefaultValue, notNull, isUnique = False, generator }, uniqueConstraint)
+normalizeColumn table Column { name, columnType, defaultValue, notNull, isUnique, generator } = (Column { name = normalizeName name, columnType = normalizeSqlType columnType, defaultValue = normalizedDefaultValue, notNull, isUnique = False, generator = normalizeColumnGenerator <$> generator }, uniqueConstraint)
     where
         uniqueConstraint =
             if isUnique
@@ -411,6 +411,9 @@ normalizeColumn table Column { name, columnType, defaultValue, notNull, isUnique
                 then Nothing
                 else Just (VarExpression "null") -- pg_dump columns don't have an explicit default null value
 
+normalizeColumnGenerator :: ColumnGenerator -> ColumnGenerator
+normalizeColumnGenerator generator@(ColumnGenerator { generate }) = generator { generate = normalizeExpression generate }
+
 normalizeExpression :: Expression -> Expression
 normalizeExpression e@(TextExpression {}) = e
 normalizeExpression (VarExpression var) = VarExpression (Text.toLower var)
@@ -427,6 +430,7 @@ normalizeExpression (GreaterThanExpression a b) = GreaterThanExpression (normali
 normalizeExpression (GreaterThanOrEqualToExpression a b) = GreaterThanOrEqualToExpression (normalizeExpression a) (normalizeExpression b)
 normalizeExpression e@(DoubleExpression {}) = e
 normalizeExpression e@(IntExpression {}) = e
+normalizeExpression (ConcatenationExpression a b) = ConcatenationExpression (normalizeExpression a) (normalizeExpression b)
 -- Enum default values from pg_dump always have an explicit type cast. Inside the Schema.sql they typically don't have those.
 -- Therefore we remove these typecasts here
 --

IHP/IDE/SchemaDesigner/Compiler.hs

@@ -161,6 +161,7 @@ compilePostgresType (PNumeric Nothing _) = "NUMERIC"
 compilePostgresType (PVaryingN (Just limit)) = "CHARACTER VARYING(" <> show limit <> ")"
 compilePostgresType (PVaryingN Nothing) = "CHARACTER VARYING"
 compilePostgresType (PCharacterN length) = "CHARACTER(" <> show length <> ")"
+compilePostgresType PSingleChar = "\"char\""
 compilePostgresType PSerial = "SERIAL"
 compilePostgresType PBigserial = "BIGSERIAL"
 compilePostgresType PJSONB = "JSONB"

IHP/IDE/SchemaDesigner/Parser.hs

@@ -228,6 +228,7 @@ sqlType = choice $ map optionalArray
         , inet
         , tsvector
         , trigger
+        , singleChar
         , customType
         ]
             where
@@ -347,6 +348,10 @@ sqlType = choice $ map optionalArray
                                 Just l -> pure (PCharacterN l)
                         _ -> Prelude.fail "Failed to parse CHARACTER VARYING(..) expression"
 
+                singleChar = do
+                    try (symbol "\"char\"")
+                    pure PSingleChar
+
                 serial = do
                     try (symbol' "SERIAL")
                     pure PSerial

IHP/IDE/SchemaDesigner/Types.hs

@@ -196,6 +196,7 @@ data PostgresType
     | PNumeric { precision :: Maybe Int, scale :: Maybe Int }
     | PVaryingN (Maybe Int)
     | PCharacterN Int
+    | PSingleChar
     | PSerial
     | PBigserial
     | PJSONB

Test/IDE/CodeGeneration/MigrationGenerator.hs

@@ -893,8 +893,36 @@ tests = do
 
                 diffSchemas targetSchema actualSchema `shouldBe` migration
 
+            it "should normalize generated columns" do
+                let targetSchema = sql [i|
+                    CREATE TABLE products (
+                        id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
+                        name TEXT NOT NULL,
+                        description TEXT NOT NULL,
+                        sku TEXT NOT NULL,
+                        text_search TSVECTOR GENERATED ALWAYS AS 
+                            ( setweight(to_tsvector('english', sku), 'A') ||
+                              setweight(to_tsvector('english', name), 'B') ||
+                              setweight(to_tsvector('english', description), 'C')
+                            ) STORED
+                    );
+                |]
+                let actualSchema = sql [i|
+                    CREATE TABLE public.products (
+                        id uuid DEFAULT public.uuid_generate_v4() NOT NULL,
+                        name text NOT NULL,
+                        description text NOT NULL,
+                        sku text NOT NULL,
+                        text_search tsvector GENERATED ALWAYS AS (((setweight(to_tsvector('english'::regconfig, sku), 'A'::"char") || setweight(to_tsvector('english'::regconfig, name), 'B'::"char")) || setweight(to_tsvector('english'::regconfig, description), 'C'::"char"))) STORED
+                    );
+                |]
+                let migration = sql [i|
+                |]
+
+                diffSchemas targetSchema actualSchema `shouldBe` migration
+
 
 sql :: Text -> [Statement]
 sql code = case Megaparsec.runParser Parser.parseDDL "" code of
-    Left parsingFailed -> error (tshow parsingFailed)
+    Left parsingFailed -> error (cs $ Megaparsec.errorBundlePretty parsingFailed)
     Right r -> r

Test/IDE/SchemaDesigner/CompilerSpec.hs

@@ -677,7 +677,7 @@ tests = do
         it "should compile 'GENERATED' columns" do
             let sql = [trimming|
                 CREATE TABLE products (
-                    ts TSVECTOR GENERATED ALWAYS AS (setweight(to_tsvector('english', sku), 'A') || setweight(to_tsvector('english', name), 'B') || setweight(to_tsvector('english', description), 'C')) STORED
+                    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 = [
@@ -694,7 +694,7 @@ tests = do
                                                 { generate =
                                                     ConcatenationExpression
                                                         (ConcatenationExpression
-                                                            (CallExpression "setweight" [CallExpression "to_tsvector" [TextExpression "english",VarExpression "sku"],TextExpression "A"])
+                                                            (CallExpression "setweight" [CallExpression "to_tsvector" [TextExpression "english",VarExpression "sku"], TypeCastExpression (TextExpression "A") PSingleChar])
                                                             (CallExpression "setweight" [CallExpression "to_tsvector" [TextExpression "english",VarExpression "name"],TextExpression "B"])
                                                         )
                                                         (CallExpression "setweight" [CallExpression "to_tsvector" [TextExpression "english",VarExpression "description"],TextExpression "C"])