{-# 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