diff --git a/IHP/Fetch.hs b/IHP/Fetch.hs index 3d5c47d63..bb8191fa2 100644 --- a/IHP/Fetch.hs +++ b/IHP/Fetch.hs @@ -188,16 +188,16 @@ genericFetchIdOne :: forall table model. (Table model, KnownSymbol table, PG.Fro genericFetchIdOne !id = query @model |> filterWhereId id |> fetchOne {-# INLINE genericFetchIds #-} -genericFetchIds :: forall table model value. (Table model, KnownSymbol table, PG.FromRow model, ?modelContext :: ModelContext, ToField value, EqOrIsOperator value, HasField "id" model value, model ~ GetModelByTableName table, GetTableName model ~ table) => [value] -> IO [model] -genericFetchIds !ids = query @model |> filterWhereIn (#id, ids) |> fetch +genericFetchIds :: forall table model. (Table model, KnownSymbol table, PG.FromRow model, ?modelContext :: ModelContext, model ~ GetModelByTableName table, GetTableName model ~ table) => [Id model] -> IO [model] +genericFetchIds !ids = query @model |> filterWhereIdIn ids |> fetch {-# INLINE genericfetchIdsOneOrNothing #-} -genericfetchIdsOneOrNothing :: forall model value table. (Table model, KnownSymbol table, PG.FromRow model, ?modelContext :: ModelContext, ToField value, EqOrIsOperator value, HasField "id" model value, model ~ GetModelByTableName table, GetTableName model ~ table) => [value] -> IO (Maybe model) -genericfetchIdsOneOrNothing !ids = query @model |> filterWhereIn (#id, ids) |> fetchOneOrNothing +genericfetchIdsOneOrNothing :: forall table model. (Table model, KnownSymbol table, PG.FromRow model, ?modelContext :: ModelContext, model ~ GetModelByTableName table, GetTableName model ~ table) => [Id model] -> IO (Maybe model) +genericfetchIdsOneOrNothing !ids = query @model |> filterWhereIdIn ids |> fetchOneOrNothing {-# INLINE genericFetchIdsOne #-} -genericFetchIdsOne :: forall model value table. (Table model, KnownSymbol table, PG.FromRow model, ?modelContext :: ModelContext, ToField value, EqOrIsOperator value, HasField "id" model value, model ~ GetModelByTableName table, GetTableName model ~ table) => [value] -> IO model -genericFetchIdsOne !ids = query @model |> filterWhereIn (#id, ids) |> fetchOne +genericFetchIdsOne :: forall table model. (Table model, KnownSymbol table, PG.FromRow model, ?modelContext :: ModelContext, model ~ GetModelByTableName table, GetTableName model ~ table) => [Id model] -> IO model +genericFetchIdsOne !ids = query @model |> filterWhereIdIn ids |> fetchOne {-# INLINE findBy #-} findBy !field !value !queryBuilder = queryBuilder |> filterWhere (field, value) |> fetchOne @@ -231,7 +231,7 @@ instance (model ~ GetModelById (Id' table), GetTableName model ~ table, FilterPr fetchOne (Just a) = genericFetchIdOne a fetchOne Nothing = error "Fetchable (Maybe Id): Failed to fetch because given id is 'Nothing', 'Just id' was expected" -instance (model ~ GetModelById (Id' table), value ~ Id' table, HasField "id" model value, ToField (PrimaryKey table), GetModelByTableName (GetTableName model) ~ model) => Fetchable [Id' table] model where +instance (model ~ GetModelById (Id' table), GetModelByTableName table ~ model, GetTableName model ~ table) => Fetchable [Id' table] model where type FetchResult [Id' table] model = [model] {-# INLINE fetch #-} fetch = genericFetchIds diff --git a/IHP/FetchRelated.hs b/IHP/FetchRelated.hs index 2768c378a..6296c0657 100644 --- a/IHP/FetchRelated.hs +++ b/IHP/FetchRelated.hs @@ -71,6 +71,7 @@ instance ( , Show (PrimaryKey tableName) , HasField "id" relatedModel (Id' tableName) , relatedModel ~ GetModelByTableName (GetTableName relatedModel) + , GetTableName relatedModel ~ tableName , Table relatedModel ) => CollectionFetchRelated (Id' tableName) relatedModel where collectionFetchRelated :: forall model relatedField. ( @@ -84,7 +85,7 @@ instance ( Table relatedModel ) => Proxy relatedField -> [model] -> IO [Include relatedField model] collectionFetchRelated relatedField model = do - relatedModels :: [relatedModel] <- query @relatedModel |> filterWhereIn (#id, map (getField @relatedField) model) |> fetch + relatedModels :: [relatedModel] <- query @relatedModel |> filterWhereIdIn (map (getField @relatedField) model) |> fetch let assignRelated :: model -> Include relatedField model assignRelated model = @@ -121,6 +122,7 @@ instance ( , ToField (PrimaryKey tableName) , HasField "id" relatedModel (Id' tableName) , relatedModel ~ GetModelByTableName (GetTableName relatedModel) + , GetTableName relatedModel ~ tableName , Table relatedModel ) => CollectionFetchRelatedOrNothing (Id' tableName) relatedModel where collectionFetchRelatedOrNothing :: forall model relatedField. ( @@ -133,7 +135,7 @@ instance ( KnownSymbol relatedField ) => Proxy relatedField -> [model] -> IO [Include relatedField model] collectionFetchRelatedOrNothing relatedField model = do - relatedModels :: [relatedModel] <- query @relatedModel |> filterWhereIn (#id, mapMaybe (getField @relatedField) model) |> fetch + relatedModels :: [relatedModel] <- query @relatedModel |> filterWhereIdIn (mapMaybe (getField @relatedField) model) |> fetch let assignRelated :: model -> Include relatedField model assignRelated model = diff --git a/IHP/IDE/SchemaDesigner/View/Columns/Edit.hs b/IHP/IDE/SchemaDesigner/View/Columns/Edit.hs index f639f17e7..4efc3dfae 100644 --- a/IHP/IDE/SchemaDesigner/View/Columns/Edit.hs +++ b/IHP/IDE/SchemaDesigner/View/Columns/Edit.hs @@ -1,6 +1,6 @@ module IHP.IDE.SchemaDesigner.View.Columns.Edit where -import IHP.ViewPrelude +import IHP.ViewPrelude hiding (primaryKeyColumnNames) import IHP.IDE.SchemaDesigner.Types import qualified IHP.IDE.SchemaDesigner.Compiler as Compiler import IHP.IDE.ToolServer.Types diff --git a/IHP/IDE/SchemaDesigner/View/Layout.hs b/IHP/IDE/SchemaDesigner/View/Layout.hs index c19f89215..2105f17cc 100644 --- a/IHP/IDE/SchemaDesigner/View/Layout.hs +++ b/IHP/IDE/SchemaDesigner/View/Layout.hs @@ -15,7 +15,7 @@ module IHP.IDE.SchemaDesigner.View.Layout , emptyColumnSelectorContainer ) where -import IHP.ViewPrelude +import IHP.ViewPrelude hiding (primaryKeyColumnNames) import IHP.IDE.SchemaDesigner.Types import IHP.IDE.ToolServer.Types import IHP.IDE.ToolServer.Helper.View diff --git a/IHP/ModelSupport.hs b/IHP/ModelSupport.hs index 0c08a301a..e083acae6 100644 --- a/IHP/ModelSupport.hs +++ b/IHP/ModelSupport.hs @@ -566,21 +566,62 @@ class -- columnNames :: [ByteString] - -- | Returns WHERE conditions to match an entity by it's primary key + -- | Returns the list of column names, that are contained in the primary key for a given model -- - -- For tables with a simple primary key this returns a tuple with the id: + -- __Example:__ -- - -- >>> primaryKeyCondition project - -- [("id", "d619f3cf-f355-4614-8a4c-e9ea4f301e39")] + -- >>> primaryKeyColumnNames @User + -- ["id"] -- - -- If the table has a composite primary key, this returns multiple elements: + -- >>> primaryKeyColumnNames @PostTagging + -- ["post_id", "tag_id"] + -- + primaryKeyColumnNames :: [ByteString] + + -- | Returns the parameters for a WHERE conditions to match an entity by it's primary key, given the entities id -- - -- >>> primaryKeyCondition postTag - -- [("post_id", "0ace9270-568f-4188-b237-3789aa520588"), ("tag_id", "0b58fdf5-4bbb-4e57-a5b7-aa1c57148e1c")] + -- For tables with a simple primary key this simply the id: -- - primaryKeyCondition :: record -> [(Text, PG.Action)] - default primaryKeyCondition :: forall id. (HasField "id" record id, ToField id) => record -> [(Text, PG.Action)] - primaryKeyCondition record = [("id", toField record.id)] + -- >>> primaryKeyConditionForId project.id + -- Plain "d619f3cf-f355-4614-8a4c-e9ea4f301e39" + -- + -- If the table has a composite primary key, this returns multiple elements: + -- + -- >>> primaryKeyConditionForId postTag.id + -- Many [Plain "(", Plain "0ace9270-568f-4188-b237-3789aa520588", Plain ",", Plain "0b58fdf5-4bbb-4e57-a5b7-aa1c57148e1c", Plain ")"] + -- + -- The order of the elements for a composite primary key must match the order of the columns returned by 'primaryKeyColumnNames' + primaryKeyConditionForId :: Id record -> PG.Action + +-- | Returns ByteString, that represents the part of an SQL where clause, that matches on a tuple consisting of all the primary keys +-- For table with simple primary keys this simply returns the name of the primary key column, without wrapping in a tuple +-- >>> primaryKeyColumnSelector @PostTag +-- "(post_tags.post_id, post_tags.tag_id)" +-- >>> primaryKeyColumnSelector @Post +-- "post_tags.post_id" +primaryKeyConditionColumnSelector :: forall record. (Table record) => ByteString +primaryKeyConditionColumnSelector = + let + qualifyColumnName col = tableNameByteString @record <> "." <> col + in + case primaryKeyColumnNames @record of + [] -> error . cs $ "Impossible happened in primaryKeyConditionColumnSelector. No primary keys found for table " <> tableName @record <> ". At least one primary key is required." + [s] -> qualifyColumnName s + conds -> "(" <> intercalate ", " (map qualifyColumnName conds) <> ")" + +-- | Returns WHERE conditions to match an entity by it's primary key +-- +-- For tables with a simple primary key this returns a tuple with the id: +-- +-- >>> primaryKeyCondition project +-- Plain "d619f3cf-f355-4614-8a4c-e9ea4f301e39" +-- +-- If the table has a composite primary key, this returns multiple elements: +-- +-- >>> primaryKeyCondition postTag +-- Many [Plain "(", Plain "0ace9270-568f-4188-b237-3789aa520588", Plain ",", Plain "0b58fdf5-4bbb-4e57-a5b7-aa1c57148e1c", Plain ")"] +primaryKeyCondition :: forall record. (HasField "id" record (Id record), Table record) => record -> PG.Action +primaryKeyCondition record = primaryKeyConditionForId @record record.id logQuery :: (?modelContext :: ModelContext, PG.ToRow parameters) => Query -> parameters -> NominalDiffTime -> IO () logQuery query parameters time = do @@ -610,7 +651,8 @@ logQuery query parameters time = do -- DELETE FROM projects WHERE id = '..' -- -- Use 'deleteRecords' if you want to delete multiple records. -deleteRecord :: forall record table. (?modelContext :: ModelContext, Show (PrimaryKey table), Table record, HasField "id" record (Id' table), ToField (PrimaryKey table), GetModelByTableName table ~ record, Show (PrimaryKey table), ToField (PrimaryKey table)) => record -> IO () +-- +deleteRecord :: forall record table. (?modelContext :: ModelContext, Table record, Show (PrimaryKey table), HasField "id" record (Id record), GetTableName record ~ table, record ~ GetModelByTableName table) => record -> IO () deleteRecord record = deleteRecordById @record record.id {-# INLINABLE deleteRecord #-} @@ -621,11 +663,11 @@ deleteRecord record = -- >>> delete projectId -- DELETE FROM projects WHERE id = '..' -- -deleteRecordById :: forall record table. (?modelContext :: ModelContext, Table record, ToField (PrimaryKey table), Show (PrimaryKey table), record ~ GetModelByTableName table) => Id' table -> IO () +deleteRecordById :: forall record table. (?modelContext :: ModelContext, Table record, Show (PrimaryKey table), GetTableName record ~ table, record ~ GetModelByTableName table) => Id' table -> IO () deleteRecordById id = do - let theQuery = "DELETE FROM " <> tableName @record <> " WHERE id = ?" - let theParameters = PG.Only id - sqlExec (PG.Query . cs $! theQuery) theParameters + let theQuery = "DELETE FROM " <> tableNameByteString @record <> " WHERE " <> (primaryKeyConditionColumnSelector @record) <> " = ?" + let theParameters = PG.Only $ primaryKeyConditionForId @record id + sqlExec (PG.Query $! theQuery) theParameters pure () {-# INLINABLE deleteRecordById #-} @@ -634,7 +676,7 @@ deleteRecordById id = do -- >>> let projects :: [Project] = ... -- >>> deleteRecords projects -- DELETE FROM projects WHERE id IN (..) -deleteRecords :: forall record table. (?modelContext :: ModelContext, Show (PrimaryKey table), Table record, HasField "id" record (Id' table), ToField (PrimaryKey table), record ~ GetModelByTableName table) => [record] -> IO () +deleteRecords :: forall record table. (?modelContext :: ModelContext, Show (PrimaryKey table), Table record, HasField "id" record (Id' table), GetTableName record ~ table, record ~ GetModelByTableName table) => [record] -> IO () deleteRecords records = deleteRecordByIds @record (ids records) {-# INLINABLE deleteRecords #-} @@ -645,11 +687,11 @@ deleteRecords records = -- >>> delete projectIds -- DELETE FROM projects WHERE id IN ('..') -- -deleteRecordByIds :: forall record table. (?modelContext :: ModelContext, Show (PrimaryKey table), Table record, ToField (PrimaryKey table), record ~ GetModelByTableName table) => [Id' table] -> IO () +deleteRecordByIds :: forall record table. (?modelContext :: ModelContext, Show (PrimaryKey table), Table record, GetTableName record ~ table, record ~ GetModelByTableName table) => [Id' table] -> IO () deleteRecordByIds ids = do - let theQuery = "DELETE FROM " <> tableName @record <> " WHERE id IN ?" - let theParameters = (PG.Only (PG.In ids)) - sqlExec (PG.Query . cs $! theQuery) theParameters + let theQuery = "DELETE FROM " <> tableNameByteString @record <> " WHERE " <> (primaryKeyConditionColumnSelector @record) <> " IN ?" + let theParameters = PG.Only $ PG.In $ map (primaryKeyConditionForId @record) ids + sqlExec (PG.Query $! theQuery) theParameters pure () {-# INLINABLE deleteRecordByIds #-} diff --git a/IHP/QueryBuilder.hs b/IHP/QueryBuilder.hs index cd4082b3a..4432b4ea0 100644 --- a/IHP/QueryBuilder.hs +++ b/IHP/QueryBuilder.hs @@ -24,6 +24,7 @@ module IHP.QueryBuilder , filterWhereCaseInsensitive , filterWhereNot , filterWhereIn +, filterWhereIdIn , filterWhereNotIn , filterWhereLike , filterWhereILike @@ -61,6 +62,9 @@ module IHP.QueryBuilder , Condition (..) , Join (..) , OrderByDirection (..) +, injectQueryBuilder +, FilterOperator (..) +, toEqOrIsOperator ) where import IHP.Prelude @@ -826,6 +830,21 @@ filterWhereCaseInsensitive (name, value) queryBuilderProvider = injectQueryBuild queryBuilder = getQueryBuilder queryBuilderProvider {-# INLINE filterWhereCaseInsensitive #-} + +filterWhereIdIn :: forall table model queryBuilderProvider (joinRegister :: *). (KnownSymbol table, Table model, model ~ GetModelByTableName table, HasQueryBuilder queryBuilderProvider joinRegister) => [Id model] -> queryBuilderProvider table -> queryBuilderProvider table +filterWhereIdIn values queryBuilderProvider = + -- We don't need to treat null values differently here, because primary keys imply not-null + let + pkConditions = map (primaryKeyConditionForId @model) values + + queryBuilder = getQueryBuilder queryBuilderProvider + + whereInQuery = FilterByQueryBuilder {queryBuilder, queryFilter = (primaryKeyConditionColumnSelector @model, InOp, toField (In pkConditions)), applyLeft = Nothing, applyRight = Nothing} + in + injectQueryBuilder whereInQuery +{-# INLINE filterWhereIdIn #-} + + -- | Joins a table to an existing QueryBuilder (or something holding a QueryBuilder) on the specified columns. Example: -- > query @Posts -- > |> innerJoin @Users (#author, #id) diff --git a/IHP/SchemaCompiler.hs b/IHP/SchemaCompiler.hs index 12df92462..10fd3dff3 100644 --- a/IHP/SchemaCompiler.hs +++ b/IHP/SchemaCompiler.hs @@ -581,11 +581,21 @@ compileUpdate table@(CreateTable { name, columns }) = columnNames = writableColumns |> map (.name) |> intercalate ", " + + primaryKeyPattern = case primaryKeyColumns table of + [] -> error $ "Impossible happened in compileUpdate. No primary keys found for table " <> cs name <> ". At least one primary key is required." + [col] -> col.name + cols -> "(" <> commaSep (map (\col -> col.name) cols) <> ")" + + primaryKeyParameters = case primaryKeyColumns table of + [] -> error $ "Impossible happened in compileUpdate. No primary keys found for table " <> cs name <> ". At least one primary key is required." + [col] -> "?" + cols -> "(" <> commaSep (map (const "?") (primaryKeyColumns table)) <> ")" in "instance CanUpdate " <> modelName <> " where\n" <> indent ("updateRecord model = do\n" <> indent ( - "List.head <$> sqlQuery \"UPDATE " <> name <> " SET " <> updates <> " WHERE id = ? RETURNING " <> columnNames <> "\" (" <> bindings <> ")\n" + "List.head <$> sqlQuery \"UPDATE " <> name <> " SET " <> updates <> " WHERE " <> primaryKeyPattern <> " = "<> primaryKeyParameters <> " RETURNING " <> columnNames <> "\" (" <> bindings <> ")\n" ) ) @@ -607,19 +617,25 @@ instance FromRow #{modelName} where compileField (fieldName, _) | isColumn fieldName = fieldName - | isManyToManyField fieldName = let (Just ref) = find (\(n, _) -> columnNameToFieldName n == fieldName) referencing in compileSetQueryBuilder ref + | isOneToManyField fieldName = let (Just ref) = find (\(n, _) -> columnNameToFieldName n == fieldName) referencing in compileSetQueryBuilder ref | fieldName == "meta" = "def { originalDatabaseRecord = Just (Data.Dynamic.toDyn theRecord) }" | otherwise = "def" isPrimaryKey name = name `elem` primaryKeyColumnNames table.primaryKeyConstraint isColumn name = name `elem` columnNames - isManyToManyField fieldName = fieldName `elem` (referencing |> map (columnNameToFieldName . fst)) + isOneToManyField fieldName = fieldName `elem` (referencing |> map (columnNameToFieldName . fst)) compileSetQueryBuilder (refTableName, refFieldName) = "(QueryBuilder.filterWhere (#" <> columnNameToFieldName refFieldName <> ", " <> primaryKeyField <> ") (QueryBuilder.query @" <> tableNameToModelName refTableName <> "))" where -- | When the referenced column is nullable, we have to wrap the @Id@ in @Just@ primaryKeyField :: Text - primaryKeyField = if refColumn.notNull then "id" else "Just id" + primaryKeyField = if refColumn.notNull then actualPrimaryKeyField else "Just " <> actualPrimaryKeyField + actualPrimaryKeyField :: Text + actualPrimaryKeyField = case primaryKeyColumns table of + [] -> error $ "Impossible happened in compilePrimaryKeyInstance. No primary keys found for table " <> cs name <> ". At least one primary key is required." + [pk] -> columnNameToFieldName pk.name + pks -> error $ "No support yet for composite foreign keys. Tables cannot have foreign keys to table '" <> cs name <> "' which has more than one column as its primary key." + (Just refTable) = let (Schema statements) = ?schema in statements @@ -754,8 +770,9 @@ instance #{instanceHead} where tableName = \"#{name}\" tableNameByteString = Data.Text.Encoding.encodeUtf8 \"#{name}\" columnNames = #{columnNames} - primaryKeyCondition #{pattern} = #{condition} - {-# INLINABLE primaryKeyCondition #-} + primaryKeyColumnNames = #{primaryKeyColumnNames} + primaryKeyConditionForId (#{pattern}) = #{condition} + {-# INLINABLE primaryKeyConditionForId #-} |] where instanceHead :: Text @@ -772,22 +789,22 @@ instance #{instanceHead} where |> \inner -> "(" <> inner <> ")" primaryKeyColumnNames :: [Text] - primaryKeyColumnNames = (primaryKeyColumns table) |> map (.name) + primaryKeyColumnNames = primaryKeyColumns table |> map (.name) primaryKeyFieldNames :: [Text] primaryKeyFieldNames = primaryKeyColumnNames |> map columnNameToFieldName pattern :: Text - pattern = tableNameToModelName name <> " { " <> intercalate ", " primaryKeyFieldNames <> " }" + pattern = "Id (" <> intercalate ", " primaryKeyFieldNames <> ")" condition :: Text - condition = primaryKeyColumns table - |> map primaryKeyToCondition - |> intercalate ", " - |> \listInner -> "[" <> listInner <> "]" + condition = case primaryKeyColumns table of + [] -> error $ "Impossible happened in compileUpdate. No primary keys found for table " <> cs name <> ". At least one primary key is required." + [column] -> primaryKeyToCondition column + cols -> "Many [Plain \"(\", " <> intercalate ", Plain \",\", " (map primaryKeyToCondition cols)<> ", Plain \")\"]" primaryKeyToCondition :: Column -> Text - primaryKeyToCondition column = "(\"" <> column.name <> "\", toField " <> columnNameToFieldName column.name <> ")" + primaryKeyToCondition column = "toField " <> columnNameToFieldName column.name columnNames = columns |> map (.name) diff --git a/Test/QueryBuilderSpec.hs b/Test/QueryBuilderSpec.hs index 6ac2bb019..049c4f413 100644 --- a/Test/QueryBuilderSpec.hs +++ b/Test/QueryBuilderSpec.hs @@ -9,7 +9,7 @@ import IHP.Prelude import IHP.QueryBuilder import IHP.ModelSupport import qualified Database.PostgreSQL.Simple.ToField as ToField -import Database.PostgreSQL.Simple.ToField (Action (..)) +import Database.PostgreSQL.Simple.ToField (Action (..), ToField (toField)) import qualified Data.ByteString.Builder as ByteString data Post = Post @@ -24,9 +24,28 @@ data Post = Post type instance GetTableName Post = "posts" type instance GetModelByTableName "posts" = Post +type instance PrimaryKey "posts" = UUID + + +data WeirdPkTag = WeirdPkTag + { tagIden :: UUID + , tagText :: Text + } + +type instance GetTableName WeirdPkTag = "weird_tags" +type instance GetModelByTableName "weird_tags" = WeirdPkTag +type instance PrimaryKey "weird_tags" = UUID + +instance Table WeirdPkTag where + columnNames = ["tag_iden", "tag_text"] + primaryKeyColumnNames = ["tag_iden"] + primaryKeyConditionForId (Id id) = toField id + instance Table Post where columnNames = ["id", "title", "external_url", "created_at", "public", "created_by", "category_id"] + primaryKeyColumnNames = ["id"] + primaryKeyConditionForId (Id id) = toField id data Tag = Tag { id :: UUID @@ -35,9 +54,12 @@ data Tag = Tag type instance GetTableName Tag = "tags" type instance GetModelByTableName "tags" = Tag +type instance PrimaryKey "tags" = UUID instance Table Tag where columnNames = ["id", "tag_text"] + primaryKeyColumnNames = ["id"] + primaryKeyConditionForId (Id id) = toField id data Tagging = Tagging { id :: UUID @@ -48,9 +70,28 @@ data Tagging = Tagging type instance GetTableName Tagging = "taggings" type instance GetModelByTableName "taggings" = Tagging +type instance PrimaryKey "taggings" = UUID instance Table Tagging where columnNames = ["id", "post_id", "tag_id"] + primaryKeyColumnNames = ["id"] + primaryKeyConditionForId (Id id) = toField id + +data CompositeTagging = CompositeTagging + { postId :: UUID + , tagId :: UUID + } + + +type instance GetTableName CompositeTagging = "composite_taggings" +type instance GetModelByTableName "composite_taggings" = CompositeTagging +type instance PrimaryKey "composite_taggings" = (Id' "posts", Id' "tags") + +instance Table CompositeTagging where + columnNames = ["post_id", "tag_id"] + primaryKeyColumnNames = ["post_id", "tag_id"] + primaryKeyConditionForId (Id (postId, tagId)) = Many ([Plain "(", toField postId, Plain ",", toField tagId, Plain ")"]) + data User = User { id :: UUID, @@ -59,9 +100,12 @@ data User = User type instance GetTableName User = "users" type instance GetModelByTableName "users" = User +type instance PrimaryKey "users" = UUID instance Table User where columnNames = ["id", "name"] + primaryKeyColumnNames = ["id"] + primaryKeyConditionForId (Id id) = toField id data FavoriteTitle = FavoriteTitle { @@ -74,7 +118,8 @@ type instance GetModelByTableName "favorite_title" = FavoriteTitle instance Table FavoriteTitle where columnNames = ["title", "likes"] - primaryKeyCondition _ = [] + primaryKeyConditionForId _ = Many [] + primaryKeyColumnNames = [] tests = do describe "QueryBuilder" do @@ -111,6 +156,12 @@ tests = do (toSQL theQuery) `shouldBe` ("SELECT posts.id, posts.title, posts.external_url, posts.created_at, posts.public, posts.created_by, posts.category_id FROM posts WHERE posts.external_url IS NOT ?", [Plain "null"]) describe "filterWhereIn" do + it "should work with #id if the Model is suitable" do + let theValues :: [UUID] = ["b80e37a8-41d4-4731-b050-a716879ef1d1", "629b7ee0-3675-4b02-ba3e-cdbd7b513553"] + let theQuery = query @Post + |> filterWhereIn (#id, theValues) + + (toSQL theQuery) `shouldBe` ("SELECT posts.id, posts.title, posts.external_url, posts.created_at, posts.public, posts.created_by, posts.category_id FROM posts WHERE posts.id IN ?", [Many [Plain "(", Plain "'b80e37a8-41d4-4731-b050-a716879ef1d1'", Plain ",", Plain "'629b7ee0-3675-4b02-ba3e-cdbd7b513553'", Plain ")"]]) it "should produce a SQL with a WHERE condition" do let theValues :: [Text] = ["first", "second"] let theQuery = query @Post @@ -141,6 +192,46 @@ tests = do (toSQL theQuery) `shouldBe` ("SELECT posts.id, posts.title, posts.external_url, posts.created_at, posts.public, posts.created_by, posts.category_id FROM posts WHERE posts.category_id IS ?", [Plain "null"]) + describe "filterWhereIdIn" do + it "should produce a SQL with a WHERE condition" do + let theValues :: [Id Post] = ["b80e37a8-41d4-4731-b050-a716879ef1d1", "629b7ee0-3675-4b02-ba3e-cdbd7b513553"] + let theQuery = query @Post + |> filterWhereIdIn theValues + + (toSQL theQuery) `shouldBe` ("SELECT posts.id, posts.title, posts.external_url, posts.created_at, posts.public, posts.created_by, posts.category_id FROM posts WHERE posts.id IN ?", [Many [Plain "(", Plain "'b80e37a8-41d4-4731-b050-a716879ef1d1'", Plain ",", Plain "'629b7ee0-3675-4b02-ba3e-cdbd7b513553'", Plain ")"]]) + + describe "with empty values" do + it "should produce a SQL with a WHERE condition" do + let theValues :: [Id Post] = [] + let theQuery = query @Post + |> filterWhereIdIn theValues + + (toSQL theQuery) `shouldBe` ("SELECT posts.id, posts.title, posts.external_url, posts.created_at, posts.public, posts.created_by, posts.category_id FROM posts WHERE posts.id IN ?", [Plain "(null)"]) + + describe "with weird primary key name" do + it "should produce a SQL with a WHERE condition" do + let theValues :: [Id WeirdPkTag] = ["b80e37a8-41d4-4731-b050-a716879ef1d1", "629b7ee0-3675-4b02-ba3e-cdbd7b513553"] + let theQuery = query @WeirdPkTag + |> filterWhereIdIn theValues + + (toSQL theQuery) `shouldBe` ("SELECT weird_tags.tag_iden, weird_tags.tag_text FROM weird_tags WHERE weird_tags.tag_iden IN ?", [Many [Plain "(", Plain "'b80e37a8-41d4-4731-b050-a716879ef1d1'", Plain ",", Plain "'629b7ee0-3675-4b02-ba3e-cdbd7b513553'", Plain ")"]]) + describe "with composite keys" do + it "should produce a SQL with a WHERE condition" do + let theValues :: [Id CompositeTagging] = [Id ("b80e37a8-41d4-4731-b050-a716879ef1d1", "629b7ee0-3675-4b02-ba3e-cdbd7b513553"), Id ("8e2ef0ef-f680-4fcf-837d-7e3171385621", "95096f81-8ca6-407f-a263-cbc33546a828")] + let theQuery = query @CompositeTagging + |> filterWhereIdIn theValues + + (toSQL theQuery) `shouldBe` ("SELECT composite_taggings.post_id, composite_taggings.tag_id FROM composite_taggings WHERE (composite_taggings.post_id, composite_taggings.tag_id) IN ?", [Many [Plain "(", Many [ Plain "(", Plain "'b80e37a8-41d4-4731-b050-a716879ef1d1'", Plain ",", Plain "'629b7ee0-3675-4b02-ba3e-cdbd7b513553'", Plain ")" ], Plain ",", Many [ Plain "(", Plain "'8e2ef0ef-f680-4fcf-837d-7e3171385621'", Plain ",", Plain "'95096f81-8ca6-407f-a263-cbc33546a828'", Plain ")"], Plain ")"]]) + + describe "with empty values" do + it "should produce a SQL with a WHERE condition" do + let theValues :: [Id CompositeTagging] = [] + let theQuery = query @CompositeTagging + |> filterWhereIdIn theValues + + (toSQL theQuery) `shouldBe` ("SELECT composite_taggings.post_id, composite_taggings.tag_id FROM composite_taggings WHERE (composite_taggings.post_id, composite_taggings.tag_id) IN ?", [Plain "(null)"]) + + describe "filterWhereInJoinedTable" do it "should produce a SQL with a WHERE condition" do let theValues :: [Text] = ["first", "second"] diff --git a/Test/SchemaCompilerSpec.hs b/Test/SchemaCompilerSpec.hs index e90af02e0..8329e26e4 100644 --- a/Test/SchemaCompilerSpec.hs +++ b/Test/SchemaCompilerSpec.hs @@ -148,7 +148,7 @@ tests = do it "should compile CanUpdate instance with an array type with an explicit cast" do let statement = StatementCreateTable $ CreateTable { name = "users", - columns = [ Column "id" PUUID Nothing False True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing], + columns = [ Column "id" PUUID Nothing True True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing], primaryKeyConstraint = PrimaryKeyConstraint ["id"], constraints = [] , unlogged = False @@ -164,7 +164,7 @@ tests = do let statement = StatementCreateTable CreateTable { name = "users" , columns = - [ Column "id" PUUID Nothing False True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing + [ Column "id" PUUID Nothing True True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing , Column {name = "electricity_unit_price", columnType = PDouble, defaultValue = Just (TypeCastExpression (DoubleExpression 0.17) PDouble), notNull = True, isUnique = False, generator = Nothing} ] , primaryKeyConstraint = PrimaryKeyConstraint ["id"] @@ -189,8 +189,9 @@ tests = do tableName = "users" tableNameByteString = Data.Text.Encoding.encodeUtf8 "users" columnNames = ["id","ids","electricity_unit_price"] - primaryKeyCondition User { id } = [("id", toField id)] - {-# INLINABLE primaryKeyCondition #-} + primaryKeyColumnNames = ["id"] + primaryKeyConditionForId (Id (id)) = toField id + {-# INLINABLE primaryKeyConditionForId #-} instance InputValue User where inputValue = IHP.ModelSupport.recordToInputValue @@ -233,7 +234,7 @@ tests = do let statement = StatementCreateTable CreateTable { name = "users" , columns = - [ Column "id" PUUID Nothing False True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing + [ Column "id" PUUID Nothing True True Nothing, Column "ids" (PArray PUUID) Nothing False False Nothing , Column {name = "electricity_unit_price", columnType = PDouble, defaultValue = Just (IntExpression 0), notNull = True, isUnique = False, generator = Nothing} ] , primaryKeyConstraint = PrimaryKeyConstraint ["id"] @@ -258,8 +259,9 @@ tests = do tableName = "users" tableNameByteString = Data.Text.Encoding.encodeUtf8 "users" columnNames = ["id","ids","electricity_unit_price"] - primaryKeyCondition User { id } = [("id", toField id)] - {-# INLINABLE primaryKeyCondition #-} + primaryKeyColumnNames = ["id"] + primaryKeyConditionForId (Id (id)) = toField id + {-# INLINABLE primaryKeyConditionForId #-} instance InputValue User where inputValue = IHP.ModelSupport.recordToInputValue @@ -302,7 +304,7 @@ tests = do let statement = StatementCreateTable CreateTable { name = "users" , columns = - [ Column "id" PUUID Nothing False True Nothing + [ Column "id" PUUID Nothing True True Nothing , Column {name = "ts", columnType = PTSVector, defaultValue = Nothing, notNull = True, isUnique = False, generator = Just (ColumnGenerator { generate = VarExpression "someResult", stored = False }) } ] , primaryKeyConstraint = PrimaryKeyConstraint ["id"] @@ -327,8 +329,9 @@ tests = do tableName = "users" tableNameByteString = Data.Text.Encoding.encodeUtf8 "users" columnNames = ["id","ts"] - primaryKeyCondition User { id } = [("id", toField id)] - {-# INLINABLE primaryKeyCondition #-} + primaryKeyColumnNames = ["id"] + primaryKeyConditionForId (Id (id)) = toField id + {-# INLINABLE primaryKeyConditionForId #-} instance InputValue User where inputValue = IHP.ModelSupport.recordToInputValue @@ -404,8 +407,9 @@ tests = do tableName = "landing_pages" tableNameByteString = Data.Text.Encoding.encodeUtf8 "landing_pages" columnNames = ["id"] - primaryKeyCondition LandingPage { id } = [("id", toField id)] - {-# INLINABLE primaryKeyCondition #-} + primaryKeyColumnNames = ["id"] + primaryKeyConditionForId (Id (id)) = toField id + {-# INLINABLE primaryKeyConditionForId #-} instance InputValue LandingPage where inputValue = IHP.ModelSupport.recordToInputValue @@ -442,53 +446,155 @@ tests = do builder |> QueryBuilder.filterWhere (#id, id) {-# INLINE filterWhereId #-} |] - describe "compileFilterPrimaryKeyInstance" do - it "should compile FilterPrimaryKey instance when primary key is called id" do - let statement = StatementCreateTable $ CreateTable { - name = "things", - columns = [ Column "id" PUUID Nothing False False Nothing ], - primaryKeyConstraint = PrimaryKeyConstraint ["id"], - constraints = [], - unlogged = False - } - let compileOutput = compileStatementPreview [statement] statement |> Text.strip - + describe "compileStatementPreview for table with arbitrarily named primary key" do + let statements = parseSqlStatements [trimming| + CREATE TABLE things ( + thing_arbitrary_ident UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL + ); + CREATE TABLE others ( + other_arbitrary_ident UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, + thing_ref UUID NOT NULL + ); + ALTER TABLE others ADD CONSTRAINT other_thing_refs FOREIGN KEY (thing_ref) REFERENCES things (thing_arbitrary_ident) ON DELETE NO ACTION; + |] + let + isTargetTable :: Statement -> Bool + isTargetTable (StatementCreateTable CreateTable { name }) = name == "things" + isTargetTable otherwise = False + let (Just statement) = find isTargetTable statements + let compileOutput = compileStatementPreview statements statement |> Text.strip + + it "should compile CanCreate instance with sqlQuery" $ \statement -> do + getInstanceDecl "CanCreate" compileOutput `shouldBe` [trimming| + instance CanCreate Thing where + create :: (?modelContext :: ModelContext) => Thing -> IO Thing + create model = do + List.head <$> sqlQuery "INSERT INTO things (thing_arbitrary_ident) VALUES (?) RETURNING thing_arbitrary_ident" (Only (fieldWithDefault #thingArbitraryIdent model)) + 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) + |] + it "should compile CanUpdate instance with sqlQuery" $ \statement -> do + getInstanceDecl "CanUpdate" compileOutput `shouldBe` [trimming| + instance CanUpdate Thing where + updateRecord model = do + List.head <$> sqlQuery "UPDATE things SET thing_arbitrary_ident = ? WHERE thing_arbitrary_ident = ? RETURNING thing_arbitrary_ident" ((fieldWithUpdate #thingArbitraryIdent model, model.thingArbitraryIdent)) + |] + it "should compile FromRow instance" $ \statement -> do + getInstanceDecl "FromRow" compileOutput `shouldBe` [trimming| + instance FromRow Thing where + fromRow = do + thingArbitraryIdent <- field + let theRecord = Thing thingArbitraryIdent (QueryBuilder.filterWhere (#thingRef, thingArbitraryIdent) (QueryBuilder.query @Other)) def { originalDatabaseRecord = Just (Data.Dynamic.toDyn theRecord) } + pure theRecord + |] + it "should compile Table instance" $ \statement -> do + getInstanceDecl "() => Table" compileOutput `shouldBe` [trimming| + instance () => Table (Thing' others) where + tableName = "things" + tableNameByteString = Data.Text.Encoding.encodeUtf8 "things" + columnNames = ["thing_arbitrary_ident"] + primaryKeyColumnNames = ["thing_arbitrary_ident"] + primaryKeyConditionForId (Id (thingArbitraryIdent)) = toField thingArbitraryIdent + {-# INLINABLE primaryKeyConditionForId #-} + |] + it "should compile QueryBuilder.FilterPrimaryKey instance" $ \statement -> do getInstanceDecl "QueryBuilder.FilterPrimaryKey" compileOutput `shouldBe` [trimming| instance QueryBuilder.FilterPrimaryKey "things" where - filterWhereId id builder = - builder |> QueryBuilder.filterWhere (#id, id) + filterWhereId thingArbitraryIdent builder = + builder |> QueryBuilder.filterWhere (#thingArbitraryIdent, thingArbitraryIdent) {-# INLINE filterWhereId #-} |] - it "should compile FilterPrimaryKey instance when primary key is called thing_id" do - let statement = StatementCreateTable $ CreateTable { - name = "things", - columns = [ Column "thing_id" PUUID Nothing False False Nothing ], - primaryKeyConstraint = PrimaryKeyConstraint ["thing_id"], - constraints = [], - unlogged = False - } - let compileOutput = compileStatementPreview [statement] statement |> Text.strip - + describe "compileStatementPreview for table with composite primary key" do + let statements = parseSqlStatements [trimming| + CREATE TABLE bits ( + bit_arbitrary_ident UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL + ); + CREATE TABLE parts ( + part_arbitrary_ident UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL + ); + CREATE TABLE bit_part_refs ( + bit_ref UUID NOT NULL, + part_ref UUID NOT NULL, + PRIMARY KEY(bit_ref, part_ref) + ); + ALTER TABLE bit_part_refs ADD CONSTRAINT bit_part_bit_refs FOREIGN KEY (bit_ref) REFERENCES bits (bit_arbitrary_ident) ON DELETE NO ACTION; + ALTER TABLE bit_part_refs ADD CONSTRAINT bit_part_part_refs FOREIGN KEY (part_ref) REFERENCES parts (part_arbitrary_ident) ON DELETE NO ACTION; + |] + let + isNamedTable :: Text -> Statement -> Bool + isNamedTable targetName (StatementCreateTable CreateTable { name }) = name == targetName + isNamedTable _ _ = False + let (Just statement) = find (isNamedTable "bit_part_refs") statements + let compileOutput = compileStatementPreview statements statement |> Text.strip + + it "should compile CanCreate instance with sqlQuery" $ \statement -> do + getInstanceDecl "CanCreate" compileOutput `shouldBe` [trimming| + instance CanCreate BitPartRef where + create :: (?modelContext :: ModelContext) => BitPartRef -> IO BitPartRef + create model = do + List.head <$> sqlQuery "INSERT INTO bit_part_refs (bit_ref, part_ref) VALUES (?, ?) RETURNING bit_ref, part_ref" ((model.bitRef, model.partRef)) + 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) + |] + it "should compile CanUpdate instance with sqlQuery" $ \statement -> do + getInstanceDecl "CanUpdate" compileOutput `shouldBe` [trimming| + instance CanUpdate BitPartRef where + updateRecord model = do + List.head <$> sqlQuery "UPDATE bit_part_refs SET bit_ref = ?, part_ref = ? WHERE (bit_ref, part_ref) = (?, ?) RETURNING bit_ref, part_ref" ((fieldWithUpdate #bitRef model, fieldWithUpdate #partRef model, model.bitRef, model.partRef)) + |] + it "should compile FromRow instance" $ \statement -> do + getInstanceDecl "FromRow" compileOutput `shouldBe` [trimming| + instance FromRow BitPartRef where + fromRow = do + bitRef <- field + partRef <- field + let theRecord = BitPartRef bitRef partRef def { originalDatabaseRecord = Just (Data.Dynamic.toDyn theRecord) } + pure theRecord + |] + it "should compile Table instance" $ \statement -> do + getInstanceDecl "(ToField bitRef, ToField partRef) => Table" compileOutput `shouldBe` [trimming| + instance (ToField bitRef, ToField partRef) => Table (BitPartRef' bitRef partRef) where + tableName = "bit_part_refs" + tableNameByteString = Data.Text.Encoding.encodeUtf8 "bit_part_refs" + columnNames = ["bit_ref","part_ref"] + primaryKeyColumnNames = ["bit_ref","part_ref"] + primaryKeyConditionForId (Id (bitRef, partRef)) = Many [Plain "(", toField bitRef, Plain ",", toField partRef, Plain ")"] + {-# INLINABLE primaryKeyConditionForId #-} + |] + it "should compile FromRow instance of table that references part of a composite key" $ \statement -> do + let (Just statement) = find (isNamedTable "parts") statements + let compileOutput = compileStatementPreview statements statement |> Text.strip + getInstanceDecl "FromRow" compileOutput `shouldBe` [trimming| + instance FromRow Part where + fromRow = do + partArbitraryIdent <- field + let theRecord = Part partArbitraryIdent (QueryBuilder.filterWhere (#partRef, partArbitraryIdent) (QueryBuilder.query @BitPartRef)) def { originalDatabaseRecord = Just (Data.Dynamic.toDyn theRecord) } + pure theRecord + |] + it "should compile QueryBuilder.FilterPrimaryKey instance" $ \statement -> do getInstanceDecl "QueryBuilder.FilterPrimaryKey" compileOutput `shouldBe` [trimming| - instance QueryBuilder.FilterPrimaryKey "things" where - filterWhereId thingId builder = - builder |> QueryBuilder.filterWhere (#thingId, thingId) + instance QueryBuilder.FilterPrimaryKey "bit_part_refs" where + filterWhereId (Id (bitRef, partRef)) builder = + builder |> QueryBuilder.filterWhere (#bitRef, bitRef) |> QueryBuilder.filterWhere (#partRef, partRef) {-# INLINE filterWhereId #-} |] - it "should compile FilterPrimaryKey instance when primary key is composite of thing_id other_id" do + describe "compileFilterPrimaryKeyInstance" do + it "should compile FilterPrimaryKey instance when primary key is called id" do let statement = StatementCreateTable $ CreateTable { - name = "thing_other_rels", - columns = [ Column "thing_id" PUUID Nothing False False Nothing, Column "other_id" PUUID Nothing False False Nothing], - primaryKeyConstraint = PrimaryKeyConstraint ["thing_id", "other_id"], + name = "things", + columns = [ Column "id" PUUID Nothing True True Nothing ], + primaryKeyConstraint = PrimaryKeyConstraint ["id"], constraints = [], unlogged = False } let compileOutput = compileStatementPreview [statement] statement |> Text.strip getInstanceDecl "QueryBuilder.FilterPrimaryKey" compileOutput `shouldBe` [trimming| - instance QueryBuilder.FilterPrimaryKey "thing_other_rels" where - filterWhereId (Id (thingId, otherId)) builder = - builder |> QueryBuilder.filterWhere (#thingId, thingId) |> QueryBuilder.filterWhere (#otherId, otherId) + instance QueryBuilder.FilterPrimaryKey "things" where + filterWhereId id builder = + builder |> QueryBuilder.filterWhere (#id, id) {-# INLINE filterWhereId #-} |]