Add internal build tool to package-with-hooks test

cabal-testsuite/PackageTests/HooksPreprocessor/custom-build-tool/custom-build-tool.cabal

@@ -10,12 +10,29 @@ build-type:         Simple
 data-dir:
   custom-build-tool-data
 data-files:
-  CustomBuildToolData.txt
+  CustomPP1Data.txt
 
 common warnings
   ghc-options: -Wall
 
-executable custom-build-tool
+library
+
+  import:
+    warnings
+
+  hs-source-dirs:
+    src
+
+  exposed-modules:
+    CustomBuildTool
+
+  build-depends:
+    base ^>= 4.18 && < 5,
+    containers,
+    directory
+
+executable custom-pp1
+
   import:
     warnings
 
@@ -27,8 +44,7 @@ executable custom-build-tool
 
   build-depends:
     base ^>= 4.18 && < 5,
-    containers,
-    directory
+    custom-build-tool
 
   autogen-modules:
     Paths_custom_build_tool

cabal-testsuite/PackageTests/HooksPreprocessor/custom-build-tool/exe/Main.hs

@@ -1,97 +1,14 @@
 module Main where
 
--- base
-import Control.Monad
-  ( unless )
-import Data.Char
-  ( isSpace )
-import Data.List
-  ( dropWhileEnd )
-import System.Environment
-  ( getArgs )
-
--- containers
-import Data.Map.Strict
-  ( Map )
-import qualified Data.Map.Strict as Map
-
--- directory
-import System.Directory
-  ( doesFileExist, getCurrentDirectory )
-
 -- custom-build-tool
+import CustomBuildTool
+  ( mkCustomBuildTool )
 import Paths_custom_build_tool -- (Cabal autogenerated module)
   ( getDataFileName )
 
 --------------------------------------------------------------------------------
 
 main :: IO ()
 main = do
