module Language.Haskell.TH.Natural.Syntax.Datatype.Newtype (
    newNewtype,

    -- * Re-exports
    module Language.Haskell.TH.Natural.Syntax.Datatype.Data,
) where

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

-- | Allows defining a newtype using a 'DataBuilder'.
--
-- Will throw at compile-time (and thus interupt compilation) if the newtype
--
--  - has more than one constructor
--
--  - that constructor has more than one field
newNewtype :: String -> DataBuilder () -> TH.Q NewtypeD
newNewtype :: String -> DataBuilder () -> Q NewtypeD
newNewtype String
dataNameStr DataBuilder ()
builder = do
    dataD <- String -> DataBuilder () -> Q DataD
newData String
dataNameStr DataBuilder ()
builder
    case dataD ^. con of
        [Con
c] ->
            let
                newtypeD :: NewtypeD
newtypeD = Cxt
-> Name
-> [TyVarBndr BndrVis]
-> Maybe Kind
-> Con
-> [DerivClause]
-> NewtypeD
MkNewtypeD (DataD
dataD DataD -> Getting Cxt DataD Cxt -> Cxt
forall s a. s -> Getting a s a -> a
^. Getting Cxt DataD Cxt
forall a b. HasCxt a b => Lens' a b
Lens' DataD Cxt
cxt) (DataD
dataD DataD -> Getting Name DataD Name -> Name
forall s a. s -> Getting a s a -> a
^. Getting Name DataD Name
forall a b. HasName a b => Lens' a b
Lens' DataD Name
name) (DataD
dataD DataD
-> Getting [TyVarBndr BndrVis] DataD [TyVarBndr BndrVis]
-> [TyVarBndr BndrVis]
forall s a. s -> Getting a s a -> a
^. Getting [TyVarBndr BndrVis] DataD [TyVarBndr BndrVis]
forall a b. HasTyVarBndr a b => Lens' a b
Lens' DataD [TyVarBndr BndrVis]
tyVarBndr) (DataD
dataD DataD -> Getting (Maybe Kind) DataD (Maybe Kind) -> Maybe Kind
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Kind) DataD (Maybe Kind)
forall a b. HasKind a b => Lens' a b
Lens' DataD (Maybe Kind)
kind) Con
c (DataD
dataD DataD -> Getting [DerivClause] DataD [DerivClause] -> [DerivClause]
forall s a. s -> Getting a s a -> a
^. Getting [DerivClause] DataD [DerivClause]
forall a b. HasDerive a b => Lens' a b
Lens' DataD [DerivClause]
derive)
             in
                case Con
c of
                    (TH.NormalC Name
_ [(Bang
b, Kind
_)]) | Bang -> Bool
noBang Bang
b -> NewtypeD -> Q NewtypeD
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return NewtypeD
newtypeD
                    (TH.RecC Name
_ [(Name
_, Bang
b, Kind
_)]) | Bang -> Bool
noBang Bang
b -> NewtypeD -> Q NewtypeD
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return NewtypeD
newtypeD
                    Con
_ -> String -> Q NewtypeD
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"When building a newtype, the constructor must be a normal or record constructor, without bang annotation"
        [Con]
_ -> String -> Q NewtypeD
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"When building a newtype, exactly one constructor is expected"
  where
    noBang :: Bang -> Bool
noBang Bang
b = Bang
b Bang -> Bang -> Bool
forall a. Eq a => a -> a -> Bool
== Bang
defaultBang