{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}

-- | Implementation of hooks executables for @build-type: Hooks@ packages.
--
-- A hooks executable is a small program compiled from the @SetupHooks.hs@
-- module of a package with @build-type: Hooks@. Its @main@ function is:
--
-- > import Distribution.Simple.SetupHooks.HooksMain (hooksMain)
-- > import SetupHooks (setupHooks)
-- > main = hooksMain setupHooks
--
-- @cabal-install@ communicates with the external hooks executable to implement
-- the hooks in a package with @build-type: Hooks@.
module Distribution.Simple.SetupHooks.HooksMain
  ( -- * Main entry point for hooks executables
    hooksMain

    -- * Hooks version handshake
  , HooksVersion (..)
  , hooksVersion
  , CabalABI (..)
  , HooksABI (..)
  ) where

-- base
import Control.Monad
  ( (>=>)
  )
import Control.Monad.IO.Class
  ( liftIO
  )
import GHC.Exception
import System.Environment
  ( getArgs
  )
import System.IO
  ( Handle
  , hClose
  , hFlush
  )

-- bytestring
import Data.ByteString.Lazy as LBS
  ( ByteString
  , hGetContents
  , hPutStr
  , null
  )

-- containers
import qualified Data.Map as Map

-- process
import System.Process.CommunicationHandle
  ( openCommunicationHandleRead
  , openCommunicationHandleWrite
  )

-- transformers
import Control.Monad.Trans.Except
  ( ExceptT
  , runExceptT
  , throwE
  )

-- Cabal-syntax
import qualified Distribution.Compat.Binary as Binary
  ( decodeOrFail
  , encode
  )
import Distribution.Types.Version
  ( Version
  )
import Distribution.Utils.Structured
  ( MD5
  , structureHash
  )

-- Cabal
import Distribution.Compat.Prelude
import Distribution.Simple.SetupHooks.Internal
import Distribution.Simple.SetupHooks.Rule
import Distribution.Simple.Utils
  ( VerboseException (..)
  , cabalVersion
  , dieWithException
  , exceptionWithMetadata
  , withOutputMarker
  )
import Distribution.Types.Component
  ( componentName
  )
import qualified Distribution.Types.LocalBuildConfig as LBC
import Distribution.Types.LocalBuildInfo
  ( LocalBuildInfo
  )
import Distribution.Verbosity
  ( Verbosity
  , defaultVerbosityHandles
  , mkVerbosity
  )
import qualified Distribution.Verbosity as Verbosity
  ( normal
  )

--------------------------------------------------------------------------------
-- Hooks version

-- | The version of the Hooks API in use.
--
-- Used for handshake before beginning inter-process communication.
data HooksVersion = HooksVersion
  { HooksVersion -> Version
hooksAPIVersion :: !Version
  , HooksVersion -> MD5
cabalABIHash :: !MD5
  , HooksVersion -> MD5
hooksABIHash :: !MD5
  }
  deriving stock (HooksVersion -> HooksVersion -> Bool
(HooksVersion -> HooksVersion -> Bool)
-> (HooksVersion -> HooksVersion -> Bool) -> Eq HooksVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HooksVersion -> HooksVersion -> Bool
== :: HooksVersion -> HooksVersion -> Bool
$c/= :: HooksVersion -> HooksVersion -> Bool
/= :: HooksVersion -> HooksVersion -> Bool
Eq, Eq HooksVersion
Eq HooksVersion =>
(HooksVersion -> HooksVersion -> Ordering)
-> (HooksVersion -> HooksVersion -> Bool)
-> (HooksVersion -> HooksVersion -> Bool)
-> (HooksVersion -> HooksVersion -> Bool)
-> (HooksVersion -> HooksVersion -> Bool)
-> (HooksVersion -> HooksVersion -> HooksVersion)
-> (HooksVersion -> HooksVersion -> HooksVersion)
-> Ord HooksVersion
HooksVersion -> HooksVersion -> Bool
HooksVersion -> HooksVersion -> Ordering
HooksVersion -> HooksVersion -> HooksVersion
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: HooksVersion -> HooksVersion -> Ordering
compare :: HooksVersion -> HooksVersion -> Ordering
$c< :: HooksVersion -> HooksVersion -> Bool
< :: HooksVersion -> HooksVersion -> Bool
$c<= :: HooksVersion -> HooksVersion -> Bool
<= :: HooksVersion -> HooksVersion -> Bool
$c> :: HooksVersion -> HooksVersion -> Bool
> :: HooksVersion -> HooksVersion -> Bool
$c>= :: HooksVersion -> HooksVersion -> Bool
>= :: HooksVersion -> HooksVersion -> Bool
$cmax :: HooksVersion -> HooksVersion -> HooksVersion
max :: HooksVersion -> HooksVersion -> HooksVersion
$cmin :: HooksVersion -> HooksVersion -> HooksVersion
min :: HooksVersion -> HooksVersion -> HooksVersion
Ord, Int -> HooksVersion -> ShowS
[HooksVersion] -> ShowS
HooksVersion -> String
(Int -> HooksVersion -> ShowS)
-> (HooksVersion -> String)
-> ([HooksVersion] -> ShowS)
-> Show HooksVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HooksVersion -> ShowS
showsPrec :: Int -> HooksVersion -> ShowS
$cshow :: HooksVersion -> String
show :: HooksVersion -> String
$cshowList :: [HooksVersion] -> ShowS
showList :: [HooksVersion] -> ShowS
Show, (forall x. HooksVersion -> Rep HooksVersion x)
-> (forall x. Rep HooksVersion x -> HooksVersion)
-> Generic HooksVersion
forall x. Rep HooksVersion x -> HooksVersion
forall x. HooksVersion -> Rep HooksVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HooksVersion -> Rep HooksVersion x
from :: forall x. HooksVersion -> Rep HooksVersion x
$cto :: forall x. Rep HooksVersion x -> HooksVersion
to :: forall x. Rep HooksVersion x -> HooksVersion
Generic)
  deriving anyclass (Get HooksVersion
[HooksVersion] -> Put
HooksVersion -> Put
(HooksVersion -> Put)
-> Get HooksVersion
-> ([HooksVersion] -> Put)
-> Binary HooksVersion
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: HooksVersion -> Put
put :: HooksVersion -> Put
$cget :: Get HooksVersion
get :: Get HooksVersion
$cputList :: [HooksVersion] -> Put
putList :: [HooksVersion] -> Put
Binary)

