-- | 'Builder' for GADT constructor
module Language.Haskell.TH.Natural.Syntax.Datatype.Con.GADT (
    -- * Type
    GADTConBuilder,
    newGADTCon,

    -- * Functions
    addField,
    addField',
) where

import Control.Lens
import qualified Language.Haskell.TH as TH
import Language.Haskell.TH.Natural.Syntax.Builder
import Language.Haskell.TH.Natural.Syntax.Datatype.Internal
import Language.Haskell.TH.Syntax.ExtractedCons

type GADTConBuilder = ConstBuilder GadtC

-- | Builds a GADT constructor
newGADTCon ::
    -- | The name of the constructor
    String ->
    -- | The return type of the constructor
    TH.Type ->
    GADTConBuilder () ->
    TH.Q GadtC
newGADTCon :: String -> Type -> GADTConBuilder () -> Q GadtC
newGADTCon String
conN Type
t GADTConBuilder ()
b = GADTConBuilder () -> GadtC -> Q GadtC
forall {k} (m :: * -> *) s (step :: k) (end :: k).
Monad m =>
BaseBuilder m s step end () -> s -> m s
runBaseBuilder GADTConBuilder ()
b ([Name] -> [BangType] -> Type -> GadtC
MkGadtC [String -> Name
TH.mkName String
conN] [] Type
t)

-- | Add a field to the constructor
addField :: TH.Type -> GADTConBuilder ()
addField :: Type -> GADTConBuilder ()
addField Type
t = BangType -> GADTConBuilder ()
addField' (Bang
defaultBang, Type
t)

-- | Same as 'addField', but allow setting the field's 'Kind'
addField' :: (TH.Bang, TH.Type) -> GADTConBuilder ()
addField' :: BangType -> GADTConBuilder ()
addField' BangType
bt = ([BangType] -> Identity [BangType]) -> GadtC -> Identity GadtC
forall a b. HasBts a b => Lens' a b
Lens' GadtC [BangType]
bts (([BangType] -> Identity [BangType]) -> GadtC -> Identity GadtC)
-> BangType -> GADTConBuilder ()
forall s (m :: * -> *) b a.
(MonadState s m, Snoc b b a a) =>
ASetter s s b b -> a -> m ()
|>= BangType
bt