{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Client.Declare.RequestType
  ( declareRequestType,
  )
where

import Data.Morpheus.Client.Fetch.RequestType
  ( RequestType (..),
  )
import Data.Morpheus.Client.Internal.Types
  ( FetchDefinition (..),
    TypeNameTH (..),
  )
import Data.Morpheus.CodeGen.Internal.TH
  ( applyCons,
    funDSimple,
    toCon,
    typeInstanceDec,
    _',
  )
import qualified Data.Text as T
import Language.Haskell.TH
  ( Dec,
    Q,
    Type,
    cxt,
    instanceD,
  )
import Relude hiding (ByteString, Type)

declareRequestType :: Text -> FetchDefinition -> Q [Dec]
declareRequestType :: Text -> FetchDefinition -> Q [Dec]
declareRequestType Text
query FetchDefinition {Maybe TypeNameTH
clientArgumentsTypeName :: FetchDefinition -> Maybe TypeNameTH
clientArgumentsTypeName :: Maybe TypeNameTH
clientArgumentsTypeName, TypeNameTH
rootTypeName :: FetchDefinition -> TypeNameTH
rootTypeName :: TypeNameTH
rootTypeName, OperationType
fetchOperationType :: FetchDefinition -> OperationType
fetchOperationType :: OperationType
fetchOperationType} =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD (forall (m :: * -> *). Quote m => [m Type] -> m Cxt
cxt []) Q Type
iHead [DecQ]
methods
  where
    queryString :: String
queryString = Text -> String
T.unpack Text
query
    typeName :: TypeName
typeName = TypeNameTH -> TypeName
typename TypeNameTH
rootTypeName
    iHead :: Q Type
iHead = forall con cons.
(ToName con, ToName cons) =>
con -> [cons] -> Q Type
applyCons ''RequestType [TypeName
typeName]
    methods :: [DecQ]
methods =
      [ Name -> [PatQ] -> ExpQ -> DecQ
funDSimple '__name [PatQ
_'] [|typeName|],
        Name -> [PatQ] -> ExpQ -> DecQ
funDSimple '__query [PatQ
_'] [|queryString|],
        Name -> [PatQ] -> ExpQ -> DecQ
funDSimple '__type [PatQ
_'] [|fetchOperationType|],
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Name -> Type -> Type -> Dec
typeInstanceDec ''RequestArgs (forall a b. ToCon a b => a -> b
toCon TypeName
typeName) (Maybe TypeNameTH -> Type
argumentType Maybe TypeNameTH
clientArgumentsTypeName)
      ]

argumentType :: Maybe TypeNameTH -> Type
argumentType :: Maybe TypeNameTH -> Type
argumentType Maybe TypeNameTH
Nothing = forall a b. ToCon a b => a -> b
toCon (String
"()" :: String)
argumentType (Just TypeNameTH
clientTypeName) = forall a b. ToCon a b => a -> b
toCon (TypeNameTH -> TypeName
typename TypeNameTH
clientTypeName)