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

module Data.Morpheus.App.Internal.Resolving
  ( Resolver,
    LiftOperation,
    runRootResolverValue,
    lift,
    Eventless,
    Failure (..),
    ResponseEvent (..),
    ResponseStream,
    cleanEvents,
    Result (..),
    ResultT (..),
    unpackEvents,
    ResolverObject (..),
    ResolverValue (..),
    WithOperation,
    PushEvents (..),
    subscribe,
    ResolverContext (..),
    unsafeInternalContext,
    RootResolverValue (..),
    resultOr,
    withArguments,
    -- Dynamic Resolver
    mkBoolean,
    mkFloat,
    mkInt,
    mkEnum,
    mkList,
    mkUnion,
    mkObject,
    mkNull,
    mkString,
    SubscriptionField (..),
    getArguments,
    ResolverState,
    liftResolverState,
    mkValue,
    ResolverEntry,
    sortErrors,
    EventHandler (..),
  )
where

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

mkString :: Token -> ResolverValue m
mkString :: Token -> ResolverValue m
mkString = ScalarValue -> ResolverValue m
forall (m :: * -> *). ScalarValue -> ResolverValue m
ResScalar (ScalarValue -> ResolverValue m)
-> (Token -> ScalarValue) -> Token -> ResolverValue m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> ScalarValue
String

mkFloat :: Double -> ResolverValue m
mkFloat :: Double -> ResolverValue m
mkFloat = ScalarValue -> ResolverValue m
forall (m :: * -> *). ScalarValue -> ResolverValue m
ResScalar (ScalarValue -> ResolverValue m)
-> (Double -> ScalarValue) -> Double -> ResolverValue m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ScalarValue
Float

mkInt :: Int -> ResolverValue m
mkInt :: Int -> ResolverValue m
mkInt = ScalarValue -> ResolverValue m
forall (m :: * -> *). ScalarValue -> ResolverValue m
ResScalar (ScalarValue -> ResolverValue m)
-> (Int -> ScalarValue) -> Int -> ResolverValue m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ScalarValue
Int

mkBoolean :: Bool -> ResolverValue m
mkBoolean :: Bool -> ResolverValue m
mkBoolean = ScalarValue -> ResolverValue m
forall (m :: * -> *). ScalarValue -> ResolverValue m
ResScalar (ScalarValue -> ResolverValue m)
-> (Bool -> ScalarValue) -> Bool -> ResolverValue m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ScalarValue
Boolean

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

mkNull :: ResolverValue m
mkNull :: ResolverValue m
mkNull = ResolverValue m
forall (m :: * -> *). ResolverValue m
ResNull

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

mkValue ::
  (Monad m) =>
  A.Value ->
  ResolverValue m
mkValue :: Value -> ResolverValue m
mkValue (A.Object Object
v) =
  TypeName -> [ResolverEntry m] -> ResolverValue m
forall (m :: * -> *).
TypeName -> [ResolverEntry m] -> ResolverValue 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)
    ([ResolverEntry m] -> ResolverValue m)
-> [ResolverEntry m] -> ResolverValue m
forall a b. (a -> b) -> a -> b
$ ((Token, Value) -> ResolverEntry m)
-> [(Token, Value)] -> [ResolverEntry m]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ((Token -> FieldName)
-> (Value -> m (ResolverValue m))
-> (Token, Value)
-> ResolverEntry m
forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
mapTuple Token -> FieldName
FieldName (ResolverValue m -> m (ResolverValue m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResolverValue m -> m (ResolverValue m))
-> (Value -> ResolverValue m) -> Value -> m (ResolverValue m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ResolverValue m
forall (m :: * -> *). Monad m => Value -> ResolverValue m
mkValue))
      (Object -> [(Token, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Object
v)
mkValue (A.Array Array
ls) = [ResolverValue m] -> ResolverValue m
forall (m :: * -> *). [ResolverValue m] -> ResolverValue m
mkList ((Value -> ResolverValue m) -> [Value] -> [ResolverValue m]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> ResolverValue m
forall (m :: * -> *). Monad m => Value -> ResolverValue m
mkValue (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
ls))
mkValue Value
A.Null = ResolverValue m
forall (m :: * -> *). ResolverValue m
mkNull
mkValue (A.Number Scientific
x) = ScalarValue -> ResolverValue m
forall (m :: * -> *). ScalarValue -> ResolverValue m
ResScalar (Scientific -> ScalarValue
decodeScientific Scientific
x)
mkValue (A.String Token
x) = ScalarValue -> ResolverValue m
forall (m :: * -> *). ScalarValue -> ResolverValue m
ResScalar (Token -> ScalarValue
String Token
x)
mkValue (A.Bool Bool
x) = ScalarValue -> ResolverValue m
forall (m :: * -> *). ScalarValue -> ResolverValue m
ResScalar (Bool -> ScalarValue
Boolean Bool
x)