{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE CPP #-}
module Generics.Simplistic.Deep.TH
( unfoldFamilyInto
, deriveDeepFor
, deriveInstancesWith
) where
import Control.Monad.State
import Control.Arrow ((***))
import Language.Haskell.TH hiding (match)
import Language.Haskell.TH.Syntax hiding (lift)
import qualified Data.Set as S
import Generics.Simplistic.Deep
unfoldFamilyInto :: String -> Q Type -> Q [Dec]
unfoldFamilyInto :: String -> Q Type -> Q [Dec]
unfoldFamilyInto n :: String
n first :: Q Type
first = do
STy
ty <- Q Type
first Q Type -> (Type -> Q STy) -> Q STy
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type -> Q STy
forall (m :: * -> *). MonadFail m => Type -> m STy
convertType
[STy]
allTys <- Set STy -> [STy]
forall a. Set a -> [a]
S.toList (Set STy -> [STy]) -> Q (Set STy) -> Q [STy]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (Set STy) Q () -> Set STy -> Q (Set STy)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (STy -> StateT (Set STy) Q ()
process STy
ty) Set STy
forall a. Set a
S.empty
Type
listStr <- [t| [String] |]
[Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Name -> Type -> Dec
SigD (String -> Name
mkName String
n) Type
listStr
, Name -> [Clause] -> Dec
FunD (String -> Name
mkName String
n) [[Pat] -> Body -> [Dec] -> Clause
Clause [] (Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ [STy] -> Exp
mkExp [STy]
allTys) []]
]
where
mkExp :: [STy] -> Exp
mkExp :: [STy] -> Exp
mkExp = [Exp] -> Exp
ListE ([Exp] -> Exp) -> ([STy] -> [Exp]) -> [STy] -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (STy -> Exp) -> [STy] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map (Lit -> Exp
LitE (Lit -> Exp) -> (STy -> Lit) -> STy -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
StringL (String -> Lit) -> (STy -> String) -> STy -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> (STy -> Doc) -> STy -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Doc
forall a. Ppr a => a -> Doc
ppr (Type -> Doc) -> (STy -> Type) -> STy -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STy -> Type
trevnocType)
deriveDeepFor :: Name -> Name -> Q [Dec]
deriveDeepFor :: Name -> Name -> Q [Dec]
deriveDeepFor pr :: Name
pr fam :: Name
fam =
let qprim :: Q Type
qprim = Type -> Q Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Name -> Type
ConT Name
pr
qfam :: Q Type
qfam = Type -> Q Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Name -> Type
ConT Name
fam
in (Type -> Q Type) -> Name -> Q [Dec]
deriveInstancesWith (\t :: Type
t -> [t| Deep $(qprim) $(qfam) $(return t) |]) Name
fam
deriveInstancesWith :: (Type -> Q Type)
-> Name
-> Q [Dec]
deriveInstancesWith :: (Type -> Q Type) -> Name -> Q [Dec]
deriveInstancesWith f :: Type -> Q Type
f fam :: Name
fam = do
[Type]
tys <- Name -> Q [Type]
getTypeLevelList Name
fam
[Type] -> (Type -> Q Dec) -> Q [Dec]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Type]
tys ((Type -> Q Dec) -> Q [Dec]) -> (Type -> Q Dec) -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ \ty :: Type
ty -> do
Type
instTy <- Type -> Q Type
f Type
ty
Dec -> Q Dec
forall (m :: * -> *) a. Monad m => a -> m a
return (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$ Maybe Overlap -> [Type] -> Type -> [Dec] -> Dec
InstanceD Maybe Overlap
forall a. Maybe a
Nothing [] Type
instTy []
getTypeLevelList :: Name -> Q [Type]
getTypeLevelList :: Name -> Q [Type]
getTypeLevelList x :: Name
x = do
Maybe Dec
mtyDecl <- Name -> Q (Maybe Dec)
reifyDec Name
x
case Maybe Dec
mtyDecl of
Nothing -> String -> Q [Type]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("Not a type declaration: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
forall a. Show a => a -> String
show (Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
x))
Just (TySynD _ _ ty :: Type
ty) -> Type -> Q [Type]
getTyLL Type
ty
Just d :: Dec
d -> String -> Q [Type]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("Not a type-level list: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
forall a. Show a => a -> String
show (Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
forall a. Show a => a -> String
show (Dec -> Doc
forall a. Ppr a => a -> Doc
ppr Dec
d))
where
getTyLL :: Type -> Q [Type]
getTyLL :: Type -> Q [Type]
getTyLL (SigT t :: Type
t _) = Type -> Q [Type]
getTyLL Type
t
getTyLL PromotedNilT = [Type] -> Q [Type]
forall (m :: * -> *) a. Monad m => a -> m a
return []
getTyLL (AppT (AppT PromotedConsT a :: Type
a) as :: Type
as) = (Type
aType -> [Type] -> [Type]
forall a. a -> [a] -> [a]
:) ([Type] -> [Type]) -> Q [Type] -> Q [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Q [Type]
getTyLL Type
as
getTyLL t :: Type
t = String -> Q [Type]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("Not a type-level list: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
forall a. Show a => a -> String
show (Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "; " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
t)
process :: STy -> StateT (S.Set STy) Q ()
process :: STy -> StateT (Set STy) Q ()
process ty :: STy
ty = do
Set STy
tys <- StateT (Set STy) Q (Set STy)
forall s (m :: * -> *). MonadState s m => m s
get
if STy
ty STy -> Set STy -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set STy
tys
then () -> StateT (Set STy) Q ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
let (tyHd :: STy
tyHd , args :: [STy]
args) = STy -> (STy, [STy])
styFlatten STy
ty
case STy
tyHd of
ConST tyName :: Name
tyName -> do
Maybe Dec
tyDecl <- Q (Maybe Dec) -> StateT (Set STy) Q (Maybe Dec)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Name -> Q (Maybe Dec)
reifyDec Name
tyName)
case Maybe Dec
tyDecl of
Just dec :: Dec
dec -> Dec -> [STy] -> StateT (Set STy) Q ()
processDecl Dec
dec [STy]
args
Nothing -> () -> StateT (Set STy) Q ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> String -> StateT (Set STy) Q ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid type"
processDecl :: Dec -> [STy] -> StateT (S.Set STy) Q ()
processDecl :: Dec -> [STy] -> StateT (Set STy) Q ()
processDecl (DataD _ tyName :: Name
tyName vars :: [TyVarBndr]
vars _ cons :: [Con]
cons _) args :: [STy]
args = do
(Set STy -> Set STy) -> StateT (Set STy) Q ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (STy -> Set STy -> Set STy
forall a. Ord a => a -> Set a -> Set a
S.insert (Name -> [STy] -> STy
styApp Name
tyName [STy]
args))
let argVal :: [(Name, STy)]
argVal = [Name] -> [STy] -> [(Name, STy)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((TyVarBndr -> Name) -> [TyVarBndr] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndr -> Name
tyvarName [TyVarBndr]
vars) [STy]
args
(Con -> StateT (Set STy) Q ()) -> [Con] -> StateT (Set STy) Q ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([(Name, STy)] -> Con -> StateT (Set STy) Q ()
processCon [(Name, STy)]
argVal) [Con]
cons
processDecl (NewtypeD _ tyName :: Name
tyName vars :: [TyVarBndr]
vars _ con :: Con
con _) args :: [STy]
args = do
(Set STy -> Set STy) -> StateT (Set STy) Q ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (STy -> Set STy -> Set STy
forall a. Ord a => a -> Set a -> Set a
S.insert (Name -> [STy] -> STy
styApp Name
tyName [STy]
args))
let argVal :: [(Name, STy)]
argVal = [Name] -> [STy] -> [(Name, STy)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((TyVarBndr -> Name) -> [TyVarBndr] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndr -> Name
tyvarName [TyVarBndr]
vars) [STy]
args
[(Name, STy)] -> Con -> StateT (Set STy) Q ()
processCon [(Name, STy)]
argVal Con
con
processDecl (TySynD _ vars :: [TyVarBndr]
vars ty :: Type
ty) args :: [STy]
args = do
STy
sty <- Type -> StateT (Set STy) Q STy
forall (m :: * -> *). MonadFail m => Type -> m STy
convertType Type
ty
let argVal :: [(Name, STy)]
argVal = [Name] -> [STy] -> [(Name, STy)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((TyVarBndr -> Name) -> [TyVarBndr] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndr -> Name
tyvarName [TyVarBndr]
vars) [STy]
args
STy -> StateT (Set STy) Q ()
process ([(Name, STy)] -> STy -> STy
styReduce [(Name, STy)]
argVal STy
sty)
processDecl _ _
= String -> StateT (Set STy) Q ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "unknown decl"
processCon :: [(Name , STy)] -> Con -> StateT (S.Set STy) Q ()
processCon :: [(Name, STy)] -> Con -> StateT (Set STy) Q ()
processCon argVal :: [(Name, STy)]
argVal con :: Con
con = do
[STy]
fields <- (Type -> StateT (Set STy) Q STy)
-> [Type] -> StateT (Set STy) Q [STy]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((STy -> STy) -> StateT (Set STy) Q STy -> StateT (Set STy) Q STy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Name, STy)] -> STy -> STy
styReduce [(Name, STy)]
argVal) (StateT (Set STy) Q STy -> StateT (Set STy) Q STy)
-> (Type -> StateT (Set STy) Q STy)
-> Type
-> StateT (Set STy) Q STy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> StateT (Set STy) Q STy
forall (m :: * -> *). MonadFail m => Type -> m STy
convertType) (Con -> [Type]
conType Con
con)
(STy -> StateT (Set STy) Q ()) -> [STy] -> StateT (Set STy) Q ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ STy -> StateT (Set STy) Q ()
process [STy]
fields
tyvarName :: TyVarBndr -> Name
tyvarName :: TyVarBndr -> Name
tyvarName (PlainTV n :: Name
n) = Name
n
tyvarName (KindedTV n :: Name
n _) = Name
n
vbtyTy :: VarBangType -> Type
vbtyTy :: VarBangType -> Type
vbtyTy (_ , _ , t :: Type
t) = Type
t
btyTy :: BangType -> Type
btyTy :: BangType -> Type
btyTy (_ , t :: Type
t) = Type
t
conType :: Con -> [Type]
conType :: Con -> [Type]
conType (NormalC _ btys :: [BangType]
btys) = (BangType -> Type) -> [BangType] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map BangType -> Type
btyTy [BangType]
btys
conType (RecC _ vbtys :: [VarBangType]
vbtys) = (VarBangType -> Type) -> [VarBangType] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map VarBangType -> Type
vbtyTy [VarBangType]
vbtys
conType (InfixC tyl :: BangType
tyl _ tyr :: BangType
tyr) = (BangType -> Type) -> [BangType] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map BangType -> Type
btyTy [BangType
tyl , BangType
tyr]
conType (ForallC _ _ c :: Con
c) = Con -> [Type]
conType Con
c
conType (GadtC _ btys :: [BangType]
btys _) = (BangType -> Type) -> [BangType] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map BangType -> Type
btyTy [BangType]
btys
conType (RecGadtC _ vbtys :: [VarBangType]
vbtys _) = (VarBangType -> Type) -> [VarBangType] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map VarBangType -> Type
vbtyTy [VarBangType]
vbtys
data STy
= AppST STy STy
| VarST Name
| ConST Name
deriving (STy -> STy -> Bool
(STy -> STy -> Bool) -> (STy -> STy -> Bool) -> Eq STy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: STy -> STy -> Bool
$c/= :: STy -> STy -> Bool
== :: STy -> STy -> Bool
$c== :: STy -> STy -> Bool
Eq , Int -> STy -> String -> String
[STy] -> String -> String
STy -> String
(Int -> STy -> String -> String)
-> (STy -> String) -> ([STy] -> String -> String) -> Show STy
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [STy] -> String -> String
$cshowList :: [STy] -> String -> String
show :: STy -> String
$cshow :: STy -> String
showsPrec :: Int -> STy -> String -> String
$cshowsPrec :: Int -> STy -> String -> String
Show, Eq STy
Eq STy =>
(STy -> STy -> Ordering)
-> (STy -> STy -> Bool)
-> (STy -> STy -> Bool)
-> (STy -> STy -> Bool)
-> (STy -> STy -> Bool)
-> (STy -> STy -> STy)
-> (STy -> STy -> STy)
-> Ord STy
STy -> STy -> Bool
STy -> STy -> Ordering
STy -> STy -> STy
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: STy -> STy -> STy
$cmin :: STy -> STy -> STy
max :: STy -> STy -> STy
$cmax :: STy -> STy -> STy
>= :: STy -> STy -> Bool
$c>= :: STy -> STy -> Bool
> :: STy -> STy -> Bool
$c> :: STy -> STy -> Bool
<= :: STy -> STy -> Bool
$c<= :: STy -> STy -> Bool
< :: STy -> STy -> Bool
$c< :: STy -> STy -> Bool
compare :: STy -> STy -> Ordering
$ccompare :: STy -> STy -> Ordering
$cp1Ord :: Eq STy
Ord)
#if __GLASGOW_HASKELL__ >= 808
convertType :: (MonadFail m) => Type -> m STy
#else
convertType :: (Monad m) => Type -> m STy
#endif
convertType :: Type -> m STy
convertType (AppT a :: Type
a b :: Type
b) = STy -> STy -> STy
AppST (STy -> STy -> STy) -> m STy -> m (STy -> STy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> m STy
forall (m :: * -> *). MonadFail m => Type -> m STy
convertType Type
a m (STy -> STy) -> m STy -> m STy
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> m STy
forall (m :: * -> *). MonadFail m => Type -> m STy
convertType Type
b
convertType (SigT t :: Type
t _) = Type -> m STy
forall (m :: * -> *). MonadFail m => Type -> m STy
convertType Type
t
convertType (VarT n :: Name
n) = STy -> m STy
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> STy
VarST Name
n)
convertType (ConT n :: Name
n) = STy -> m STy
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> STy
ConST Name
n)
convertType (ParensT t :: Type
t) = Type -> m STy
forall (m :: * -> *). MonadFail m => Type -> m STy
convertType Type
t
convertType ListT = STy -> m STy
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> STy
ConST (String -> Name
mkName "[]"))
convertType (TupleT n :: Int
n) = STy -> m STy
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> STy
ConST (String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ '('Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) ',' String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")"))
convertType t :: Type
t = String -> m STy
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("convertType: Unsupported Type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
t)
trevnocType :: STy -> Type
trevnocType :: STy -> Type
trevnocType (AppST a :: STy
a b :: STy
b) = Type -> Type -> Type
AppT (STy -> Type
trevnocType STy
a) (STy -> Type
trevnocType STy
b)
trevnocType (VarST n :: Name
n) = Name -> Type
VarT Name
n
trevnocType (ConST n :: Name
n)
| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
mkName "[]" = Type
ListT
| Name -> Bool
forall a. Show a => a -> Bool
isTupleN Name
n = Int -> Type
TupleT (Int -> Type) -> Int -> Type
forall a b. (a -> b) -> a -> b
$ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Name -> String
forall a. Show a => a -> String
show Name
n) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
| Bool
otherwise = Name -> Type
ConT Name
n
where isTupleN :: a -> Bool
isTupleN n0 :: a
n0 = Int -> String -> String
forall a. Int -> [a] -> [a]
take 2 (a -> String
forall a. Show a => a -> String
show a
n0) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "(,"
stySubst :: STy -> Name -> STy -> STy
stySubst :: STy -> Name -> STy -> STy
stySubst (AppST a :: STy
a b :: STy
b) m :: Name
m n :: STy
n = STy -> STy -> STy
AppST (STy -> Name -> STy -> STy
stySubst STy
a Name
m STy
n) (STy -> Name -> STy -> STy
stySubst STy
b Name
m STy
n)
stySubst (ConST a :: Name
a) _ _ = Name -> STy
ConST Name
a
stySubst (VarST x :: Name
x) m :: Name
m n :: STy
n
| Name
x Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
m = STy
n
| Bool
otherwise = Name -> STy
VarST Name
x
styReduce :: [(Name , STy)] -> STy -> STy
styReduce :: [(Name, STy)] -> STy -> STy
styReduce parms :: [(Name, STy)]
parms t :: STy
t = ((Name, STy) -> STy -> STy) -> STy -> [(Name, STy)] -> STy
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(n :: Name
n , m :: STy
m) ty :: STy
ty -> STy -> Name -> STy -> STy
stySubst STy
ty Name
n STy
m) STy
t [(Name, STy)]
parms
styFlatten :: STy -> (STy , [STy])
styFlatten :: STy -> (STy, [STy])
styFlatten (AppST a :: STy
a b :: STy
b) = STy -> STy
forall a. a -> a
id (STy -> STy) -> ([STy] -> [STy]) -> (STy, [STy]) -> (STy, [STy])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** ([STy] -> [STy] -> [STy]
forall a. [a] -> [a] -> [a]
++ [STy
b]) ((STy, [STy]) -> (STy, [STy])) -> (STy, [STy]) -> (STy, [STy])
forall a b. (a -> b) -> a -> b
$ STy -> (STy, [STy])
styFlatten STy
a
styFlatten sty :: STy
sty = (STy
sty , [])
styApp :: Name -> [STy] -> STy
styApp :: Name -> [STy] -> STy
styApp name :: Name
name args :: [STy]
args = STy -> [STy] -> STy
go (Name -> STy
ConST Name
name) ([STy] -> [STy]
forall a. [a] -> [a]
reverse [STy]
args)
where go :: STy -> [STy] -> STy
go t :: STy
t [] = STy
t
go t :: STy
t (x :: STy
x:xs :: [STy]
xs) = STy -> STy -> STy
AppST (STy -> [STy] -> STy
go STy
t [STy]
xs) STy
x
reifyDec :: Name -> Q (Maybe Dec)
reifyDec :: Name -> Q (Maybe Dec)
reifyDec name :: Name
name =
do Info
info <- Name -> Q Info
reify Name
name
case Info
info of TyConI dec :: Dec
dec -> Maybe Dec -> Q (Maybe Dec)
forall (m :: * -> *) a. Monad m => a -> m a
return (Dec -> Maybe Dec
forall a. a -> Maybe a
Just Dec
dec)
_ -> Maybe Dec -> Q (Maybe Dec)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Dec
forall a. Maybe a
Nothing