module Impl.Utils where
import Language.Haskell.TH
import qualified Data.Map as Map
type family (as :: [x]) ++ (bs :: [x]) :: [x] where
'[] ++ bs = bs
(a ': as) ++ bs = a ': (as ++ bs)
infixr 0 :->
type family as :-> r where
(a ': as) :-> r = a -> as :-> r
'[] :-> r = r
data Method a = Required a | Optional a
methodsFor :: Name
-> TypeQ
{-# DEPRECATED methodsFor "`reify` doesn't currently allow introspecting default definitions,\
\ so they are always `Required`" #-}
methodsFor n = do
ClassI (ClassD _ _ _ _ decs) _ <- reify n
let methods = Map.elems $ foldr addDecl Map.empty decs
return (typeList methods)
where
mkOptional = \case Required a -> Optional a; Optional a -> Optional a
addDecl = \case
SigD n _ty -> Map.insert n
$ Required (LitT (StrTyLit (nameBase n)))
ValD (VarP n) _ _ -> Map.adjust mkOptional n
FunD n _ -> Map.adjust mkOptional n
typeList :: [Method Type] -> Type
typeList = foldr (cons . methodType) PromotedNilT where
cons t = AppT (AppT PromotedConsT t)
methodType = \case
Required t -> ConT 'Required `AppT` t
Optional t -> ConT 'Optional `AppT` t