{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}

module Data.Morpheus.App.NamedResolvers
  ( ref,
    object,
    variant,
    list,
    refs,
    enum,
    queryResolvers,
    getArgument,
    NamedResolverFunction,
    RootResolverValue,
    ResultBuilder,
    nullRes,
  )
where

import qualified Data.HashMap.Lazy as HM
import Data.Morpheus.App.Internal.Resolving.MonadResolver
  ( MonadResolver,
    getArgument,
  )
import Data.Morpheus.App.Internal.Resolving.Resolver (Resolver)
import Data.Morpheus.App.Internal.Resolving.RootResolverValue (RootResolverValue (..))
import Data.Morpheus.App.Internal.Resolving.Types
  ( NamedResolver (..),
    NamedResolverRef (..),
    NamedResolverResult (..),
    ObjectTypeResolver (..),
    ResolverMap,
    ResolverValue (..),
    mkEnum,
    mkList,
  )
import Data.Morpheus.Types.Internal.AST
  ( FieldName,
    QUERY,
    TypeName,
    ValidValue,
  )

-- PUBLIC

-- fields
enum :: TypeName -> ResolverValue m
enum :: forall (m :: * -> *). TypeName -> ResolverValue m
enum = TypeName -> ResolverValue m
forall (m :: * -> *). TypeName -> ResolverValue m
mkEnum

list :: [ResolverValue m] -> ResolverValue m
list :: forall (m :: * -> *). [ResolverValue m] -> ResolverValue m
list = [ResolverValue m] -> ResolverValue m
forall (m :: * -> *). [ResolverValue m] -> ResolverValue m
mkList

ref :: Applicative m => TypeName -> ValidValue -> ResolverValue m
ref :: forall (m :: * -> *).
Applicative m =>
TypeName -> ValidValue -> ResolverValue m
ref TypeName
typeName = m NamedResolverRef -> ResolverValue m
forall (m :: * -> *). m NamedResolverRef -> ResolverValue m
ResRef (m NamedResolverRef -> ResolverValue m)
-> (ValidValue -> m NamedResolverRef)
-> ValidValue
-> ResolverValue m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedResolverRef -> m NamedResolverRef
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedResolverRef -> m NamedResolverRef)
-> (ValidValue -> NamedResolverRef)
-> ValidValue
-> m NamedResolverRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> NamedResolverArg -> NamedResolverRef
NamedResolverRef TypeName
typeName (NamedResolverArg -> NamedResolverRef)
-> (ValidValue -> NamedResolverArg)
-> ValidValue
-> NamedResolverRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidValue -> NamedResolverArg
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

refs :: Applicative m => TypeName -> [ValidValue] -> ResolverValue m
refs :: forall (m :: * -> *).
Applicative m =>
TypeName -> NamedResolverArg -> ResolverValue m
refs TypeName
typeName = [ResolverValue m] -> ResolverValue m
forall (m :: * -> *). [ResolverValue m] -> ResolverValue m
mkList ([ResolverValue m] -> ResolverValue m)
-> (NamedResolverArg -> [ResolverValue m])
-> NamedResolverArg
-> ResolverValue m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidValue -> ResolverValue m)
-> NamedResolverArg -> [ResolverValue m]
forall a b. (a -> b) -> [a] -> [b]
map (TypeName -> ValidValue -> ResolverValue m
forall (m :: * -> *).
Applicative m =>
TypeName -> ValidValue -> ResolverValue m
ref TypeName
typeName)

type NamedResolverFunction o e m = NamedFunction (Resolver o e m)

type NamedFunction m = [ValidValue] -> m [ResultBuilder m]

-- types
object :: (MonadResolver m) => [(FieldName, m (ResolverValue m))] -> m (ResultBuilder m)
object :: forall (m :: * -> *).
MonadResolver m =>
[(FieldName, m (ResolverValue m))] -> m (ResultBuilder m)
object = ResultBuilder m -> m (ResultBuilder m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResultBuilder m -> m (ResultBuilder m))
-> ([(FieldName, m (ResolverValue m))] -> ResultBuilder m)
-> [(FieldName, m (ResolverValue m))]
-> m (ResultBuilder m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FieldName, m (ResolverValue m))] -> ResultBuilder m
forall (m :: * -> *).
[(FieldName, m (ResolverValue m))] -> ResultBuilder m
Object

