{-# LANGUAGE TypeFamilies, DataKinds, MultiParamTypeClasses, PolyKinds, TypeApplications, ScopedTypeVariables, ConstraintKinds, TypeOperators, GADTs, UndecidableInstances, StandaloneDeriving, FunctionalDependencies, FlexibleContexts, AllowAmbiguousTypes #-}
module IHP.FetchRelated (fetchRelated, collectionFetchRelated, collectionFetchRelatedOrNothing, fetchRelatedOrNothing, maybeFetchRelatedOrNothing) where
import IHP.Prelude
import Database.PostgreSQL.Simple.ToField
import qualified Database.PostgreSQL.Simple as PG
import IHP.ModelSupport (Include, Id', PrimaryKey, GetModelByTableName, Table)
import IHP.QueryBuilder
import IHP.Fetch
class CollectionFetchRelated relatedFieldValue relatedModel where
collectionFetchRelated :: forall model relatedField. (
?modelContext :: ModelContext,
HasField relatedField model relatedFieldValue,
UpdateField relatedField model (Include relatedField model) relatedFieldValue (FetchResult relatedFieldValue relatedModel),
Fetchable relatedFieldValue relatedModel,
KnownSymbol (GetTableName relatedModel),
PG.FromRow relatedModel,
KnownSymbol relatedField
) => Proxy relatedField -> [model] -> IO [Include relatedField model]
class CollectionFetchRelatedOrNothing relatedFieldValue relatedModel where
collectionFetchRelatedOrNothing :: forall model relatedField. (
?modelContext :: ModelContext,
HasField relatedField model (Maybe relatedFieldValue),
UpdateField relatedField model (Include relatedField model) (Maybe relatedFieldValue) (Maybe (FetchResult relatedFieldValue relatedModel)),
Fetchable relatedFieldValue relatedModel,
KnownSymbol (GetTableName relatedModel),
PG.FromRow relatedModel,
KnownSymbol relatedField
) => Proxy relatedField -> [model] -> IO [Include relatedField model]
instance (
Eq (PrimaryKey tableName)
, ToField (PrimaryKey tableName)
, 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. (
?modelContext :: ModelContext,
HasField relatedField model (Id' tableName),
UpdateField relatedField model (Include relatedField model) (Id' tableName) (FetchResult (Id' tableName) relatedModel),
Fetchable (Id' tableName) relatedModel,
KnownSymbol (GetTableName relatedModel),
PG.FromRow relatedModel,
KnownSymbol relatedField,
Table relatedModel
) => Proxy relatedField -> [model] -> IO [Include relatedField model]
collectionFetchRelated :: forall model (relatedField :: Symbol).
(?modelContext::ModelContext,
HasField relatedField model (Id' tableName),
UpdateField
relatedField
model
(Include relatedField model)
(Id' tableName)
(FetchResult (Id' tableName) relatedModel),
Fetchable (Id' tableName) relatedModel,
KnownSymbol (GetTableName relatedModel), FromRow relatedModel,
KnownSymbol relatedField, Table relatedModel) =>
Proxy relatedField -> [model] -> IO [Include relatedField model]
collectionFetchRelated Proxy relatedField
relatedField [model]
model = do
[relatedModel]
relatedModels :: [relatedModel] <- forall model (table :: Symbol).
(table ~ GetTableName model, Table model, DefaultScope table) =>
QueryBuilder table
query @relatedModel QueryBuilder tableName
-> (QueryBuilder tableName -> QueryBuilder tableName)
-> QueryBuilder tableName
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Id relatedModel]
-> QueryBuilder tableName -> QueryBuilder tableName
forall (table :: Symbol) model
(queryBuilderProvider :: Symbol -> *) joinRegister.
(KnownSymbol table, Table model, model ~ GetModelByTableName table,
HasQueryBuilder queryBuilderProvider joinRegister) =>
[Id model]
-> queryBuilderProvider table -> queryBuilderProvider table
filterWhereIdIn ((model -> Id' tableName) -> [model] -> [Id' tableName]
forall a b. (a -> b) -> [a] -> [b]
map (forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @relatedField) [model]
model) QueryBuilder tableName
-> (QueryBuilder tableName -> IO [relatedModel])
-> IO [relatedModel]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> QueryBuilder tableName -> IO [relatedModel]
QueryBuilder tableName
-> IO (FetchResult (QueryBuilder tableName) relatedModel)
forall fetchable model.
(Fetchable fetchable model, Table model, FromRow model,
?modelContext::ModelContext) =>
fetchable -> IO (FetchResult fetchable model)
fetch
let
assignRelated :: model -> Include relatedField model
assignRelated :: model -> Include relatedField model
assignRelated model
model =
let
relatedModel :: relatedModel
relatedModel :: relatedModel
relatedModel = case (relatedModel -> Bool) -> [relatedModel] -> Maybe relatedModel
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\relatedModel
r -> relatedModel
r.id Id' tableName -> Id' tableName -> Bool
forall a. Eq a => a -> a -> Bool
== Id' tableName
targetForeignKey) [relatedModel]
relatedModels of
Just relatedModel
m -> relatedModel
m
Maybe relatedModel
Nothing -> Text -> relatedModel
forall a. Text -> a
error (Text
"Could not find record with id = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Id' tableName -> Text
forall a. Show a => a -> Text
show Id' tableName
targetForeignKey Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in result set. Looks like the foreign key is pointing to a non existing record")
targetForeignKey :: Id' tableName
targetForeignKey = (forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @relatedField model
model :: Id' tableName)
in
forall (field :: Symbol) model model' value value'.
UpdateField field model model' value value' =>
value' -> model -> model'
updateField @relatedField relatedModel
relatedModel model
model
let
result :: [Include relatedField model]
result :: [Include relatedField model]
result = (model -> Include relatedField model)
-> [model] -> [Include relatedField model]
forall a b. (a -> b) -> [a] -> [b]
map model -> Include relatedField model
assignRelated [model]
model
[Include relatedField model] -> IO [Include relatedField model]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Include relatedField model]
result
instance (
Eq (PrimaryKey tableName)
, 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. (
?modelContext :: ModelContext,
HasField relatedField model (Maybe (Id' tableName)),
UpdateField relatedField model (Include relatedField model) (Maybe (Id' tableName)) (Maybe (FetchResult (Id' tableName) relatedModel)),
Fetchable (Id' tableName) relatedModel,
KnownSymbol (GetTableName relatedModel),
PG.FromRow relatedModel,
KnownSymbol relatedField
) => Proxy relatedField -> [model] -> IO [Include relatedField model]
collectionFetchRelatedOrNothing :: forall model (relatedField :: Symbol).
(?modelContext::ModelContext,
HasField relatedField model (Maybe (Id' tableName)),
UpdateField
relatedField
model
(Include relatedField model)
(Maybe (Id' tableName))
(Maybe (FetchResult (Id' tableName) relatedModel)),
Fetchable (Id' tableName) relatedModel,
KnownSymbol (GetTableName relatedModel), FromRow relatedModel,
KnownSymbol relatedField) =>
Proxy relatedField -> [model] -> IO [Include relatedField model]
collectionFetchRelatedOrNothing Proxy relatedField
relatedField [model]
model = do
[relatedModel]
relatedModels :: [relatedModel] <- forall model (table :: Symbol).
(table ~ GetTableName model, Table model, DefaultScope table) =>
QueryBuilder table
query @relatedModel QueryBuilder tableName
-> (QueryBuilder tableName -> QueryBuilder tableName)
-> QueryBuilder tableName
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> [Id relatedModel]
-> QueryBuilder tableName -> QueryBuilder tableName
forall (table :: Symbol) model
(queryBuilderProvider :: Symbol -> *) joinRegister.
(KnownSymbol table, Table model, model ~ GetModelByTableName table,
HasQueryBuilder queryBuilderProvider joinRegister) =>
[Id model]
-> queryBuilderProvider table -> queryBuilderProvider table
filterWhereIdIn ((model -> Maybe (Id' tableName)) -> [model] -> [Id' tableName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @relatedField) [model]
model) QueryBuilder tableName
-> (QueryBuilder tableName -> IO [relatedModel])
-> IO [relatedModel]
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> QueryBuilder tableName -> IO [relatedModel]
QueryBuilder tableName
-> IO (FetchResult (QueryBuilder tableName) relatedModel)
forall fetchable model.
(Fetchable fetchable model, Table model, FromRow model,
?modelContext::ModelContext) =>
fetchable -> IO (FetchResult fetchable model)
fetch
let
assignRelated :: model -> Include relatedField model
assignRelated :: model -> Include relatedField model
assignRelated model
model =
let
relatedModel :: Maybe (FetchResult (Id' tableName) relatedModel)
relatedModel :: Maybe (FetchResult (Id' tableName) relatedModel)
relatedModel = (relatedModel -> Bool) -> [relatedModel] -> Maybe relatedModel
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\relatedModel
r -> Id' tableName -> Maybe (Id' tableName)
forall a. a -> Maybe a
Just relatedModel
r.id Maybe (Id' tableName) -> Maybe (Id' tableName) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (Id' tableName)
targetForeignKey) [relatedModel]
relatedModels
targetForeignKey :: Maybe (Id' tableName)
targetForeignKey = (forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @relatedField model
model :: Maybe (Id' tableName))
in
forall (field :: Symbol) model model' value value'.
UpdateField field model model' value value' =>
value' -> model -> model'
updateField @relatedField Maybe relatedModel
Maybe (FetchResult (Id' tableName) relatedModel)
relatedModel model
model
let
result :: [Include relatedField model]
result :: [Include relatedField model]
result = (model -> Include relatedField model)
-> [model] -> [Include relatedField model]
forall a b. (a -> b) -> [a] -> [b]
map model -> Include relatedField model
assignRelated [model]
model
[Include relatedField model] -> IO [Include relatedField model]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Include relatedField model]
result
instance (relatedModel ~ GetModelByTableName relatedTable, Table relatedModel) => CollectionFetchRelated (QueryBuilder relatedTable) relatedModel where
collectionFetchRelated :: forall model relatedField. (
?modelContext :: ModelContext,
HasField relatedField model (QueryBuilder relatedTable),
UpdateField relatedField model (Include relatedField model) (QueryBuilder relatedTable) (FetchResult (QueryBuilder relatedTable) relatedModel),
Fetchable (QueryBuilder relatedTable) relatedModel,
KnownSymbol (GetTableName relatedModel),
PG.FromRow relatedModel,
KnownSymbol relatedField
) => Proxy relatedField -> [model] -> IO [Include relatedField model]
collectionFetchRelated :: forall model (relatedField :: Symbol).
(?modelContext::ModelContext,
HasField relatedField model (QueryBuilder relatedTable),
UpdateField
relatedField
model
(Include relatedField model)
(QueryBuilder relatedTable)
(FetchResult (QueryBuilder relatedTable) relatedModel),
Fetchable (QueryBuilder relatedTable) relatedModel,
KnownSymbol (GetTableName relatedModel), FromRow relatedModel,
KnownSymbol relatedField) =>
Proxy relatedField -> [model] -> IO [Include relatedField model]
collectionFetchRelated Proxy relatedField
relatedField [model]
models = do
let fetchRelated :: model -> IO (Include relatedField model)
fetchRelated model
model = do
let QueryBuilder relatedTable
queryBuilder :: QueryBuilder relatedTable = forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @relatedField model
model
[relatedModel]
result :: [relatedModel] <- QueryBuilder relatedTable
-> IO (FetchResult (QueryBuilder relatedTable) relatedModel)
forall fetchable model.
(Fetchable fetchable model, Table model, FromRow model,
?modelContext::ModelContext) =>
fetchable -> IO (FetchResult fetchable model)
fetch QueryBuilder relatedTable
queryBuilder
Include relatedField model -> IO (Include relatedField model)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (field :: Symbol) model model' value value'.
UpdateField field model model' value value' =>
value' -> model -> model'
updateField @relatedField [relatedModel]
result model
model)
(model -> IO (Include relatedField model))
-> [model] -> IO [Include relatedField model]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM model -> IO (Include relatedField model)
fetchRelated [model]
models
fetchRelated :: forall model field fieldValue fetchModel. (
?modelContext :: ModelContext,
UpdateField field model (Include field model) fieldValue (FetchResult fieldValue fetchModel),
HasField field model fieldValue,
PG.FromRow fetchModel,
KnownSymbol (GetTableName fetchModel),
Fetchable fieldValue fetchModel,
Table fetchModel
) => Proxy field -> model -> IO (Include field model)
fetchRelated :: forall model (field :: Symbol) fieldValue fetchModel.
(?modelContext::ModelContext,
UpdateField
field
model
(Include field model)
fieldValue
(FetchResult fieldValue fetchModel),
HasField field model fieldValue, FromRow fetchModel,
KnownSymbol (GetTableName fetchModel),
Fetchable fieldValue fetchModel, Table fetchModel) =>
Proxy field -> model -> IO (Include field model)
fetchRelated Proxy field
relatedField model
model = do
FetchResult fieldValue fetchModel
result :: FetchResult fieldValue fetchModel <- fieldValue -> IO (FetchResult fieldValue fetchModel)
forall fetchable model.
(Fetchable fetchable model, Table model, FromRow model,
?modelContext::ModelContext) =>
fetchable -> IO (FetchResult fetchable model)
fetch ((forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @field model
model) :: fieldValue)
let model' :: Include field model
model' = forall (field :: Symbol) model model' value value'.
UpdateField field model model' value value' =>
value' -> model -> model'
updateField @field FetchResult fieldValue fetchModel
result model
model
Include field model -> IO (Include field model)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Include field model
model'
{-# INLINE fetchRelated #-}
fetchRelatedOrNothing :: forall model field fieldValue fetchModel. (
?modelContext :: ModelContext,
UpdateField field model (Include field model) (Maybe fieldValue) (Maybe (FetchResult fieldValue fetchModel)),
HasField field model (Maybe fieldValue),
PG.FromRow fetchModel,
KnownSymbol (GetTableName fetchModel),
Fetchable fieldValue fetchModel,
Table fetchModel
) => Proxy field -> model -> IO (Include field model)
fetchRelatedOrNothing :: forall model (field :: Symbol) fieldValue fetchModel.
(?modelContext::ModelContext,
UpdateField
field
model
(Include field model)
(Maybe fieldValue)
(Maybe (FetchResult fieldValue fetchModel)),
HasField field model (Maybe fieldValue), FromRow fetchModel,
KnownSymbol (GetTableName fetchModel),
Fetchable fieldValue fetchModel, Table fetchModel) =>
Proxy field -> model -> IO (Include field model)
fetchRelatedOrNothing Proxy field
relatedField model
model = do
Maybe (FetchResult fieldValue fetchModel)
result :: Maybe (FetchResult fieldValue fetchModel) <- case forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @field model
model of
Just fieldValue
fieldValue -> FetchResult fieldValue fetchModel
-> Maybe (FetchResult fieldValue fetchModel)
forall a. a -> Maybe a
Just (FetchResult fieldValue fetchModel
-> Maybe (FetchResult fieldValue fetchModel))
-> IO (FetchResult fieldValue fetchModel)
-> IO (Maybe (FetchResult fieldValue fetchModel))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> fieldValue -> IO (FetchResult fieldValue fetchModel)
forall fetchable model.
(Fetchable fetchable model, Table model, FromRow model,
?modelContext::ModelContext) =>
fetchable -> IO (FetchResult fetchable model)
fetch fieldValue
fieldValue
Maybe fieldValue
Nothing -> Maybe (FetchResult fieldValue fetchModel)
-> IO (Maybe (FetchResult fieldValue fetchModel))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (FetchResult fieldValue fetchModel)
forall a. Maybe a
Nothing
let model' :: Include field model
model' = forall (field :: Symbol) model model' value value'.
UpdateField field model model' value value' =>
value' -> model -> model'
updateField @field Maybe (FetchResult fieldValue fetchModel)
result model
model
Include field model -> IO (Include field model)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Include field model
model'
{-# INLINE fetchRelatedOrNothing #-}
maybeFetchRelatedOrNothing :: forall model field fieldValue fetchModel. (
?modelContext :: ModelContext,
UpdateField field model (Include field model) (Maybe fieldValue) (Maybe (FetchResult fieldValue fetchModel)),
HasField field model (Maybe fieldValue),
PG.FromRow fetchModel,
KnownSymbol (GetTableName fetchModel),
Fetchable fieldValue fetchModel,
Table fetchModel
) => Proxy field -> Maybe model -> IO (Maybe (Include field model))
maybeFetchRelatedOrNothing :: forall model (field :: Symbol) fieldValue fetchModel.
(?modelContext::ModelContext,
UpdateField
field
model
(Include field model)
(Maybe fieldValue)
(Maybe (FetchResult fieldValue fetchModel)),
HasField field model (Maybe fieldValue), FromRow fetchModel,
KnownSymbol (GetTableName fetchModel),
Fetchable fieldValue fetchModel, Table fetchModel) =>
Proxy field -> Maybe model -> IO (Maybe (Include field model))
maybeFetchRelatedOrNothing Proxy field
relatedField = IO (Maybe (Include field model))
-> (model -> IO (Maybe (Include field model)))
-> Maybe model
-> IO (Maybe (Include field model))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Include field model) -> IO (Maybe (Include field model))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Include field model)
forall a. Maybe a
Nothing) (\model
q -> Proxy field -> model -> IO (Include field model)
forall model (field :: Symbol) fieldValue fetchModel.
(?modelContext::ModelContext,
UpdateField
field
model
(Include field model)
(Maybe fieldValue)
(Maybe (FetchResult fieldValue fetchModel)),
HasField field model (Maybe fieldValue), FromRow fetchModel,
KnownSymbol (GetTableName fetchModel),
Fetchable fieldValue fetchModel, Table fetchModel) =>
Proxy field -> model -> IO (Include field model)
fetchRelatedOrNothing Proxy field
relatedField model
q IO (Include field model)
-> (Include field model -> IO (Maybe (Include field model)))
-> IO (Maybe (Include field model))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Include field model) -> IO (Maybe (Include field model))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Include field model) -> IO (Maybe (Include field model)))
-> (Include field model -> Maybe (Include field model))
-> Include field model
-> IO (Maybe (Include field model))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Include field model -> Maybe (Include field model)
forall a. a -> Maybe a
Just)
{-# INLINE maybeFetchRelatedOrNothing #-}