{-# LANGUAGE QualifiedDo #-}

-- | Builder for type synonyms
module Language.Haskell.TH.Natural.Syntax.TypeSynonym (
    -- * Type
    newTypeSynonym,
    TypeSynonymBuilder,
    TypeSynonymBuilderState (..),

    -- * Functions
    addTypeVar,
    addTypeVar',
    returns,

    -- * Lenses
    resType,
    tyVars,
) where

import Control.Lens
import Language.Haskell.TH
import qualified Language.Haskell.TH as TH
import Language.Haskell.TH.Gen
import Language.Haskell.TH.Natural.Syntax.Builder as B
import Language.Haskell.TH.Natural.Syntax.Common
import Language.Haskell.TH.Syntax.ExtractedCons (HasTyVarBndr (..), TySynD (MkTySynD))

type TypeSynonymBuilder prev next a = Builder TypeSynonymBuilderState prev next a

data TypeSynonymBuilderState = MkTSBS
    { TypeSynonymBuilderState -> Maybe Type
_resType :: Maybe TH.Type
    , TypeSynonymBuilderState -> [TyVarBndr BndrVis]
_tyVars :: [TyVarBndr BndrVis]
    }

makeLenses ''TypeSynonymBuilderState

instance HasTyVarBndr TypeSynonymBuilderState [TyVarBndr BndrVis] where
    tyVarBndr :: Lens' TypeSynonymBuilderState [TyVarBndr BndrVis]
tyVarBndr = ([TyVarBndr BndrVis] -> f [TyVarBndr BndrVis])
-> TypeSynonymBuilderState -> f TypeSynonymBuilderState
Lens' TypeSynonymBuilderState [TyVarBndr BndrVis]
tyVars

-- | Builds a type synonym. The first argument is the name of the type synonym
newTypeSynonym :: String -> TypeSynonymBuilder step Ready () -> Q TySynD
newTypeSynonym :: forall (step :: BuilderStep).
String -> TypeSynonymBuilder step 'Ready () -> Q TySynD
newTypeSynonym String
synName TypeSynonymBuilder step 'Ready ()
builder = do
    MkTSBS{..} <- TypeSynonymBuilder step 'Ready ()
-> TypeSynonymBuilderState -> Q TypeSynonymBuilderState
forall {k} (m :: * -> *) s (step :: k) (end :: k).
Monad m =>
BaseBuilder m s step end () -> s -> m s
runBaseBuilder TypeSynonymBuilder step 'Ready ()
builder (Maybe Type -> [TyVarBndr BndrVis] -> TypeSynonymBuilderState
MkTSBS Maybe Type
forall a. Maybe a
Nothing [])
    resTy <- case _resType of
        Maybe Type
Nothing -> String -> Q Type
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
"The type synonym does not have a type."
        Just Type
r -> Type -> Q Type
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
r
    return $ MkTySynD (TH.mkName synName) _tyVars resTy

-- | Sets the RHS of the type synonym definition
returns :: (GenType b) => b -> TypeSynonymBuilder step Ready ()
returns :: forall b (step :: BuilderStep).
GenType b =>
b -> TypeSynonymBuilder step 'Ready ()
returns b
b = BaseBuilder Q TypeSynonymBuilderState step step ()
-> BaseBuilder Q TypeSynonymBuilderState step 'Ready ()
forall {k} (m :: * -> *) s (step :: k) a (next :: k).
BaseBuilder m s step step a -> BaseBuilder m s step next a
impure (BaseBuilder Q TypeSynonymBuilderState step step ()
 -> BaseBuilder Q TypeSynonymBuilderState step 'Ready ())
-> BaseBuilder Q TypeSynonymBuilderState step step ()
-> BaseBuilder Q TypeSynonymBuilderState step 'Ready ()
forall a b. (a -> b) -> a -> b
$ B.do
    ty <- Q Type -> BaseBuilder Q TypeSynonymBuilderState step step Type
forall {k} (m :: * -> *) a s (step :: k).
Monad m =>
m a -> BaseBuilder m s step step a
liftB (Q Type -> BaseBuilder Q TypeSynonymBuilderState step step Type)
-> Q Type -> BaseBuilder Q TypeSynonymBuilderState step step Type
forall a b. (a -> b) -> a -> b
$ b -> Q Type
forall a. GenType a => a -> Q Type
genTy b
b
    resType ?= ty