Added Int type to SQL Parser

Previously all Int's have been handled like variables (in a way that makes sense :D 1 is just a symbol standing for number 1). This has caused issues as we introduced support for Double literal expressions recently. Now integer literals have their own representation in the AST.

Fixes #1027

IHP/IDE/SchemaDesigner/Compiler.hs

@@ -88,6 +88,7 @@ compileExpression (LessThanOrEqualToExpression a b) = compileExpression a <> " <
 compileExpression (GreaterThanExpression a b) = compileExpression a <> " > " <> compileExpression b
 compileExpression (GreaterThanOrEqualToExpression a b) = compileExpression a <> " >= " <> compileExpression b
 compileExpression (DoubleExpression double) = tshow double
+compileExpression (IntExpression integer) = tshow integer
 compileExpression (TypeCastExpression value type_) = compileExpression value <> "::" <> compilePostgresType type_
 
 compareStatement (CreateEnumType {}) _ = LT

IHP/IDE/SchemaDesigner/Parser.hs

@@ -350,7 +350,7 @@ sqlType = choice $ map optionalArray
                     theType <- try (takeWhile1P (Just "Custom type") (\c -> isAlphaNum c || c == '_'))
                     pure (PCustomType theType)
 
-term = parens expression <|> try callExpr <|> try doubleExpr <|> varExpr <|> (textExpr <* optional space)
+term = parens expression <|> try callExpr <|> try doubleExpr <|> try intExpr <|> varExpr <|> (textExpr <* optional space)
     where
         parens f = between (char '(' >> space) (char ')' >> space) f
 
@@ -396,6 +396,9 @@ varExpr = VarExpression <$> identifier
 doubleExpr :: Parser Expression
 doubleExpr = DoubleExpression <$> Lexer.float
 
+intExpr :: Parser Expression
+intExpr = IntExpression <$> Lexer.decimal
+
 callExpr :: Parser Expression
 callExpr = do
     func <- identifier

IHP/IDE/SchemaDesigner/Types.hs

@@ -98,6 +98,8 @@ data Expression =
     | GreaterThanOrEqualToExpression Expression Expression
     -- | Double literal value, e.g. 0.1337
     | DoubleExpression Double
+    -- | Integer literal value, e.g. 1337
+    | IntExpression Int
     -- | value::type
     | TypeCastExpression Expression PostgresType
     deriving (Eq, Show)

IHP/SchemaCompiler.hs

@@ -576,6 +576,7 @@ toDefaultValueExpr Column { columnType, notNull, defaultValue = Just theDefaultV
                                 otherwise           -> error ("toDefaultValueExpr: BOOL column needs to have a VarExpression as default value. Got: " <> show otherwise)
                             PDouble -> case theNormalizedDefaultValue of
                                 DoubleExpression value -> wrapNull notNull (tshow value)
+                                IntExpression value -> wrapNull notNull (tshow value)
                                 otherwise           -> error ("toDefaultValueExpr: DOUBLE column needs to have a DoubleExpression as default value. Got: " <> show otherwise)
                             _ -> "def"
 toDefaultValueExpr _ = "def"

Test/IDE/SchemaDesigner/CompilerSpec.hs

@@ -464,6 +464,11 @@ tests = do
             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}], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [] }
             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}], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [] }
+            compileSql [statement] `shouldBe` sql
+
         it "should compile a partial index" do
             let sql = cs [plain|CREATE UNIQUE INDEX unique_source_id ON listings (source, source_id) WHERE source IS NOT NULL AND source_id IS NOT NULL;\n|]
             let index = CreateIndex

Test/IDE/SchemaDesigner/ParserSpec.hs

@@ -218,7 +218,7 @@ tests = do
                         { checkExpression =
                             LessThanExpression
                                 (CallExpression ("length") [VarExpression "title"])
-                                (VarExpression "20")
+                                (IntExpression 20)
                         }
                     }
 
@@ -232,7 +232,7 @@ tests = do
                         { checkExpression =
                             LessThanOrEqualToExpression
                                 (CallExpression ("length") [VarExpression "title"])
-                                (VarExpression "20")
+                                (IntExpression 20)
                         }
                     }
 
@@ -244,7 +244,7 @@ tests = do
                         { checkExpression =
                             GreaterThanExpression
                                 (CallExpression ("length") [VarExpression "title"])
-                                (VarExpression "20")
+                                (IntExpression 20)
                         }
                     }
 
@@ -257,7 +257,7 @@ tests = do
                         { checkExpression =
                             GreaterThanOrEqualToExpression
                                 (CallExpression ("length") [VarExpression "title"])
-                                (VarExpression "20")
+                                (IntExpression 20)
                         }
                     }
 