variant :: (MonadResolver m) => TypeName -> ValidValue -> m (ResultBuilder m)
variant :: forall (m :: * -> *).
MonadResolver m =>
TypeName -> ValidValue -> m (ResultBuilder m)
variant TypeName
tName = ResultBuilder m -> m (ResultBuilder m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResultBuilder m -> m (ResultBuilder m))
-> (ValidValue -> ResultBuilder m)
-> ValidValue
-> m (ResultBuilder m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> ValidValue -> ResultBuilder m
forall (m :: * -> *). TypeName -> ValidValue -> ResultBuilder m
Union TypeName
tName

nullRes :: (MonadResolver m) => m (ResultBuilder m)
nullRes :: forall (m :: * -> *). MonadResolver m => m (ResultBuilder m)
nullRes = ResultBuilder m -> m (ResultBuilder m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultBuilder m
forall (m :: * -> *). ResultBuilder m
Null

queryResolvers :: Monad m => [(TypeName, NamedFunction (Resolver QUERY e m))] -> RootResolverValue e m
queryResolvers :: forall (m :: * -> *) e.
Monad m =>
[(TypeName, NamedFunction (Resolver QUERY e m))]
-> RootResolverValue e m
queryResolvers = ResolverMap (Resolver QUERY e m) -> RootResolverValue e m
forall e (m :: * -> *).
ResolverMap (Resolver QUERY e m) -> RootResolverValue e m
NamedResolversValue (ResolverMap (Resolver QUERY e m) -> RootResolverValue e m)
-> ([(TypeName, NamedFunction (Resolver QUERY e m))]
    -> ResolverMap (Resolver QUERY e m))
-> [(TypeName, NamedFunction (Resolver QUERY e m))]
-> RootResolverValue e m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TypeName, NamedFunction (Resolver QUERY e m))]
-> ResolverMap (Resolver QUERY e m)
forall (m :: * -> *).
MonadResolver m =>
[(TypeName, NamedFunction m)] -> ResolverMap m
mkResolverMap

-- INTERNAL
data ResultBuilder m
  = Object [(FieldName, m (ResolverValue m))]
  | Union TypeName ValidValue
  | Null

mkResolverMap :: MonadResolver m => [(TypeName, NamedFunction m)] -> ResolverMap m
mkResolverMap :: forall (m :: * -> *).
MonadResolver m =>
[(TypeName, NamedFunction m)] -> ResolverMap m
mkResolverMap = [(TypeName, NamedResolver m)] -> HashMap TypeName (NamedResolver m)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(TypeName, NamedResolver m)]
 -> HashMap TypeName (NamedResolver m))
-> ([(TypeName, NamedFunction m)] -> [(TypeName, NamedResolver m)])
-> [(TypeName, NamedFunction m)]
-> HashMap TypeName (NamedResolver m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TypeName, NamedFunction m) -> (TypeName, NamedResolver m))
-> [(TypeName, NamedFunction m)] -> [(TypeName, NamedResolver m)]
forall a b. (a -> b) -> [a] -> [b]
map (TypeName, NamedFunction m) -> (TypeName, NamedResolver m)
forall (m :: * -> *).
MonadResolver m =>
(TypeName, NamedFunction m) -> (TypeName, NamedResolver m)
packRes
  where
    packRes :: MonadResolver m => (TypeName, NamedFunction m) -> (TypeName, NamedResolver m)
    packRes :: forall (m :: * -> *).
MonadResolver m =>
(TypeName, NamedFunction m) -> (TypeName, NamedResolver m)
packRes (TypeName
typeName, NamedFunction m
f) = (TypeName
typeName, TypeName -> NamedResolverFun m -> NamedResolver m
forall (m :: * -> *).
TypeName -> NamedResolverFun m -> NamedResolver m
NamedResolver TypeName
typeName (([ResultBuilder m] -> [NamedResolverResult m])
-> m [ResultBuilder m] -> m [NamedResolverResult m]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ResultBuilder m -> NamedResolverResult m)
-> [ResultBuilder m] -> [NamedResolverResult m]
forall a b. (a -> b) -> [a] -> [b]
map ResultBuilder m -> NamedResolverResult m
forall {m :: * -> *}. ResultBuilder m -> NamedResolverResult m
mapValue) (m [ResultBuilder m] -> m [NamedResolverResult m])
-> NamedFunction m -> NamedResolverFun m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedFunction m
f))
      where
        mapValue :: ResultBuilder m -> NamedResolverResult m
mapValue (Object [(FieldName, m (ResolverValue m))]
x) = ObjectTypeResolver m -> NamedResolverResult m
forall (m :: * -> *). ObjectTypeResolver m -> NamedResolverResult m
NamedObjectResolver (HashMap FieldName (m (ResolverValue m)) -> ObjectTypeResolver m
forall (m :: * -> *).
HashMap FieldName (m (ResolverValue m)) -> ObjectTypeResolver m
ObjectTypeResolver (HashMap FieldName (m (ResolverValue m)) -> ObjectTypeResolver m)
-> HashMap FieldName (m (ResolverValue m)) -> ObjectTypeResolver m
forall a b. (a -> b) -> a -> b
$ [(FieldName, m (ResolverValue m))]
-> HashMap FieldName (m (ResolverValue m))
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(FieldName, m (ResolverValue m))]
x)
        mapValue (Union TypeName
name ValidValue
x) = NamedResolverRef -> NamedResolverResult m
forall (m :: * -> *). NamedResolverRef -> NamedResolverResult m
NamedUnionResolver (TypeName -> NamedResolverArg -> NamedResolverRef
NamedResolverRef TypeName
name [ValidValue
x])
        mapValue ResultBuilder m
Null = NamedResolverResult m
forall (m :: * -> *). NamedResolverResult m
NamedNullResolver