Added support for more advanced postgres expression in check constraints

New operators: =, AND, IS, NOT, OR, <, <=, >, >=
digitallyinduced · Jun 5, 2021 · 7cbfb1f · 7cbfb1f
1 parent 94e9361
commit 7cbfb1f
Show file tree

Hide file tree

Showing 5 changed files with 185 additions and 3 deletions.
diff --git a/IHP/IDE/SchemaDesigner/Compiler.hs b/IHP/IDE/SchemaDesigner/Compiler.hs
@@ -78,6 +78,15 @@ compileExpression (TextExpression value) = "'" <> value <> "'"
 compileExpression (VarExpression name) = name
 compileExpression (CallExpression func args) = func <> "(" <> intercalate ", " (map compileExpression args) <> ")"
 compileExpression (NotEqExpression a b) = compileExpression a <> " <> " <> compileExpression b
+compileExpression (EqExpression a b) = compileExpression a <> " = " <> compileExpression b
+compileExpression (IsExpression a b) = compileExpression a <> " IS " <> compileExpression b
+compileExpression (NotExpression a) = "NOT " <> compileExpression a
+compileExpression (AndExpression a b) = compileExpression a <> " AND " <> compileExpression b
+compileExpression (OrExpression a b) = "(" <> compileExpression a <> ") OR (" <> compileExpression b <> ")"
+compileExpression (LessThanExpression a b) = compileExpression a <> " < " <> compileExpression b
+compileExpression (LessThanOrEqualToExpression a b) = compileExpression a <> " <= " <> compileExpression b
+compileExpression (GreaterThanExpression a b) = compileExpression a <> " > " <> compileExpression b
+compileExpression (GreaterThanOrEqualToExpression a b) = compileExpression a <> " >= " <> compileExpression b
 
 compareStatement (CreateEnumType {}) _ = LT
 compareStatement (StatementCreateTable CreateTable {}) (AddConstraint {}) = LT

diff --git a/IHP/IDE/SchemaDesigner/Parser.hs b/IHP/IDE/SchemaDesigner/Parser.hs
@@ -344,13 +344,26 @@ sqlType = choice $ map optionalArray
                     theType <- try (takeWhile1P (Just "Custom type") (\c -> isAlphaNum c || c == '_'))
                     pure (PCustomType theType)
 
-term = parens expression <|> try callExpr <|> varExpr <|> textExpr
+term = parens expression <|> try callExpr <|> varExpr <|> (textExpr <* optional space)
     where
         parens f = between (char '(' >> space) (char ')' >> space) f
 
-table = [ [ binary  "<>"  NotEqExpression ] ]
+table = [
+            [ binary  "<>"  NotEqExpression
+            , binary "="  EqExpression
+
+            , binary "<=" LessThanOrEqualToExpression
+            , binary "<"  LessThanExpression
+            , binary ">="  GreaterThanOrEqualToExpression
+            , binary ">"  GreaterThanExpression
+
+            , binary "IS" IsExpression
+            , prefix "NOT" NotExpression
+            ],
+            [ binary "AND" AndExpression, binary "OR" OrExpression ]
+        ]
     where
-        binary  name f = InfixL  (f <$ symbol name)
+        binary  name f = InfixL  (f <$ try (symbol name))
         prefix  name f = Prefix  (f <$ symbol name)
         postfix name f = Postfix (f <$ symbol name)
 
@@ -370,6 +383,7 @@ callExpr :: Parser Expression
 callExpr = do
     func <- identifier
     args <- between (char '(') (char ')') (expression `sepBy` char ',')
+    space
     pure (CallExpression func args)
 
 textExpr :: Parser Expression

diff --git a/IHP/IDE/SchemaDesigner/Types.hs b/IHP/IDE/SchemaDesigner/Types.hs
@@ -77,6 +77,24 @@ data Expression =
     | CallExpression Text [Expression]
     -- | Not equal operator, a <> b
     | NotEqExpression Expression Expression
