-- \section[Hooks]{Low level API hooks}

-- NB: this module is SOURCE-imported by DynFlags, and should primarily
--     refer to *types*, rather than *code*

{-# LANGUAGE CPP #-}
module Hooks ( Hooks
             , emptyHooks
             , lookupHook
             , getHooked
               -- the hooks:
             , dsForeignsHook
             , tcForeignImportsHook
             , tcForeignExportsHook
             , hscFrontendHook
             , hscCompileCoreExprHook
             , ghcPrimIfaceHook
             , runPhaseHook
             , runMetaHook
             , linkHook
             , runRnSpliceHook
             , getValueSafelyHook
             , createIservProcessHook
             ) where

import GhcPrelude

import DynFlags
import PipelineMonad
import HscTypes
import GHC.Hs.Decls
import GHC.Hs.Binds
import GHC.Hs.Expr
import OrdList
import TcRnTypes
import Bag
import RdrName
import Name
import Id
import CoreSyn
import GHCi.RemoteTypes
import SrcLoc
import Type
import System.Process
import BasicTypes
import GHC.Hs.Extension

import Data.Maybe

{-
************************************************************************
*                                                                      *
\subsection{Hooks}
*                                                                      *
************************************************************************
-}

-- | 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
emptyHooks = Hooks :: Maybe
  ([LForeignDecl GhcTc]
   -> DsM (ForeignStubs, OrdList (Id, CoreExpr)))
-> Maybe
     ([LForeignDecl GhcRn]
      -> TcM ([Id], [LForeignDecl GhcTc], Bag GlobalRdrElt))
-> Maybe
     ([LForeignDecl GhcRn]
      -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt))
-> Maybe (ModSummary -> Hsc FrontendResult)
-> Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue)
-> Maybe ModIface
-> Maybe
     (PhasePlus
      -> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath))
-> Maybe (MetaHook TcM)
-> Maybe
     (GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag)
-> Maybe (HsSplice GhcRn -> RnM (HsSplice GhcRn))
-> Maybe (HscEnv -> Name -> Type -> IO (Maybe HValue))
-> Maybe (CreateProcess -> IO ProcessHandle)
-> Hooks
Hooks
  { dsForeignsHook :: Maybe
  ([LForeignDecl GhcTc]
   -> DsM (ForeignStubs, OrdList (Id, CoreExpr)))
dsForeignsHook         = Maybe
  ([LForeignDecl GhcTc]
   -> DsM (ForeignStubs, OrdList (Id, CoreExpr)))
forall a. Maybe a
Nothing
  , tcForeignImportsHook :: Maybe
  ([LForeignDecl GhcRn]
   -> TcM ([Id], [LForeignDecl GhcTc], Bag GlobalRdrElt))
tcForeignImportsHook   = Maybe
  ([LForeignDecl GhcRn]
   -> TcM ([Id], [LForeignDecl GhcTc], Bag GlobalRdrElt))
forall a. Maybe a
Nothing
  , tcForeignExportsHook :: Maybe
  ([LForeignDecl GhcRn]
   -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt))
tcForeignExportsHook   = Maybe
  ([LForeignDecl GhcRn]
   -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt))
forall a. Maybe a
Nothing
  , hscFrontendHook :: Maybe (ModSummary -> Hsc FrontendResult)
hscFrontendHook        = Maybe (ModSummary -> Hsc FrontendResult)
forall a. Maybe a
Nothing
  , hscCompileCoreExprHook :: Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue)
hscCompileCoreExprHook = Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue)
forall a. Maybe a
Nothing
  , ghcPrimIfaceHook :: Maybe ModIface
ghcPrimIfaceHook       = Maybe ModIface
forall a. Maybe a
Nothing
  , runPhaseHook :: Maybe
  (PhasePlus
   -> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath))
runPhaseHook           = Maybe
  (PhasePlus
   -> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath))
forall a. Maybe a
Nothing
  , runMetaHook :: Maybe (MetaHook TcM)
