From 3b46b102a88a1935891cd8a36d1f98af1f18e176 Mon Sep 17 00:00:00 2001 From: sheaf Date: Thu, 12 Mar 2026 13:03:47 +0100 Subject: [PATCH] Pre-build rules can generate autogen extra sources With this commit, the SetupHooks API now considers all extra source files placed in the autogen directory for the component to be additional demands on pre-build rules. For example, a pre-build rule that generates a C or JavaScript source file (putting it in the appropriate autogen module for the component) will now be run, while it used to not be run before (as it used to be considered "not demanded"). --- .../src/Distribution/Simple/SetupHooks.hs | 26 ++- Cabal-syntax/src/Distribution/Utils/Path.hs | 20 +++ .../Simple/SetupHooks/Internal.hs | 148 +++++++++++++--- .../SetupHooks/SetupHooksNonHs/A.hs | 23 +++ .../SetupHooks/SetupHooksNonHs/Bot.c | 5 + .../SetupHooks/SetupHooksNonHs/Bot.h | 2 + .../SetupHooks/SetupHooksNonHs/Main.hs | 14 ++ .../SetupHooks/SetupHooksNonHs/Setup.hs | 7 + .../SetupHooks/SetupHooksNonHs/SetupHooks.hs | 160 ++++++++++++++++++ .../SetupHooks/SetupHooksNonHs/Top.c | 9 + .../SetupHooks/SetupHooksNonHs/Top.h | 6 + .../SetupHooks/SetupHooksNonHs/cabal.out | 11 ++ .../SetupHooks/SetupHooksNonHs/cabal.test.hs | 2 + .../setup-hooks-non-hs-rules-test.cabal | 35 ++++ changelog.d/pr-11573.md | 28 +++ 15 files changed, 466 insertions(+), 30 deletions(-) create mode 100644 cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/A.hs create mode 100644 cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Bot.c create mode 100644 cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Bot.h create mode 100644 cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Main.hs create mode 100644 cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Setup.hs create mode 100644 cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/SetupHooks.hs create mode 100644 cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Top.c create mode 100644 cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Top.h create mode 100644 cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/cabal.out create mode 100644 cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/setup-hooks-non-hs-rules-test.cabal create mode 100644 changelog.d/pr-11573.md diff --git a/Cabal-hooks/src/Distribution/Simple/SetupHooks.hs b/Cabal-hooks/src/Distribution/Simple/SetupHooks.hs index 19c21c75d9c..2a8b878e17a 100644 --- a/Cabal-hooks/src/Distribution/Simple/SetupHooks.hs +++ b/Cabal-hooks/src/Distribution/Simple/SetupHooks.hs @@ -73,7 +73,7 @@ module Distribution.Simple.SetupHooks , staticRule, dynamicRule -- *** Rule inputs/outputs - -- $rulesDemand + -- $rulesDeps , Location(..) , location , autogenComponentModulesDir @@ -317,7 +317,7 @@ Each t'Rule' consists of: Rules are constructed using either one of the 'staticRule' or 'dynamicRule' smart constructors. Directly constructing a t'Rule' using the constructors of that data type is not advised, as this relies on internal implementation details -which are subject to change in between versions of the `Cabal-hooks` library. +which are subject to change in between versions of the "Cabal-hooks" library. Note that: @@ -335,7 +335,7 @@ Note that: when to re-compute the entire set of rules. -} -{- $rulesDemand +{- $rulesDeps Rules can declare various kinds of dependencies: - 'staticDependencies': files or other rules that a rule statically depends on, @@ -373,6 +373,26 @@ to behave as follows: 1. Any time the rules are out-of-date, query the rules to obtain up-to-date rules. 2. Re-run stale rules. + +Cabal will execute all **demanded** rules in dependency order. A rule is +demanded if it satisfies one of the following conditions: + + 1. It is a dependency of another demanded rule. + 2. The rule generates a Haskell file declared in the autogen-modules field. + In this case, the rule **must** place the generated source file in the + 'autogenComponentModulesDir' appropriate for the component. + 3. (Since Cabal 3.18 only) The rule generates a non-Haskell source file, such + as a C or JavaScript source. In this case (because there is no + "autogen-c-sources" field), the following steps must be taken: + a. Add the file to the 'c-sources' (or 'js-sources', etc) field of the + package description in a per-component pre-configure hook, declaring it + in the same 'autogenComponentModulesDir' directory (as if it was a @.hs@ file). + b. Add a pre-build rule that generates the source file and puts it in + this same 'autogenComponentModulesDir' directory. + Note that any file declared in the 'includes'/'autogen-includes' fields + must be present at **configure** time, so cannot be generated in a + pre-build rule. In that case, either use a pre-configure hook or don't + declare it under the 'includes' field (if possible). -} {- $rulesAPI diff --git a/Cabal-syntax/src/Distribution/Utils/Path.hs b/Cabal-syntax/src/Distribution/Utils/Path.hs index a4d09334e01..786fcda43ea 100644 --- a/Cabal-syntax/src/Distribution/Utils/Path.hs +++ b/Cabal-syntax/src/Distribution/Utils/Path.hs @@ -59,6 +59,7 @@ module Distribution.Utils.Path , dropExtensionsSymbolicPath , replaceExtensionSymbolicPath , normaliseSymbolicPath + , relativePathMaybe -- ** Working directory handling , interpretSymbolicPathCWD @@ -90,6 +91,9 @@ import qualified System.FilePath as FilePath import Data.Kind ( Type ) +import Data.List + ( stripPrefix + ) import GHC.Stack ( HasCallStack ) @@ -338,6 +342,22 @@ interpretSymbolicPathAbsolute (AbsolutePath p) sym = interpretSymbolicPath (Just coerceSymbolicPath :: SymbolicPathX allowAbsolute from to1 -> SymbolicPathX allowAbsolute from to2 coerceSymbolicPath = coerce +-- | Does the second argument point to a sub-directory of the first one? +-- If so, return the relative portion of the path, relative to the first argument. +relativePathMaybe :: SymbolicPath from (Dir dir) -> SymbolicPath from to -> Maybe (RelativePath dir to) +relativePathMaybe base fp = + let dirPieces = + FilePath.splitDirectories $ + FilePath.dropTrailingPathSeparator $ + FilePath.normalise $ + getSymbolicPath base + pathPieces = + FilePath.splitDirectories $ + FilePath.normalise $ + getSymbolicPath fp + in unsafeMakeSymbolicPath . FilePath.joinPath + <$> stripPrefix dirPieces pathPieces + -- | Change both what a symbolic path is pointing from and pointing to. -- -- Avoid using this in new code. diff --git a/Cabal/src/Distribution/Simple/SetupHooks/Internal.hs b/Cabal/src/Distribution/Simple/SetupHooks/Internal.hs index 0057bbee9a1..3678df41da8 100644 --- a/Cabal/src/Distribution/Simple/SetupHooks/Internal.hs +++ b/Cabal/src/Distribution/Simple/SetupHooks/Internal.hs @@ -7,6 +7,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} -- | @@ -88,6 +89,7 @@ import Distribution.Compat.Prelude import Prelude () import Distribution.Compat.Lens ((.~)) +import Distribution.ModuleName (ModuleName) import Distribution.PackageDescription import Distribution.Simple.BuildPaths import Distribution.Simple.Compiler (Compiler (..)) @@ -123,6 +125,7 @@ import qualified Data.Map as Map import qualified Data.Set as Set import System.Directory (doesFileExist) +import qualified System.FilePath as FilePath -------------------------------------------------------------------------------- -- SetupHooks @@ -890,20 +893,64 @@ executeRulesUserOrSystem scope runDepsCmdData runCmdData verbosity lbi tgtInfo a , map (fmap ruleFromVertex) (v : vs) ) - -- Compute demanded rules. + -- Compute demanded rules: anything reachable from the roots, which are: -- - -- SetupHooks TODO: maybe requiring all generated modules to appear - -- in autogen-modules is excessive; we can look through all modules instead. + -- - autogen modules + -- - extra-c-sources, extra-asm-sources, ... + -- (there is no 'autogen' field for those, at least not yet) + -- + -- This does not include autogen-includes, because .h files are required + -- during configure time, so not relevant for pre-build rules which are run + -- after configure. + autogenModPaths :: [RelativePath Source File] autogenModPaths = map (\m -> moduleNameSymbolicPath m <.> "hs") $ - autogenModules $ - componentBuildInfo $ - targetComponent tgtInfo - leafRule_maybe (rId, r) = - if any ((r `ruleOutputsLocation`) . (Location compAutogenDir)) autogenModPaths - then vertexFromRuleId rId - else Nothing - leafRules = mapMaybe leafRule_maybe $ Map.toList allRules + autogenModules compBuildInfo + autogenExtraSourcesPaths :: [RelativePath Source File] + autogenExtraSourcesPaths = + concatMap (mapMaybe relativeToAutogen) $ + [ cSources compBuildInfo + , cxxSources compBuildInfo + , cmmSources compBuildInfo + , asmSources compBuildInfo + , jsSources compBuildInfo + ] + leafRule_maybe + :: (RuleId, RuleData scope) + -> Either (NotDemandedRuleReasons scope) Graph.Vertex + leafRule_maybe (rId, r) + | any (any $ (r `ruleOutputsLocation`) . Location compAutogenDir) $ + [ autogenModPaths + , autogenExtraSourcesPaths + ] = + case vertexFromRuleId rId of + Just v -> Right v + Nothing -> + error $ + unlines + [ "internal error: no graph vertex for rule " ++ show rId + , "Rule: " ++ show rId + ] + | otherwise = + Left $ + NDRR + { nonDemandedRules = Map.singleton rId r + , nonAutogenHaskellModules = + Map.singleton + rId + [ fromString $ intercalate "." $ FilePath.splitDirectories hsPath + | Location _ outPath <- NE.toList (results r) + , (hsPath, ".hs") <- [FilePath.splitExtension (getSymbolicPath outPath)] + ] + , filesNotInAutogenFolders = + Map.singleton + rId + [ unsafeCoerceSymbolicPath fp + | Location base fp <- NE.toList (results r) + , Nothing <- [relativeToAutogen base] + ] + } + (nonDmdReasons, leafRules) = partitionEithers $ map leafRule_maybe $ Map.toList allRules demandedRuleVerts = Set.fromList $ concatMap (Graph.reachable ruleGraph) leafRules nonDemandedRuleVerts = Set.fromList (Graph.vertices ruleGraph) Set.\\ demandedRuleVerts @@ -922,22 +969,7 @@ executeRulesUserOrSystem scope runDepsCmdData runCmdData verbosity lbi tgtInfo a -- Emit a warning if there are non-demanded rules. unless (null nonDemandedRuleVerts) $ warn verbosity $ - unlines $ - "The following rules are not demanded and will not be run:" - : concat - [ [ " - " ++ show rId ++ "," - , " generating " ++ show (NE.toList $ results r) - ] - | v <- Set.toList nonDemandedRuleVerts - , let (r, rId, _) = ruleFromVertex v - ] - ++ [ "Possible reasons for this error:" - , " - Some autogenerated modules were not declared" - , " (in the package description or in the pre-configure hooks)" - , " - The output location for an autogenerated module is incorrect," - , " (e.g. the file extension is incorrect, or" - , " it is not in the appropriate 'autogenComponentModules' directory)" - ] + pprNotDemandedRuleReasons comp compAutogenDir (mconcat nonDmdReasons) -- Run all the demanded rules, in dependency order. for_ sccs $ \(Graph.Node ruleVertex _) -> @@ -977,12 +1009,74 @@ executeRulesUserOrSystem scope runDepsCmdData runCmdData verbosity lbi tgtInfo a SSystem -> id clbi = targetCLBI tgtInfo mbWorkDir = mbWorkDirLBI lbi + comp = targetComponent tgtInfo compAutogenDir = autogenComponentModulesDir lbi clbi + compBuildInfo = componentBuildInfo comp errorOut e = dieWithException verbosity $ SetupHooksException $ RulesException e + relativeToAutogen :: SymbolicPath Pkg to -> Maybe (RelativePath Source to) + relativeToAutogen = relativePathMaybe compAutogenDir + +data NotDemandedRuleReasons scope = NDRR + { nonDemandedRules :: Map RuleId (RuleData scope) + , nonAutogenHaskellModules :: Map RuleId [ModuleName] + , filesNotInAutogenFolders :: Map RuleId [RelativePath Pkg File] + } +instance Semigroup (NotDemandedRuleReasons scope) where + NDRR r1 m1 f1 <> NDRR r2 m2 f2 = NDRR (r1 <> r2) (m1 <> m2) (f1 <> f2) +instance Monoid (NotDemandedRuleReasons scope) where + mempty = NDRR mempty mempty mempty + +pprNotDemandedRuleReasons + :: Component + -> SymbolicPath Pkg (Dir Source) + -> NotDemandedRuleReasons scope + -> String +pprNotDemandedRuleReasons + comp + compAutogenDir + (NDRR non_dmd_verts mods_map miss_files_map) = + unlines $ header ++ mods_lines ++ files_lines + where + mods = aux mods_map + miss_files = aux miss_files_map + + aux xs = concatMap (\(rId, x) -> map (rId,) x) $ Map.toList xs + ppr (rId, x) = " - " ++ show x ++ " (for rule " ++ show rId ++ ")" + + header :: [String] + header = + "The following rules are not demanded and will not be run:" + : concat + [ [ " - " ++ show rId ++ "," + , " generating " ++ show (NE.toList $ results r) + ] + | (rId, r) <- Map.toList non_dmd_verts + ] + + mods_lines, files_lines :: [String] + mods_lines + | null mods = + [] + | otherwise = + ("Perhaps add the following to the 'autogen-modules' field of '" ++ show comp ++ "'.") + : map ppr mods + files_lines + | null miss_files = + [] + | otherwise = + ("The following autogenerated file" ++ s ++ " for " ++ show comp ++ " " ++ isOrAre ++ " misplaced.") + : (itOrThey ++ " should go in " ++ show compAutogenDir ++ "'.") + : map ppr miss_files + where + (s, isOrAre, itOrThey) = + case miss_files of + [_] -> ("", "is", "It") + _ -> ("s", "are", "They") + directRuleDependencyMaybe :: Rule.Dependency -> Maybe RuleId directRuleDependencyMaybe (RuleDependency dep) = Just $ outputOfRule dep directRuleDependencyMaybe (FileDependency{}) = Nothing diff --git a/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/A.hs b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/A.hs new file mode 100644 index 00000000000..8945f63c1f3 --- /dev/null +++ b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/A.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE ForeignFunctionInterface, CApiFFI #-} + +module A ( bobble, isNeeded ) where + +import Foreign.C.Types ( CInt(..) ) + +-- B is autogenerated +import B ( foo, isNeeded ) + +bar x = 2 + foo x * 3 + +foreign export ccall bar :: CInt -> CInt + +wobble x = gen_quux x + +foreign import capi "Gen.h gen_quux" gen_quux :: CInt -> CInt +foreign import capi "Gen.h gen_nozzle" gen_nozzle :: CInt -> CInt + +foreign import capi "Top.h wyzzy" wyzzy :: CInt -> CInt + +bobble = wyzzy 0 + +foreign export ccall wobble :: CInt -> CInt diff --git a/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Bot.c b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Bot.c new file mode 100644 index 00000000000..a064199f267 --- /dev/null +++ b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Bot.c @@ -0,0 +1,5 @@ + + +int xyzzy(int x) { + return (x - 99); +} diff --git a/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Bot.h b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Bot.h new file mode 100644 index 00000000000..60b50c08a3d --- /dev/null +++ b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Bot.h @@ -0,0 +1,2 @@ + +int xyzzy(int); diff --git a/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Main.hs b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Main.hs new file mode 100644 index 00000000000..7c1cca760bd --- /dev/null +++ b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Main.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +module Main where + +import Foreign.C.Types (CInt(..)) + +import A (bobble, isNeeded) + +foreign import ccall razzle :: CInt -> CInt + +main = do + print bobble + print $ razzle 3 + print $ isNeeded 77 diff --git a/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Setup.hs b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Setup.hs new file mode 100644 index 00000000000..4ad8e7121af --- /dev/null +++ b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Setup.hs @@ -0,0 +1,7 @@ +module Main where + +import Distribution.Simple ( defaultMainWithSetupHooks ) +import SetupHooks ( setupHooks ) + +main :: IO () +main = defaultMainWithSetupHooks setupHooks diff --git a/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/SetupHooks.hs b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/SetupHooks.hs new file mode 100644 index 00000000000..f144af69867 --- /dev/null +++ b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/SetupHooks.hs @@ -0,0 +1,160 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecursiveDo #-} +{-# LANGUAGE StaticPointers #-} + +module SetupHooks where + +import Distribution.Compat.Binary +import Distribution.ModuleName +import Distribution.Simple.LocalBuildInfo + ( interpretSymbolicPathLBI ) +import Distribution.Simple.SetupHooks +import Distribution.Simple.Utils +import Distribution.Types.LocalBuildInfo + ( buildDirPBD ) +import Distribution.Types.UnqualComponentName + ( unUnqualComponentName ) +import Distribution.Utils.Path +import Distribution.Verbosity + +import Control.Monad ( void ) +import Data.Foldable ( for_ ) +import Data.List ( isPrefixOf ) +import qualified Data.List.NonEmpty as NE +import Data.String +import Data.Traversable ( for ) +import GHC.Generics + +import qualified Data.Map as Map + +setupHooks :: SetupHooks +setupHooks = + noSetupHooks + { configureHooks = + noConfigureHooks + { preConfComponentHook = Just pcc } + , buildHooks = + noBuildHooks + { preBuildComponentRules = Just $ rules (static ()) preBuildRules + } + } + +pcc :: PreConfComponentHook +pcc (PreConfComponentInputs _lbc pbd _comp) = + return $ + PreConfComponentOutputs $ ComponentDiff $ CExe $ + emptyExecutable + { buildInfo = + -- Need to add the .c files, so that they get included in the final + -- linking invocation. + -- + -- For the .h file: + -- + -- - We don't need it at configure time, so we generate it in a pre-build rule. + -- We can't add it to 'includes'/'autogenIncludes', as Cabal would go looking for it + -- at configure time (before we run pre-build rules). + -- - If we needed it at configure time, we would need to generate it + -- in this per-component pre-configure hook and then add it to 'includes'/'autogenIncludes'. + -- That would work, but would mean we wouldn't benefit from + -- recompilation checking. + emptyBuildInfo + { cSources = [ autogenDir unsafeMakeSymbolicPath "Gen.c" + , autogenDir unsafeMakeSymbolicPath "Gen2.c"] + } + } + where + autogenDir = buildDirPBD pbd (unsafeMakeSymbolicPath "NonHs/autogen") + +preBuildRules :: PreBuildComponentInputs -> RulesM () +preBuildRules (PreBuildComponentInputs { buildingWhat = what, localBuildInfo = lbi, targetInfo = tgt }) = mdo + let verbosityFlags = buildingWhatVerbosity what + clbi = targetCLBI tgt + autogenDir = autogenComponentModulesDir lbi clbi + buildDir = componentBuildDir lbi clbi + + runPpAction1 (PpInput {..}) = do + let verbosity = mkVerbosity defaultVerbosityHandles verbosityFlags + warn verbosity "Running MyPp1" + rewriteFileEx verbosity (getSymbolicPath genDir "Gen.h") $ unlines + [ "#include \"Bot.h\"" + , "int gen_quux(int);" + , "int gen_nozzle(int);" + , "int norbert(int);" + ] + rewriteFileEx verbosity (getSymbolicPath genDir "Gen.c") $ unlines + [ "#include \"A_stub.h\"" + , "#include \"B_stub.h\"" + , "int gen_quux(int x) { return (foo(x) + bar(x)); };" + , "int gen_nozzle(int x) { return (x + wobble(x)); };" + , "int norbert(int x) { return (x+x); };" + ] + + runPpAction2 (PpInput {..}) = do + let verbosity = mkVerbosity defaultVerbosityHandles verbosityFlags + warn verbosity "Running MyPp2" + rewriteFileEx verbosity (getSymbolicPath genDir "B.hs") $ unlines + [ "{-# LANGUAGE ForeignFunctionInterface, CApiFFI #-}" + , "module B where" + , "import Foreign.C.Types (CInt(..))" + , "foo :: CInt -> CInt" + , "foo x = 2 * x + 1" + , "" + , "foreign export ccall foo :: CInt -> CInt" + , "foreign import capi \"Gen.h norbert\" norbert :: CInt -> CInt" + , "" + , "foreign import ccall \"is_needed\" isNeeded :: Int -> Int" + ] + + -- Check that this rule is demanded via the cSources demand. + -- No other rule demands it. + runPpAction3 (PpInput {..}) = do + let verbosity = mkVerbosity defaultVerbosityHandles verbosityFlags + warn verbosity "Running MyPp3" + rewriteFileEx verbosity (getSymbolicPath genDir "Gen2.c") $ unlines + [ "int is_needed(int x) { return (x+ 999000); };" + ] + + mkRule1 = + staticRule + (mkCommand (static Dict) (static runPpAction1) $ PpInput {genDir = autogenDir, ..}) + [ ] + ( Location autogenDir (unsafeMakeSymbolicPath "Gen.h") NE.:| + [ Location autogenDir (unsafeMakeSymbolicPath "Gen.c") + ] ) + + mkRule2 dep = + staticRule + (mkCommand (static Dict) (static runPpAction2) $ PpInput {genDir = autogenDir, ..}) + [ RuleDependency (RuleOutput dep 0) ] + ( Location autogenDir (unsafeMakeSymbolicPath "B.hs") NE.:| [] ) + + mkRule3 = + staticRule + (mkCommand (static Dict) (static runPpAction3) $ PpInput {genDir = autogenDir, ..}) + [ ] + ( NE.singleton $ Location autogenDir (unsafeMakeSymbolicPath "Gen2.c") ) + + r1 <- registerRule "MyPP1" mkRule1 + void $ registerRule "MyPP2" (mkRule2 r1) + void $ registerRule "MyPP3" mkRule3 + +-- | Input to preprocessor command +data PpInput + = PpInput + { verbosityFlags :: VerbosityFlags + , genDir :: SymbolicPath Pkg (Dir Source) + } + deriving stock ( Show, Generic ) + deriving anyclass Binary + +modName :: ModuleName -> String +modName = intercalate "." . components + +modNames :: [ModuleName] -> String +modNames mns = "[" ++ intercalate ", " (map modName mns) ++ "]" diff --git a/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Top.c b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Top.c new file mode 100644 index 00000000000..4b57bfe9e0a --- /dev/null +++ b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Top.c @@ -0,0 +1,9 @@ + +#include "Gen.h" +#include "A_stub.h" + +int wyzzy(int x) { return (gen_nozzle(x) + 1); }; + +int razzle(int x) { + return (bar(x) - wobble(x)); +} diff --git a/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Top.h b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Top.h new file mode 100644 index 00000000000..0537d61aa97 --- /dev/null +++ b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/Top.h @@ -0,0 +1,6 @@ + +#include "Gen.h" + +int wyzzy(int); + +int razzle(int); diff --git a/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/cabal.out b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/cabal.out new file mode 100644 index 00000000000..561fd270492 --- /dev/null +++ b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/cabal.out @@ -0,0 +1,11 @@ +# cabal run +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - setup-hooks-non-hs-rules-test-0.1.0.0 (exe:NonHs) (first run) +Configuring setup-hooks-non-hs-rules-test-0.1.0.0... +Warning: Running MyPp3 +Warning: Running MyPp1 +Warning: Running MyPp2 +Preprocessing executable 'NonHs' for setup-hooks-non-hs-rules-test-0.1.0.0... +Building executable 'NonHs' for setup-hooks-non-hs-rules-test-0.1.0.0... diff --git a/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/cabal.test.hs b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/cabal.test.hs new file mode 100644 index 00000000000..927d123f0ff --- /dev/null +++ b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/cabal.test.hs @@ -0,0 +1,2 @@ +import Test.Cabal.Prelude +main = cabalTest $ cabal "run" [] diff --git a/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/setup-hooks-non-hs-rules-test.cabal b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/setup-hooks-non-hs-rules-test.cabal new file mode 100644 index 00000000000..e59d950d270 --- /dev/null +++ b/cabal-testsuite/PackageTests/SetupHooks/SetupHooksNonHs/setup-hooks-non-hs-rules-test.cabal @@ -0,0 +1,35 @@ +cabal-version: 3.14 +name: setup-hooks-non-hs-rules-test +version: 0.1.0.0 +synopsis: Test implementing rules for non-hs files (.c, .h etc) +license: BSD-3-Clause +author: NA +maintainer: NA +category: Testing +build-type: Hooks + +custom-setup + setup-depends: Cabal, Cabal-hooks, base, filepath, containers + +executable NonHs + hs-source-dirs: . + main-is: Main.hs + + other-modules: A, B + autogen-modules: B + + include-dirs: . + includes: Bot.h + + c-sources: Bot.c, Top.c + + -- Gen.c gets declared by a pre-conf hook, and generated by a pre-build rule. + -- + -- Gen.h gets generated by a pre-build rule, but we can't declare it in + -- the 'includes' or 'autogen-includes' fields, as those are expected to be + -- present at configure time. + -- Instead, we simply rely on it being present because the autogen module is + -- added to include paths. + + build-depends: base + default-language: Haskell2010 diff --git a/changelog.d/pr-11573.md b/changelog.d/pr-11573.md new file mode 100644 index 00000000000..8d0d6e3bb27 --- /dev/null +++ b/changelog.d/pr-11573.md @@ -0,0 +1,28 @@ +--- +synopsis: Pre-build rules can generate autogen extra sources +packages: [Cabal, Cabal-hooks] +prs: 11573 +issues: 11607 +--- + +It is now possible to write pre-build rules that generate source files other +than Haskell files. + +Because there is no counterpart to `autogen-modules` for non-Haskell source +files, you will need to proceed in two steps: + + 1. In a per-component pre-configure hook, add the files you want to generate + to the relevant fields, e.g. the `cSources` field of `BuildInfo`. + + These files must be relative to `autogenCompModulesDir`. + + 2. Pre-build rules generating these files will now be demanded. This avoids + getting an error message "The following pre-build rules are not demanded + and will not be run". + +Note that include files (such as `.h` files) are a bit different: any files +listed under `includes`/`autogen-includes` are required at **configure** time. +This gives `SetupHooks` authors two choices: either list the include files in +`autogen-includes` but generate them in a pre-configure hook, or don't list them +there and generate them in a pre-build rule, relying on the files getting picked +up from included directories (this may be brittle).