{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Client.CodeGen.TH
  ( deriveIfNotDefined,
    declareIfNotDeclared,
  )
where

import Data.Morpheus.CodeGen.Internal.AST
  ( CodeGenType (..),
    CodeGenTypeName (..),
    TypeClassInstance (..),
    getFullName,
  )
import Data.Morpheus.CodeGen.TH (toName)
import Language.Haskell.TH
import Relude

isTypeDeclared :: CodeGenTypeName -> Q Bool
isTypeDeclared :: CodeGenTypeName -> Q Bool
isTypeDeclared CodeGenTypeName
name = forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Q (Maybe Name)
lookupTypeName (forall a. ToString a => a -> String
toString forall a b. (a -> b) -> a -> b
$ CodeGenTypeName -> TypeName
getFullName CodeGenTypeName
name)

isInstanceDefined :: Name -> CodeGenTypeName -> Q Bool
isInstanceDefined :: Name -> CodeGenTypeName -> Q Bool
isInstanceDefined Name
typeClass CodeGenTypeName
tName = do
  Bool
exists <- CodeGenTypeName -> Q Bool
isTypeDeclared CodeGenTypeName
tName
  if Bool
exists
    then Name -> [Type] -> Q Bool
isInstance Name
typeClass [Name -> Type
ConT (forall a. ToName a => a -> Name
toName CodeGenTypeName
tName)]
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

deriveIfNotDefined :: (TypeClassInstance a -> Q Dec) -> TypeClassInstance a -> Q [Dec]
deriveIfNotDefined :: forall a.
(TypeClassInstance a -> Q Dec) -> TypeClassInstance a -> Q [Dec]
deriveIfNotDefined TypeClassInstance a -> Q Dec
f TypeClassInstance a
dec = do
  Bool
exists <- Name -> CodeGenTypeName -> Q Bool
isInstanceDefined (forall body. TypeClassInstance body -> Name
typeClassName TypeClassInstance a
dec) (forall body. TypeClassInstance body -> CodeGenTypeName
typeClassTarget TypeClassInstance a
dec)
  forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TypeClassInstance a -> Q Dec
f [TypeClassInstance a
dec | Bool -> Bool
not Bool
exists]

declareIfNotDeclared :: (CodeGenType -> Q a) -> CodeGenType -> Q [a]
declareIfNotDeclared :: forall a. (CodeGenType -> Q a) -> CodeGenType -> Q [a]
declareIfNotDeclared CodeGenType -> Q a
f CodeGenType
codeGenType = do
  Bool
exists <- CodeGenTypeName -> Q Bool
isTypeDeclared (CodeGenType -> CodeGenTypeName
cgTypeName CodeGenType
codeGenType)
  forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse CodeGenType -> Q a
f [CodeGenType
codeGenType | Bool -> Bool
not Bool
exists]