runMetaHook            = Maybe (MetaHook TcM)
forall a. Maybe a
Nothing
  , linkHook :: Maybe
  (GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag)
linkHook               = Maybe
  (GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag)
forall a. Maybe a
Nothing
  , runRnSpliceHook :: Maybe (HsSplice GhcRn -> RnM (HsSplice GhcRn))
runRnSpliceHook        = Maybe (HsSplice GhcRn -> RnM (HsSplice GhcRn))
forall a. Maybe a
Nothing
  , getValueSafelyHook :: Maybe (HscEnv -> Name -> Type -> IO (Maybe HValue))
getValueSafelyHook     = Maybe (HscEnv -> Name -> Type -> IO (Maybe HValue))
forall a. Maybe a
Nothing
  , createIservProcessHook :: Maybe (CreateProcess -> IO ProcessHandle)
createIservProcessHook = Maybe (CreateProcess -> IO ProcessHandle)
forall a. Maybe a
Nothing
  }

data Hooks = Hooks
  { Hooks
-> Maybe
     ([LForeignDecl GhcTc]
      -> DsM (ForeignStubs, OrdList (Id, CoreExpr)))
dsForeignsHook         :: Maybe ([LForeignDecl GhcTc]
                           -> DsM (ForeignStubs, OrdList (Id, CoreExpr)))
  , Hooks
-> Maybe
     ([LForeignDecl GhcRn]
      -> TcM ([Id], [LForeignDecl GhcTc], Bag GlobalRdrElt))
tcForeignImportsHook   :: Maybe ([LForeignDecl GhcRn]
                          -> TcM ([Id], [LForeignDecl GhcTc], Bag GlobalRdrElt))
  , Hooks
-> Maybe
     ([LForeignDecl GhcRn]
      -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt))
tcForeignExportsHook   :: Maybe ([LForeignDecl GhcRn]
            -> TcM (LHsBinds GhcTcId, [LForeignDecl GhcTcId], Bag GlobalRdrElt))
  , Hooks -> Maybe (ModSummary -> Hsc FrontendResult)
hscFrontendHook        :: Maybe (ModSummary -> Hsc FrontendResult)
  , Hooks -> Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue)
hscCompileCoreExprHook ::
               Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue)
  , Hooks -> Maybe ModIface
ghcPrimIfaceHook       :: Maybe ModIface
  , Hooks
-> Maybe
     (PhasePlus
      -> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath))
runPhaseHook           :: Maybe (PhasePlus -> FilePath -> DynFlags
                                         -> CompPipeline (PhasePlus, FilePath))
  , Hooks -> Maybe (MetaHook TcM)
runMetaHook            :: Maybe (MetaHook TcM)
  , Hooks
-> Maybe
     (GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag)
linkHook               :: Maybe (GhcLink -> DynFlags -> Bool
                                         -> HomePackageTable -> IO SuccessFlag)
  , Hooks -> Maybe (HsSplice GhcRn -> RnM (HsSplice GhcRn))
runRnSpliceHook        :: Maybe (HsSplice GhcRn -> RnM (HsSplice GhcRn))
  , Hooks -> Maybe (HscEnv -> Name -> Type -> IO (Maybe HValue))
getValueSafelyHook     :: Maybe (HscEnv -> Name -> Type
                                                          -> IO (Maybe HValue))
  , Hooks -> Maybe (CreateProcess -> IO ProcessHandle)
createIservProcessHook :: Maybe (CreateProcess -> IO ProcessHandle)
  }

getHooked :: (Functor f, HasDynFlags f) => (Hooks -> Maybe a) -> a -> f a
getHooked :: (Hooks -> Maybe a) -> a -> f a
getHooked Hooks -> Maybe a
hook a
def = (DynFlags -> a) -> f DynFlags -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Hooks -> Maybe a) -> a -> DynFlags -> a
forall a. (Hooks -> Maybe a) -> a -> DynFlags -> a
lookupHook Hooks -> Maybe a
hook a
def) f DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags

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