{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Types.Internal.Resolving
  ( Resolver,
    LiftOperation,
    runRootResModel,
    lift,
    Eventless,
    Failure (..),
    ResponseEvent (..),
    ResponseStream,
    cleanEvents,
    Result (..),
    ResultT (..),
    unpackEvents,
    ObjectResModel (..),
    ResModel (..),
    WithOperation,
    PushEvents (..),
    subscribe,
    ResolverContext (..),
    unsafeInternalContext,
    RootResModel (..),
    resultOr,
    withArguments,
    -- Dynamic Resolver
    mkBoolean,
    mkFloat,
    mkInt,
    mkEnum,
    mkList,
    mkUnion,
    mkObject,
    mkNull,
    mkString,
    SubscriptionField (..),
    getArguments,
    ResolverState,
    liftResolverState,
    mkValue,
    FieldResModel,
    sortErrors,
    EventHandler (..),
  )
where

import qualified Data.Aeson as A
import qualified Data.HashMap.Lazy as HM
import Data.Morpheus.Internal.Utils
  ( mapTuple,
  )
import Data.Morpheus.Types.Internal.AST
  ( FieldName (..),
    ScalarValue (..),
    Token,
    TypeName (..),
    decodeScientific,
  )
import Data.Morpheus.Types.Internal.Resolving.Core
import Data.Morpheus.Types.Internal.Resolving.Event
import Data.Morpheus.Types.Internal.Resolving.Resolver
import Data.Morpheus.Types.Internal.Resolving.ResolverState
import qualified Data.Vector as V
  ( toList,
  )
import Relude

mkString :: Token -> ResModel o e m
mkString :: Token -> ResModel o e m
mkString = ScalarValue -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *).
ScalarValue -> ResModel o e m
ResScalar (ScalarValue -> ResModel o e m)
-> (Token -> ScalarValue) -> Token -> ResModel o e m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> ScalarValue
String

mkFloat :: Float -> ResModel o e m
mkFloat :: Float -> ResModel o e m
mkFloat = ScalarValue -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *).
ScalarValue -> ResModel o e m
ResScalar (ScalarValue -> ResModel o e m)
-> (Float -> ScalarValue) -> Float -> ResModel o e m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> ScalarValue
Float

mkInt :: Int -> ResModel o e m
mkInt :: Int -> ResModel o e m
mkInt = ScalarValue -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *).
ScalarValue -> ResModel o e m
ResScalar (ScalarValue -> ResModel o e m)
-> (Int -> ScalarValue) -> Int -> ResModel o e m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ScalarValue
Int

mkBoolean :: Bool -> ResModel o e m
mkBoolean :: Bool -> ResModel o e m
mkBoolean = ScalarValue -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *).
ScalarValue -> ResModel o e m
ResScalar (ScalarValue -> ResModel o e m)
-> (Bool -> ScalarValue) -> Bool -> ResModel o e m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ScalarValue
Boolean

mkEnum :: TypeName -> TypeName -> ResModel o e m
mkEnum :: TypeName -> TypeName -> ResModel o e m
mkEnum = TypeName -> TypeName -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *).
TypeName -> TypeName -> ResModel o e m
ResEnum

mkList :: [ResModel o e m] -> ResModel o e m
mkList :: [ResModel o e m] -> ResModel o e m
mkList = [ResModel o e m] -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *).
[ResModel o e m] -> ResModel o e m
ResList

mkUnion :: TypeName -> Resolver o e m (ResModel o e m) -> ResModel o e m
mkUnion :: TypeName -> Resolver o e m (ResModel o e m) -> ResModel o e m
mkUnion = TypeName -> Resolver o e m (ResModel o e m) -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *).
TypeName -> Resolver o e m (ResModel o e m) -> ResModel o e m
ResUnion

mkNull :: ResModel o e m
mkNull :: ResModel o e m
mkNull = ResModel o e m
forall (o :: OperationType) e (m :: * -> *). ResModel o e m
ResNull

unPackName :: A.Value -> TypeName
unPackName :: Value -> TypeName
unPackName (A.String Token
x) = Token -> TypeName
TypeName Token
x
unPackName Value
_ = TypeName
"__JSON__"

