module Language.Haskell.TH.Natural.Syntax.Common (addContext, addBody, addBody', addTypeVar, addTypeVar') where

import Control.Lens
import qualified Language.Haskell.TH as TH
import Language.Haskell.TH.Gen
import Language.Haskell.TH.Natural.Syntax.Builder (Builder, liftB)
import Language.Haskell.TH.Natural.Syntax.Name
import Language.Haskell.TH.Syntax.ExtractedCons

-- | Add a constraint to a context
addContext :: (HasCxt s [a]) => TH.Q a -> Builder s step step ()
addContext :: forall {k} s a (step :: k).
HasCxt s [a] =>
Q a -> Builder s step step ()
addContext Q a
qty = do
    ty_ <- Q a -> BaseBuilder Q s step step a
forall {k} (m :: * -> *) a s (step :: k).
Monad m =>
m a -> BaseBuilder m s step step a
liftB Q a
qty
    cxt |>= ty_

-- | Add a 'Dec'
addBody :: (HasDecs s [TH.Dec], GenDec a) => a -> Builder s step step ()
addBody :: forall {k} s a (step :: k).
(HasDecs s [Dec], GenDec a) =>
a -> Builder s step step ()
addBody a
s = do
    dec <- Q Dec -> BaseBuilder Q s step step Dec
forall {k} (m :: * -> *) a s (step :: k).
Monad m =>
m a -> BaseBuilder m s step step a
liftB (Q Dec -> BaseBuilder Q s step step Dec)
-> Q Dec -> BaseBuilder Q s step step Dec
forall a b. (a -> b) -> a -> b
$ a -> Q Dec
forall a. GenDec a => a -> Q Dec
genDec a
s
    decs |>= dec

-- | Add many 'Dec's. Usually used with 'newFunc'
addBody' :: (HasDecs s [a]) => TH.Q [a] -> Builder s step step ()
addBody' :: forall {k} s a (step :: k).
HasDecs s [a] =>
Q [a] -> Builder s step step ()
addBody' Q [a]
s = do
    dec' <- Q [a] -> BaseBuilder Q s step step [a]
forall {k} (m :: * -> *) a s (step :: k).
Monad m =>
m a -> BaseBuilder m s step step a
liftB Q [a]
s
    decs <>= dec'

-- | Add the type variable to the 'tyVarBndr' list
addTypeVar :: (HasTyVarBndr s [TH.TyVarBndr TH.BndrVis]) => TypeVarName -> Builder s step step ()
addTypeVar :: forall {k} s (step :: k).
HasTyVarBndr s [TyVarBndr BndrVis] =>
TypeVarName -> Builder s step step ()
addTypeVar TypeVarName
tyN = TypeVarName -> BndrVis -> Maybe Kind -> Builder s step step ()
forall {k} s vis (step :: k).
HasTyVarBndr s [TyVarBndr vis] =>
TypeVarName -> vis -> Maybe Kind -> Builder s step step ()
addTypeVar' TypeVarName
tyN BndrVis
TH.BndrReq Maybe Kind
forall a. Maybe a
Nothing

-- | Same as 'addTypeVar', but allows setting the kind and vis of the type variable
addTypeVar' :: (HasTyVarBndr s [TH.TyVarBndr vis]) => TypeVarName -> vis -> Maybe TH.Kind -> Builder s step step ()
addTypeVar' :: forall {k} s vis (step :: k).
HasTyVarBndr s [TyVarBndr vis] =>
TypeVarName -> vis -> Maybe Kind -> Builder s step step ()
addTypeVar' TypeVarName
tyN vis
vis Maybe Kind
mkind = ([TyVarBndr vis] -> Identity [TyVarBndr vis]) -> s -> Identity s
forall a b. HasTyVarBndr a b => Lens' a b
Lens' s [TyVarBndr vis]
tyVarBndr (([TyVarBndr vis] -> Identity [TyVarBndr vis]) -> s -> Identity s)
-> TyVarBndr vis -> BaseBuilder Q s step step ()
forall s (m :: * -> *) b a.
(MonadState s m, Snoc b b a a) =>
ASetter s s b b -> a -> m ()
|>= TyVarBndr vis
-> (Kind -> TyVarBndr vis) -> Maybe Kind -> TyVarBndr vis
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Name -> vis -> TyVarBndr vis
forall flag. Name -> flag -> TyVarBndr flag
TH.PlainTV Name
n vis
vis) (Name -> vis -> Kind -> TyVarBndr vis
forall flag. Name -> flag -> Kind -> TyVarBndr flag
TH.KindedTV Name
n vis
vis) Maybe Kind
mkind
  where
    n :: Name
n = TypeVarName
tyN TypeVarName -> Getting Name TypeVarName Name -> Name
forall s a. s -> Getting a s a -> a
^. Getting Name TypeVarName Name
forall a b. HasName a b => Lens' a b
Lens' TypeVarName Name
name