-- | The version of the Hooks API built into this version of the Cabal library.
--
-- Used for handshake before beginning inter-process communication.
hooksVersion :: HooksVersion
hooksVersion :: HooksVersion
hooksVersion =
  HooksVersion
    { hooksAPIVersion :: Version
hooksAPIVersion = Version
cabalVersion
    , cabalABIHash :: MD5
cabalABIHash = Proxy CabalABI -> MD5
forall a. Structured a => Proxy a -> MD5
structureHash (Proxy CabalABI -> MD5) -> Proxy CabalABI -> MD5
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @CabalABI
    , hooksABIHash :: MD5
hooksABIHash = Proxy HooksABI -> MD5
forall a. Structured a => Proxy a -> MD5
structureHash (Proxy HooksABI -> MD5) -> Proxy HooksABI -> MD5
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @HooksABI
    }

-- | Tracks the parts of the Cabal API relevant to its binary interface.
data CabalABI = CabalABI
  { CabalABI -> LocalBuildInfo
cabalLocalBuildInfo :: LocalBuildInfo
  }
  deriving stock ((forall x. CabalABI -> Rep CabalABI x)
-> (forall x. Rep CabalABI x -> CabalABI) -> Generic CabalABI
forall x. Rep CabalABI x -> CabalABI
forall x. CabalABI -> Rep CabalABI x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CabalABI -> Rep CabalABI x
from :: forall x. CabalABI -> Rep CabalABI x
$cto :: forall x. Rep CabalABI x -> CabalABI
to :: forall x. Rep CabalABI x -> CabalABI
Generic)

deriving anyclass instance Structured CabalABI

-- | Tracks the parts of the Hooks API relevant to its binary interface.
data HooksABI = HooksABI
  { HooksABI
-> ((PreConfPackageInputs, PreConfPackageOutputs),
    PostConfPackageInputs,
    (PreConfComponentInputs, PreConfComponentOutputs))
confHooks
      :: ( (PreConfPackageInputs, PreConfPackageOutputs)
         , PostConfPackageInputs
         , (PreConfComponentInputs, PreConfComponentOutputs)
         )
  , HooksABI
-> (PreBuildComponentInputs, (RuleId, Rule, RuleBinary),
    PostBuildComponentInputs)
buildHooks
      :: ( PreBuildComponentInputs
         , (RuleId, Rule, RuleBinary)
         , PostBuildComponentInputs
         )
  , HooksABI -> InstallComponentInputs
installHooks :: InstallComponentInputs
  }
  deriving stock ((forall x. HooksABI -> Rep HooksABI x)
-> (forall x. Rep HooksABI x -> HooksABI) -> Generic HooksABI
forall x. Rep HooksABI x -> HooksABI
forall x. HooksABI -> Rep HooksABI x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HooksABI -> Rep HooksABI x
from :: forall x. HooksABI -> Rep HooksABI x
$cto :: forall x. Rep HooksABI x -> HooksABI
to :: forall x. Rep HooksABI x -> HooksABI
Generic)

deriving anyclass instance Structured HooksABI

--------------------------------------------------------------------------------
-- Error types (internal)

data SetupHooksExeException
  = -- | Missing hook type argument.
    NoHookType
  | -- | Could not parse a communication handle argument.
    NoHandle (Maybe String)
  | -- | Incorrect arguments passed to the hooks executable.
    BadHooksExeArgs
      String
      -- ^ hook name
      BadHooksExecutableArgs
  deriving (Int -> SetupHooksExeException -> ShowS
[SetupHooksExeException] -> ShowS
SetupHooksExeException -> String
(Int -> SetupHooksExeException -> ShowS)
-> (SetupHooksExeException -> String)
-> ([SetupHooksExeException] -> ShowS)
-> Show SetupHooksExeException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetupHooksExeException -> ShowS
showsPrec :: Int -> SetupHooksExeException -> ShowS
$cshow :: SetupHooksExeException -> String
show :: SetupHooksExeException -> String
$cshowList :: [SetupHooksExeException] -> ShowS
showList :: [SetupHooksExeException] -> ShowS
Show)

-- | An error describing an invalid argument passed to a hooks executable.
data BadHooksExecutableArgs
  = -- | Unknown hook type was requested.
    UnknownHookType
      {BadHooksExecutableArgs -> [String]
knownHookTypes :: [String]}
  | -- | Failed to decode the binary input to a hook.
    CouldNotDecodeInput
      ByteString
      -- ^ hook input that failed to decode
      Int64
      -- ^ byte offset at which decoding failed
      String
      -- ^ decoding error message
  | -- | The rule does not have a dynamic dependency computation.
    NoDynDepsCmd RuleId
  deriving (Int -> BadHooksExecutableArgs -> ShowS
[BadHooksExecutableArgs] -> ShowS
BadHooksExecutableArgs -> String
(Int -> BadHooksExecutableArgs -> ShowS)
-> (BadHooksExecutableArgs -> String)
-> ([BadHooksExecutableArgs] -> ShowS)
-> Show BadHooksExecutableArgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BadHooksExecutableArgs -> ShowS
showsPrec :: Int -> BadHooksExecutableArgs -> ShowS
$cshow :: BadHooksExecutableArgs -> String
show :: BadHooksExecutableArgs -> String
$cshowList :: [BadHooksExecutableArgs] -> ShowS
showList :: [BadHooksExecutableArgs] -> ShowS
Show)

