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