hooks-exe (empty) → 3.18

raw patch · 6 files changed

+403/−0 lines, 6 filesdep +Cabaldep +Cabal-syntaxdep +basesetup-changed

Dependencies added: Cabal, Cabal-syntax, base, bytestring, filepath, process

Files

Setup.hs +6/−0
changelog.md +6/−0
cli/Distribution/Client/SetupHooks/CallHooksExe.hs +238/−0
cli/Distribution/Client/SetupHooks/CallHooksExe/Errors.hs +92/−0
hooks-exe.cabal +57/−0
readme.md +4/−0

+ Setup.hs view

@@ -0,0 +1,6 @@+module Main where
+
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain

+ changelog.md view

@@ -0,0 +1,6 @@+# Changelog for `hooks-exe`
+
+## 3.18 – July 2026
+
+  * Initial release of `Hooks` integration for `cabal-install`.
+

+ cli/Distribution/Client/SetupHooks/CallHooksExe.hs view

@@ -0,0 +1,238 @@+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{- HLINT ignore "Use curry" -}
+
+module Distribution.Client.SetupHooks.CallHooksExe
+  ( callHooksExe
+  , externalSetupHooks
+  , externalSetupHooksABI
+  , buildTypeSetupHooks
+  , buildTypePreBuildHooks
+  , runExternalPreBuildRules
+  , hooksProgFilePath
+  ) where
+
+-- base
+import GHC.Stack
+
+-- bytestring
+import Data.ByteString.Lazy as LBS
+  ( hGetContents
+  , hPut
+  , null
+  )
+
+-- process
+import qualified System.Process as P
+import System.Process.CommunicationHandle
+  ( readCreateProcessWithExitCodeCommunicationHandle )
+
+-- filepath
+import System.FilePath
+  ( (</>), (<.>) )
+
+-- Cabal
+import Distribution.Compat.Prelude
+import qualified Distribution.Compat.Binary as Binary
+import Distribution.Simple
+  ( autoconfSetupHooks )
+import Distribution.Simple.Build
+  ( builtinPreBuildHooks )
+import Distribution.Simple.BuildPaths
+  ( exeExtension )
+import Distribution.Simple.SetupHooks.Internal
+import Distribution.Simple.SetupHooks.Rule
+import Distribution.Simple.Utils
+  ( dieWithException )
+import Distribution.System
+  ( buildPlatform )
+import Distribution.Types.BuildType
+  ( BuildType(..) )
+import Distribution.Utils.Path
+  ( CWD
+  , Dist
+  , Pkg
+  , SymbolicPath
+  , FileOrDir(..)
+  , interpretSymbolicPath
+  )
+import Distribution.Verbosity
+  ( Verbosity, VerbosityHandles, mkVerbosity )
+
+-- hooks-cli
+import Distribution.Client.SetupHooks.CallHooksExe.Errors
+import Distribution.Simple.SetupHooks.HooksMain
+  ( HooksVersion )
+
+--------------------------------------------------------------------------------
+
+type HookIO inputs outputs =
+  ( HasCallStack
+  , Typeable inputs, Typeable outputs
+  , Binary inputs, Binary outputs
+  )
+
+-- | Call an external hooks executable in order to execute a Cabal Setup hook.
+callHooksExe
+  :: forall inputs outputs
+  .  HookIO inputs outputs
+  => Verbosity
+  -> FilePath -- ^ path to hooks executable
+  -> String   -- ^ name of the hook to run
+  -> inputs   -- ^ argument to the hook
+  -> IO outputs
+callHooksExe verb hooksExe hookName input = do
+  (ex, output) <-
+    -- The arguments to the external hooks executable are:
+    --
+    --  1. Input handle, from which the hooks executable receives its input.
+    --  2. Output handle, to which the hooks executable writes its output.
+    --  3. The hook type to run.
+    --
+    -- The hooks executable will read input from the input handle, decode it,
+    -- run the necessary hook, producing a result which it encodes and writes
+    -- to the output handle.
+    readCreateProcessWithExitCodeCommunicationHandle
+      ( \(theyRead, theyWrite) -> P.proc hooksExe [show theyRead, show theyWrite, hookName] )
+      ( \ hWeRead -> hGetContents hWeRead )
+      ( \ hWeWrite -> do
+        let i = Binary.encode input
+        unless (LBS.null i) $
+          hPut hWeWrite i
+      )
+  case ex of
+    ExitFailure exitCode ->
+      dieWithException verb $
+        HookFailed hookName $
+          HookException exitCode
+    ExitSuccess -> do
+      let mbOutput = Binary.decodeOrFail output
+      case mbOutput of
+        Left (_, offset, err) -> do
+          dieWithException verb $
+            HookFailed hookName $
+              CouldNotDecodeOutput output offset err
+        Right (_, _, res) -> return res
+
+-- | Construct a 'SetupHooks' that runs the hooks of the external hooks executable
+-- at the given path through the CLI.
+--
+-- This should only be used at the final step of compiling a package, when we
+-- have all the hooks in hand. The SetupHooks that are returned by this function
+-- cannot be combined with any other SetupHooks; they must directly be used to
+-- build the package.
+externalSetupHooks :: Verbosity -> FilePath -> SetupHooks
+externalSetupHooks verb hooksExe =
+  SetupHooks
+    { configureHooks =
+        ConfigureHooks
+          { preConfPackageHook = Just $ hook "preConfPackage"
+          , postConfPackageHook = Just $ hook "postConfPackage"
+          , preConfComponentHook = Just $ hook "preConfComponent"
+          }
+    , buildHooks =
+        BuildHooks
+          { -- NB: external pre-build rules are special, due to the StaticPtr machinery.
+            -- To invoke them, we must separately call 'runExternalPreBuildRules'.
+            preBuildComponentRules = Nothing
+          , postBuildComponentHook = Just $ hook "postBuildComponent"
+          }
+    , installHooks =
+        InstallHooks
+          { installComponentHook = Just $ hook "installComponent"
+          }
+    }
+  where
+    hook :: HookIO inputs outputs => String -> inputs -> IO outputs
+    hook = callHooksExe verb hooksExe
+
+-- | The ABI of an external hooks executable.
+--
+-- This information is used to handshake before further communication,
+-- in order to avoid a cascade of errors with mismatched 'Binary' instances.
+externalSetupHooksABI :: Verbosity -> FilePath -> IO HooksVersion
+externalSetupHooksABI verb hooksExe =
+  callHooksExe verb hooksExe "version" ()
+
+-- | The 'SetupHooks' associated to a particular 'BuildType'.
+--
+-- **Warning:** for @build-type: Hooks@, this does not include the pre-build
+-- hooks. Those can be retrieved with 'buildTypePreBuildHooks'.
+buildTypeSetupHooks
+  :: Verbosity
+  -> Maybe (SymbolicPath CWD (Dir Pkg))
+  -> SymbolicPath Pkg (Dir Dist)
+  -> BuildType
+  -> SetupHooks
+buildTypeSetupHooks verb mbWorkDir distPref = \case
+  Hooks -> externalSetupHooks verb $ hooksProgFilePath mbWorkDir distPref
+  Configure -> autoconfSetupHooks
+  _ -> noSetupHooks
+    -- Note: if any built-in functionality is implemented using SetupHooks,
+    -- we would also need to include those.
+
+-- | The pre-build hooks obtained by communication with an external hooks executable.
+buildTypePreBuildHooks
+  :: VerbosityHandles
+  -> Maybe (SymbolicPath CWD (Dir Pkg))
+  -> SymbolicPath Pkg (Dir Dist)
+  -> BuildType
+  -> ( PreBuildComponentInputs -> IO [MonitorFilePath] )
+buildTypePreBuildHooks verbHandles mbWorkDir distPref bt pbci = do
+  builtinMons <- builtinPreBuildHooks bt pbci
+  externalMons <- case bt of
+    Hooks ->
+      runExternalPreBuildRules verbHandles
+        (hooksProgFilePath mbWorkDir distPref)
+        pbci
+    _ -> return []
+  return (builtinMons ++ externalMons)
+
+-- | Run pre-build rules coming from an external hooks executable at the
+-- given filepath.
+--
+-- Note that 'executeRulesUserOrSystem' handles recompilation checking, only
+-- re-running rules that are stale.
+runExternalPreBuildRules
+  :: VerbosityHandles
+  -> FilePath -- ^ path to external hooks executable
+  -> PreBuildComponentInputs
+  -> IO [MonitorFilePath]
+runExternalPreBuildRules verbHandles hooksExe
+  pbci@PreBuildComponentInputs
+    { buildingWhat = what
+    , localBuildInfo = lbi
+    , targetInfo = tgt } = do
+  let verbFlags = buildingWhatVerbosity what
+      verbosity = mkVerbosity verbHandles verbFlags
+      hook :: HookIO inputs outputs => String -> inputs -> IO outputs
+      hook = callHooksExe verbosity hooksExe
+  -- Here we make sure to use 'RuleBinary' (@'Scope' == 'System'@)
+  -- to avoid looking up static pointer keys from the hooks executable
+  -- from the outside (e.g. from within cabal-install).
+  (rulesMap :: Map RuleId RuleBinary, monitors) <- hook "preBuildRules" pbci
+  executeRulesUserOrSystem
+    SSystem
+    ( \ rId cmd -> case cmd of
+      StaticRuleCommand {} -> return Nothing
+      DynamicRuleCommands {} -> Just <$> hook "runPreBuildRuleDeps" (rId, cmd)
+    )
+    ( \ rId cmd -> hook "runPreBuildRule" (rId, cmd) )
+    verbosity lbi tgt rulesMap
+  return monitors
+
+-- | The path to the external hooks executable.
+hooksProgFilePath
+  :: Maybe (SymbolicPath CWD (Dir Pkg))
+  -> SymbolicPath Pkg (Dir Dist)
+  -> FilePath
+hooksProgFilePath mbWorkDir distPref =
+  interpretSymbolicPath mbWorkDir distPref
+    </> "setup"
+    </> "hooks"
+    <.> exeExtension buildPlatform

