-- | 'Builder' for instance declaration
module Language.Haskell.TH.Natural.Syntax.Instance (
    -- * Builder
    newInstance,
    InstanceBuilder,

    -- * Functions
    setOverlap,
    addInstanceArg,

    -- * Re-export
    newTypeVar,
    module Language.Haskell.TH.Natural.Syntax.Builder.Monad,
    module Language.Haskell.TH.Natural.Syntax.Common,
) where

import Control.Lens
import Language.Haskell.TH (Q)
import qualified Language.Haskell.TH as TH
import Language.Haskell.TH.Gen
import Language.Haskell.TH.Natural.Syntax.Builder
import Language.Haskell.TH.Natural.Syntax.Builder.Monad
import Language.Haskell.TH.Natural.Syntax.Common
import Language.Haskell.TH.Natural.Syntax.Name
import Language.Haskell.TH.Syntax.ExtractedCons

type InstanceBuilder a = ConstBuilder InstanceD a

-- | Builds a new instance for the typeclass. The argument is the 'Name' of that typeclass
newInstance :: TH.Name -> InstanceBuilder () -> Q InstanceD
newInstance :: Name -> InstanceBuilder () -> Q InstanceD
newInstance Name
className InstanceBuilder ()
builder = InstanceBuilder () -> InstanceD -> Q InstanceD
forall {k} (m :: * -> *) s (step :: k) (end :: k).
Monad m =>
BaseBuilder m s step end () -> s -> m s
runBaseBuilder InstanceBuilder ()
builder InstanceD
instance_
  where
    instance_ :: InstanceD
instance_ = Maybe Overlap -> Cxt -> Type -> [Dec] -> InstanceD
MkInstanceD Maybe Overlap
forall a. Maybe a
Nothing [] (Name -> Type
TH.ConT Name
className) []

-- | Set an 'Overlap' pragma to the instance
setOverlap :: TH.Overlap -> InstanceBuilder ()
setOverlap :: Overlap -> InstanceBuilder ()
setOverlap = ((Maybe Overlap -> Identity (Maybe Overlap))
-> InstanceD -> Identity InstanceD
forall a b. HasOverlap a b => Lens' a b
Lens' InstanceD (Maybe Overlap)
overlap ((Maybe Overlap -> Identity (Maybe Overlap))
 -> InstanceD -> Identity InstanceD)
-> Overlap -> InstanceBuilder ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?=)

-- | Add an type argument to the instance
addInstanceArg :: (GenType t) => t -> InstanceBuilder ()
addInstanceArg :: forall t. GenType t => t -> InstanceBuilder ()
addInstanceArg t
qty = do
    ty' <- Q Type -> BaseBuilder Q InstanceD 'Ready 'Ready Type
forall {k} (m :: * -> *) a s (step :: k).
Monad m =>
m a -> BaseBuilder m s step step a
liftB (Q Type -> BaseBuilder Q InstanceD 'Ready 'Ready Type)
-> Q Type -> BaseBuilder Q InstanceD 'Ready 'Ready Type
forall a b. (a -> b) -> a -> b
$ t -> Q Type
forall a. GenType a => a -> Q Type
genTy t
qty
    unsafeWithState $ ty %= (`TH.AppT` ty')