{-# LANGUAGE DataKinds #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.Client.Declare.Client ( declareClient, ) where import Data.Morpheus.Client.Declare.Aeson ( aesonDeclarations, ) import Data.Morpheus.Client.Declare.Type ( typeDeclarations, ) import Data.Morpheus.Client.Fetch ( deriveFetch, ) import Data.Morpheus.Client.Internal.Types ( ClientDefinition (..), ClientTypeDefinition (..), TypeNameTH (..), ) import Data.Morpheus.CodeGen.Internal.TH (toCon) import Language.Haskell.TH import Relude hiding (Type) declareClient :: String -> ClientDefinition -> Q [Dec] declareClient :: String -> ClientDefinition -> Q [Dec] declareClient String _ ClientDefinition {clientTypes :: ClientDefinition -> [ClientTypeDefinition] clientTypes = []} = [Dec] -> Q [Dec] forall (f :: * -> *) a. Applicative f => a -> f a pure [] declareClient String src ClientDefinition {Maybe ClientTypeDefinition clientArguments :: ClientDefinition -> Maybe ClientTypeDefinition clientArguments :: Maybe ClientTypeDefinition clientArguments, clientTypes :: ClientDefinition -> [ClientTypeDefinition] clientTypes = ClientTypeDefinition rootType : [ClientTypeDefinition] subTypes} = [Dec] -> [Dec] -> [Dec] forall a. Semigroup a => a -> a -> a (<>) ([Dec] -> [Dec] -> [Dec]) -> Q [Dec] -> Q ([Dec] -> [Dec]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Type, Q [Dec]) -> String -> ClientTypeDefinition -> Q [Dec] defineOperationType (Maybe ClientTypeDefinition -> (Type, Q [Dec]) queryArgumentType Maybe ClientTypeDefinition clientArguments) String src ClientTypeDefinition rootType Q ([Dec] -> [Dec]) -> Q [Dec] -> Q [Dec] forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> ([[Dec]] -> [Dec] forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (ClientTypeDefinition -> Q [Dec]) -> [ClientTypeDefinition] -> Q [[Dec]] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse ClientTypeDefinition -> Q [Dec] declareType [ClientTypeDefinition] subTypes) declareType :: ClientTypeDefinition -> Q [Dec] declareType :: ClientTypeDefinition -> Q [Dec] declareType clientType :: ClientTypeDefinition clientType@ClientTypeDefinition {TypeKind clientKind :: ClientTypeDefinition -> TypeKind clientKind :: TypeKind clientKind} = ClientTypeDefinition -> [ClientTypeDefinition -> Q Dec] -> Q [Dec] forall (f :: * -> *) a b. Applicative f => a -> [a -> f b] -> f [b] apply ClientTypeDefinition clientType (TypeKind -> [ClientTypeDefinition -> Q Dec] typeDeclarations TypeKind clientKind [ClientTypeDefinition -> Q Dec] -> [ClientTypeDefinition -> Q Dec] -> [ClientTypeDefinition -> Q Dec] forall a. Semigroup a => a -> a -> a <> TypeKind -> [ClientTypeDefinition -> Q Dec] aesonDeclarations TypeKind clientKind) apply :: Applicative f => a -> [a -> f b] -> f [b] apply :: a -> [a -> f b] -> f [b] apply a a = ((a -> f b) -> f b) -> [a -> f b] -> f [b] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse (\a -> f b f -> a -> f b f a a) queryArgumentType :: Maybe ClientTypeDefinition -> (Type, Q [Dec]) queryArgumentType :: Maybe ClientTypeDefinition -> (Type, Q [Dec]) queryArgumentType Maybe ClientTypeDefinition Nothing = (String -> Type forall a b. ToCon a b => a -> b toCon (String "()" :: String), [Dec] -> Q [Dec] forall (f :: * -> *) a. Applicative f => a -> f a pure []) queryArgumentType (Just client :: ClientTypeDefinition client@ClientTypeDefinition {TypeNameTH clientTypeName :: ClientTypeDefinition -> TypeNameTH clientTypeName :: TypeNameTH clientTypeName}) = (TypeName -> Type forall a b. ToCon a b => a -> b toCon (TypeNameTH -> TypeName typename TypeNameTH clientTypeName), ClientTypeDefinition -> Q [Dec] declareType ClientTypeDefinition client) defineOperationType :: (Type, Q [Dec]) -> String -> ClientTypeDefinition -> Q [Dec] defineOperationType :: (Type, Q [Dec]) -> String -> ClientTypeDefinition -> Q [Dec] defineOperationType (Type argType, Q [Dec] argumentTypes) String query clientType :: ClientTypeDefinition clientType@ClientTypeDefinition { clientTypeName :: ClientTypeDefinition -> TypeNameTH clientTypeName = TypeNameTH {TypeName typename :: TypeName typename :: TypeNameTH -> TypeName typename} } = do [Dec] rootType <- ClientTypeDefinition -> Q [Dec] declareType ClientTypeDefinition clientType [Dec] typeClassFetch <- Type -> TypeName -> String -> Q [Dec] deriveFetch Type argType TypeName typename String query [Dec] argsT <- Q [Dec] argumentTypes [Dec] -> Q [Dec] forall (f :: * -> *) a. Applicative f => a -> f a pure ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec] forall a b. (a -> b) -> a -> b $ [Dec] rootType [Dec] -> [Dec] -> [Dec] forall a. Semigroup a => a -> a -> a <> [Dec] typeClassFetch [Dec] -> [Dec] -> [Dec] forall a. Semigroup a => a -> a -> a <> [Dec] argsT