+ cli/Distribution/Client/SetupHooks/CallHooksExe/Errors.hs view

@@ -0,0 +1,92 @@+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+
+module Distribution.Client.SetupHooks.CallHooksExe.Errors
+  ( HookInput(..)
+  , SetupHooksCallExeException (..)
+  , HookFailedReason(..)
+  , setupHooksCallExeExceptionCode
+  , setupHooksCallExeExceptionMessage
+  ) where
+
+-- Cabal
+import Distribution.Compat.Binary
+  ( Binary )
+import Distribution.Simple.Utils
+
+-- base
+import GHC.Exception
+import Data.Int
+  ( Int64 )
+import Data.Typeable
+  ( Typeable )
+
+-- bytestring
+import Data.ByteString.Lazy
+  ( ByteString )
+
+--------------------------------------------------------------------------------
+
+data HookInput where
+  HookInput :: (Binary input, Typeable input, Show input)
+            => input -> HookInput
+instance Show HookInput where
+  show (HookInput input) = show input
+
+data SetupHooksCallExeException
+  = HookFailed
+      String
+        -- ^ hook name
+      HookFailedReason
+        -- ^ why did the hook fail?
+  deriving Show
+
+data HookFailedReason
+  -- | The hooks executable terminated with non-zero exit code.
+  = HookException
+      Int -- ^ exit code
+  -- | We failed to decode the output of the hooks executable.
+  | CouldNotDecodeOutput
+        ByteString
+          -- ^ hook output that we failed to decode
+        Int64
+          -- ^ byte offset at which the decoding error took place
+        String
+          -- ^ info about the decoding error
+  deriving Show
+
+setupHooksCallExeExceptionCode :: SetupHooksCallExeException -> Int
+setupHooksCallExeExceptionCode = \case
+  HookFailed _ reason -> setupHooksCallExeFailedExceptionCode reason
+
+setupHooksCallExeFailedExceptionCode :: HookFailedReason -> Int
+setupHooksCallExeFailedExceptionCode = \case
+  HookException {} -> 7717
+  CouldNotDecodeOutput {} -> 5412
+
+setupHooksCallExeExceptionMessage :: SetupHooksCallExeException -> String
+setupHooksCallExeExceptionMessage = \case
+  HookFailed hookName reason ->
+   setupHooksCallExeFailedMessage hookName reason
+
+setupHooksCallExeFailedMessage :: String -> HookFailedReason -> String
+setupHooksCallExeFailedMessage hookName = \case
+  HookException {} ->
+    "An exception occurred when running the " ++ hookName ++ " hook."
+  CouldNotDecodeOutput _bytes offset err ->
+    "Failed to decode the output of the " ++ hookName ++ " hook.\n\
+    \Decoding failed at position " ++ show offset ++ " with error: " ++ err ++ ".\n\
+    \This could be due to a mismatch between the Cabal version of cabal-install and of the hooks executable."
+
+instance Exception (VerboseException SetupHooksCallExeException) where
+  displayException (VerboseException stack timestamp verb err) =
+    withOutputMarker
+      verb
+      ( concat
+          [ "Error: [Cabal-"
+          , show (setupHooksCallExeExceptionCode err)
+          , "]\n"
+          ]
+      )
+      ++ exceptionWithMetadata stack timestamp verb (setupHooksCallExeExceptionMessage err)