-  putStrLn "Starting custom-build-tool"
-  -- Get all the constants defined in the data file for the build tool.
-  customDataFile <- getDataFileName "CustomBuildToolData.txt"
-  customDataFileExists <- doesFileExist customDataFile
-  unless customDataFileExists $ do
-    cwd <- getCurrentDirectory
-    error $
-      unlines
-        [ "Custom preprocessor could not access its data file."
-        , "Tried to look in: " ++ customDataFile
-        , "cwd: " ++ show cwd ]
-  customDataLines <- lines <$> readFile customDataFile
-  let customConstants :: Map String Int
-      customConstants = Map.fromList $ map read customDataLines
-
-  -- Obtain input/output file paths from arguments to the preprocessor.
-  args <- getArgs
-  case args of
-    [inputFile, outputFile] -> do
-      inputFileExists <- doesFileExist inputFile
-      unless inputFileExists $
-        error $
-          unlines
-            [ "Custom preprocessor could not read input file."
-            , "Input file: " ++ inputFile ]
-      -- Read the input file, substitute constants for their values,
-      -- and write the result to the output file path.
-      inputLines <- lines <$> readFile inputFile
-      let outputLines = map ( preprocessLine customConstants ) ( zip [1..] inputLines )
-      writeFile outputFile ( unlines outputLines )
-    [] ->
-      putStrLn "Custom preprocessor: no arguments."
-    _ ->
-      error $
-        unlines
-          [ "Custom preprocessor was given incorrect arguments."
-          , "Expected input and output file paths, but got " ++ what ++ "." ]
-      where
-        what = case args of
-          [] -> "none"
-          [_] -> "a single argument"
-          _  -> show (length args) ++ " arguments"
-
--- | Substitute any occurrence of {# ConstantName #} with the value of ConstantName,
--- looked up in the data file for the preprocessor.
-preprocessLine :: Map String Int -> ( Int, String ) -> String
-preprocessLine constants ( ln_no, ln ) = go "" ln
-  where
-    go reversedPrev [] = reverse reversedPrev
-    go reversedPrev ('{':'#':rest) = reverse reversedPrev ++ inner "" rest
-    go reversedPrev (c:rest) = go (c:reversedPrev) rest
-
-    inner reversedNm ('#':'}':rest) =
-      let constName = trimWhitespace $ reverse reversedNm
-       in case Map.lookup constName constants of
-            Just val -> show val ++ go "" rest
-            Nothing ->
-              error $ unlines
-                [ "Could not preprocess line " ++ show ln_no ++ ":"
-                , "unknown constant \"" ++ constName ++ "\"." ]
-    inner reversedNm (c:rest) = inner (c:reversedNm) rest
-    inner reversedNm "" =
-      error $ unlines
-        [ "Could not preprocess line " ++ show ln_no ++ ":"
-        , "unterminated constant \"{# " ++ reverse reversedNm ++ "\"." ]
-
-trimWhitespace :: String -> String
-trimWhitespace = dropWhile isSpace . dropWhileEnd isSpace
+  customDataFile <- getDataFileName "CustomPP1Data.txt"
+  mkCustomBuildTool "custom-pp1" customDataFile

cabal-testsuite/PackageTests/HooksPreprocessor/custom-build-tool/src/CustomBuildTool.hs

@@ -0,0 +1,93 @@
+module CustomBuildTool
+  ( mkCustomBuildTool )
+  where
+
+-- base
+import Control.Monad
+  ( unless )
+import Data.Char
+  ( isSpace )
+import Data.List
+  ( dropWhileEnd )
+import System.Environment
+  ( getArgs )
+
+-- containers
+import Data.Map.Strict
+  ( Map )
+import qualified Data.Map.Strict as Map
+
+-- directory
+import System.Directory
+  ( doesFileExist, getCurrentDirectory )
+
+--------------------------------------------------------------------------------
+
+mkCustomBuildTool :: String -> FilePath -> IO ()
+mkCustomBuildTool buildToolName customDataFile = do
+  putStrLn $ "Starting " ++ buildToolName
+  -- Get all the constants defined in the data file for the build tool.
+  customDataFileExists <- doesFileExist customDataFile
+  unless customDataFileExists $ do
+    cwd <- getCurrentDirectory
+    error $
+      unlines
+        [ "Custom preprocessor " ++ buildToolName ++ " could not access its data file."
+        , "Tried to look in: " ++ customDataFile
+        , "cwd: " ++ show cwd ]
+  customDataLines <- lines <$> readFile customDataFile
+  let customConstants :: Map String Int
+      customConstants = Map.fromList $ map read customDataLines
+
+  -- Obtain input/output file paths from arguments to the preprocessor.
+  args <- getArgs
+  case args of
+    [inputFile, outputFile] -> do
+      inputFileExists <- doesFileExist inputFile
+      unless inputFileExists $
+        error $
+          unlines
+            [ "Custom preprocessor " ++ buildToolName ++ " could not read input file."
+            , "Input file: " ++ inputFile ]
+      -- Read the input file, substitute constants for their values,
+      -- and write the result to the output file path.
+      inputLines <- lines <$> readFile inputFile
+      let outputLines = map ( preprocessLine customConstants ) ( zip [1..] inputLines )
+      writeFile outputFile ( unlines outputLines )
+    [] ->
+      putStrLn $ "Custom preprocessor " ++ buildToolName ++ ": no arguments."
+    _ ->
+      error $
+        unlines
+          [ "Custom preprocessor " ++ buildToolName ++ " was given incorrect arguments."
+          , "Expected input and output file paths, but got " ++ what ++ "." ]
+      where
+        what = case args of
+          [_] -> "a single argument"
+          _  -> show (length args) ++ " arguments"
+
+-- | Substitute any occurrence of {# ConstantName #} with the value of ConstantName,
+-- looked up in the data file for the preprocessor.
+preprocessLine :: Map String Int -> ( Int, String ) -> String
+preprocessLine constants ( ln_no, ln ) = go "" ln
+  where
+    go reversedPrev [] = reverse reversedPrev
+    go reversedPrev ('{':'#':rest) = reverse reversedPrev ++ inner "" rest
+    go reversedPrev (c:rest) = go (c:reversedPrev) rest
+
+    inner reversedNm ('#':'}':rest) =
+      let constName = trimWhitespace $ reverse reversedNm
+       in case Map.lookup constName constants of
+            Just val -> show val ++ go "" rest
+            Nothing ->
+              error $ unlines
+                [ "Could not preprocess line " ++ show ln_no ++ ":"
+                , "unknown constant \"" ++ constName ++ "\"." ]
+    inner reversedNm (c:rest) = inner (c:reversedNm) rest
+    inner reversedNm "" =
+      error $ unlines
+        [ "Could not preprocess line " ++ show ln_no ++ ":"
+        , "unterminated constant \"{# " ++ reverse reversedNm ++ "\"." ]
+
+trimWhitespace :: String -> String
+trimWhitespace = dropWhile isSpace . dropWhileEnd isSpace

cabal-testsuite/PackageTests/HooksPreprocessor/package-with-hooks/SetupHooks.hs

@@ -25,42 +25,28 @@ import Distribution.Simple.SetupHooks
 -- Cabal
 import Distribution.ModuleName
   ( ModuleName )
-import Distribution.Simple.Flag
-  ( fromFlag )
 import Distribution.Simple.LocalBuildInfo
   ( mbWorkDirLBI )
 import Distribution.Simple.Program
-  ( configureProgram, runProgramCwd )
+  ( runProgramCwd )
 import Distribution.Simple.Program.Db
   ( lookupProgram )
 import Distribution.Simple.Utils
   ( createDirectoryIfMissingVerbose, findFileCwdWithExtension' )
 import Distribution.Types.Component
   ( componentBuildInfo )
-import qualified Distribution.Types.LocalBuildConfig as LBC
-  ( withPrograms )
 import Distribution.Types.LocalBuildInfo
   ( withPrograms )
-import Distribution.Types.VersionRange
-  ( anyVersion )
 import Distribution.Utils.Path
   ( SymbolicPath, FileOrDir(Dir), CWD, Pkg
-  , interpretSymbolicPath, getSymbolicPath, moduleNameSymbolicPath
+  , getSymbolicPath, moduleNameSymbolicPath
   )
 import Distribution.Utils.ShortText
   ( toShortText )
 
--- containers
-import qualified Data.Map as Map
-  ( singleton )
-
--- directory
-import System.Directory
-  ( getCurrentDirectory )
-
 -- filepath
 import System.FilePath
-  ( (</>), replaceExtension, takeDirectory )
+  ( (</>), replaceExtension, takeDirectory, takeExtension )
 
 --------------------------------------------------------------------------------
 
@@ -74,9 +60,6 @@ setupHooks =
         }
     }
 
-customPpName :: String
-customPpName = "custom-build-tool"
-
 -- | Runs the custom-build-tool preprocessor on all .hs-custompp files.
 preBuildRules :: PreBuildComponentInputs -> RulesM ()
 preBuildRules
@@ -94,24 +77,33 @@ preBuildRules
           progDb = withPrograms lbi
           mbWorkDir = mbWorkDirLBI lbi
 
-    -- 1. Look up the custom-build-tool preprocessor.
-      let customPpProg = simpleProgram customPpName
-          mbCustomPp = lookupProgram customPpProg progDb
-          customPp = case mbCustomPp of
+    -- 1. Look up the custom-build-tool preprocessors.
+      let customPp1Prog = simpleProgram "custom-pp1"
+          mbCustomPp1 = lookupProgram customPp1Prog progDb
+          customPp1 = case mbCustomPp1 of
+            Just pp -> pp
+            Nothing ->
+              error $
+                unlines
+                  [ "package-with-hooks: could not find custom-pp1 pre-processor in the program database."
+                  , "Component: " ++ show compNm ]
+          customPp2Prog = simpleProgram "custom-pp2"
+          mbCustomPp2 = lookupProgram customPp2Prog progDb
+          customPp2 = case mbCustomPp2 of
             Just pp -> pp
             Nothing ->
               error $
                 unlines
-                  [ "package-with-hooks: could not find " ++ show customPpName ++ " pre-processor in the program database."
+                  [ "package-with-hooks: could not find custom-pp2 pre-processor in the program database."
                   , "Component: " ++ show compNm ]
 
-    -- 2. Create a command to run this preprocess, passing input and output file locations.
+    -- 2. Create a command to run a preprocessor, passing input and output file locations.
       let
-        ppCmd :: Location -> Location
+        ppCmd :: ConfiguredProgram -> Location -> Location
               -> Command ( Verbosity, Maybe (SymbolicPath CWD (Dir Pkg)), ConfiguredProgram, Location, Location ) ( IO () )
-        ppCmd i o =
+        ppCmd pp i o =
           mkCommand ( static Dict ) ( static ppModule )
-            ( verbosity, mbWorkDir, customPp,  i, o )
+            ( verbosity, mbWorkDir, pp, i, o )
 
     -- 3. Get all modules listed in the package description for this component.
       let mods = componentModules comp
@@ -122,7 +114,7 @@ preBuildRules
       ppMbMods <-
         liftIO $
           for mods $ \ md -> do
-            mbPath <- findFileCwdWithExtension' mbWorkDir [ "hs-custompp" ] searchDirs
+            mbPath <- findFileCwdWithExtension' mbWorkDir [ "hs-custompp1", "hs-custompp2" ] searchDirs
                         ( moduleNameSymbolicPath md )
             case mbPath of
               Just ( base, rel ) ->
@@ -134,16 +126,21 @@ preBuildRules
       let ppMods = catMaybes ppMbMods
       liftIO $ putStrLn $ unlines $
         "package-with-hooks: hs-custompp modules:"
-        : ( map ( \ m -> "  - " ++ show m ) mods )
+        : ( map ( \ m -> "  - " ++ show m ) ppMods )
     -- TODO: declare the corresponding monitored files corresponding to the
     -- above search (it would be nice to be able to use findFileWithExtensionMonitored).
 
     -- 5. Declare a rule for each custom-pp module that runs the pre-processor.
       for_ ppMods $ \ ( md, inputLoc@( _inputBaseDir, inputRelPath ) ) -> do
-        let outputBaseLoc = getSymbolicPath $ autogenComponentModulesDir lbi clbi
+        let ext = takeExtension inputRelPath
+            customPp = case ext of
+              ".hs-custompp1" -> customPp1
+              ".hs-custompp2" -> customPp2
+              _ -> error $ "internal error: unhandled extension " ++ ext
+            outputBaseLoc = getSymbolicPath $ autogenComponentModulesDir lbi clbi
             outputLoc = ( outputBaseLoc, replaceExtension inputRelPath "hs" )
         registerRule_ ( toShortText $ show md ) $
-          staticRule ( ppCmd inputLoc outputLoc ) [] ( NE.singleton outputLoc )
+          staticRule ( ppCmd customPp inputLoc outputLoc ) [] ( NE.singleton outputLoc )
 
 ppModule :: ( Verbosity, Maybe (SymbolicPath CWD (Dir Pkg)), ConfiguredProgram, Location, Location ) -> IO ()
 ppModule ( verbosity, mbWorkDir, customPp, ( inputBaseDir, inputRelPath ), ( outputBaseDir, outputRelPath ) ) = do

cabal-testsuite/PackageTests/HooksPreprocessor/package-with-hooks/data/CustomPP2Data.txt

@@ -0,0 +1 @@
+("MyConstant", 1717)

cabal-testsuite/PackageTests/HooksPreprocessor/package-with-hooks/exe/Main.hs

@@ -0,0 +1,16 @@
+module Main where
+
+-- custom-build-tool
+import CustomBuildTool
+  ( mkCustomBuildTool )
+
+-- package-with-hooks
+import Paths_package_with_hooks -- (Cabal autogenerated module)
+  ( getDataFileName )
+
+--------------------------------------------------------------------------------
+
+main :: IO ()
+main = do
+  customDataFile <- getDataFileName "CustomPP2Data.txt"
+  mkCustomBuildTool "custom-pp2" customDataFile