parse EXCLUDE constraints

Author: jeyj0

IHP/IDE/SchemaDesigner/Parser.hs

@@ -141,7 +141,7 @@ parseTableConstraint = do
         lexeme "CONSTRAINT"
         identifier
     (Left <$> parsePrimaryKeyConstraint) <|>
-      (Right <$> (parseForeignKeyConstraint name <|> parseUniqueConstraint name <|> parseCheckConstraint name))
+      (Right <$> (parseForeignKeyConstraint name <|> parseUniqueConstraint name <|> parseCheckConstraint name <|> parseExcludeConstraint name))
 
 parsePrimaryKeyConstraint = do
     lexeme "PRIMARY"
@@ -172,6 +172,34 @@ parseCheckConstraint name = do
     checkExpression <- between (char '(' >> space) (char ')' >> space) expression
     pure CheckConstraint { name, checkExpression }
 
+parseExcludeConstraint name = do
+    lexeme "EXCLUDE"
+    excludeElements <- between (char '(' >> space) (char ')' >> space) $ excludeElement `sepBy` (char ',' >> space)
+    predicate <- optional do
+        lexeme "WHERE"
+        between (char '(' >> space) (char ')' >> space) expression
+    pure ExcludeConstraint { name, excludeElements, predicate }
+    where
+        excludeElement = do
+            element <- identifier
+            space
+            lexeme "WITH"
+            space
+            operator <- parseOperator
+            pure ExcludeConstraintElement { element, operator }
+
+parseOperator = choice $ map lexeme
+    [ "="
+    , "<>"
+    , "!="
+    , "<="
+    , "<"
+    , ">="
+    , ">"
+    , "AND"
+    , "OR"
+    ]
+
 parseOnDelete = choice
         [ (lexeme "NO" >> lexeme "ACTION") >> pure NoAction
         , (lexeme "RESTRICT" >> pure Restrict)

IHP/IDE/SchemaDesigner/Types.hs

@@ -124,12 +124,20 @@ data Constraint
         { name :: !(Maybe Text)
         , checkExpression :: !Expression
         }
+    | ExcludeConstraint
+        { name :: !(Maybe Text)
+        , excludeElements :: ![ExcludeConstraintElement]
+        , predicate :: !(Maybe Expression)
+        }
     | AlterTableAddPrimaryKey
         { name :: !(Maybe Text)
         , primaryKeyConstraint :: !PrimaryKeyConstraint
         }
     deriving (Eq, Show)
 
+data ExcludeConstraintElement = ExcludeConstraintElement { element :: !Text, operator :: !Text }
+    deriving (Eq, Show)
+
 data Expression =
     -- | Sql string like @'hello'@
     TextExpression Text

Test/IDE/SchemaDesigner/ParserSpec.hs

@@ -310,6 +310,51 @@ tests = do
                         }
                     }
 
+        it "should parse ALTER TABLE .. ADD CONSTRAINT .. EXCLUDE .." do
+            parseSql "ALTER TABLE posts ADD CONSTRAINT unique_title_by_author EXCLUDE (title WITH =, author WITH =);" `shouldBe` AddConstraint
+                    { tableName = "posts"
+                    , constraint = ExcludeConstraint
+                        { name = "unique_title_by_author"
+                        , excludeElements =
+                            [ ExcludeConstraintElement { element = "title", operator = "=" }
+                            , ExcludeConstraintElement { element = "author", operator = "=" }
+                            ]
+                        , predicate = Nothing
+                        }
+                    }
+
+        it "should parse ALTER TABLE .. ADD CONSTRAINT .. EXCLUDE .. WHERE .." do
+            parseSql "ALTER TABLE posts ADD CONSTRAINT unique_title_by_author EXCLUDE (title WITH =, author WITH =) WHERE (title = 'why');" `shouldBe` AddConstraint
+                    { tableName = "posts"
+                    , constraint = ExcludeConstraint
+                        { name = "unique_title_by_author"
+                        , excludeElements =
+                            [ ExcludeConstraintElement { element = "title", operator = "=" }
+                            , ExcludeConstraintElement { element = "author", operator = "=" }
+                            ]
+                        , predicate = Just $ EqExpression (VarExpression "title") (TextExpression "why")
+                        }
+                    }
+
+        it "should parse ALTER TABLE .. ADD CONSTRAINT .. EXCLUDE .. WHERE .. with various operators" do
+            parseSql "ALTER TABLE posts ADD CONSTRAINT unique_title_by_author EXCLUDE (i1 WITH =, i2 WITH <>, i3 WITH !=, i4 WITH <, i5 WITH <=, i6 WITH >, i7 WITH >=, i8 WITH AND, i9 WITH OR) WHERE (title = 'why');" `shouldBe` AddConstraint
+                    { tableName = "posts"
+                    , constraint = ExcludeConstraint
+                        { name = "unique_title_by_author"
+                        , excludeElements =
+                            [ ExcludeConstraintElement { element = "i1", operator = "=" }
+                            , ExcludeConstraintElement { element = "i2", operator = "<>" }
+                            , ExcludeConstraintElement { element = "i3", operator = "!=" }
+                            , ExcludeConstraintElement { element = "i4", operator = "<" }
+                            , ExcludeConstraintElement { element = "i5", operator = "<=" }
+                            , ExcludeConstraintElement { element = "i6", operator = ">" }
+                            , ExcludeConstraintElement { element = "i7", operator = ">=" }
+                            , ExcludeConstraintElement { element = "i8", operator = "AND" }
+                            , ExcludeConstraintElement { element = "i9", operator = "OR" }
+                            ]
+                        , predicate = Just $ EqExpression (VarExpression "title") (TextExpression "why")
+                        }
+                    }
 
         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"] }