+    -- | Equal operator, a = b
+    | EqExpression Expression Expression
+    -- | a AND b
+    | AndExpression Expression Expression
+    -- | a IS b
+    | IsExpression Expression Expression
+    -- | NOT a
+    | NotExpression Expression
+    -- | a OR b
+    | OrExpression Expression Expression
+    -- | a < b
+    | LessThanExpression Expression Expression
+    -- | a <= b
+    | LessThanOrEqualToExpression Expression Expression
+    -- | a > b
+    | GreaterThanExpression Expression Expression
+    -- | a >= b
+    | GreaterThanOrEqualToExpression Expression Expression
     deriving (Eq, Show)
 
 data PostgresType

diff --git a/Test/IDE/SchemaDesigner/CompilerSpec.hs b/Test/IDE/SchemaDesigner/CompilerSpec.hs
@@ -191,6 +191,70 @@ tests = do
                     }
             compileSql [statement] `shouldBe` "ALTER TABLE posts ADD CONSTRAINT check_title_length CHECK (title <> '');\n"
 
+        it "should compile a complex ALTER TABLE .. ADD CONSTRAINT .. CHECK .." do
+            let statement = AddConstraint
+                    { tableName = "properties"
+                    , constraintName = "foobar"
+                    , constraint = CheckConstraint
+                        { checkExpression = OrExpression
+                                (AndExpression
+                                    (AndExpression
+                                        (EqExpression (VarExpression "property_type") (TextExpression "haus_buy"))
+                                        (IsExpression (VarExpression "area_garden") (NotExpression (VarExpression "NULL")))
+                                    )
+                                    (IsExpression (VarExpression "rent_monthly") (VarExpression "NULL"))
+                                )
+
+                                (AndExpression
+                                    (AndExpression
+                                        (EqExpression (VarExpression "property_type") (TextExpression "haus_rent"))
+                                        (IsExpression (VarExpression "rent_monthly") (NotExpression (VarExpression "NULL")))
+                                    )
+                                    (IsExpression (VarExpression "price") (VarExpression "NULL"))
+                                )
+                        }
+                    }
+            compileSql [statement] `shouldBe` "ALTER TABLE properties ADD CONSTRAINT foobar CHECK ((property_type = 'haus_buy' AND area_garden IS NOT NULL AND rent_monthly IS NULL) OR (property_type = 'haus_rent' AND rent_monthly IS NOT NULL AND price IS NULL));\n"
+
+        it "should compile ALTER TABLE .. ADD CONSTRAINT .. CHECK .. with a <" do
+            let statement = AddConstraint
+                    { tableName = "posts"
+                    , constraintName = "check_title_length"
+                    , constraint = CheckConstraint
+                        { checkExpression = LessThanExpression (CallExpression ("length") [VarExpression "title"]) (VarExpression "20")
+                        }
+                    }
+            compileSql [statement] `shouldBe` "ALTER TABLE posts ADD CONSTRAINT check_title_length CHECK (length(title) < 20);\n"
+
+        it "should compile ALTER TABLE .. ADD CONSTRAINT .. CHECK .. with a <=" do
+            let statement = AddConstraint
+                    { tableName = "posts"
+                    , constraintName = "check_title_length"
+                    , constraint = CheckConstraint
+                        { checkExpression = LessThanOrEqualToExpression (CallExpression ("length") [VarExpression "title"]) (VarExpression "20")
+                        }
+                    }
+            compileSql [statement] `shouldBe` "ALTER TABLE posts ADD CONSTRAINT check_title_length CHECK (length(title) <= 20);\n"
+
+        it "should compile ALTER TABLE .. ADD CONSTRAINT .. CHECK .. with a >" do
+            let statement = AddConstraint
+                    { tableName = "posts"
+                    , constraintName = "check_title_length"
+                    , constraint = CheckConstraint
+                        { checkExpression = GreaterThanExpression (CallExpression ("length") [VarExpression "title"]) (VarExpression "20")
+                        }
+                    }
+            compileSql [statement] `shouldBe` "ALTER TABLE posts ADD CONSTRAINT check_title_length CHECK (length(title) > 20);\n"
+
+        it "should compile ALTER TABLE .. ADD CONSTRAINT .. CHECK .. with a >=" do
+            let statement = AddConstraint
+                    { tableName = "posts"
+                    , constraintName = "check_title_length"
+                    , constraint = CheckConstraint
+                        { checkExpression = GreaterThanOrEqualToExpression (CallExpression ("length") [VarExpression "title"]) (VarExpression "20")
+                        }
+                    }
+            compileSql [statement] `shouldBe` "ALTER TABLE posts ADD CONSTRAINT check_title_length CHECK (length(title) >= 20);\n"
 
         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|]