@@ -469,6 +469,13 @@ tests = do
                     ]
             parseSqlStatements sql `shouldBe` statements
 
+        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}], primaryKeyConstraint = PrimaryKeyConstraint [], constraints = [] }
+                    ]
+            parseSqlStatements sql `shouldBe` statements
+
         it "should parse a partial index" do
             parseSql "CREATE UNIQUE INDEX unique_source_id ON listings (source, source_id) WHERE source IS NOT NULL AND source_id IS NOT NULL;" `shouldBe` CreateIndex
                     { indexName = "unique_source_id"

Test/SchemaCompilerSpec.hs

@@ -170,8 +170,6 @@ tests = do
                         }
                 let compileOutput = compileStatementPreview [statement] statement |> Text.strip
 
-                putStrLn compileOutput
-
                 compileOutput `shouldBe` [text|
                     data User'  = User {id :: (Id' "users"), ids :: (Maybe [UUID]), electricityUnitPrice :: Double, meta :: MetaBag} deriving (Eq, Show)
                     instance InputValue User where inputValue = IHP.ModelSupport.recordToInputValue
@@ -218,6 +216,64 @@ tests = do
                         newRecord = User def def 0.17  def
                     instance Default (Id' "users") where def = Id def
                 |]
+            it "should deal with integer default values for double columns" do
+                let statement = StatementCreateTable CreateTable
+                        { name = "users"
+                        , columns =
+                            [ Column "id" PUUID Nothing False True, Column "ids" (PArray PUUID) Nothing False False
+                            , Column {name = "electricity_unit_price", columnType = PDouble, defaultValue = Just (IntExpression 0), notNull = True, isUnique = False}
+                            ]
+                        , primaryKeyConstraint = PrimaryKeyConstraint ["id"]
+                        , constraints = []
+                        }
+                let compileOutput = compileStatementPreview [statement] statement |> Text.strip
+
+                compileOutput `shouldBe` [text|
+                    data User'  = User {id :: (Id' "users"), ids :: (Maybe [UUID]), electricityUnitPrice :: Double, meta :: MetaBag} deriving (Eq, Show)
+                    instance InputValue User where inputValue = IHP.ModelSupport.recordToInputValue
+                    type User = User' 
+
+                    instance FromRow User where
+                        fromRow = do
+                            id <- field
+                            ids <- field
+                            electricityUnitPrice <- field
+                            let theRecord = User id ids electricityUnitPrice def { originalDatabaseRecord = Just (Data.Dynamic.toDyn theRecord) }
+                            pure theRecord
+
+                    type instance GetTableName (User' ) = "users"
+                    type instance GetModelByTableName "users" = User
+                    type instance GetModelName (User' ) = "User"
+
+                    type instance PrimaryKey "users" = UUID
+
+                    instance QueryBuilder.FilterPrimaryKey "users" where
+                        filterWhereId id builder =
+                            builder |> QueryBuilder.filterWhere (#id, id)
+                        {-# INLINE filterWhereId #-}
+
+
+                    instance () => PrimaryKeyCondition (User' ) where
+                        primaryKeyCondition User { id } = [("id", toField id)]
+                        {-# INLINABLE primaryKeyCondition #-}
+
+                    instance CanCreate User where
+                        create :: (?modelContext :: ModelContext) => User -> IO User
+                        create model = do
+                            List.head <$> sqlQuery "INSERT INTO users (id, ids, electricity_unit_price) VALUES (?, ? :: UUID[], ?) RETURNING *" ((get #id model, get #ids model, fieldWithDefault #electricityUnitPrice model))
+                        createMany [] = pure []
+                        createMany models = do
+                            sqlQuery (Query $ "INSERT INTO users (id, ids, electricity_unit_price) VALUES " <> (ByteString.intercalate ", " (List.map (\_ -> "(?, ? :: UUID[], ?)") models)) <> " RETURNING *") (List.concat $ List.map (\model -> [toField (get #id model), toField (get #ids model), toField (fieldWithDefault #electricityUnitPrice model)]) models)
+
+                    instance CanUpdate User where
+                        updateRecord model = do
+                            List.head <$> sqlQuery "UPDATE users SET id = ?, ids = ? :: UUID[], electricity_unit_price = ? WHERE id = ? RETURNING *" ((fieldWithUpdate #id model, fieldWithUpdate #ids model, fieldWithUpdate #electricityUnitPrice model, get #id model))
+
+                    instance Record User where
+                        {-# INLINE newRecord #-}
+                        newRecord = User def def 0  def
+                    instance Default (Id' "users") where def = Id def
+                |]
 
 getInstanceDecl :: Text -> Text -> Text
 getInstanceDecl instanceName full =