{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module Language.Haskell.TH.Desugar.Sweeten (
expToTH, matchToTH, patToTH, decsToTH, decToTH,
letDecToTH, typeToTH,
conToTH, foreignToTH, pragmaToTH, ruleBndrToTH,
clauseToTH, tvbToTH, cxtToTH, predToTH, derivClauseToTH,
#if __GLASGOW_HASKELL__ >= 801
patSynDirToTH,
#endif
typeArgToTH
) where
import Prelude hiding (exp)
import Control.Arrow
import Language.Haskell.TH hiding (cxt)
import Language.Haskell.TH.Desugar.AST
import Language.Haskell.TH.Desugar.Core (DTypeArg(..))
import Language.Haskell.TH.Desugar.Util
import Data.Maybe ( maybeToList, mapMaybe )
expToTH :: DExp -> Exp
expToTH :: DExp -> Exp
expToTH (DVarE n :: Name
n) = Name -> Exp
VarE Name
n
expToTH (DConE n :: Name
n) = Name -> Exp
ConE Name
n
expToTH (DLitE l :: Lit
l) = Lit -> Exp
LitE Lit
l
expToTH (DAppE e1 :: DExp
e1 e2 :: DExp
e2) = Exp -> Exp -> Exp
AppE (DExp -> Exp
expToTH DExp
e1) (DExp -> Exp
expToTH DExp
e2)
expToTH (DLamE names :: [Name]
names exp :: DExp
exp) = [Pat] -> Exp -> Exp
LamE ((Name -> Pat) -> [Name] -> [Pat]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Pat
VarP [Name]
names) (DExp -> Exp
expToTH DExp
exp)
expToTH (DCaseE exp :: DExp
exp matches :: [DMatch]
matches) = Exp -> [Match] -> Exp
CaseE (DExp -> Exp
expToTH DExp
exp) ((DMatch -> Match) -> [DMatch] -> [Match]
forall a b. (a -> b) -> [a] -> [b]
map DMatch -> Match
matchToTH [DMatch]
matches)
expToTH (DLetE decs :: [DLetDec]
decs exp :: DExp
exp) = [Dec] -> Exp -> Exp
LetE ((DLetDec -> Maybe Dec) -> [DLetDec] -> [Dec]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DLetDec -> Maybe Dec
letDecToTH [DLetDec]
decs) (DExp -> Exp
expToTH DExp
exp)
expToTH (DSigE exp :: DExp
exp ty :: DType
ty) = Exp -> Type -> Exp
SigE (DExp -> Exp
expToTH DExp
exp) (DType -> Type
typeToTH DType
ty)
#if __GLASGOW_HASKELL__ < 709
expToTH (DStaticE _) = error "Static expressions supported only in GHC 7.10+"
#else
expToTH (DStaticE exp :: DExp
exp) = Exp -> Exp
StaticE (DExp -> Exp
expToTH DExp
exp)
#endif
#if __GLASGOW_HASKELL__ >= 801
expToTH (DAppTypeE exp :: DExp
exp ty :: DType
ty) = Exp -> Type -> Exp
AppTypeE (DExp -> Exp
expToTH DExp
exp) (DType -> Type
typeToTH DType
ty)
#else
expToTH (DAppTypeE exp _) = expToTH exp
#endif
matchToTH :: DMatch -> Match
matchToTH :: DMatch -> Match
matchToTH (DMatch pat :: DPat
pat exp :: DExp
exp) = Pat -> Body -> [Dec] -> Match
Match (DPat -> Pat
patToTH DPat
pat) (Exp -> Body
NormalB (DExp -> Exp
expToTH DExp
exp)) []
patToTH :: DPat -> Pat
patToTH :: DPat -> Pat
patToTH (DLitP lit :: Lit
lit) = Lit -> Pat
LitP Lit
lit
patToTH (DVarP n :: Name
n) = Name -> Pat
VarP Name
n
patToTH (DConP n :: Name
n pats :: [DPat]
pats) = Name -> [Pat] -> Pat
ConP Name
n ((DPat -> Pat) -> [DPat] -> [Pat]
forall a b. (a -> b) -> [a] -> [b]
map DPat -> Pat
patToTH [DPat]
pats)
patToTH (DTildeP pat :: DPat
pat) = Pat -> Pat
TildeP (DPat -> Pat
patToTH DPat
pat)
patToTH (DBangP pat :: DPat
pat) = Pat -> Pat
BangP (DPat -> Pat
patToTH DPat
pat)
patToTH (DSigP pat :: DPat
pat ty :: DType
ty) = Pat -> Type -> Pat
SigP (DPat -> Pat
patToTH DPat
pat) (DType -> Type
typeToTH DType
ty)
patToTH DWildP = Pat
WildP
decsToTH :: [DDec] -> [Dec]
decsToTH :: [DDec] -> [Dec]
decsToTH = (DDec -> [Dec]) -> [DDec] -> [Dec]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DDec -> [Dec]
decToTH
decToTH :: DDec -> [Dec]
decToTH :: DDec -> [Dec]
decToTH (DLetDec d :: DLetDec
d) = Maybe Dec -> [Dec]
forall a. Maybe a -> [a]
maybeToList (DLetDec -> Maybe Dec
letDecToTH DLetDec
d)
decToTH (DDataD Data cxt :: DCxt
cxt n :: Name
n tvbs :: [DTyVarBndr]
tvbs _mk :: Maybe DType
_mk cons :: [DCon]
cons derivings :: [DDerivClause]
derivings) =
#if __GLASGOW_HASKELL__ > 710
[Cxt
-> Name
-> [TyVarBndr]
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Dec
DataD (DCxt -> Cxt
cxtToTH DCxt
cxt) Name
n ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
forall a b. (a -> b) -> [a] -> [b]
map DTyVarBndr -> TyVarBndr
tvbToTH [DTyVarBndr]
tvbs) ((DType -> Type) -> Maybe DType -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DType -> Type
typeToTH Maybe DType
_mk) ((DCon -> Con) -> [DCon] -> [Con]
forall a b. (a -> b) -> [a] -> [b]
map DCon -> Con
conToTH [DCon]
cons)
((DDerivClause -> [DerivClause]) -> [DDerivClause] -> [DerivClause]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DDerivClause -> [DerivClause]
derivClauseToTH [DDerivClause]
derivings)]
#else
[DataD (cxtToTH cxt) n (map tvbToTH tvbs) (map conToTH cons)
(map derivingToTH derivings)]
#endif
decToTH (DDataD Newtype cxt :: DCxt
cxt n :: Name
n tvbs :: [DTyVarBndr]
tvbs _mk :: Maybe DType
_mk [con :: DCon
con] derivings :: [DDerivClause]
derivings) =
#if __GLASGOW_HASKELL__ > 710
[Cxt
-> Name -> [TyVarBndr] -> Maybe Type -> Con -> [DerivClause] -> Dec
NewtypeD (DCxt -> Cxt
cxtToTH DCxt
cxt) Name
n ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
forall a b. (a -> b) -> [a] -> [b]
map DTyVarBndr -> TyVarBndr
tvbToTH [DTyVarBndr]
tvbs) ((DType -> Type) -> Maybe DType -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DType -> Type
typeToTH Maybe DType
_mk) (DCon -> Con
conToTH DCon
con)
((DDerivClause -> [DerivClause]) -> [DDerivClause] -> [DerivClause]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DDerivClause -> [DerivClause]
derivClauseToTH [DDerivClause]
derivings)]
#else
[NewtypeD (cxtToTH cxt) n (map tvbToTH tvbs) (conToTH con)
(map derivingToTH derivings)]
#endif
decToTH (DTySynD n :: Name
n tvbs :: [DTyVarBndr]
tvbs ty :: DType
ty) = [Name -> [TyVarBndr] -> Type -> Dec
TySynD Name
n ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
forall a b. (a -> b) -> [a] -> [b]
map DTyVarBndr -> TyVarBndr
tvbToTH [DTyVarBndr]
tvbs) (DType -> Type
typeToTH DType
ty)]
decToTH (DClassD cxt :: DCxt
cxt n :: Name
n tvbs :: [DTyVarBndr]
tvbs fds :: [FunDep]
fds decs :: [DDec]
decs) =
[Cxt -> Name -> [TyVarBndr] -> [FunDep] -> [Dec] -> Dec
ClassD (DCxt -> Cxt
cxtToTH DCxt
cxt) Name
n ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
forall a b. (a -> b) -> [a] -> [b]
map DTyVarBndr -> TyVarBndr
tvbToTH [DTyVarBndr]
tvbs) [FunDep]
fds ([DDec] -> [Dec]
decsToTH [DDec]
decs)]
decToTH (DInstanceD over :: Maybe Overlap
over mtvbs :: Maybe [DTyVarBndr]
mtvbs _cxt :: DCxt
_cxt _ty :: DType
_ty decs :: [DDec]
decs) =
[Maybe Overlap -> DCxt -> DType -> [DDec] -> Dec
instanceDToTH Maybe Overlap
over DCxt
cxt' DType
ty' [DDec]
decs]
where
(cxt' :: DCxt
cxt', ty' :: DType
ty') = case Maybe [DTyVarBndr]
mtvbs of
Nothing -> (DCxt
_cxt, DType
_ty)
Just _tvbs :: [DTyVarBndr]
_tvbs ->
#if __GLASGOW_HASKELL__ < 800 || __GLASGOW_HASKELL__ >= 802
([], [DTyVarBndr] -> DCxt -> DType -> DType
DForallT [DTyVarBndr]
_tvbs DCxt
_cxt DType
_ty)
#else
error $ "Explicit foralls in instance declarations "
++ "are broken on GHC 8.0."
#endif
decToTH (DForeignD f :: DForeign
f) = [Foreign -> Dec
ForeignD (DForeign -> Foreign
foreignToTH DForeign
f)]
#if __GLASGOW_HASKELL__ > 710
decToTH (DOpenTypeFamilyD (DTypeFamilyHead n :: Name
n tvbs :: [DTyVarBndr]
tvbs frs :: DFamilyResultSig
frs ann :: Maybe InjectivityAnn
ann)) =
[TypeFamilyHead -> Dec
OpenTypeFamilyD (Name
-> [TyVarBndr]
-> FamilyResultSig
-> Maybe InjectivityAnn
-> TypeFamilyHead
TypeFamilyHead Name
n ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
forall a b. (a -> b) -> [a] -> [b]
map DTyVarBndr -> TyVarBndr
tvbToTH [DTyVarBndr]
tvbs) (DFamilyResultSig -> FamilyResultSig
frsToTH DFamilyResultSig
frs) Maybe InjectivityAnn
ann)]
#else
decToTH (DOpenTypeFamilyD (DTypeFamilyHead n tvbs frs _ann)) =
[FamilyD TypeFam n (map tvbToTH tvbs) (frsToTH frs)]
#endif
decToTH (DDataFamilyD n :: Name
n tvbs :: [DTyVarBndr]
tvbs mk :: Maybe DType
mk) =
#if __GLASGOW_HASKELL__ > 710
[Name -> [TyVarBndr] -> Maybe Type -> Dec
DataFamilyD Name
n ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
forall a b. (a -> b) -> [a] -> [b]
map DTyVarBndr -> TyVarBndr
tvbToTH [DTyVarBndr]
tvbs) ((DType -> Type) -> Maybe DType -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DType -> Type
typeToTH Maybe DType
mk)]
#else
[FamilyD DataFam n (map tvbToTH tvbs) (fmap typeToTH mk)]
#endif
decToTH (DDataInstD nd :: NewOrData
nd cxt :: DCxt
cxt mtvbs :: Maybe [DTyVarBndr]
mtvbs lhs :: DType
lhs mk :: Maybe DType
mk cons :: [DCon]
cons derivings :: [DDerivClause]
derivings) =
let ndc :: DNewOrDataCons
ndc = case (NewOrData
nd, [DCon]
cons) of
(Newtype, [con :: DCon
con]) -> DCon -> DNewOrDataCons
DNewtypeCon DCon
con
(Newtype, _) -> [Char] -> DNewOrDataCons
forall a. HasCallStack => [Char] -> a
error "Newtype that doesn't have only one constructor"
(Data, _) -> [DCon] -> DNewOrDataCons
DDataCons [DCon]
cons
in DNewOrDataCons
-> DCxt
-> Maybe [DTyVarBndr]
-> DType
-> Maybe DType
-> [DDerivClause]
-> [Dec]
dataInstDecToTH DNewOrDataCons
ndc DCxt
cxt Maybe [DTyVarBndr]
mtvbs DType
lhs Maybe DType
mk [DDerivClause]
derivings
#if __GLASGOW_HASKELL__ >= 807
decToTH (DTySynInstD eqn :: DTySynEqn
eqn) = [TySynEqn -> Dec
TySynInstD ((Name, TySynEqn) -> TySynEqn
forall a b. (a, b) -> b
snd ((Name, TySynEqn) -> TySynEqn) -> (Name, TySynEqn) -> TySynEqn
forall a b. (a -> b) -> a -> b
$ DTySynEqn -> (Name, TySynEqn)
tySynEqnToTH DTySynEqn
eqn)]
#else
decToTH (DTySynInstD eqn) =
let (n, eqn') = tySynEqnToTH eqn in
[TySynInstD n eqn']
#endif
#if __GLASGOW_HASKELL__ > 710
decToTH (DClosedTypeFamilyD (DTypeFamilyHead n :: Name
n tvbs :: [DTyVarBndr]
tvbs frs :: DFamilyResultSig
frs ann :: Maybe InjectivityAnn
ann) eqns :: [DTySynEqn]
eqns) =
[TypeFamilyHead -> [TySynEqn] -> Dec
ClosedTypeFamilyD (Name
-> [TyVarBndr]
-> FamilyResultSig
-> Maybe InjectivityAnn
-> TypeFamilyHead
TypeFamilyHead Name
n ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
forall a b. (a -> b) -> [a] -> [b]
map DTyVarBndr -> TyVarBndr
tvbToTH [DTyVarBndr]
tvbs) (DFamilyResultSig -> FamilyResultSig
frsToTH DFamilyResultSig
frs) Maybe InjectivityAnn
ann)
((DTySynEqn -> TySynEqn) -> [DTySynEqn] -> [TySynEqn]
forall a b. (a -> b) -> [a] -> [b]
map ((Name, TySynEqn) -> TySynEqn
forall a b. (a, b) -> b
snd ((Name, TySynEqn) -> TySynEqn)
-> (DTySynEqn -> (Name, TySynEqn)) -> DTySynEqn -> TySynEqn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DTySynEqn -> (Name, TySynEqn)
tySynEqnToTH) [DTySynEqn]
eqns)
]
#else
decToTH (DClosedTypeFamilyD (DTypeFamilyHead n tvbs frs _ann) eqns) =
[ClosedTypeFamilyD n (map tvbToTH tvbs) (frsToTH frs) (map (snd . tySynEqnToTH) eqns)]
#endif
decToTH (DRoleAnnotD n :: Name
n roles :: [Role]
roles) = [Name -> [Role] -> Dec
RoleAnnotD Name
n [Role]
roles]
decToTH (DStandaloneDerivD mds :: Maybe DDerivStrategy
mds mtvbs :: Maybe [DTyVarBndr]
mtvbs _cxt :: DCxt
_cxt _ty :: DType
_ty) =
[Maybe DDerivStrategy -> DCxt -> DType -> Dec
standaloneDerivDToTH Maybe DDerivStrategy
mds DCxt
cxt' DType
ty']
where
(cxt' :: DCxt
cxt', ty' :: DType
ty') = case Maybe [DTyVarBndr]
mtvbs of
Nothing -> (DCxt
_cxt, DType
_ty)
Just _tvbs :: [DTyVarBndr]
_tvbs ->
#if __GLASGOW_HASKELL__ < 710 || __GLASGOW_HASKELL__ >= 802
([], [DTyVarBndr] -> DCxt -> DType -> DType
DForallT [DTyVarBndr]
_tvbs DCxt
_cxt DType
_ty)
#else
error $ "Explicit foralls in standalone deriving declarations "
++ "are broken on GHC 7.10 and 8.0."
#endif
#if __GLASGOW_HASKELL__ < 709
decToTH (DDefaultSigD {}) =
error "Default method signatures supported only in GHC 7.10+"
#else
decToTH (DDefaultSigD n :: Name
n ty :: DType
ty) = [Name -> Type -> Dec
DefaultSigD Name
n (DType -> Type
typeToTH DType
ty)]
#endif
#if __GLASGOW_HASKELL__ >= 801
decToTH (DPatSynD n :: Name
n args :: PatSynArgs
args dir :: DPatSynDir
dir pat :: DPat
pat) = [Name -> PatSynArgs -> PatSynDir -> Pat -> Dec
PatSynD Name
n PatSynArgs
args (DPatSynDir -> PatSynDir
patSynDirToTH DPatSynDir
dir) (DPat -> Pat
patToTH DPat
pat)]
decToTH (DPatSynSigD n :: Name
n ty :: DType
ty) = [Name -> Type -> Dec
PatSynSigD Name
n (DType -> Type
typeToTH DType
ty)]
#else
decToTH dec
| DPatSynD{} <- dec = patSynErr
| DPatSynSigD{} <- dec = patSynErr
where
patSynErr = error "Pattern synonyms supported only in GHC 8.2+"
#endif
decToTH _ = [Char] -> [Dec]
forall a. HasCallStack => [Char] -> a
error "Newtype declaration without exactly 1 constructor."
data DNewOrDataCons
= DNewtypeCon DCon
| DDataCons [DCon]
dataInstDecToTH :: DNewOrDataCons -> DCxt -> Maybe [DTyVarBndr] -> DType
-> Maybe DKind -> [DDerivClause] -> [Dec]
dataInstDecToTH :: DNewOrDataCons
-> DCxt
-> Maybe [DTyVarBndr]
-> DType
-> Maybe DType
-> [DDerivClause]
-> [Dec]
dataInstDecToTH ndc :: DNewOrDataCons
ndc cxt :: DCxt
cxt _mtvbs :: Maybe [DTyVarBndr]
_mtvbs lhs :: DType
lhs _mk :: Maybe DType
_mk derivings :: [DDerivClause]
derivings =
case DNewOrDataCons
ndc of
DNewtypeCon con :: DCon
con ->
#if __GLASGOW_HASKELL__ >= 807
[Cxt
-> Maybe [TyVarBndr]
-> Type
-> Maybe Type
-> Con
-> [DerivClause]
-> Dec
NewtypeInstD (DCxt -> Cxt
cxtToTH DCxt
cxt) (([DTyVarBndr] -> [TyVarBndr])
-> Maybe [DTyVarBndr] -> Maybe [TyVarBndr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DTyVarBndr -> TyVarBndr
tvbToTH) Maybe [DTyVarBndr]
_mtvbs) (DType -> Type
typeToTH DType
lhs)
((DType -> Type) -> Maybe DType -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DType -> Type
typeToTH Maybe DType
_mk) (DCon -> Con
conToTH DCon
con)
((DDerivClause -> [DerivClause]) -> [DDerivClause] -> [DerivClause]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DDerivClause -> [DerivClause]
derivClauseToTH [DDerivClause]
derivings)]
#elif __GLASGOW_HASKELL__ > 710
[NewtypeInstD (cxtToTH cxt) _n _lhs_args (fmap typeToTH _mk) (conToTH con)
(concatMap derivClauseToTH derivings)]
#else
[NewtypeInstD (cxtToTH cxt) _n _lhs_args (conToTH con)
(map derivingToTH derivings)]
#endif
DDataCons cons :: [DCon]
cons ->
#if __GLASGOW_HASKELL__ >= 807
[Cxt
-> Maybe [TyVarBndr]
-> Type
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Dec
DataInstD (DCxt -> Cxt
cxtToTH DCxt
cxt) (([DTyVarBndr] -> [TyVarBndr])
-> Maybe [DTyVarBndr] -> Maybe [TyVarBndr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DTyVarBndr -> TyVarBndr
tvbToTH) Maybe [DTyVarBndr]
_mtvbs) (DType -> Type
typeToTH DType
lhs)
((DType -> Type) -> Maybe DType -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DType -> Type
typeToTH Maybe DType
_mk) ((DCon -> Con) -> [DCon] -> [Con]
forall a b. (a -> b) -> [a] -> [b]
map DCon -> Con
conToTH [DCon]
cons)
((DDerivClause -> [DerivClause]) -> [DDerivClause] -> [DerivClause]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DDerivClause -> [DerivClause]
derivClauseToTH [DDerivClause]
derivings)]
#elif __GLASGOW_HASKELL__ > 710
[DataInstD (cxtToTH cxt) _n _lhs_args (fmap typeToTH _mk) (map conToTH cons)
(concatMap derivClauseToTH derivings)]
#else
[DataInstD (cxtToTH cxt) _n _lhs_args (map conToTH cons)
(map derivingToTH derivings)]
#endif
where
_lhs' :: Type
_lhs' = DType -> Type
typeToTH DType
lhs
(_n :: Name
_n, _lhs_args :: Cxt
_lhs_args) =
case Type -> (Type, [TypeArg])
unfoldType Type
_lhs' of
(ConT n :: Name
n, lhs_args :: [TypeArg]
lhs_args) -> (Name
n, [TypeArg] -> Cxt
filterTANormals [TypeArg]
lhs_args)
(_, _) -> [Char] -> (Name, Cxt)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Name, Cxt)) -> [Char] -> (Name, Cxt)
forall a b. (a -> b) -> a -> b
$ "Illegal data instance LHS: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Type -> [Char]
forall a. Ppr a => a -> [Char]
pprint Type
_lhs'
#if __GLASGOW_HASKELL__ > 710
frsToTH :: DFamilyResultSig -> FamilyResultSig
frsToTH :: DFamilyResultSig -> FamilyResultSig
frsToTH DNoSig = FamilyResultSig
NoSig
frsToTH (DKindSig k :: DType
k) = Type -> FamilyResultSig
KindSig (DType -> Type
typeToTH DType
k)
frsToTH (DTyVarSig tvb :: DTyVarBndr
tvb) = TyVarBndr -> FamilyResultSig
TyVarSig (DTyVarBndr -> TyVarBndr
tvbToTH DTyVarBndr
tvb)
#else
frsToTH :: DFamilyResultSig -> Maybe Kind
frsToTH DNoSig = Nothing
frsToTH (DKindSig k) = Just (typeToTH k)
frsToTH (DTyVarSig (DPlainTV _)) = Nothing
frsToTH (DTyVarSig (DKindedTV _ k)) = Just (typeToTH k)
#endif
#if __GLASGOW_HASKELL__ <= 710
derivingToTH :: DDerivClause -> Name
derivingToTH (DDerivClause _ [DConT nm]) = nm
derivingToTH p =
error ("Template Haskell in GHC < 8.0 only allows simple derivings: " ++ show p)
#endif
letDecToTH :: DLetDec -> Maybe Dec
letDecToTH :: DLetDec -> Maybe Dec
letDecToTH (DFunD name :: Name
name clauses :: [DClause]
clauses) = Dec -> Maybe Dec
forall a. a -> Maybe a
Just (Dec -> Maybe Dec) -> Dec -> Maybe Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Clause] -> Dec
FunD Name
name ((DClause -> Clause) -> [DClause] -> [Clause]
forall a b. (a -> b) -> [a] -> [b]
map DClause -> Clause
clauseToTH [DClause]
clauses)
letDecToTH (DValD pat :: DPat
pat exp :: DExp
exp) = Dec -> Maybe Dec
forall a. a -> Maybe a
Just (Dec -> Maybe Dec) -> Dec -> Maybe Dec
forall a b. (a -> b) -> a -> b
$ Pat -> Body -> [Dec] -> Dec
ValD (DPat -> Pat
patToTH DPat
pat) (Exp -> Body
NormalB (DExp -> Exp
expToTH DExp
exp)) []
letDecToTH (DSigD name :: Name
name ty :: DType
ty) = Dec -> Maybe Dec
forall a. a -> Maybe a
Just (Dec -> Maybe Dec) -> Dec -> Maybe Dec
forall a b. (a -> b) -> a -> b
$ Name -> Type -> Dec
SigD Name
name (DType -> Type
typeToTH DType
ty)
letDecToTH (DInfixD f :: Fixity
f name :: Name
name) = Dec -> Maybe Dec
forall a. a -> Maybe a
Just (Dec -> Maybe Dec) -> Dec -> Maybe Dec
forall a b. (a -> b) -> a -> b
$ Fixity -> Name -> Dec
InfixD Fixity
f Name
name
letDecToTH (DPragmaD prag :: DPragma
prag) = (Pragma -> Dec) -> Maybe Pragma -> Maybe Dec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pragma -> Dec
PragmaD (DPragma -> Maybe Pragma
pragmaToTH DPragma
prag)
conToTH :: DCon -> Con
#if __GLASGOW_HASKELL__ > 710
conToTH :: DCon -> Con
conToTH (DCon [] [] n :: Name
n (DNormalC _ stys :: [DBangType]
stys) rty :: DType
rty) =
[Name] -> [BangType] -> Type -> Con
GadtC [Name
n] ((DBangType -> BangType) -> [DBangType] -> [BangType]
forall a b. (a -> b) -> [a] -> [b]
map ((DType -> Type) -> DBangType -> BangType
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second DType -> Type
typeToTH) [DBangType]
stys) (DType -> Type
typeToTH DType
rty)
conToTH (DCon [] [] n :: Name
n (DRecC vstys :: [DVarBangType]
vstys) rty :: DType
rty) =
[Name] -> [VarBangType] -> Type -> Con
RecGadtC [Name
n] ((DVarBangType -> VarBangType) -> [DVarBangType] -> [VarBangType]
forall a b. (a -> b) -> [a] -> [b]
map ((DType -> Type) -> DVarBangType -> VarBangType
forall a b c d. (a -> b) -> (c, d, a) -> (c, d, b)
thirdOf3 DType -> Type
typeToTH) [DVarBangType]
vstys) (DType -> Type
typeToTH DType
rty)
#else
conToTH (DCon [] [] n (DNormalC True [sty1, sty2]) _) =
InfixC ((bangToStrict *** typeToTH) sty1) n ((bangToStrict *** typeToTH) sty2)
conToTH (DCon [] [] n (DNormalC _ stys) _) =
NormalC n (map (bangToStrict *** typeToTH) stys)
conToTH (DCon [] [] n (DRecC vstys) _) =
RecC n (map (\(v,b,t) -> (v,bangToStrict b,typeToTH t)) vstys)
#endif
#if __GLASGOW_HASKELL__ > 710
conToTH (DCon tvbs :: [DTyVarBndr]
tvbs cxt :: DCxt
cxt n :: Name
n fields :: DConFields
fields rty :: DType
rty) =
[TyVarBndr] -> Cxt -> Con -> Con
ForallC ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
forall a b. (a -> b) -> [a] -> [b]
map DTyVarBndr -> TyVarBndr
tvbToTH [DTyVarBndr]
tvbs) (DCxt -> Cxt
cxtToTH DCxt
cxt) (DCon -> Con
conToTH (DCon -> Con) -> DCon -> Con
forall a b. (a -> b) -> a -> b
$ [DTyVarBndr] -> DCxt -> Name -> DConFields -> DType -> DCon
DCon [] [] Name
n DConFields
fields DType
rty)
#else
conToTH (DCon tvbs cxt n fields rty)
| null ex_tvbs && null cxt
= con'
| otherwise
= ForallC ex_tvbs (cxtToTH cxt) con'
where
ex_tvbs :: [TyVarBndr]
ex_tvbs = map tvbToTH $ drop num_univ_tvs tvbs
num_univ_tvs :: Int
num_univ_tvs = go rty
where
go :: DType -> Int
go (DAppT t1 t2) = go t1 + go t2
go (DSigT t _) = go t
go (DVarT {}) = 1
go (DConT {}) = 0
go DArrowT = 0
go (DLitT {}) = 0
go (DForallT {}) = error "`forall` type used in GADT return type"
go DWildCardT = 0
go (DAppKindT {}) = 0
con' :: Con
con' = conToTH $ DCon [] [] n fields rty
#endif
instanceDToTH :: Maybe Overlap -> DCxt -> DType -> [DDec] -> Dec
instanceDToTH :: Maybe Overlap -> DCxt -> DType -> [DDec] -> Dec
instanceDToTH _over :: Maybe Overlap
_over cxt :: DCxt
cxt ty :: DType
ty decs :: [DDec]
decs =
Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
InstanceD
#if __GLASGOW_HASKELL__ >= 800
Maybe Overlap
_over
#endif
(DCxt -> Cxt
cxtToTH DCxt
cxt) (DType -> Type
typeToTH DType
ty) ([DDec] -> [Dec]
decsToTH [DDec]
decs)
standaloneDerivDToTH :: Maybe DDerivStrategy -> DCxt -> DType -> Dec
#if __GLASGOW_HASKELL__ >= 710
standaloneDerivDToTH :: Maybe DDerivStrategy -> DCxt -> DType -> Dec
standaloneDerivDToTH _mds :: Maybe DDerivStrategy
_mds cxt :: DCxt
cxt ty :: DType
ty =
Maybe DerivStrategy -> Cxt -> Type -> Dec
StandaloneDerivD
#if __GLASGOW_HASKELL__ >= 802
((DDerivStrategy -> DerivStrategy)
-> Maybe DDerivStrategy -> Maybe DerivStrategy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DDerivStrategy -> DerivStrategy
derivStrategyToTH Maybe DDerivStrategy
_mds)
#endif
(DCxt -> Cxt
cxtToTH DCxt
cxt) (DType -> Type
typeToTH DType
ty)
#else
standaloneDerivDToTH _ _ _ = error "Standalone deriving supported only in GHC 7.10+"
#endif
foreignToTH :: DForeign -> Foreign
foreignToTH :: DForeign -> Foreign
foreignToTH (DImportF cc :: Callconv
cc safety :: Safety
safety str :: [Char]
str n :: Name
n ty :: DType
ty) =
Callconv -> Safety -> [Char] -> Name -> Type -> Foreign
ImportF Callconv
cc Safety
safety [Char]
str Name
n (DType -> Type
typeToTH DType
ty)
foreignToTH (DExportF cc :: Callconv
cc str :: [Char]
str n :: Name
n ty :: DType
ty) = Callconv -> [Char] -> Name -> Type -> Foreign
ExportF Callconv
cc [Char]
str Name
n (DType -> Type
typeToTH DType
ty)
pragmaToTH :: DPragma -> Maybe Pragma
pragmaToTH :: DPragma -> Maybe Pragma
pragmaToTH (DInlineP n :: Name
n inl :: Inline
inl rm :: RuleMatch
rm phases :: Phases
phases) = Pragma -> Maybe Pragma
forall a. a -> Maybe a
Just (Pragma -> Maybe Pragma) -> Pragma -> Maybe Pragma
forall a b. (a -> b) -> a -> b
$ Name -> Inline -> RuleMatch -> Phases -> Pragma
InlineP Name
n Inline
inl RuleMatch
rm Phases
phases
pragmaToTH (DSpecialiseP n :: Name
n ty :: DType
ty m_inl :: Maybe Inline
m_inl phases :: Phases
phases) =
Pragma -> Maybe Pragma
forall a. a -> Maybe a
Just (Pragma -> Maybe Pragma) -> Pragma -> Maybe Pragma
forall a b. (a -> b) -> a -> b
$ Name -> Type -> Maybe Inline -> Phases -> Pragma
SpecialiseP Name
n (DType -> Type
typeToTH DType
ty) Maybe Inline
m_inl Phases
phases
pragmaToTH (DSpecialiseInstP ty :: DType
ty) = Pragma -> Maybe Pragma
forall a. a -> Maybe a
Just (Pragma -> Maybe Pragma) -> Pragma -> Maybe Pragma
forall a b. (a -> b) -> a -> b
$ Type -> Pragma
SpecialiseInstP (DType -> Type
typeToTH DType
ty)
#if __GLASGOW_HASKELL__ >= 807
pragmaToTH (DRuleP str :: [Char]
str mtvbs :: Maybe [DTyVarBndr]
mtvbs rbs :: [DRuleBndr]
rbs lhs :: DExp
lhs rhs :: DExp
rhs phases :: Phases
phases) =
Pragma -> Maybe Pragma
forall a. a -> Maybe a
Just (Pragma -> Maybe Pragma) -> Pragma -> Maybe Pragma
forall a b. (a -> b) -> a -> b
$ [Char]
-> Maybe [TyVarBndr]
-> [RuleBndr]
-> Exp
-> Exp
-> Phases
-> Pragma
RuleP [Char]
str (([DTyVarBndr] -> [TyVarBndr])
-> Maybe [DTyVarBndr] -> Maybe [TyVarBndr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DTyVarBndr -> TyVarBndr
tvbToTH) Maybe [DTyVarBndr]
mtvbs) ((DRuleBndr -> RuleBndr) -> [DRuleBndr] -> [RuleBndr]
forall a b. (a -> b) -> [a] -> [b]
map DRuleBndr -> RuleBndr
ruleBndrToTH [DRuleBndr]
rbs)
(DExp -> Exp
expToTH DExp
lhs) (DExp -> Exp
expToTH DExp
rhs) Phases
phases
#else
pragmaToTH (DRuleP str _ rbs lhs rhs phases) =
Just $ RuleP str (map ruleBndrToTH rbs) (expToTH lhs) (expToTH rhs) phases
#endif
pragmaToTH (DAnnP target :: AnnTarget
target exp :: DExp
exp) = Pragma -> Maybe Pragma
forall a. a -> Maybe a
Just (Pragma -> Maybe Pragma) -> Pragma -> Maybe Pragma
forall a b. (a -> b) -> a -> b
$ AnnTarget -> Exp -> Pragma
AnnP AnnTarget
target (DExp -> Exp
expToTH DExp
exp)
#if __GLASGOW_HASKELL__ < 709
pragmaToTH (DLineP {}) = Nothing
#else
pragmaToTH (DLineP n :: Int
n str :: [Char]
str) = Pragma -> Maybe Pragma
forall a. a -> Maybe a
Just (Pragma -> Maybe Pragma) -> Pragma -> Maybe Pragma
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> Pragma
LineP Int
n [Char]
str
#endif
#if __GLASGOW_HASKELL__ < 801
pragmaToTH (DCompleteP {}) = Nothing
#else
pragmaToTH (DCompleteP cls :: [Name]
cls mty :: Maybe Name
mty) = Pragma -> Maybe Pragma
forall a. a -> Maybe a
Just (Pragma -> Maybe Pragma) -> Pragma -> Maybe Pragma
forall a b. (a -> b) -> a -> b
$ [Name] -> Maybe Name -> Pragma
CompleteP [Name]
cls Maybe Name
mty
#endif
ruleBndrToTH :: DRuleBndr -> RuleBndr
ruleBndrToTH :: DRuleBndr -> RuleBndr
ruleBndrToTH (DRuleVar n :: Name
n) = Name -> RuleBndr
RuleVar Name
n
ruleBndrToTH (DTypedRuleVar n :: Name
n ty :: DType
ty) = Name -> Type -> RuleBndr
TypedRuleVar Name
n (DType -> Type
typeToTH DType
ty)
#if __GLASGOW_HASKELL__ >= 807
tySynEqnToTH :: DTySynEqn -> (Name, TySynEqn)
tySynEqnToTH :: DTySynEqn -> (Name, TySynEqn)
tySynEqnToTH (DTySynEqn tvbs :: Maybe [DTyVarBndr]
tvbs lhs :: DType
lhs rhs :: DType
rhs) =
let lhs' :: Type
lhs' = DType -> Type
typeToTH DType
lhs in
case Type -> (Type, [TypeArg])
unfoldType Type
lhs' of
(ConT n :: Name
n, _lhs_args :: [TypeArg]
_lhs_args) -> (Name
n, Maybe [TyVarBndr] -> Type -> Type -> TySynEqn
TySynEqn (([DTyVarBndr] -> [TyVarBndr])
-> Maybe [DTyVarBndr] -> Maybe [TyVarBndr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DTyVarBndr -> TyVarBndr
tvbToTH) Maybe [DTyVarBndr]
tvbs) Type
lhs' (DType -> Type
typeToTH DType
rhs))
(_, _) -> [Char] -> (Name, TySynEqn)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Name, TySynEqn)) -> [Char] -> (Name, TySynEqn)
forall a b. (a -> b) -> a -> b
$ "Illegal type instance LHS: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Type -> [Char]
forall a. Ppr a => a -> [Char]
pprint Type
lhs'
#else
tySynEqnToTH :: DTySynEqn -> (Name, TySynEqn)
tySynEqnToTH (DTySynEqn _ lhs rhs) =
let lhs' = typeToTH lhs in
case unfoldType lhs' of
(ConT n, lhs_args) -> (n, TySynEqn (filterTANormals lhs_args) (typeToTH rhs))
(_, _) -> error $ "Illegal type instance LHS: " ++ pprint lhs'
#endif
clauseToTH :: DClause -> Clause
clauseToTH :: DClause -> Clause
clauseToTH (DClause pats :: [DPat]
pats exp :: DExp
exp) = [Pat] -> Body -> [Dec] -> Clause
Clause ((DPat -> Pat) -> [DPat] -> [Pat]
forall a b. (a -> b) -> [a] -> [b]
map DPat -> Pat
patToTH [DPat]
pats) (Exp -> Body
NormalB (DExp -> Exp
expToTH DExp
exp)) []
typeToTH :: DType -> Type
typeToTH :: DType -> Type
typeToTH (DForallT tvbs :: [DTyVarBndr]
tvbs cxt :: DCxt
cxt ty :: DType
ty) = [TyVarBndr] -> Cxt -> Type -> Type
ForallT ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
forall a b. (a -> b) -> [a] -> [b]
map DTyVarBndr -> TyVarBndr
tvbToTH [DTyVarBndr]
tvbs) ((DType -> Type) -> DCxt -> Cxt
forall a b. (a -> b) -> [a] -> [b]
map DType -> Type
predToTH DCxt
cxt) (DType -> Type
typeToTH DType
ty)
typeToTH (DAppT t1 :: DType
t1 t2 :: DType
t2) = Type -> Type -> Type
AppT (DType -> Type
typeToTH DType
t1) (DType -> Type
typeToTH DType
t2)
typeToTH (DSigT ty :: DType
ty ki :: DType
ki) = Type -> Type -> Type
SigT (DType -> Type
typeToTH DType
ty) (DType -> Type
typeToTH DType
ki)
typeToTH (DVarT n :: Name
n) = Name -> Type
VarT Name
n
typeToTH (DConT n :: Name
n) = Name -> Type
tyconToTH Name
n
typeToTH DArrowT = Type
ArrowT
typeToTH (DLitT lit :: TyLit
lit) = TyLit -> Type
LitT TyLit
lit
#if __GLASGOW_HASKELL__ > 710
typeToTH DWildCardT = Type
WildCardT
#else
typeToTH DWildCardT = error "Wildcards supported only in GHC 8.0+"
#endif
#if __GLASGOW_HASKELL__ >= 807
typeToTH (DAppKindT t :: DType
t k :: DType
k) = Type -> Type -> Type
AppKindT (DType -> Type
typeToTH DType
t) (DType -> Type
typeToTH DType
k)
#else
typeToTH (DAppKindT t _) = typeToTH t
#endif
tvbToTH :: DTyVarBndr -> TyVarBndr
tvbToTH :: DTyVarBndr -> TyVarBndr
tvbToTH (DPlainTV n :: Name
n) = Name -> TyVarBndr
PlainTV Name
n
tvbToTH (DKindedTV n :: Name
n k :: DType
k) = Name -> Type -> TyVarBndr
KindedTV Name
n (DType -> Type
typeToTH DType
k)
cxtToTH :: DCxt -> Cxt
cxtToTH :: DCxt -> Cxt
cxtToTH = (DType -> Type) -> DCxt -> Cxt
forall a b. (a -> b) -> [a] -> [b]
map DType -> Type
predToTH
#if __GLASGOW_HASKELL__ >= 801
derivClauseToTH :: DDerivClause -> [DerivClause]
derivClauseToTH :: DDerivClause -> [DerivClause]
derivClauseToTH (DDerivClause mds :: Maybe DDerivStrategy
mds cxt :: DCxt
cxt) =
[Maybe DerivStrategy -> Cxt -> DerivClause
DerivClause ((DDerivStrategy -> DerivStrategy)
-> Maybe DDerivStrategy -> Maybe DerivStrategy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DDerivStrategy -> DerivStrategy
derivStrategyToTH Maybe DDerivStrategy
mds) (DCxt -> Cxt
cxtToTH DCxt
cxt)]
#else
derivClauseToTH :: DDerivClause -> Cxt
derivClauseToTH (DDerivClause _ cxt) = cxtToTH cxt
#endif
#if __GLASGOW_HASKELL__ >= 801
derivStrategyToTH :: DDerivStrategy -> DerivStrategy
derivStrategyToTH :: DDerivStrategy -> DerivStrategy
derivStrategyToTH DStockStrategy = DerivStrategy
StockStrategy
derivStrategyToTH DAnyclassStrategy = DerivStrategy
AnyclassStrategy
derivStrategyToTH DNewtypeStrategy = DerivStrategy
NewtypeStrategy
#if __GLASGOW_HASKELL__ >= 805
derivStrategyToTH (DViaStrategy ty :: DType
ty) = Type -> DerivStrategy
ViaStrategy (DType -> Type
typeToTH DType
ty)
#else
derivStrategyToTH (DViaStrategy _) = error "DerivingVia supported only in GHC 8.6+"
#endif
#endif
#if __GLASGOW_HASKELL__ >= 801
patSynDirToTH :: DPatSynDir -> PatSynDir
patSynDirToTH :: DPatSynDir -> PatSynDir
patSynDirToTH DUnidir = PatSynDir
Unidir
patSynDirToTH DImplBidir = PatSynDir
ImplBidir
patSynDirToTH (DExplBidir clauses :: [DClause]
clauses) = [Clause] -> PatSynDir
ExplBidir ((DClause -> Clause) -> [DClause] -> [Clause]
forall a b. (a -> b) -> [a] -> [b]
map DClause -> Clause
clauseToTH [DClause]
clauses)
#endif
predToTH :: DPred -> Pred
#if __GLASGOW_HASKELL__ < 709
predToTH = go []
where
go acc (DAppT p t) = go (typeToTH t : acc) p
go acc (DAppKindT t _) = go acc t
go acc (DSigT p _) = go acc p
go acc (DConT n)
| nameBase n == "~"
, [t1, t2] <- acc
= EqualP t1 t2
| otherwise
= ClassP n acc
go _ (DVarT _)
= error "Template Haskell in GHC <= 7.8 does not support variable constraints."
go _ DWildCardT
= error "Wildcards supported only in GHC 8.0+"
go _ (DForallT {})
= error "Quantified constraints supported only in GHC 8.6+"
go _ DArrowT
= error "(->) spotted at head of a constraint"
go _ (DLitT {})
= error "Type-level literal spotted at head of a constraint"
#else
predToTH :: DType -> Type
predToTH (DAppT p :: DType
p t :: DType
t) = Type -> Type -> Type
AppT (DType -> Type
predToTH DType
p) (DType -> Type
typeToTH DType
t)
predToTH (DSigT p :: DType
p k :: DType
k) = Type -> Type -> Type
SigT (DType -> Type
predToTH DType
p) (DType -> Type
typeToTH DType
k)
predToTH (DVarT n :: Name
n) = Name -> Type
VarT Name
n
predToTH (DConT n :: Name
n) = DType -> Type
typeToTH (Name -> DType
DConT Name
n)
predToTH DArrowT = Type
ArrowT
predToTH (DLitT lit :: TyLit
lit) = TyLit -> Type
LitT TyLit
lit
#if __GLASGOW_HASKELL__ > 710
predToTH DWildCardT = Type
WildCardT
#else
predToTH DWildCardT = error "Wildcards supported only in GHC 8.0+"
#endif
#if __GLASGOW_HASKELL__ >= 805
predToTH (DForallT tvbs :: [DTyVarBndr]
tvbs cxt :: DCxt
cxt p :: DType
p) =
[TyVarBndr] -> Cxt -> Type -> Type
ForallT ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
forall a b. (a -> b) -> [a] -> [b]
map DTyVarBndr -> TyVarBndr
tvbToTH [DTyVarBndr]
tvbs) ((DType -> Type) -> DCxt -> Cxt
forall a b. (a -> b) -> [a] -> [b]
map DType -> Type
predToTH DCxt
cxt) (DType -> Type
predToTH DType
p)
#else
predToTH (DForallT {}) = error "Quantified constraints supported only in GHC 8.6+"
#endif
#if __GLASGOW_HASKELL__ >= 807
predToTH (DAppKindT p :: DType
p k :: DType
k) = Type -> Type -> Type
AppKindT (DType -> Type
predToTH DType
p) (DType -> Type
typeToTH DType
k)
#else
predToTH (DAppKindT p _) = predToTH p
#endif
#endif
tyconToTH :: Name -> Type
tyconToTH :: Name -> Type
tyconToTH n :: Name
n
| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== ''(->) = Type
ArrowT
| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== ''[] = Type
ListT
#if __GLASGOW_HASKELL__ >= 709
| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== ''(~) = Type
EqualityT
#endif
| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== '[] = Type
PromotedNilT
| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== '(:) = Type
PromotedConsT
| Just deg :: Int
deg <- Name -> Maybe Int
tupleNameDegree_maybe Name
n
= if Name -> Bool
isDataName Name
n
#if __GLASGOW_HASKELL__ >= 805
then Int -> Type
PromotedTupleT Int
deg
#else
then PromotedT n
#endif
else Int -> Type
TupleT Int
deg
| Just deg :: Int
deg <- Name -> Maybe Int
unboxedTupleNameDegree_maybe Name
n = Int -> Type
UnboxedTupleT Int
deg
#if __GLASGOW_HASKELL__ >= 801
| Just deg :: Int
deg <- Name -> Maybe Int
unboxedSumNameDegree_maybe Name
n = Int -> Type
UnboxedSumT Int
deg
#endif
| Bool
otherwise = Name -> Type
ConT Name
n
typeArgToTH :: DTypeArg -> TypeArg
typeArgToTH :: DTypeArg -> TypeArg
typeArgToTH (DTANormal t :: DType
t) = Type -> TypeArg
TANormal (DType -> Type
typeToTH DType
t)
typeArgToTH (DTyArg k :: DType
k) = Type -> TypeArg
TyArg (DType -> Type
typeToTH DType
k)
#if __GLASGOW_HASKELL__ <= 710
bangToStrict :: Bang -> Strict
bangToStrict (Bang SourceUnpack _) = Unpacked
bangToStrict (Bang _ SourceStrict) = IsStrict
bangToStrict (Bang _ _) = NotStrict
#endif