diff --git a/Test/IDE/SchemaDesigner/ParserSpec.hs b/Test/IDE/SchemaDesigner/ParserSpec.hs
@@ -185,6 +185,83 @@ tests = do
                         }
                     }
 
+        it "should parse a complex ALTER TABLE .. ADD CONSTRAINT .. CHECK .." do
+            parseSql "ALTER TABLE properties ADD CONSTRAINT foobar CHECK ((property_type = 'haus_buy' AND area_garden IS NOT NULL AND rent_monthly IS NULL) OR (property_type = 'haus_rent' AND rent_monthly IS NOT NULL AND price IS NULL));" `shouldBe` AddConstraint
+                    { tableName = "properties"
+                    , constraintName = "foobar"
+                    , constraint = CheckConstraint
+                        { checkExpression = OrExpression
+                                (AndExpression
+                                    (AndExpression
+                                        (EqExpression (VarExpression "property_type") (TextExpression "haus_buy"))
+                                        (IsExpression (VarExpression "area_garden") (NotExpression (VarExpression "NULL")))
+                                    )
+                                    (IsExpression (VarExpression "rent_monthly") (VarExpression "NULL"))
+                                )
+
+                                (AndExpression
+                                    (AndExpression
+                                        (EqExpression (VarExpression "property_type") (TextExpression "haus_rent"))
+                                        (IsExpression (VarExpression "rent_monthly") (NotExpression (VarExpression "NULL")))
+                                    )
+                                    (IsExpression (VarExpression "price") (VarExpression "NULL"))
+                                )
+                        }
+                    }
+
+
+        it "should parse ALTER TABLE .. ADD CONSTRAINT .. CHECK .. with a <" do
+            parseSql "ALTER TABLE posts ADD CONSTRAINT check_title_length CHECK (length(title) < 20);" `shouldBe` AddConstraint
+                    { tableName = "posts"
+                    , constraintName = "check_title_length"
+                    , constraint = CheckConstraint
+                        { checkExpression = 
+                            LessThanExpression
+                                (CallExpression ("length") [VarExpression "title"])
+                                (VarExpression "20")
+                        }
+                    }
+
+
+
+        it "should parse ALTER TABLE .. ADD CONSTRAINT .. CHECK .. with a <=" do
+            parseSql "ALTER TABLE posts ADD CONSTRAINT check_title_length CHECK (length(title) <= 20);" `shouldBe` AddConstraint
+                    { tableName = "posts"
+                    , constraintName = "check_title_length"
+                    , constraint = CheckConstraint
+                        { checkExpression = 
+                            LessThanOrEqualToExpression
+                                (CallExpression ("length") [VarExpression "title"])
+                                (VarExpression "20")
+                        }
+                    }
+
+        it "should parse ALTER TABLE .. ADD CONSTRAINT .. CHECK .. with a >" do
+            parseSql "ALTER TABLE posts ADD CONSTRAINT check_title_length CHECK (length(title) > 20);" `shouldBe` AddConstraint
+                    { tableName = "posts"
+                    , constraintName = "check_title_length"
+                    , constraint = CheckConstraint
+                        { checkExpression = 
+                            GreaterThanExpression
+                                (CallExpression ("length") [VarExpression "title"])
+                                (VarExpression "20")
+                        }
+                    }
+
+
+        it "should parse ALTER TABLE .. ADD CONSTRAINT .. CHECK .. with a >=" do
+            parseSql "ALTER TABLE posts ADD CONSTRAINT check_title_length CHECK (length(title) >= 20);" `shouldBe` AddConstraint
+                    { tableName = "posts"
+                    , constraintName = "check_title_length"
+                    , constraint = CheckConstraint
+                        { checkExpression = 
+                            GreaterThanOrEqualToExpression
+                                (CallExpression ("length") [VarExpression "title"])
+                                (VarExpression "20")
+                        }
+                    }
+
+
         it "should parse CREATE TYPE .. AS ENUM" do
             parseSql "CREATE TYPE colors AS ENUM ('yellow', 'red', 'green');" `shouldBe` CreateEnumType { name = "colors", values = ["yellow", "red", "green"] }