{-# LANGUAGE TypeFamilies, DataKinds, MultiParamTypeClasses, PolyKinds, TypeApplications, ScopedTypeVariables, TypeInType, ConstraintKinds, TypeOperators, GADTs, UndecidableInstances, StandaloneDeriving, FunctionalDependencies, FlexibleContexts, AllowAmbiguousTypes #-}
{-|
Module: IHP.FetchRelated
Description:  Provides fetchRelated, collectionFetchRelated, etc.
Copyright: (c) digitally induced GmbH, 2020

This modules provides helper functions to access relationshops for a model.

See https://ihp.digitallyinduced.com/Guide/relationships.html for some examples.
-}
module IHP.FetchRelated (fetchRelated, collectionFetchRelated, fetchRelatedOrNothing, maybeFetchRelatedOrNothing) where

import IHP.Prelude
import Database.PostgreSQL.Simple.ToField
import qualified Database.PostgreSQL.Simple as PG
import qualified Database.PostgreSQL.Simple.Types as PG
import IHP.ModelSupport (Include, Id', PrimaryKey, GetModelByTableName)
import IHP.QueryBuilder
import IHP.Fetch

-- | This class provides the collectionFetchRelated function
--
-- This function is provided by this class as we have to deal with two cases:
-- 
-- 1. the related field is a id, e.g. like the company ids in @users |> collectionFetchRelated #companyId@
-- 2. the related field is a query builder, e.g. in @posts |> collectionFetchRelated #comments@
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]

-- | Provides collectionFetchRelated for ids, e.g. @collectionFetchRelated #companyId@
--
-- When we want to fetch all the users with their companies, we can use collectionFetchRelated like this:
--
-- > users <- query @User
-- >     |> fetch
-- >     >>= collectionFetchRelated #companyId
--
-- This will query all users with their company. The type of @users@ is @[Include "companyId" User]@.
--
-- This example will trigger only two SQL queries:
-- 
-- > SELECT * FROM users
-- > SELECT * FROM companies WHERE id IN (?)
instance (
        Eq (PrimaryKey tableName)
        , ToField (PrimaryKey tableName)
        , Show (PrimaryKey tableName)
        , HasField "id" relatedModel (Id' tableName)
        , relatedModel ~ GetModelByTableName (GetTableName 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
        ) => Proxy relatedField -> [model] -> IO [Include relatedField model]
    collectionFetchRelated :: Proxy relatedField -> [model] -> IO [Include relatedField model]
collectionFetchRelated Proxy relatedField
relatedField [model]
model = do
        [relatedModel]
relatedModels :: [relatedModel] <- forall model (table :: Symbol).
(table ~ GetTableName model, DefaultScope table) =>
QueryBuilder table
forall (table :: Symbol).
(table ~ GetTableName relatedModel, DefaultScope table) =>
QueryBuilder table
query @relatedModel QueryBuilder (GetTableName relatedModel)
-> (QueryBuilder (GetTableName relatedModel)
    -> QueryBuilder (GetTableName relatedModel))
-> QueryBuilder (GetTableName relatedModel)
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Proxy "id", [Id' tableName])
-> QueryBuilder (GetTableName relatedModel)
-> QueryBuilder (GetTableName relatedModel)
forall (name :: Symbol) (table :: Symbol) model value.
(KnownSymbol name, ToField value, HasField name model value,
 model ~ GetModelByTableName table) =>
(Proxy name, [value]) -> QueryBuilder table -> QueryBuilder table
filterWhereIn (IsLabel "id" (Proxy "id")
Proxy "id"
#id, (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 r a. HasField relatedField r a => r -> a
getField @relatedField) [model]
model) QueryBuilder (GetTableName relatedModel)
-> (QueryBuilder (GetTableName relatedModel) -> IO [relatedModel])
-> IO [relatedModel]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> QueryBuilder (GetTableName relatedModel) -> IO [relatedModel]
forall fetchable model.
(Fetchable fetchable model, KnownSymbol (GetTableName 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 -> Id' tableName
forall k (x :: k) r a. HasField x r a => r -> a
getField @"id" relatedModel
r :: Id' tableName) 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 = (model -> Id' tableName
forall k (x :: k) r a. HasField x r a => r -> a
getField @relatedField model
model :: Id' tableName)
                in
                    relatedModel -> model -> Include relatedField model
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 (f :: * -> *) a. Applicative f => a -> f a
pure [Include relatedField model]
result

-- | Provides collectionFetchRelated for QueryBuilder's, e.g. @collectionFetchRelated #comments@
--
-- When we want to fetch all the comments for a list of posts, we can use collectionFetchRelated like this:
--
-- > posts <- query @Post
-- >     |> fetch
-- >     >>= collectionFetchRelated #comments
--
-- This will query all posts with their comments. The type of @posts@ is @[Include "comments" Post]@.
--
-- When fetching query builders, currently the implementation is not very efficient. E.g. given 10 Posts above, it will run 10 queries to fetch the comments. We should optimise this behavior in the future.
instance (relatedModel ~ GetModelByTableName relatedTable) => 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 :: 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 = model -> QueryBuilder relatedTable
forall k (x :: k) 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, KnownSymbol (GetTableName model),
 FromRow model, ?modelContext::ModelContext) =>
fetchable -> IO (FetchResult fetchable model)
fetch QueryBuilder relatedTable
queryBuilder
                Include relatedField model -> IO (Include relatedField model)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([relatedModel] -> model -> Include relatedField model
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)
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
    ) => Proxy field -> model -> IO (Include field model)
fetchRelated :: Proxy field -> model -> IO (Include field model)
fetchRelated Proxy field
relatedField model
model = do
    result :: FetchResult fieldValue fetchModel <- fieldValue -> IO (FetchResult fieldValue fetchModel)
forall fetchable model.
(Fetchable fetchable model, KnownSymbol (GetTableName model),
 FromRow model, ?modelContext::ModelContext) =>
fetchable -> IO (FetchResult fetchable model)
fetch ((model -> fieldValue
forall k (x :: k) r a. HasField x r a => r -> a
getField @field model
model) :: fieldValue)
    let model' :: Include field model
model' = FetchResult fieldValue fetchModel -> model -> Include field 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 (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
    ) => Proxy field -> model -> IO (Include field model)
fetchRelatedOrNothing :: Proxy field -> model -> IO (Include field model)
fetchRelatedOrNothing Proxy field
relatedField model
model = do
    result :: Maybe (FetchResult fieldValue fetchModel) <- case model -> Maybe fieldValue
forall k (x :: k) 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, KnownSymbol (GetTableName 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 (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (FetchResult fieldValue fetchModel)
forall a. Maybe a
Nothing
    let model' :: Include field model
model' = Maybe (FetchResult fieldValue fetchModel)
-> model -> Include field 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 (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
    ) => Proxy field -> Maybe model -> IO (Maybe (Include field model))
maybeFetchRelatedOrNothing :: 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 (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) =>
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Include field model) -> IO (Maybe (Include field model))
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 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 #-}