-- | Metaprogramming types
module GHC.Types.Meta
   ( MetaRequest(..)
   , MetaHook
   , MetaResult -- data constructors not exported to ensure correct response type
   , metaRequestE
   , metaRequestP
   , metaRequestT
   , metaRequestD
   , metaRequestAW
   )
where

import GHC.Prelude

import GHC.Serialized   ( Serialized )

import GHC.Hs


-- | The supported metaprogramming result types
data MetaRequest
  = MetaE  (LHsExpr GhcPs   -> MetaResult)
  | MetaP  (LPat GhcPs      -> MetaResult)
  | MetaT  (LHsType GhcPs   -> MetaResult)
  | MetaD  ([LHsDecl GhcPs] -> MetaResult)
  | MetaAW (Serialized     -> MetaResult)

-- | data constructors not exported to ensure correct result type
data MetaResult
  = MetaResE  { MetaResult -> LHsExpr GhcPs
unMetaResE  :: LHsExpr GhcPs   }
  | MetaResP  { MetaResult -> LPat GhcPs
unMetaResP  :: LPat GhcPs      }
  | MetaResT  { MetaResult -> LHsType GhcPs
unMetaResT  :: LHsType GhcPs   }
  | MetaResD  { MetaResult -> [LHsDecl GhcPs]
unMetaResD  :: [LHsDecl GhcPs] }
  | MetaResAW { MetaResult -> Serialized
unMetaResAW :: Serialized      }

type MetaHook f = MetaRequest -> LHsExpr GhcTc -> f MetaResult

metaRequestE :: Functor f => MetaHook f -> LHsExpr GhcTc -> f (LHsExpr GhcPs)
metaRequestE :: forall (f :: * -> *).
Functor f =>
MetaHook f -> LHsExpr GhcTc -> f (LHsExpr GhcPs)
metaRequestE MetaHook f
h = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MetaResult -> LHsExpr GhcPs
unMetaResE forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaHook f
h ((LHsExpr GhcPs -> MetaResult) -> MetaRequest
MetaE LHsExpr GhcPs -> MetaResult
MetaResE)

metaRequestP :: Functor f => MetaHook f -> LHsExpr GhcTc -> f (LPat GhcPs)
metaRequestP :: forall (f :: * -> *).
Functor f =>
MetaHook f -> LHsExpr GhcTc -> f (LPat GhcPs)
metaRequestP MetaHook f
h = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MetaResult -> LPat GhcPs
unMetaResP forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaHook f
h ((LPat GhcPs -> MetaResult) -> MetaRequest
MetaP LPat GhcPs -> MetaResult
MetaResP)

metaRequestT :: Functor f => MetaHook f -> LHsExpr GhcTc -> f (LHsType GhcPs)
metaRequestT :: forall (f :: * -> *).
Functor f =>
MetaHook f -> LHsExpr GhcTc -> f (LHsType GhcPs)
metaRequestT MetaHook f
h = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MetaResult -> LHsType GhcPs
unMetaResT forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaHook f
h ((LHsType GhcPs -> MetaResult) -> MetaRequest
MetaT LHsType GhcPs -> MetaResult
MetaResT)

metaRequestD :: Functor f => MetaHook f -> LHsExpr GhcTc -> f [LHsDecl GhcPs]
metaRequestD :: forall (f :: * -> *).
Functor f =>
MetaHook f -> LHsExpr GhcTc -> f [LHsDecl GhcPs]
metaRequestD MetaHook f
h = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MetaResult -> [LHsDecl GhcPs]
unMetaResD forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaHook f
h (([LHsDecl GhcPs] -> MetaResult) -> MetaRequest
MetaD [LHsDecl GhcPs] -> MetaResult
MetaResD)

metaRequestAW :: Functor f => MetaHook f -> LHsExpr GhcTc -> f Serialized
metaRequestAW :: forall (f :: * -> *).
Functor f =>
MetaHook f -> LHsExpr GhcTc -> f Serialized
metaRequestAW MetaHook f
h = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MetaResult -> Serialized
unMetaResAW forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaHook f
h ((Serialized -> MetaResult) -> MetaRequest
MetaAW Serialized -> MetaResult
MetaResAW)