+ hooks-exe.cabal view

@@ -0,0 +1,57 @@+cabal-version: 3.0
+name:          hooks-exe
+version:       3.18
+copyright:     2024, Cabal Development Team
+license:       BSD-3-Clause
+author:        Cabal Development Team <cabal-devel@haskell.org>
+maintainer:    cabal-devel@haskell.org
+homepage:      http://www.haskell.org/cabal/
+bug-reports:   https://github.com/haskell/cabal/issues
+synopsis:      cabal-install integration for Hooks build-type
+description:
+  Layer for integrating Hooks build-type with cabal-install
+category:      Distribution
+build-type:    Simple
+
+extra-doc-files:
+  readme.md changelog.md
+
+common warnings
+  ghc-options:
+    -Wall
+    -Wcompat
+    -Wnoncanonical-monad-instances -Wincomplete-uni-patterns
+    -Wincomplete-record-updates
+    -fno-warn-unticked-promoted-constructors
+  if impl(ghc < 8.8)
+    ghc-options: -Wnoncanonical-monadfail-instances
+  if impl(ghc >=9.0)
+    -- Warning: even though introduced with GHC 8.10, -Wunused-packages
+    -- gives false positives with GHC 8.10.
+    ghc-options: -Wunused-packages
+
+-- Library imported by cabal-install to interface with an external
+-- hooks executable.
+library
+  import: warnings
+  hs-source-dirs:
+    cli
+  build-depends:
+    base
+      >= 4.10     && < 5,
+    bytestring
+      >= 0.10.6.0 && < 0.13,
+    filepath
+      >= 1.4.0.0  && < 1.6 ,
+    process
+      >= 1.6.20.0 && < 1.7 ,
+    Cabal >= 3.18.0 && < 3.19,
+    Cabal-syntax >= 3.18.0 && < 3.19,
+
+  exposed-modules:
+    Distribution.Client.SetupHooks.CallHooksExe
+  other-modules:
+    Distribution.Client.SetupHooks.CallHooksExe.Errors
+
+  default-language:
+    Haskell2010

+ readme.md view

@@ -0,0 +1,4 @@+# `hooks-exe`
+
+This library integrates `Cabal`'s `Hooks` build-type into `cabal-install`.
+It is only meant to be used by `cabal-install`, not imported by users.