setupHooksExeExceptionCode :: SetupHooksExeException -> Int
setupHooksExeExceptionCode :: SetupHooksExeException -> Int
setupHooksExeExceptionCode = \case
  SetupHooksExeException
NoHookType -> Int
7982
  NoHandle{} -> Int
8811
  BadHooksExeArgs String
_ BadHooksExecutableArgs
rea -> BadHooksExecutableArgs -> Int
badHooksExeArgsCode BadHooksExecutableArgs
rea

setupHooksExeExceptionMessage :: SetupHooksExeException -> String
setupHooksExeExceptionMessage :: SetupHooksExeException -> String
setupHooksExeExceptionMessage = \case
  SetupHooksExeException
NoHookType ->
    String
"Missing argument to Hooks executable.\n\
    \Expected two arguments: communication handle and hook type."
  NoHandle Maybe String
Nothing ->
    String
"Missing argument to Hooks executable.\n\
    \Expected two arguments: communication handle and hook type."
  NoHandle (Just String
h) ->
    String
"Invalid handle reference passed to Hooks executable: '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
h String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."
  BadHooksExeArgs String
hookName BadHooksExecutableArgs
reason ->
    String -> BadHooksExecutableArgs -> String
badHooksExeArgsMessage String
hookName BadHooksExecutableArgs
reason

badHooksExeArgsCode :: BadHooksExecutableArgs -> Int
badHooksExeArgsCode :: BadHooksExecutableArgs -> Int
badHooksExeArgsCode = \case
  UnknownHookType{} -> Int
4229
  CouldNotDecodeInput{} -> Int
9121
  NoDynDepsCmd{} -> Int
3231

badHooksExeArgsMessage :: String -> BadHooksExecutableArgs -> String
badHooksExeArgsMessage :: String -> BadHooksExecutableArgs -> String
badHooksExeArgsMessage String
hookName = \case
  UnknownHookType [String]
knownHookNames ->
    String
"Unknown hook type "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
hookName
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".\n\
         \Known hook types are: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
knownHookNames
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
  CouldNotDecodeInput ByteString
_bytes Int64
offset String
err ->
    String
"Failed to decode the input to the "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
hookName
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" hook.\n\
         \Decoding failed at position "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int64 -> String
forall a. Show a => a -> String
show Int64
offset
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" with error: "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".\n\
         \This could be due to a mismatch between the Cabal version of cabal-install\
         \ and of the hooks executable."
  NoDynDepsCmd RuleId
rId ->
    [String] -> String
unlines
      [ String
"Unexpected rule " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> RuleId -> String
forall a. Show a => a -> String
show RuleId
rId String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" in the " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
hookName String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" hook."
      , String
"The rule does not have an associated dynamic dependency computation."
      ]

instance Exception (VerboseException SetupHooksExeException) where
  displayException :: VerboseException SetupHooksExeException -> String
  displayException :: VerboseException SetupHooksExeException -> String
displayException (VerboseException CallStack
stack POSIXTime
timestamp VerbosityFlags
verb SetupHooksExeException
err) =
    VerbosityFlags -> ShowS
withOutputMarker
      VerbosityFlags
verb
      ( [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ String
"Error: [Cabal-"
          , Int -> String
forall a. Show a => a -> String
show (SetupHooksExeException -> Int
setupHooksExeExceptionCode SetupHooksExeException
err)
          , String
"]\n"
          ]
      )
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ CallStack -> POSIXTime -> VerbosityFlags -> ShowS
exceptionWithMetadata CallStack
stack POSIXTime
timestamp VerbosityFlags
verb (SetupHooksExeException -> String
setupHooksExeExceptionMessage SetupHooksExeException
err)

-- | The verbosity used inside the hooks executable.
--
-- The hooks executable is always invoked as a separate process, so stdout
-- and stderr are available for verbosity output and can be redirected via
-- the @System.Process@ API.
hooksExeVerbosity :: Verbosity
hooksExeVerbosity :: Verbosity
hooksExeVerbosity = VerbosityHandles -> VerbosityFlags -> Verbosity
mkVerbosity VerbosityHandles
defaultVerbosityHandles VerbosityFlags
Verbosity.normal

--------------------------------------------------------------------------------
-- Main entry point

-- | Create a hooks executable @main@ given the package's 'SetupHooks'.
--
-- The executable expects three command-line arguments:
--
--  1. A reference to an input communication handle (to read hook inputs from).
--  2. A reference to an output communication handle (to write hook outputs to).
--  3. The hook type to run.
--
-- The hook reads binary-encoded data from the input handle, runs the
-- requested hook, and writes the binary-encoded result to the output handle.
hooksMain :: SetupHooks -> IO ()
hooksMain :: SetupHooks -> IO ()
hooksMain SetupHooks
setupHooks = HooksM () -> IO ()
forall a. HooksM a -> IO a
runHooksM (HooksM () -> IO ()) -> HooksM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  ((hRead, hWrite), hookName) <- HooksM ((Handle, Handle), String)
getHooksMainArgs
  case lookup hookName allHookHandlers of
    Just (Handle, Handle) -> SetupHooks -> HooksM ()
