{-# LANGUAGE QualifiedDo #-}

-- | 'Builder' for data type declaration
module Language.Haskell.TH.Natural.Syntax.Datatype.Data (
    -- * Type
    newData,
    DataBuilder,

    -- * Functions
    addCon,
    setKind,
    addDeriving,
    addDeriving',

    -- ** Reexports
    addContext,
    addTypeVar,
    addTypeVar',
) where

import Control.Lens
import Language.Haskell.TH.Gen
import Language.Haskell.TH.Natural.Syntax.Builder as B
import Language.Haskell.TH.Natural.Syntax.Common
import qualified Language.Haskell.TH.Syntax as TH
import Language.Haskell.TH.Syntax.ExtractedCons

type DataBuilder = ConstBuilder DataD

-- | Builds a new data type declaration. The first argument is the name of the data type.
newData :: String -> DataBuilder () -> TH.Q DataD
newData :: String -> DataBuilder () -> Q DataD
newData String
dataNameStr DataBuilder ()
builder = DataBuilder () -> DataD -> Q DataD
forall {k} (m :: * -> *) s (step :: k) (end :: k).
Monad m =>
BaseBuilder m s step end () -> s -> m s
runBaseBuilder DataBuilder ()
builder DataD
baseData
  where
    baseData :: DataD
baseData = Cxt
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Type
-> [Con]
-> [DerivClause]
-> DataD
MkDataD [] Name
dataName [] Maybe Type
forall a. Maybe a
Nothing [] []
    dataName :: Name
dataName = String -> Name
TH.mkName String
dataNameStr

setKind :: TH.Type -> DataBuilder ()
setKind :: Type -> DataBuilder ()
setKind Type
k = (Maybe Type -> Identity (Maybe Type)) -> DataD -> Identity DataD
forall a b. HasKind a b => Lens' a b
Lens' DataD (Maybe Type)
kind ((Maybe Type -> Identity (Maybe Type)) -> DataD -> Identity DataD)
-> Type -> DataBuilder ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Type
k

-- | Add a deriving clause using the 'Name' of the typeclass to derive
--
-- @
--   addDeriving 'Show
-- @
addDeriving :: TH.Name -> DataBuilder ()
addDeriving :: Name -> DataBuilder ()
addDeriving Name
tyN = DerivClause -> DataBuilder ()
addDeriving' (DerivClause -> DataBuilder ()) -> DerivClause -> DataBuilder ()
forall a b. (a -> b) -> a -> b
$ Maybe DerivStrategy -> Cxt -> DerivClause
TH.DerivClause Maybe DerivStrategy
forall a. Maybe a
Nothing [Name -> Type
TH.ConT Name
tyN]

addDeriving' :: TH.DerivClause -> DataBuilder ()
addDeriving' :: DerivClause -> DataBuilder ()
addDeriving' DerivClause
dc = ([DerivClause] -> Identity [DerivClause])
-> DataD -> Identity DataD
forall a b. HasDerive a b => Lens' a b
Lens' DataD [DerivClause]
derive (([DerivClause] -> Identity [DerivClause])
 -> DataD -> Identity DataD)
-> DerivClause -> DataBuilder ()
forall s (m :: * -> *) b a.
(MonadState s m, Snoc b b a a) =>
ASetter s s b b -> a -> m ()
|>= DerivClause
dc

-- | Add a constructor to the data type
addCon :: (GenCon b) => b -> DataBuilder ()
addCon :: forall b. GenCon b => b -> DataBuilder ()
addCon b
b = B.do
    newCon <- Q Con -> BaseBuilder Q DataD 'Ready 'Ready Con
forall {k} (m :: * -> *) a s (step :: k).
Monad m =>
m a -> BaseBuilder m s step step a
liftB (Q Con -> BaseBuilder Q DataD 'Ready 'Ready Con)
-> Q Con -> BaseBuilder Q DataD 'Ready 'Ready Con
forall a b. (a -> b) -> a -> b
$ b -> Q Con
forall a. GenCon a => a -> Q Con
genCon b
b
    con |>= newCon