{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.App.Internal.Resolving.Utils
  ( ResolverValue (..),
    requireObject,
    NamedResolverRef (..),
    ObjectTypeResolver,
    lookupResJSON,
    mkValue,
  )
where

import Control.Monad.Except (MonadError (throwError))
import qualified Data.Aeson as A
import Data.Morpheus.App.Internal.Resolving.Types
  ( NamedResolverRef (..),
    ObjectTypeResolver (..),
    ResolverValue (..),
    mkList,
    mkNull,
    mkObjectMaybe,
  )
import Data.Morpheus.Internal.Utils (selectOr, toAssoc)
import qualified Data.Morpheus.Internal.Utils as U
import Data.Morpheus.Types.Internal.AST
  ( FieldName,
    GQLError,
    ScalarValue (..),
    TypeName,
    decodeScientific,
    internal,
    packName,
    unpackName,
  )
import qualified Data.Vector as V
import Relude

lookupResJSON :: (MonadError GQLError f, Monad m) => FieldName -> A.Value -> f (ObjectTypeResolver m)
lookupResJSON :: forall (f :: * -> *) (m :: * -> *).
(MonadError GQLError f, Monad m) =>
FieldName -> Value -> f (ObjectTypeResolver m)
lookupResJSON FieldName
name (A.Object Object
fields) =
  forall k (c :: * -> *) d a.
IsMap k c =>
d -> (a -> d) -> k -> c a -> d
selectOr
    forall (m :: * -> *) (a :: * -> *).
Monad m =>
m (ObjectTypeResolver a)
mkEmptyObject
    (forall (f :: * -> *) (m :: * -> *).
MonadError GQLError f =>
ResolverValue m -> f (ObjectTypeResolver m)
requireObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Monad m => Value -> ResolverValue m
mkValue)
    (forall a (t :: NAME). NamePacking a => Name t -> a
unpackName FieldName
name)
    Object
fields
lookupResJSON FieldName
_ Value
_ = forall (m :: * -> *) (a :: * -> *).
Monad m =>
m (ObjectTypeResolver a)
mkEmptyObject

mkEmptyObject :: Monad m => m (ObjectTypeResolver a)
mkEmptyObject :: forall (m :: * -> *) (a :: * -> *).
Monad m =>
m (ObjectTypeResolver a)
mkEmptyObject = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
HashMap FieldName (m (ResolverValue m)) -> ObjectTypeResolver m
ObjectTypeResolver forall a. Monoid a => a
mempty

mkValue ::
  (Monad m) =>
  A.Value ->
  ResolverValue m
mkValue :: forall (m :: * -> *). Monad m => Value -> ResolverValue m
mkValue (A.Object Object
v) =
  forall (m :: * -> *).
Maybe TypeName -> [ResolverEntry m] -> ResolverValue m
mkObjectMaybe
    (forall k (m :: * -> *) a. IsMap k m => k -> m a -> Maybe a
U.lookup Key
"__typename" Object
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe TypeName
unpackJSONName)
    forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a (t :: NAME). NamePacking a => a -> Name t
packName (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Monad m => Value -> ResolverValue m
mkValue))
      (forall k (m :: * -> *) a. IsMap k m => m a -> [(k, a)]
toAssoc Object
v)
mkValue (A.Array Array
ls) = forall (m :: * -> *). [ResolverValue m] -> ResolverValue m
mkList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *). Monad m => Value -> ResolverValue m
mkValue (forall a. Vector a -> [a]
V.toList Array
ls))
mkValue Value
A.Null = forall (m :: * -> *). ResolverValue m
mkNull
mkValue (A.Number Scientific
x) = forall (m :: * -> *). ScalarValue -> ResolverValue m
ResScalar (Scientific -> ScalarValue
decodeScientific Scientific
x)
mkValue (A.String Text
x) = forall (m :: * -> *). ScalarValue -> ResolverValue m
ResScalar (Text -> ScalarValue
String Text
x)
mkValue (A.Bool Bool
x) = forall (m :: * -> *). ScalarValue -> ResolverValue m
ResScalar (Bool -> ScalarValue
Boolean Bool
x)

requireObject :: MonadError GQLError f => ResolverValue m -> f (ObjectTypeResolver m)
requireObject :: forall (f :: * -> *) (m :: * -> *).
MonadError GQLError f =>
ResolverValue m -> f (ObjectTypeResolver m)
requireObject (ResObject Maybe TypeName
_ ObjectTypeResolver m
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ObjectTypeResolver m
x
requireObject ResolverValue m
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> GQLError
internal GQLError
"resolver must be an object")

unpackJSONName :: A.Value -> Maybe TypeName
unpackJSONName :: Value -> Maybe TypeName
unpackJSONName (A.String Text
x) = forall a. a -> Maybe a
Just (forall a (t :: NAME). NamePacking a => a -> Name t
packName Text
x)
unpackJSONName Value
_ = forall a. Maybe a
Nothing