mkValue ::
  (LiftOperation o, Monad m) =>
  A.Value ->
  ResModel o e m
mkValue :: Value -> ResModel o e m
mkValue (A.Object Object
v) =
  TypeName
-> [(FieldName, Resolver o e m (ResModel o e m))] -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *).
TypeName
-> [(FieldName, Resolver o e m (ResModel o e m))] -> ResModel o e m
mkObject
    (TypeName -> (Value -> TypeName) -> Maybe Value -> TypeName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TypeName
"__JSON__" Value -> TypeName
unPackName (Maybe Value -> TypeName) -> Maybe Value -> TypeName
forall a b. (a -> b) -> a -> b
$ Token -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Token
"__typename" Object
v)
    ([(FieldName, Resolver o e m (ResModel o e m))] -> ResModel o e m)
-> [(FieldName, Resolver o e m (ResModel o e m))] -> ResModel o e m
forall a b. (a -> b) -> a -> b
$ ((Token, Value) -> (FieldName, Resolver o e m (ResModel o e m)))
-> [(Token, Value)]
-> [(FieldName, Resolver o e m (ResModel o e m))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ((Token -> FieldName)
-> (Value -> Resolver o e m (ResModel o e m))
-> (Token, Value)
-> (FieldName, Resolver o e m (ResModel o e m))
forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
mapTuple Token -> FieldName
FieldName (ResModel o e m -> Resolver o e m (ResModel o e m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResModel o e m -> Resolver o e m (ResModel o e m))
-> (Value -> ResModel o e m)
-> Value
-> Resolver o e m (ResModel o e m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ResModel o e m
forall (o :: OperationType) (m :: * -> *) e.
(LiftOperation o, Monad m) =>
Value -> ResModel o e m
mkValue))
      (Object -> [(Token, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Object
v)
mkValue (A.Array Array
ls) = [ResModel o e m] -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *).
[ResModel o e m] -> ResModel o e m
mkList ((Value -> ResModel o e m) -> [Value] -> [ResModel o e m]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> ResModel o e m
forall (o :: OperationType) (m :: * -> *) e.
(LiftOperation o, Monad m) =>
Value -> ResModel o e m
mkValue (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
ls))
mkValue Value
A.Null = ResModel o e m
forall (o :: OperationType) e (m :: * -> *). ResModel o e m
mkNull
mkValue (A.Number Scientific
x) = ScalarValue -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *).
ScalarValue -> ResModel o e m
ResScalar (Scientific -> ScalarValue
decodeScientific Scientific
x)
mkValue (A.String Token
x) = ScalarValue -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *).
ScalarValue -> ResModel o e m
ResScalar (Token -> ScalarValue
String Token
x)
mkValue (A.Bool Bool
x) = ScalarValue -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *).
ScalarValue -> ResModel o e m
ResScalar (Bool -> ScalarValue
Boolean Bool
x)

type FieldResModel o e m = (FieldName, Resolver o e m (ResModel o e m))

mkObject ::
  TypeName ->
  [(FieldName, Resolver o e m (ResModel o e m))] ->
  ResModel o e m
mkObject :: TypeName
-> [(FieldName, Resolver o e m (ResModel o e m))] -> ResModel o e m
mkObject TypeName
__typename [(FieldName, Resolver o e m (ResModel o e m))]
fields =
  ObjectResModel o e m -> ResModel o e m
forall (o :: OperationType) e (m :: * -> *).
ObjectResModel o e m -> ResModel o e m
ResObject
    ( ObjectResModel :: forall (o :: OperationType) e (m :: * -> *).
TypeName
-> HashMap FieldName (Resolver o e m (ResModel o e m))
-> ObjectResModel o e m
ObjectResModel
        { TypeName
__typename :: TypeName
__typename :: TypeName
__typename,
          objectFields :: HashMap FieldName (Resolver o e m (ResModel o e m))
objectFields = [(FieldName, Resolver o e m (ResModel o e m))]
-> HashMap FieldName (Resolver o e m (ResModel o e m))
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(FieldName, Resolver o e m (ResModel o e m))]
fields
        }
    )