diff --git a/IHP/ModelSupport.hs b/IHP/ModelSupport.hs index 89b301813..0f973a7ad 100644 --- a/IHP/ModelSupport.hs +++ b/IHP/ModelSupport.hs @@ -102,6 +102,12 @@ type family GetModelByTableName (tableName :: Symbol) :: Type class CanCreate a where create :: (?modelContext :: ModelContext) => a -> IO a createMany :: (?modelContext :: ModelContext) => [a] -> IO [a] + + -- | Like 'createRecord' but doesn't return the created record + createRecordDiscardResult :: (?modelContext :: ModelContext) => a -> IO () + createRecordDiscardResult record = do + _ <- createRecord record + pure () class CanUpdate a where updateRecord :: (?modelContext :: ModelContext) => a -> IO a diff --git a/Test/SchemaCompilerSpec.hs b/Test/SchemaCompilerSpec.hs index d203a8198..b89b2f137 100644 --- a/Test/SchemaCompilerSpec.hs +++ b/Test/SchemaCompilerSpec.hs @@ -137,6 +137,9 @@ tests = do createMany [] = pure [] createMany models = do sqlQuery (Query $ "INSERT INTO users (id) VALUES " <> (ByteString.intercalate ", " (List.map (\_ -> "(?)") models)) <> " RETURNING id") (List.concat $ List.map (\model -> [toField (model.id)]) models) + createRecordDiscardResult :: (?modelContext :: ModelContext) => User -> IO () + createRecordDiscardResult model = do + sqlExecDiscardResult "INSERT INTO users (id) VALUES (?)" (Only (model.id)) |] it "should compile CanUpdate instance with sqlQuery" $ \statement -> do getInstanceDecl "CanUpdate" compileOutput `shouldBe` [trimming| @@ -219,6 +222,9 @@ tests = do createMany [] = pure [] createMany models = do sqlQuery (Query $ "INSERT INTO users (id, ids, electricity_unit_price) VALUES " <> (ByteString.intercalate ", " (List.map (\_ -> "(?, ? :: UUID[], ?)") models)) <> " RETURNING id, ids, electricity_unit_price") (List.concat $ List.map (\model -> [toField (model.id), toField (model.ids), toField (fieldWithDefault #electricityUnitPrice model)]) models) + createRecordDiscardResult :: (?modelContext :: ModelContext) => User -> IO () + createRecordDiscardResult model = do + sqlExecDiscardResult "INSERT INTO users (id, ids, electricity_unit_price) VALUES (?, ? :: UUID[], ?)" ((model.id, model.ids, fieldWithDefault #electricityUnitPrice model)) instance CanUpdate User where updateRecord model = do @@ -291,6 +297,9 @@ tests = do createMany [] = pure [] createMany models = do sqlQuery (Query $ "INSERT INTO users (id, ids, electricity_unit_price) VALUES " <> (ByteString.intercalate ", " (List.map (\_ -> "(?, ? :: UUID[], ?)") models)) <> " RETURNING id, ids, electricity_unit_price") (List.concat $ List.map (\model -> [toField (model.id), toField (model.ids), toField (fieldWithDefault #electricityUnitPrice model)]) models) + createRecordDiscardResult :: (?modelContext :: ModelContext) => User -> IO () + createRecordDiscardResult model = do + sqlExecDiscardResult "INSERT INTO users (id, ids, electricity_unit_price) VALUES (?, ? :: UUID[], ?)" ((model.id, model.ids, fieldWithDefault #electricityUnitPrice model)) instance CanUpdate User where updateRecord model = do @@ -362,6 +371,9 @@ tests = do createMany [] = pure [] createMany models = do sqlQuery (Query $ "INSERT INTO users (id) VALUES " <> (ByteString.intercalate ", " (List.map (\_ -> "(?)") models)) <> " RETURNING id") (List.concat $ List.map (\model -> [toField (model.id)]) models) + createRecordDiscardResult :: (?modelContext :: ModelContext) => User -> IO () + createRecordDiscardResult model = do + sqlExecDiscardResult "INSERT INTO users (id) VALUES (?)" (Only (model.id)) instance CanUpdate User where updateRecord model = do @@ -439,6 +451,9 @@ tests = do createMany [] = pure [] createMany models = do sqlQuery (Query $ "INSERT INTO landing_pages (id) VALUES " <> (ByteString.intercalate ", " (List.map (\_ -> "(?)") models)) <> " RETURNING id") (List.concat $ List.map (\model -> [toField (fieldWithDefault #id model)]) models) + createRecordDiscardResult :: (?modelContext :: ModelContext) => LandingPage -> IO () + createRecordDiscardResult model = do + sqlExecDiscardResult "INSERT INTO landing_pages (id) VALUES (?)" (Only (fieldWithDefault #id model)) instance CanUpdate LandingPage where updateRecord model = do @@ -483,6 +498,9 @@ tests = do createMany [] = pure [] createMany models = do sqlQuery (Query $ "INSERT INTO things (thing_arbitrary_ident) VALUES " <> (ByteString.intercalate ", " (List.map (\_ -> "(?)") models)) <> " RETURNING thing_arbitrary_ident") (List.concat $ List.map (\model -> [toField (fieldWithDefault #thingArbitraryIdent model)]) models) + createRecordDiscardResult :: (?modelContext :: ModelContext) => Thing -> IO () + createRecordDiscardResult model = do + sqlExecDiscardResult "INSERT INTO things (thing_arbitrary_ident) VALUES (?)" (Only (fieldWithDefault #thingArbitraryIdent model)) |] it "should compile CanUpdate instance with sqlQuery" $ \statement -> do getInstanceDecl "CanUpdate" compileOutput `shouldBe` [trimming| @@ -549,6 +567,9 @@ tests = do createMany [] = pure [] createMany models = do sqlQuery (Query $ "INSERT INTO bit_part_refs (bit_ref, part_ref) VALUES " <> (ByteString.intercalate ", " (List.map (\_ -> "(?, ?)") models)) <> " RETURNING bit_ref, part_ref") (List.concat $ List.map (\model -> [toField (model.bitRef), toField (model.partRef)]) models) + createRecordDiscardResult :: (?modelContext :: ModelContext) => BitPartRef -> IO () + createRecordDiscardResult model = do + sqlExecDiscardResult "INSERT INTO bit_part_refs (bit_ref, part_ref) VALUES (?, ?)" ((model.bitRef, model.partRef)) |] it "should compile CanUpdate instance with sqlQuery" $ \statement -> do getInstanceDecl "CanUpdate" compileOutput `shouldBe` [trimming| diff --git a/ihp-ide/IHP/SchemaCompiler.hs b/ihp-ide/IHP/SchemaCompiler.hs index 0a2680ba7..260a13fe9 100644 --- a/ihp-ide/IHP/SchemaCompiler.hs +++ b/ihp-ide/IHP/SchemaCompiler.hs @@ -574,6 +574,11 @@ compileCreate table@(CreateTable { name, columns }) = <> indent ("sqlQuery (Query $ \"INSERT INTO " <> name <> " (" <> columnNames <> ") VALUES \" <> (ByteString.intercalate \", \" (List.map (\\_ -> \"(" <> values <> ")\") models)) <> \" RETURNING " <> columnNames <> "\") " <> createManyFieldValues <> "\n" ) ) + <> indent ( + "createRecordDiscardResult :: (?modelContext :: ModelContext) => " <> modelName <> " -> IO ()\n" + <> "createRecordDiscardResult model = do\n" + <> indent ("sqlExecDiscardResult \"INSERT INTO " <> name <> " (" <> columnNames <> ") VALUES (" <> values <> ")\" (" <> compileToRowValues bindings <> ")\n") + ) commaSep :: [Text] -> Text commaSep = intercalate ", "