TypedNameQuote.hs

{-

> :t $$(named [|| map ||])
$$(named [|| map ||])
  :: TypedName
       ((ghc-prim-0.5.3:GHC.Types.Any -> ghc-prim-0.5.3:GHC.Types.Any)
        -> [ghc-prim-0.5.3:GHC.Types.Any]
        -> [ghc-prim-0.5.3:GHC.Types.Any])
> $$(named [|| map ||])
TypedName GHC.Base.map

-}

{-# LANGUAGE DeriveLift #-}
module TypedNameQuote (TypedName, named) where
import Language.Haskell.TH.Syntax
import Language.Haskell.TH.Lift ()
data TypedName a = TypedName Name deriving (Lift, Show)
named :: Q (TExp a) -> Q (TExp (TypedName a))
named getNamedExp = do
  namedExp <- getNamedExp
  case namedExp of
    TExp (VarE name) -> unsafeTExpCoerce (lift (TypedName name))
    _ -> error "Need a variable name."