handleAction ->
      (Handle, Handle) -> SetupHooks -> HooksM ()
handleAction (Handle
hRead, Handle
hWrite) SetupHooks
setupHooks
    Maybe ((Handle, Handle) -> SetupHooks -> HooksM ())
Nothing ->
      SetupHooksExeException -> HooksM ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (SetupHooksExeException -> HooksM ())
-> SetupHooksExeException -> HooksM ()
forall a b. (a -> b) -> a -> b
$
        String -> BadHooksExecutableArgs -> SetupHooksExeException
BadHooksExeArgs String
hookName (BadHooksExecutableArgs -> SetupHooksExeException)
-> BadHooksExecutableArgs -> SetupHooksExeException
forall a b. (a -> b) -> a -> b
$
          UnknownHookType
            { knownHookTypes :: [String]
knownHookTypes = ((String, (Handle, Handle) -> SetupHooks -> HooksM ()) -> String)
-> [(String, (Handle, Handle) -> SetupHooks -> HooksM ())]
-> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, (Handle, Handle) -> SetupHooks -> HooksM ()) -> String
forall a b. (a, b) -> a
fst [(String, (Handle, Handle) -> SetupHooks -> HooksM ())]
allHookHandlers
            }
  where
    allHookHandlers :: [(String, (Handle, Handle) -> SetupHooks -> HooksM ())]
allHookHandlers = [(HookHandler -> String
hookName HookHandler
h, HookHandler -> (Handle, Handle) -> SetupHooks -> HooksM ()
hookHandler HookHandler
h) | HookHandler
h <- [HookHandler]
hookHandlers]

    -- Get the communication handles and the name of the hook to run
    getHooksMainArgs :: HooksM ((Handle, Handle), String)
    getHooksMainArgs :: HooksM ((Handle, Handle), String)
getHooksMainArgs =
      IO [String] -> ExceptT SetupHooksExeException IO [String]
forall a. IO a -> ExceptT SetupHooksExeException IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [String]
getArgs ExceptT SetupHooksExeException IO [String]
-> ([String] -> HooksM ((Handle, Handle), String))
-> HooksM ((Handle, Handle), String)
forall a b.
ExceptT SetupHooksExeException IO a
-> (a -> ExceptT SetupHooksExeException IO b)
-> ExceptT SetupHooksExeException IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        String
inputFdRef : String
outputFdRef : String
hookNm : [String]
_ ->
          case (String -> Maybe CommunicationHandle
forall a. Read a => String -> Maybe a
readMaybe String
inputFdRef, String -> Maybe CommunicationHandle
forall a. Read a => String -> Maybe a
readMaybe String
outputFdRef) of
            (Just CommunicationHandle
readNm, Just CommunicationHandle
writeNm) -> do
              hRead <- IO Handle -> ExceptT SetupHooksExeException IO Handle
forall a. IO a -> ExceptT SetupHooksExeException IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> ExceptT SetupHooksExeException IO Handle)
-> IO Handle -> ExceptT SetupHooksExeException IO Handle
forall a b. (a -> b) -> a -> b
$ CommunicationHandle -> IO Handle
openCommunicationHandleRead CommunicationHandle
readNm
              hWrite <- liftIO $ openCommunicationHandleWrite writeNm
              return ((hRead, hWrite), hookNm)
            (Maybe CommunicationHandle
Nothing, Maybe CommunicationHandle
_) ->
              SetupHooksExeException -> HooksM ((Handle, Handle), String)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (SetupHooksExeException -> HooksM ((Handle, Handle), String))
-> SetupHooksExeException -> HooksM ((Handle, Handle), String)
forall a b. (a -> b) -> a -> b
$ Maybe String -> SetupHooksExeException
NoHandle (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"hook input communication handle '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
inputFdRef String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'")
            (Maybe CommunicationHandle
_, Maybe CommunicationHandle
Nothing) ->
              SetupHooksExeException -> HooksM ((Handle, Handle), String)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (SetupHooksExeException -> HooksM ((Handle, Handle), String))
-> SetupHooksExeException -> HooksM ((Handle, Handle), String)
forall a b. (a -> b) -> a -> b
$ Maybe String -> SetupHooksExeException
NoHandle (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"hook output communication handle '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
outputFdRef String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'")
        [String]
_ -> SetupHooksExeException -> HooksM ((Handle, Handle), String)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (SetupHooksExeException -> HooksM ((Handle, Handle), String))
-> SetupHooksExeException -> HooksM ((Handle, Handle), String)
forall a b. (a -> b) -> a -> b
$ Maybe String -> SetupHooksExeException
NoHandle Maybe String
forall a. Maybe a
Nothing

type HooksM = ExceptT SetupHooksExeException IO

runHooksM :: HooksM a -> IO a
runHooksM :: forall a. HooksM a -> IO a
runHooksM = ExceptT SetupHooksExeException IO a
-> IO (Either SetupHooksExeException a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT SetupHooksExeException IO a
 -> IO (Either SetupHooksExeException a))
-> (Either SetupHooksExeException a -> IO a)
-> ExceptT SetupHooksExeException IO a
-> IO a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (SetupHooksExeException -> IO a)
-> (a -> IO a) -> Either SetupHooksExeException a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Verbosity -> SetupHooksExeException -> IO a
forall a1 a.
(HasCallStack, Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
hooksExeVerbosity) a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Run a hook by reading its input from a handle, invoking it, and writing
-- its output to another handle.
runHookHandle
  :: forall inputs outputs
   . (Binary inputs, Binary outputs)
  => (Handle, Handle)
  -- ^ Input and output communication handles
  -> String
  -- ^ Hook name (used in error messages)
  -> (inputs -> HooksM outputs)
  -- ^ The hook to run
  -> HooksM ()
runHookHandle :: forall inputs outputs.
(Binary inputs, Binary outputs) =>
(Handle, Handle)
-> String -> (inputs -> HooksM outputs) -> HooksM ()
runHookHandle (Handle
hRead, Handle
hWrite) String
hookName inputs -> HooksM outputs
hook = do
  inputsData <- IO ByteString -> ExceptT SetupHooksExeException IO ByteString
forall a. IO a -> ExceptT SetupHooksExeException IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ExceptT SetupHooksExeException IO ByteString)
-> IO ByteString -> ExceptT SetupHooksExeException IO ByteString
forall a b. (a -> b) -> a -> b
$ Handle -> IO ByteString
LBS.hGetContents Handle
hRead
  let mb_inputs = ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, inputs)
