main/Hooks.lhs

\section[Hooks]{Low level API hooks} \begin{code}

    module Hooks ( Hooks
                 , emptyHooks
                 , lookupHook
                 , getHooked
                   -- the hooks:
                 , dsForeignsHook
                 , tcForeignImportsHook
                 , tcForeignExportsHook
                 , hscFrontendHook
                 , hscCompileOneShotHook
                 , hscCompileCoreExprHook
                 , ghcPrimIfaceHook
                 , runPhaseHook
                 , linkHook
                 , runQuasiQuoteHook
                 , runRnSpliceHook
                 , getValueSafelyHook
                 ) where

    import DynFlags
    import HsTypes
    import Name
    import PipelineMonad
    import HscTypes
    import HsDecls
    import HsBinds
    import HsExpr
    import {-# SOURCE #-} DsMonad
    import OrdList
    import Id
    import TcRnTypes
    import Bag
    import RdrName
    import CoreSyn
    import BasicTypes
    import Type
    import SrcLoc

    import Data.Maybe

\end{code} %************************************************************************ %* * \subsection{Hooks} %* * %************************************************************************ \begin{code}

    -- | Hooks can be used by GHC API clients to replace parts of
    --   the compiler pipeline. If a hook is not installed, GHC
    --   uses the default built-in behaviour

    emptyHooks :: Hooks
    emptyHooks = Hooks Nothing Nothing Nothing Nothing Nothing Nothing
                       Nothing Nothing Nothing Nothing Nothing Nothing

    data Hooks = Hooks
      { dsForeignsHook         :: Maybe ([LForeignDecl Id] -> DsM (ForeignStubs, OrdList (Id, CoreExpr)))
      , tcForeignImportsHook   :: Maybe ([LForeignDecl Name] -> TcM ([Id], [LForeignDecl Id], Bag GlobalRdrElt))
      , tcForeignExportsHook   :: Maybe ([LForeignDecl Name] -> TcM (LHsBinds TcId, [LForeignDecl TcId], Bag GlobalRdrElt))
      , hscFrontendHook        :: Maybe (ModSummary -> Hsc TcGblEnv)
      , hscCompileOneShotHook  :: Maybe (HscEnv -> FilePath -> ModSummary -> SourceModified -> IO HscStatus)
      , hscCompileCoreExprHook :: Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO HValue)
      , ghcPrimIfaceHook       :: Maybe ModIface
      , runPhaseHook           :: Maybe (PhasePlus -> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath))
      , linkHook               :: Maybe (GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag)
      , runQuasiQuoteHook      :: Maybe (HsQuasiQuote Name -> RnM (HsQuasiQuote Name))
      , runRnSpliceHook        :: Maybe (LHsExpr Name -> RnM (LHsExpr Name))
      , getValueSafelyHook     :: Maybe (HscEnv -> Name -> Type -> IO (Maybe HValue))
      }

    getHooked :: (Functor f, HasDynFlags f) => (Hooks -> Maybe a) -> a -> f a
    getHooked hook def = fmap (lookupHook hook def) getDynFlags

    lookupHook :: (Hooks -> Maybe a) -> a -> DynFlags -> a
    lookupHook hook def = fromMaybe def . hook . hooks

\end{code}