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

import qualified Data.HashMap.Lazy as HM
import Data.Morpheus.App.Internal.Resolving.Resolver (LiftOperation, Resolver, getArgument)
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 = forall (m :: * -> *). TypeName -> ResolverValue m
mkEnum

list :: [ResolverValue m] -> ResolverValue m
list :: forall (m :: * -> *). [ResolverValue m] -> ResolverValue m
list = 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 = forall (m :: * -> *). m NamedResolverRef -> ResolverValue m
ResRef forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> ValidValue -> NamedResolverRef
NamedResolverRef TypeName
typeName

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

type NamedResolverFunction o e m = ValidValue -> Resolver o e m (ResultBuilder o e m)

-- types
object :: (LiftOperation o, Monad m) => [(FieldName, Resolver o e m (ResolverValue (Resolver o e m)))] -> Resolver o e m (ResultBuilder o e m)
object :: forall (o :: OperationType) (m :: * -> *) e.
(LiftOperation o, Monad m) =>
[(FieldName, Resolver o e m (ResolverValue (Resolver o e m)))]
-> Resolver o e m (ResultBuilder o e m)
object = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (o :: OperationType) e (m :: * -> *).
[(FieldName, Resolver o e m (ResolverValue (Resolver o e m)))]
-> ResultBuilder o e m
Object

variant :: (LiftOperation o, Monad m) => TypeName -> ValidValue -> Resolver o e m (ResultBuilder o e m)
variant :: forall (o :: OperationType) (m :: * -> *) e.
(LiftOperation o, Monad m) =>
TypeName -> ValidValue -> Resolver o e m (ResultBuilder o e m)
variant TypeName
tName = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (o :: OperationType) e (m :: * -> *).
TypeName -> ValidValue -> ResultBuilder o e m
Union TypeName
tName

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

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

mkResolverMap :: (LiftOperation o, Monad m) => [(TypeName, NamedResolverFunction o e m)] -> ResolverMap (Resolver o e m)
mkResolverMap :: forall (o :: OperationType) (m :: * -> *) e.
(LiftOperation o, Monad m) =>
[(TypeName, NamedResolverFunction o e m)]
-> ResolverMap (Resolver o e m)
mkResolverMap = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (o :: OperationType) (m :: * -> *) e.
(LiftOperation o, Monad m) =>
(TypeName, ValidValue -> Resolver o e m (ResultBuilder o e m))
-> (TypeName, NamedResolver (Resolver o e m))
packRes
  where
    packRes :: (LiftOperation o, Monad m) => (TypeName, ValidValue -> Resolver o e m (ResultBuilder o e m)) -> (TypeName, NamedResolver (Resolver o e m))
    packRes :: forall (o :: OperationType) (m :: * -> *) e.
(LiftOperation o, Monad m) =>
(TypeName, ValidValue -> Resolver o e m (ResultBuilder o e m))
-> (TypeName, NamedResolver (Resolver o e m))
packRes (TypeName
typeName, ValidValue -> Resolver o e m (ResultBuilder o e m)
value) =
      ( TypeName
typeName,
        forall (m :: * -> *).
TypeName
-> (ValidValue -> m (NamedResolverResult m)) -> NamedResolver m
NamedResolver
          TypeName
typeName
          ( forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {o :: OperationType} {e} {m :: * -> *}.
ResultBuilder o e m -> NamedResolverResult (Resolver o e m)
mapValue
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidValue -> Resolver o e m (ResultBuilder o e m)
value
          )
      )
      where
        mapValue :: ResultBuilder o e m -> NamedResolverResult (Resolver o e m)
mapValue (Object [(FieldName, Resolver o e m (ResolverValue (Resolver o e m)))]
x) = forall (m :: * -> *). ObjectTypeResolver m -> NamedResolverResult m
NamedObjectResolver (forall (m :: * -> *).
HashMap FieldName (m (ResolverValue m)) -> ObjectTypeResolver m
ObjectTypeResolver forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(FieldName, Resolver o e m (ResolverValue (Resolver o e m)))]
x)
        mapValue (Union TypeName
name ValidValue
x) = forall (m :: * -> *). NamedResolverRef -> NamedResolverResult m
NamedUnionResolver (TypeName -> ValidValue -> NamedResolverRef
NamedResolverRef TypeName
name ValidValue
x)