forall a.
Binary a =>
ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
Binary.decodeOrFail ByteString
inputsData
  case mb_inputs of
    Left (ByteString
_, Int64
offset, String
err) ->
      SetupHooksExeException -> HooksM ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (SetupHooksExeException -> HooksM ())
-> SetupHooksExeException -> HooksM ()
forall a b. (a -> b) -> a -> b
$
        String -> BadHooksExecutableArgs -> SetupHooksExeException
BadHooksExeArgs String
hookName (BadHooksExecutableArgs -> SetupHooksExeException)
-> BadHooksExecutableArgs -> SetupHooksExeException
forall a b. (a -> b) -> a -> b
$
          ByteString -> Int64 -> String -> BadHooksExecutableArgs
CouldNotDecodeInput ByteString
inputsData Int64
offset String
err
    Right (ByteString
_, Int64
_, inputs
inputs) ->
      inputs -> HooksM outputs
hook inputs
inputs HooksM outputs -> (outputs -> HooksM ()) -> HooksM ()
forall a b.
ExceptT SetupHooksExeException IO a
-> (a -> ExceptT SetupHooksExeException IO b)
-> ExceptT SetupHooksExeException IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \outputs
output -> IO () -> HooksM ()
forall a. IO a -> ExceptT SetupHooksExeException IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HooksM ()) -> IO () -> HooksM ()
forall a b. (a -> b) -> a -> b
$ do
        let outputData :: ByteString
outputData = outputs -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode outputs
output
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
LBS.null ByteString
outputData) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          Handle -> ByteString -> IO ()
LBS.hPutStr Handle
hWrite ByteString
outputData
        Handle -> IO ()
hFlush Handle
hWrite
        Handle -> IO ()
hClose Handle
hWrite

data HookHandler = HookHandler
  { HookHandler -> String
hookName :: !String
  , HookHandler -> (Handle, Handle) -> SetupHooks -> HooksM ()
hookHandler :: (Handle, Handle) -> SetupHooks -> HooksM ()
  }

