{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.Client.Transform.Core ( Converter (..), compileError, getType, leafType, typeFrom, deprecationWarning, customScalarTypes, UpdateT (..), resolveUpdates, ) where import Control.Monad.Except (MonadError (throwError)) import Data.Morpheus.Client.Internal.Types ( ClientTypeDefinition (..), ) import Data.Morpheus.CodeGen.Internal.TH ( camelCaseTypeName, ) import Data.Morpheus.Error ( deprecatedField, ) import Data.Morpheus.Internal.Ext ( GQLResult, Result (..), ) import Data.Morpheus.Internal.Utils ( selectBy, ) import Data.Morpheus.Types.Internal.AST ( ANY, Directives, FieldName, GQLError, RAW, Ref (..), Schema (..), TRUE, TypeContent (..), TypeDefinition (..), TypeName, VALID, VariableDefinitions, internal, isNotSystemTypeName, lookupDeprecated, lookupDeprecatedReason, msg, typeDefinitions, ) import Relude type Env = (Schema VALID, VariableDefinitions RAW) newtype Converter a = Converter { Converter a -> ReaderT Env GQLResult a runConverter :: ReaderT Env GQLResult a } deriving ( a -> Converter b -> Converter a (a -> b) -> Converter a -> Converter b (forall a b. (a -> b) -> Converter a -> Converter b) -> (forall a b. a -> Converter b -> Converter a) -> Functor Converter forall a b. a -> Converter b -> Converter a forall a b. (a -> b) -> Converter a -> Converter b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: a -> Converter b -> Converter a $c<$ :: forall a b. a -> Converter b -> Converter a fmap :: (a -> b) -> Converter a -> Converter b $cfmap :: forall a b. (a -> b) -> Converter a -> Converter b Functor, Functor Converter a -> Converter a Functor Converter -> (forall a. a -> Converter a) -> (forall a b. Converter (a -> b) -> Converter a -> Converter b) -> (forall a b c. (a -> b -> c) -> Converter a -> Converter b -> Converter c) -> (forall a b. Converter a -> Converter b -> Converter b) -> (forall a b. Converter a -> Converter b -> Converter a) -> Applicative Converter Converter a -> Converter b -> Converter b Converter a -> Converter b -> Converter a Converter (a -> b) -> Converter a -> Converter b (a -> b -> c) -> Converter a -> Converter b -> Converter c forall a. a -> Converter a forall a b. Converter a -> Converter b -> Converter a forall a b. Converter a -> Converter b -> Converter b forall a b. Converter (a -> b) -> Converter a -> Converter b forall a b c. (a -> b -> c) -> Converter a -> Converter b -> Converter c forall (f :: * -> *). Functor f -> (forall a. a -> f a) -> (forall a b. f (a -> b) -> f a -> f b) -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c) -> (forall a b. f a -> f b -> f b) -> (forall a b. f a -> f b -> f a) -> Applicative f <* :: Converter a -> Converter b -> Converter a $c<* :: forall a b. Converter a -> Converter b -> Converter a *> :: Converter a -> Converter b -> Converter b $c*> :: forall a b. Converter a -> Converter b -> Converter b liftA2 :: (a -> b -> c) -> Converter a -> Converter b -> Converter c $cliftA2 :: forall a b c. (a -> b -> c) -> Converter a -> Converter b -> Converter c <*> :: Converter (a -> b) -> Converter a -> Converter b $c<*> :: forall a b. Converter (a -> b) -> Converter a -> Converter b pure :: a -> Converter a $cpure :: forall a. a -> Converter a $cp1Applicative :: Functor Converter Applicative, Applicative Converter a -> Converter a Applicative Converter -> (forall a b. Converter a -> (a -> Converter b) -> Converter b) -> (forall a b. Converter a -> Converter b -> Converter b) -> (forall a. a -> Converter a) -> Monad Converter Converter a -> (a -> Converter b) -> Converter b Converter a -> Converter b -> Converter b forall a. a -> Converter a forall a b. Converter a -> Converter b -> Converter b forall a b. Converter a -> (a -> Converter b) -> Converter b forall (m :: * -> *). Applicative m -> (forall a b. m a -> (a -> m b) -> m b) -> (forall a b. m a -> m b -> m b) -> (forall a. a -> m a) -> Monad m return :: a -> Converter a $creturn :: forall a. a -> Converter a >> :: Converter a -> Converter b -> Converter b $c>> :: forall a b. Converter a -> Converter b -> Converter b >>= :: Converter a -> (a -> Converter b) -> Converter b $c>>= :: forall a b. Converter a -> (a -> Converter b) -> Converter b $cp1Monad :: Applicative Converter Monad, MonadReader Env, MonadError GQLError ) newtype UpdateT m a = UpdateT {UpdateT m a -> a -> m a updateTState :: a -> m a} resolveUpdates :: Monad m => a -> [UpdateT m a] -> m a resolveUpdates :: a -> [UpdateT m a] -> m a resolveUpdates a a = (a -> (a -> m a) -> m a) -> a -> [a -> m a] -> m a forall (t :: * -> *) (m :: * -> *) b a. (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b foldlM a -> (a -> m a) -> m a forall a b. a -> (a -> b) -> b (&) a a ([a -> m a] -> m a) -> ([UpdateT m a] -> [a -> m a]) -> [UpdateT m a] -> m a forall b c a. (b -> c) -> (a -> b) -> a -> c . (UpdateT m a -> a -> m a) -> [UpdateT m a] -> [a -> m a] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap UpdateT m a -> a -> m a forall (m :: * -> *) a. UpdateT m a -> a -> m a updateTState compileError :: GQLError -> GQLError compileError :: GQLError -> GQLError compileError GQLError x = GQLError -> GQLError internal (GQLError -> GQLError) -> GQLError -> GQLError forall a b. (a -> b) -> a -> b $ GQLError "Unhandled Compile Time Error: \"" GQLError -> GQLError -> GQLError forall a. Semigroup a => a -> a -> a <> GQLError x GQLError -> GQLError -> GQLError forall a. Semigroup a => a -> a -> a <> GQLError "\" ;" getType :: TypeName -> Converter (TypeDefinition ANY VALID) getType :: TypeName -> Converter (TypeDefinition ANY VALID) getType TypeName typename = (Env -> HashMap TypeName (TypeDefinition ANY VALID)) -> Converter (HashMap TypeName (TypeDefinition ANY VALID)) forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks (Schema VALID -> HashMap TypeName (TypeDefinition ANY VALID) forall (s :: Stage). Schema s -> HashMap TypeName (TypeDefinition ANY s) typeDefinitions (Schema VALID -> HashMap TypeName (TypeDefinition ANY VALID)) -> (Env -> Schema VALID) -> Env -> HashMap TypeName (TypeDefinition ANY VALID) forall b c a. (b -> c) -> (a -> b) -> a -> c . Env -> Schema VALID forall a b. (a, b) -> a fst) Converter (HashMap TypeName (TypeDefinition ANY VALID)) -> (HashMap TypeName (TypeDefinition ANY VALID) -> Converter (TypeDefinition ANY VALID)) -> Converter (TypeDefinition ANY VALID) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= GQLError -> TypeName -> HashMap TypeName (TypeDefinition ANY VALID) -> Converter (TypeDefinition ANY VALID) forall e (m :: * -> *) k (c :: * -> *) a. (MonadError e m, IsMap k c, Monad m) => e -> k -> c a -> m a selectBy (GQLError -> GQLError compileError (GQLError -> GQLError) -> GQLError -> GQLError forall a b. (a -> b) -> a -> b $ GQLError " can't find Type" GQLError -> GQLError -> GQLError forall a. Semigroup a => a -> a -> a <> TypeName -> GQLError forall a. Msg a => a -> GQLError msg TypeName typename) TypeName typename customScalarTypes :: TypeName -> [TypeName] customScalarTypes :: TypeName -> [TypeName] customScalarTypes TypeName typeName | TypeName -> Bool isNotSystemTypeName TypeName typeName = [TypeName typeName] | Bool otherwise = [] leafType :: TypeDefinition a VALID -> Converter ([ClientTypeDefinition], [TypeName]) leafType :: TypeDefinition a VALID -> Converter ([ClientTypeDefinition], [TypeName]) leafType TypeDefinition {TypeName typeName :: forall (a :: TypeCategory) (s :: Stage). TypeDefinition a s -> TypeName typeName :: TypeName typeName, TypeContent TRUE a VALID typeContent :: forall (a :: TypeCategory) (s :: Stage). TypeDefinition a s -> TypeContent TRUE a s typeContent :: TypeContent TRUE a VALID typeContent} = TypeContent TRUE a VALID -> Converter ([ClientTypeDefinition], [TypeName]) forall (a :: TypeCategory). TypeContent TRUE a VALID -> Converter ([ClientTypeDefinition], [TypeName]) fromKind TypeContent TRUE a VALID typeContent where fromKind :: TypeContent TRUE a VALID -> Converter ([ClientTypeDefinition], [TypeName]) fromKind :: TypeContent TRUE a VALID -> Converter ([ClientTypeDefinition], [TypeName]) fromKind DataEnum {} = ([ClientTypeDefinition], [TypeName]) -> Converter ([ClientTypeDefinition], [TypeName]) forall (f :: * -> *) a. Applicative f => a -> f a pure ([], [TypeName typeName]) fromKind DataScalar {} = ([ClientTypeDefinition], [TypeName]) -> Converter ([ClientTypeDefinition], [TypeName]) forall (f :: * -> *) a. Applicative f => a -> f a pure ([], TypeName -> [TypeName] customScalarTypes TypeName typeName) fromKind TypeContent TRUE a VALID _ = GQLError -> Converter ([ClientTypeDefinition], [TypeName]) forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (GQLError -> Converter ([ClientTypeDefinition], [TypeName])) -> GQLError -> Converter ([ClientTypeDefinition], [TypeName]) forall a b. (a -> b) -> a -> b $ GQLError -> GQLError compileError GQLError "Invalid schema Expected scalar" typeFrom :: [FieldName] -> TypeDefinition a VALID -> TypeName typeFrom :: [FieldName] -> TypeDefinition a VALID -> TypeName typeFrom [FieldName] path TypeDefinition {TypeName typeName :: TypeName typeName :: forall (a :: TypeCategory) (s :: Stage). TypeDefinition a s -> TypeName typeName, TypeContent TRUE a VALID typeContent :: TypeContent TRUE a VALID typeContent :: forall (a :: TypeCategory) (s :: Stage). TypeDefinition a s -> TypeContent TRUE a s typeContent} = TypeContent TRUE a VALID -> TypeName __typeFrom TypeContent TRUE a VALID typeContent where __typeFrom :: TypeContent TRUE a VALID -> TypeName __typeFrom DataObject {} = [FieldName] -> TypeName -> TypeName forall (t :: NAME). [Name t] -> TypeName -> TypeName camelCaseTypeName [FieldName] path TypeName typeName __typeFrom DataInterface {} = [FieldName] -> TypeName -> TypeName forall (t :: NAME). [Name t] -> TypeName -> TypeName camelCaseTypeName [FieldName] path TypeName typeName __typeFrom DataUnion {} = [FieldName] -> TypeName -> TypeName forall (t :: NAME). [Name t] -> TypeName -> TypeName camelCaseTypeName [FieldName] path TypeName typeName __typeFrom TypeContent TRUE a VALID _ = TypeName typeName deprecationWarning :: Directives VALID -> (FieldName, Ref FieldName) -> Converter () deprecationWarning :: Directives VALID -> (FieldName, Ref FieldName) -> Converter () deprecationWarning Directives VALID dirs (FieldName typename, Ref FieldName ref) = case Directives VALID -> Maybe (Directive VALID) forall (s :: Stage). Directives s -> Maybe (Directive s) lookupDeprecated Directives VALID dirs of Just Directive VALID deprecation -> ReaderT Env GQLResult () -> Converter () forall a. ReaderT Env GQLResult a -> Converter a Converter (ReaderT Env GQLResult () -> Converter ()) -> ReaderT Env GQLResult () -> Converter () forall a b. (a -> b) -> a -> b $ Result GQLError () -> ReaderT Env GQLResult () forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (Result GQLError () -> ReaderT Env GQLResult ()) -> Result GQLError () -> ReaderT Env GQLResult () forall a b. (a -> b) -> a -> b $ Success :: forall err a. a -> [err] -> Result err a Success {result :: () result = (), [GQLError] warnings :: [GQLError] warnings :: [GQLError] warnings} where warnings :: [GQLError] warnings = [ FieldName -> Ref FieldName -> Maybe Description -> GQLError deprecatedField FieldName typename Ref FieldName ref (Directive VALID -> Maybe Description forall (s :: Stage). Directive s -> Maybe Description lookupDeprecatedReason Directive VALID deprecation) ] Maybe (Directive VALID) Nothing -> () -> Converter () forall (f :: * -> *) a. Applicative f => a -> f a pure ()