hookHandlers :: [HookHandler]
hookHandlers :: [HookHandler]
hookHandlers =
  [ let hookName :: String
hookName = String
"version"
     in String
-> ((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler
HookHandler String
hookName (((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler)
-> ((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler
forall a b. (a -> b) -> a -> b
$ \(Handle, Handle)
h SetupHooks
_ ->
          (Handle, Handle)
-> String -> (() -> HooksM HooksVersion) -> HooksM ()
forall inputs outputs.
(Binary inputs, Binary outputs) =>
(Handle, Handle)
-> String -> (inputs -> HooksM outputs) -> HooksM ()
runHookHandle (Handle, Handle)
h String
hookName ((() -> HooksM HooksVersion) -> HooksM ())
-> (() -> HooksM HooksVersion) -> HooksM ()
forall a b. (a -> b) -> a -> b
$ \() ->
            HooksVersion -> HooksM HooksVersion
forall a. a -> ExceptT SetupHooksExeException IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HooksVersion
hooksVersion
  , let hookName :: String
hookName = String
"preConfPackage"
        noHook :: PreConfPackageInputs -> m PreConfPackageOutputs
noHook (PreConfPackageInputs{localBuildConfig :: PreConfPackageInputs -> LocalBuildConfig
localBuildConfig = LocalBuildConfig
lbc}) =
          PreConfPackageOutputs -> m PreConfPackageOutputs
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PreConfPackageOutputs -> m PreConfPackageOutputs)
-> PreConfPackageOutputs -> m PreConfPackageOutputs
forall a b. (a -> b) -> a -> b
$
            PreConfPackageOutputs
              { buildOptions :: BuildOptions
buildOptions = LocalBuildConfig -> BuildOptions
LBC.withBuildOptions LocalBuildConfig
lbc
              , extraConfiguredProgs :: ConfiguredProgs
extraConfiguredProgs = ConfiguredProgs
forall k a. Map k a
Map.empty
              }
     in String
-> ((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler
HookHandler String
hookName (((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler)
-> ((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler
forall a b. (a -> b) -> a -> b
$ \(Handle, Handle)
h (SetupHooks{configureHooks :: SetupHooks -> ConfigureHooks
configureHooks = ConfigureHooks{Maybe PostConfPackageHook
Maybe PreConfComponentHook
Maybe PreConfPackageHook
preConfPackageHook :: Maybe PreConfPackageHook
postConfPackageHook :: Maybe PostConfPackageHook
preConfComponentHook :: Maybe PreConfComponentHook
postConfPackageHook :: ConfigureHooks -> Maybe PostConfPackageHook
preConfComponentHook :: ConfigureHooks -> Maybe PreConfComponentHook
preConfPackageHook :: ConfigureHooks -> Maybe PreConfPackageHook
..}}) ->
          (Handle, Handle)
-> String
-> (PreConfPackageInputs -> HooksM PreConfPackageOutputs)
-> HooksM ()
forall inputs outputs.
(Binary inputs, Binary outputs) =>
(Handle, Handle)
-> String -> (inputs -> HooksM outputs) -> HooksM ()
runHookHandle (Handle, Handle)
h String
hookName ((PreConfPackageInputs -> HooksM PreConfPackageOutputs)
 -> HooksM ())
-> (PreConfPackageInputs -> HooksM PreConfPackageOutputs)
-> HooksM ()
forall a b. (a -> b) -> a -> b
$ (PreConfPackageInputs -> HooksM PreConfPackageOutputs)
-> (PreConfPackageHook
    -> PreConfPackageInputs -> HooksM PreConfPackageOutputs)
-> Maybe PreConfPackageHook
-> PreConfPackageInputs
-> HooksM PreConfPackageOutputs
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PreConfPackageInputs -> HooksM PreConfPackageOutputs
forall {m :: * -> *}.
Monad m =>
PreConfPackageInputs -> m PreConfPackageOutputs
noHook (IO PreConfPackageOutputs -> HooksM PreConfPackageOutputs
forall a. IO a -> ExceptT SetupHooksExeException IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PreConfPackageOutputs -> HooksM PreConfPackageOutputs)
-> PreConfPackageHook
-> PreConfPackageInputs
-> HooksM PreConfPackageOutputs
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) Maybe PreConfPackageHook
preConfPackageHook
  , let hookName :: String
hookName = String
"postConfPackage"
        noHook :: p -> m ()
noHook p
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     in String
-> ((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler
HookHandler String
hookName (((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler)
-> ((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler
forall a b. (a -> b) -> a -> b
$ \(Handle, Handle)
h (SetupHooks{configureHooks :: SetupHooks -> ConfigureHooks
configureHooks = ConfigureHooks{Maybe PostConfPackageHook
Maybe PreConfComponentHook
Maybe PreConfPackageHook
postConfPackageHook :: ConfigureHooks -> Maybe PostConfPackageHook
preConfComponentHook :: ConfigureHooks -> Maybe PreConfComponentHook
preConfPackageHook :: ConfigureHooks -> Maybe PreConfPackageHook
preConfPackageHook :: Maybe PreConfPackageHook
postConfPackageHook :: Maybe PostConfPackageHook
preConfComponentHook :: Maybe PreConfComponentHook
..}}) ->
          (Handle, Handle)
-> String -> (PostConfPackageInputs -> HooksM ()) -> HooksM ()
forall inputs outputs.
(Binary inputs, Binary outputs) =>
(Handle, Handle)
-> String -> (inputs -> HooksM outputs) -> HooksM ()
runHookHandle (Handle, Handle)
h String
hookName ((PostConfPackageInputs -> HooksM ()) -> HooksM ())
-> (PostConfPackageInputs -> HooksM ()) -> HooksM ()
forall a b. (a -> b) -> a -> b
$ (PostConfPackageInputs -> HooksM ())
-> (PostConfPackageHook -> PostConfPackageInputs -> HooksM ())
-> Maybe PostConfPackageHook
-> PostConfPackageInputs
-> HooksM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PostConfPackageInputs -> HooksM ()
forall {m :: * -> *} {p}. Monad m => p -> m ()
noHook (IO () -> HooksM ()
forall a. IO a -> ExceptT SetupHooksExeException IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HooksM ())
-> PostConfPackageHook -> PostConfPackageInputs -> HooksM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) Maybe PostConfPackageHook
postConfPackageHook
  , let hookName :: String
hookName = String
"preConfComponent"
        noHook :: PreConfComponentInputs -> m PreConfComponentOutputs
noHook (PreConfComponentInputs{component :: PreConfComponentInputs -> Component
component = Component
c}) =
          PreConfComponentOutputs -> m PreConfComponentOutputs
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PreConfComponentOutputs -> m PreConfComponentOutputs)
-> PreConfComponentOutputs -> m PreConfComponentOutputs
forall a b. (a -> b) -> a -> b
$ PreConfComponentOutputs{componentDiff :: ComponentDiff
componentDiff = ComponentName -> ComponentDiff
emptyComponentDiff (ComponentName -> ComponentDiff) -> ComponentName -> ComponentDiff
forall a b. (a -> b) -> a -> b
$ Component -> ComponentName
componentName Component
c}
     in String
-> ((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler
HookHandler String
hookName (((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler)
-> ((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler
forall a b. (a -> b) -> a -> b
$ \(Handle, Handle)
h (SetupHooks{configureHooks :: SetupHooks -> ConfigureHooks
configureHooks = ConfigureHooks{Maybe PostConfPackageHook
Maybe PreConfComponentHook
Maybe PreConfPackageHook
postConfPackageHook :: ConfigureHooks -> Maybe PostConfPackageHook
preConfComponentHook :: ConfigureHooks -> Maybe PreConfComponentHook
preConfPackageHook :: ConfigureHooks -> Maybe PreConfPackageHook
preConfPackageHook :: Maybe PreConfPackageHook
postConfPackageHook :: Maybe PostConfPackageHook
preConfComponentHook :: Maybe PreConfComponentHook
..}}) ->
          (Handle, Handle)
-> String
-> (PreConfComponentInputs -> HooksM PreConfComponentOutputs)
-> HooksM ()
forall inputs outputs.
(Binary inputs, Binary outputs) =>
(Handle, Handle)
-> String -> (inputs -> HooksM outputs) -> HooksM ()
runHookHandle (Handle, Handle)
h String
hookName ((PreConfComponentInputs -> HooksM PreConfComponentOutputs)
 -> HooksM ())
-> (PreConfComponentInputs -> HooksM PreConfComponentOutputs)
-> HooksM ()
forall a b. (a -> b) -> a -> b
$ (PreConfComponentInputs -> HooksM PreConfComponentOutputs)
-> (PreConfComponentHook
    -> PreConfComponentInputs -> HooksM PreConfComponentOutputs)
-> Maybe PreConfComponentHook
-> PreConfComponentInputs
-> HooksM PreConfComponentOutputs
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PreConfComponentInputs -> HooksM PreConfComponentOutputs
forall {m :: * -> *}.
Monad m =>
PreConfComponentInputs -> m PreConfComponentOutputs
noHook (IO PreConfComponentOutputs -> HooksM PreConfComponentOutputs
forall a. IO a -> ExceptT SetupHooksExeException IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PreConfComponentOutputs -> HooksM PreConfComponentOutputs)
-> PreConfComponentHook
-> PreConfComponentInputs
-> HooksM PreConfComponentOutputs
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) Maybe PreConfComponentHook
preConfComponentHook
  , let hookName :: String
hookName = String
"preBuildRules"
     in String
-> ((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler
HookHandler String
hookName (((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler)
-> ((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler
forall a b. (a -> b) -> a -> b
$ \(Handle, Handle)
h (SetupHooks{buildHooks :: SetupHooks -> BuildHooks
buildHooks = BuildHooks{Maybe PreBuildComponentRules
Maybe PostBuildComponentHook
preBuildComponentRules :: Maybe PreBuildComponentRules
postBuildComponentHook :: Maybe PostBuildComponentHook
postBuildComponentHook :: BuildHooks -> Maybe PostBuildComponentHook
preBuildComponentRules :: BuildHooks -> Maybe PreBuildComponentRules
..}}) ->
          (Handle, Handle)
-> String
-> (PreBuildComponentInputs
    -> HooksM (Map RuleId Rule, [MonitorFilePath]))
-> HooksM ()
forall inputs outputs.
(Binary inputs, Binary outputs) =>
(Handle, Handle)
-> String -> (inputs -> HooksM outputs) -> HooksM ()
runHookHandle (Handle, Handle)
h String
hookName ((PreBuildComponentInputs
  -> HooksM (Map RuleId Rule, [MonitorFilePath]))
 -> HooksM ())
-> (PreBuildComponentInputs
    -> HooksM (Map RuleId Rule, [MonitorFilePath]))
-> HooksM ()
forall a b. (a -> b) -> a -> b
$ \PreBuildComponentInputs
preBuildInputs ->
            case Maybe PreBuildComponentRules
preBuildComponentRules of
              Maybe PreBuildComponentRules
Nothing -> (Map RuleId Rule, [MonitorFilePath])
-> HooksM (Map RuleId Rule, [MonitorFilePath])
forall a. a -> ExceptT SetupHooksExeException IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map RuleId Rule
forall k a. Map k a
Map.empty, [])
              Just PreBuildComponentRules
pbcRules ->
                IO (Map RuleId Rule, [MonitorFilePath])
-> HooksM (Map RuleId Rule, [MonitorFilePath])
forall a. IO a -> ExceptT SetupHooksExeException IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map RuleId Rule, [MonitorFilePath])
 -> HooksM (Map RuleId Rule, [MonitorFilePath]))
-> IO (Map RuleId Rule, [MonitorFilePath])
-> HooksM (Map RuleId Rule, [MonitorFilePath])
forall a b. (a -> b) -> a -> b
$
                  Verbosity
-> PreBuildComponentInputs
-> PreBuildComponentRules
-> IO (Map RuleId Rule, [MonitorFilePath])
forall env.
Verbosity
-> env -> Rules env -> IO (Map RuleId Rule, [MonitorFilePath])
computeRules Verbosity
hooksExeVerbosity PreBuildComponentInputs
preBuildInputs PreBuildComponentRules
pbcRules
  , let hookName :: String
hookName = String
"runPreBuildRuleDeps"
     in String
-> ((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler
HookHandler String
hookName (((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler)
-> ((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler
forall a b. (a -> b) -> a -> b
$ \(Handle, Handle)
h SetupHooks
_ ->
          (Handle, Handle)
-> String
-> ((RuleId, RuleDynDepsCmd 'User)
    -> HooksM ([Dependency], ByteString))
-> HooksM ()
forall inputs outputs.
(Binary inputs, Binary outputs) =>
(Handle, Handle)
-> String -> (inputs -> HooksM outputs) -> HooksM ()
runHookHandle (Handle, Handle)
h String
hookName (((RuleId, RuleDynDepsCmd 'User)
  -> HooksM ([Dependency], ByteString))
 -> HooksM ())
-> ((RuleId, RuleDynDepsCmd 'User)
    -> HooksM ([Dependency], ByteString))
-> HooksM ()
forall a b. (a -> b) -> a -> b
$ \(RuleId
ruleId, RuleDynDepsCmd 'User
ruleDeps) ->
            case RuleDynDepsCmd 'User -> Maybe (IO ([Dependency], ByteString))
runRuleDynDepsCmd RuleDynDepsCmd 'User
ruleDeps of
              Maybe (IO ([Dependency], ByteString))
Nothing ->
                SetupHooksExeException -> HooksM ([Dependency], ByteString)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (SetupHooksExeException -> HooksM ([Dependency], ByteString))
-> SetupHooksExeException -> HooksM ([Dependency], ByteString)
forall a b. (a -> b) -> a -> b
$
                  String -> BadHooksExecutableArgs -> SetupHooksExeException
BadHooksExeArgs String
hookName (BadHooksExecutableArgs -> SetupHooksExeException)
-> BadHooksExecutableArgs -> SetupHooksExeException
forall a b. (a -> b) -> a -> b
$
                    RuleId -> BadHooksExecutableArgs
NoDynDepsCmd RuleId
ruleId
              Just IO ([Dependency], ByteString)
getDeps -> IO ([Dependency], ByteString) -> HooksM ([Dependency], ByteString)
forall a. IO a -> ExceptT SetupHooksExeException IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ([Dependency], ByteString)
getDeps
  , let hookName :: String
hookName = String
"runPreBuildRule"
     in String
-> ((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler
HookHandler String
hookName (((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler)
-> ((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler
forall a b. (a -> b) -> a -> b
$ \(Handle, Handle)
h SetupHooks
_ ->
          (Handle, Handle)
-> String
-> ((RuleId, RuleExecCmd 'User) -> HooksM ())
-> HooksM ()
forall inputs outputs.
(Binary inputs, Binary outputs) =>
(Handle, Handle)
-> String -> (inputs -> HooksM outputs) -> HooksM ()
runHookHandle (Handle, Handle)
h String
hookName (((RuleId, RuleExecCmd 'User) -> HooksM ()) -> HooksM ())
-> ((RuleId, RuleExecCmd 'User) -> HooksM ()) -> HooksM ()
forall a b. (a -> b) -> a -> b
$ \(RuleId
_ruleId :: RuleId, RuleExecCmd 'User
rExecCmd) ->
            IO () -> HooksM ()
forall a. IO a -> ExceptT SetupHooksExeException IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HooksM ()) -> IO () -> HooksM ()
forall a b. (a -> b) -> a -> b
$ RuleExecCmd 'User -> IO ()
runRuleExecCmd RuleExecCmd 'User
rExecCmd
  , let hookName :: String
hookName = String
"postBuildComponent"
        noHook :: p -> m ()
noHook p
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     in String
-> ((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler
HookHandler String
hookName (((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler)
-> ((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler
forall a b. (a -> b) -> a -> b
$ \(Handle, Handle)
h (SetupHooks{buildHooks :: SetupHooks -> BuildHooks
buildHooks = BuildHooks{Maybe PreBuildComponentRules
Maybe PostBuildComponentHook
postBuildComponentHook :: BuildHooks -> Maybe PostBuildComponentHook
preBuildComponentRules :: BuildHooks -> Maybe PreBuildComponentRules
preBuildComponentRules :: Maybe PreBuildComponentRules
postBuildComponentHook :: Maybe PostBuildComponentHook
..}}) ->
          (Handle, Handle)
-> String -> (PostBuildComponentInputs -> HooksM ()) -> HooksM ()
forall inputs outputs.
(Binary inputs, Binary outputs) =>
(Handle, Handle)
-> String -> (inputs -> HooksM outputs) -> HooksM ()
runHookHandle (Handle, Handle)
h String
hookName ((PostBuildComponentInputs -> HooksM ()) -> HooksM ())
-> (PostBuildComponentInputs -> HooksM ()) -> HooksM ()
forall a b. (a -> b) -> a -> b
$ (PostBuildComponentInputs -> HooksM ())
-> (PostBuildComponentHook
    -> PostBuildComponentInputs -> HooksM ())
-> Maybe PostBuildComponentHook
-> PostBuildComponentInputs
-> HooksM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PostBuildComponentInputs -> HooksM ()
forall {m :: * -> *} {p}. Monad m => p -> m ()
noHook (IO () -> HooksM ()
forall a. IO a -> ExceptT SetupHooksExeException IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HooksM ())
-> PostBuildComponentHook -> PostBuildComponentInputs -> HooksM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) Maybe PostBuildComponentHook
postBuildComponentHook
  , let hookName :: String
hookName = String
"installComponent"
        noHook :: p -> m ()
noHook p
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     in String
-> ((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler
HookHandler String
hookName (((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler)
-> ((Handle, Handle) -> SetupHooks -> HooksM ()) -> HookHandler
forall a b. (a -> b) -> a -> b
$ \(Handle, Handle)
h (SetupHooks{installHooks :: SetupHooks -> InstallHooks
installHooks = InstallHooks{Maybe InstallComponentHook
installComponentHook :: Maybe InstallComponentHook
installComponentHook :: InstallHooks -> Maybe InstallComponentHook
..}}) ->
          (Handle, Handle)
-> String -> (InstallComponentInputs -> HooksM ()) -> HooksM ()
forall inputs outputs.
(Binary inputs, Binary outputs) =>
(Handle, Handle)
-> String -> (inputs -> HooksM outputs) -> HooksM ()
runHookHandle (Handle, Handle)
h String
hookName ((InstallComponentInputs -> HooksM ()) -> HooksM ())
-> (InstallComponentInputs -> HooksM ()) -> HooksM ()
forall a b. (a -> b) -> a -> b
$ (InstallComponentInputs -> HooksM ())
-> (InstallComponentHook -> InstallComponentInputs -> HooksM ())
-> Maybe InstallComponentHook
-> InstallComponentInputs
-> HooksM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe InstallComponentInputs -> HooksM ()
forall {m :: * -> *} {p}. Monad m => p -> m ()
noHook (IO () -> HooksM ()
forall a. IO a -> ExceptT SetupHooksExeException IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HooksM ())
-> InstallComponentHook -> InstallComponentInputs -> HooksM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) Maybe InstallComponentHook
installComponentHook
  ]