Skip to content

Commit caab57b

Browse files
sheafsheaf
committed
Add internal build tool to package-with-hooks test
1 parent c209ca5 commit caab57b

File tree

13 files changed

+216
-156
lines changed

13 files changed

+216
-156
lines changed

‎cabal-testsuite/PackageTests/HooksPreprocessor/custom-build-tool/custom-build-tool-data/CustomBuildToolData.txt renamed to ‎cabal-testsuite/PackageTests/HooksPreprocessor/custom-build-tool/custom-build-tool-data/CustomPP1Data.txt

File renamed without changes.

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

Lines changed: 20 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -10,12 +10,29 @@ build-type: Simple
1010
data-dir:
1111
custom-build-tool-data
1212
data-files:
13-
CustomBuildToolData.txt
13+
CustomPP1Data.txt
1414

1515
common warnings
1616
ghc-options: -Wall
1717

18-
executable custom-build-tool
18+
library
19+
20+
import:
21+
warnings
22+
23+
hs-source-dirs:
24+
src
25+
26+
exposed-modules:
27+
CustomBuildTool
28+
29+
build-depends:
30+
base ^>= 4.18 && < 5,
31+
containers,
32+
directory
33+
34+
executable custom-pp1
35+
1936
import:
2037
warnings
2138

@@ -27,8 +44,7 @@ executable custom-build-tool
2744

2845
build-depends:
2946
base ^>= 4.18 && < 5,
30-
containers,
31-
directory
47+
custom-build-tool
3248

3349
autogen-modules:
3450
Paths_custom_build_tool

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

Lines changed: 4 additions & 87 deletions
Original file line numberDiff line numberDiff line change
@@ -1,97 +1,14 @@
11
module Main where
22

3-
-- base
4-
import Control.Monad
5-
( unless )
6-
import Data.Char
7-
( isSpace )
8-
import Data.List
9-
( dropWhileEnd )
10-
import System.Environment
11-
( getArgs )
12-
13-
-- containers
14-
import Data.Map.Strict
15-
( Map )
16-
import qualified Data.Map.Strict as Map
17-
18-
-- directory
19-
import System.Directory
20-
( doesFileExist, getCurrentDirectory )
21-
223
-- custom-build-tool
4+
import CustomBuildTool
5+
( mkCustomBuildTool )
236
import Paths_custom_build_tool -- (Cabal autogenerated module)
247
( getDataFileName )
258

269
--------------------------------------------------------------------------------
2710

2811
main :: IO ()
2912
main = do
30-
putStrLn "Starting custom-build-tool"
31-
-- Get all the constants defined in the data file for the build tool.
32-
customDataFile <- getDataFileName "CustomBuildToolData.txt"
33-
customDataFileExists <- doesFileExist customDataFile
34-
unless customDataFileExists $ do
35-
cwd <- getCurrentDirectory
36-
error $
37-
unlines
38-
[ "Custom preprocessor could not access its data file."
39-
, "Tried to look in: " ++ customDataFile
40-
, "cwd: " ++ show cwd ]
41-
customDataLines <- lines <$> readFile customDataFile
42-
let customConstants :: Map String Int
43-
customConstants = Map.fromList $ map read customDataLines
44-
45-
-- Obtain input/output file paths from arguments to the preprocessor.
46-
args <- getArgs
47-
case args of
48-
[inputFile, outputFile] -> do
49-
inputFileExists <- doesFileExist inputFile
50-
unless inputFileExists $
51-
error $
52-
unlines
53-
[ "Custom preprocessor could not read input file."
54-
, "Input file: " ++ inputFile ]
55-
-- Read the input file, substitute constants for their values,
56-
-- and write the result to the output file path.
57-
inputLines <- lines <$> readFile inputFile
58-
let outputLines = map ( preprocessLine customConstants ) ( zip [1..] inputLines )
59-
writeFile outputFile ( unlines outputLines )
60-
[] ->
61-
putStrLn "Custom preprocessor: no arguments."
62-
_ ->
63-
error $
64-
unlines
65-
[ "Custom preprocessor was given incorrect arguments."
66-
, "Expected input and output file paths, but got " ++ what ++ "." ]
67-
where
68-
what = case args of
69-
[] -> "none"
70-
[_] -> "a single argument"
71-
_ -> show (length args) ++ " arguments"
72-
73-
-- | Substitute any occurrence of {# ConstantName #} with the value of ConstantName,
74-
-- looked up in the data file for the preprocessor.
75-
preprocessLine :: Map String Int -> ( Int, String ) -> String
76-
preprocessLine constants ( ln_no, ln ) = go "" ln
77-
where
78-
go reversedPrev [] = reverse reversedPrev
79-
go reversedPrev ('{':'#':rest) = reverse reversedPrev ++ inner "" rest
80-
go reversedPrev (c:rest) = go (c:reversedPrev) rest
81-
82-
inner reversedNm ('#':'}':rest) =
83-
let constName = trimWhitespace $ reverse reversedNm
84-
in case Map.lookup constName constants of
85-
Just val -> show val ++ go "" rest
86-
Nothing ->
87-
error $ unlines
88-
[ "Could not preprocess line " ++ show ln_no ++ ":"
89-
, "unknown constant \"" ++ constName ++ "\"." ]
90-
inner reversedNm (c:rest) = inner (c:reversedNm) rest
91-
inner reversedNm "" =
92-
error $ unlines
93-
[ "Could not preprocess line " ++ show ln_no ++ ":"
94-
, "unterminated constant \"{# " ++ reverse reversedNm ++ "\"." ]
95-
96-
trimWhitespace :: String -> String
97-
trimWhitespace = dropWhile isSpace . dropWhileEnd isSpace
13+
customDataFile <- getDataFileName "CustomPP1Data.txt"
14+
mkCustomBuildTool "custom-pp1" customDataFile

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

Lines changed: 93 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,93 @@
1+
module CustomBuildTool
2+
( mkCustomBuildTool )
3+
where
4+
5+
-- base
6+
import Control.Monad
7+
( unless )
8+
import Data.Char
9+
( isSpace )
10+
import Data.List
11+
( dropWhileEnd )
12+
import System.Environment
13+
( getArgs )
14+
15+
-- containers
16+
import Data.Map.Strict
17+
( Map )
18+
import qualified Data.Map.Strict as Map
19+
20+
-- directory
21+
import System.Directory
22+
( doesFileExist, getCurrentDirectory )
23+
24+
--------------------------------------------------------------------------------
25+
26+
mkCustomBuildTool :: String -> FilePath -> IO ()
27+
mkCustomBuildTool buildToolName customDataFile = do
28+
putStrLn $ "Starting " ++ buildToolName
29+
-- Get all the constants defined in the data file for the build tool.
30+
customDataFileExists <- doesFileExist customDataFile
31+
unless customDataFileExists $ do
32+
cwd <- getCurrentDirectory
33+
error $
34+
unlines
35+
[ "Custom preprocessor " ++ buildToolName ++ " could not access its data file."
36+
, "Tried to look in: " ++ customDataFile
37+
, "cwd: " ++ show cwd ]
38+
customDataLines <- lines <$> readFile customDataFile
39+
let customConstants :: Map String Int
40+
customConstants = Map.fromList $ map read customDataLines
41+
42+
-- Obtain input/output file paths from arguments to the preprocessor.
43+
args <- getArgs
44+
case args of
45+
[inputFile, outputFile] -> do
46+
inputFileExists <- doesFileExist inputFile
47+
unless inputFileExists $
48+
error $
49+
unlines
50+
[ "Custom preprocessor " ++ buildToolName ++ " could not read input file."
51+
, "Input file: " ++ inputFile ]
52+
-- Read the input file, substitute constants for their values,
53+
-- and write the result to the output file path.
54+
inputLines <- lines <$> readFile inputFile
55+
let outputLines = map ( preprocessLine customConstants ) ( zip [1..] inputLines )
56+
writeFile outputFile ( unlines outputLines )
57+
[] ->
58+
putStrLn $ "Custom preprocessor " ++ buildToolName ++ ": no arguments."
59+
_ ->
60+
error $
61+
unlines
62+
[ "Custom preprocessor " ++ buildToolName ++ " was given incorrect arguments."
63+
, "Expected input and output file paths, but got " ++ what ++ "." ]
64+
where
65+
what = case args of
66+
[_] -> "a single argument"
67+
_ -> show (length args) ++ " arguments"
68+
69+
-- | Substitute any occurrence of {# ConstantName #} with the value of ConstantName,
70+
-- looked up in the data file for the preprocessor.
71+
preprocessLine :: Map String Int -> ( Int, String ) -> String
72+
preprocessLine constants ( ln_no, ln ) = go "" ln
73+
where
74+
go reversedPrev [] = reverse reversedPrev
75+
go reversedPrev ('{':'#':rest) = reverse reversedPrev ++ inner "" rest
76+
go reversedPrev (c:rest) = go (c:reversedPrev) rest
77+
78+
inner reversedNm ('#':'}':rest) =
79+
let constName = trimWhitespace $ reverse reversedNm
80+
in case Map.lookup constName constants of
81+
Just val -> show val ++ go "" rest
82+
Nothing ->
83+
error $ unlines
84+
[ "Could not preprocess line " ++ show ln_no ++ ":"
85+
, "unknown constant \"" ++ constName ++ "\"." ]
86+
inner reversedNm (c:rest) = inner (c:reversedNm) rest
87+
inner reversedNm "" =
88+
error $ unlines
89+
[ "Could not preprocess line " ++ show ln_no ++ ":"
90+
, "unterminated constant \"{# " ++ reverse reversedNm ++ "\"." ]
91+
92+
trimWhitespace :: String -> String
93+
trimWhitespace = dropWhile isSpace . dropWhileEnd isSpace

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

Lines changed: 30 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -25,42 +25,28 @@ import Distribution.Simple.SetupHooks
2525
-- Cabal
2626
import Distribution.ModuleName
2727
( ModuleName )
28-
import Distribution.Simple.Flag
29-
( fromFlag )
3028
import Distribution.Simple.LocalBuildInfo
3129
( mbWorkDirLBI )
3230
import Distribution.Simple.Program
33-
( configureProgram, runProgramCwd )
31+
( runProgramCwd )
3432
import Distribution.Simple.Program.Db
3533
( lookupProgram )
3634
import Distribution.Simple.Utils
3735
( createDirectoryIfMissingVerbose, findFileCwdWithExtension' )
3836
import Distribution.Types.Component
3937
( componentBuildInfo )
40-
import qualified Distribution.Types.LocalBuildConfig as LBC
41-
( withPrograms )
4238
import Distribution.Types.LocalBuildInfo
4339
( withPrograms )
44-
import Distribution.Types.VersionRange
45-
( anyVersion )
4640
import Distribution.Utils.Path
4741
( SymbolicPath, FileOrDir(Dir), CWD, Pkg
48-
, interpretSymbolicPath, getSymbolicPath, moduleNameSymbolicPath
42+
, getSymbolicPath, moduleNameSymbolicPath
4943
)
5044
import Distribution.Utils.ShortText
5145
( toShortText )
5246

53-
-- containers
54-
import qualified Data.Map as Map
55-
( singleton )
56-
57-
-- directory
58-
import System.Directory
59-
( getCurrentDirectory )
60-
6147
-- filepath
6248
import System.FilePath
63-
( (</>), replaceExtension, takeDirectory )
49+
( (</>), replaceExtension, takeDirectory, takeExtension )
6450

6551
--------------------------------------------------------------------------------
6652

@@ -74,9 +60,6 @@ setupHooks =
7460
}
7561
}
7662

77-
customPpName :: String
78-
customPpName = "custom-build-tool"
79-
8063
-- | Runs the custom-build-tool preprocessor on all .hs-custompp files.
8164
preBuildRules :: PreBuildComponentInputs -> RulesM ()
8265
preBuildRules
@@ -94,24 +77,33 @@ preBuildRules
9477
progDb = withPrograms lbi
9578
mbWorkDir = mbWorkDirLBI lbi
9679

97-
-- 1. Look up the custom-build-tool preprocessor.
98-
let customPpProg = simpleProgram customPpName
99-
mbCustomPp = lookupProgram customPpProg progDb
100-
customPp = case mbCustomPp of
80+
-- 1. Look up the custom-build-tool preprocessors.
81+
let customPp1Prog = simpleProgram "custom-pp1"
82+
mbCustomPp1 = lookupProgram customPp1Prog progDb
83+
customPp1 = case mbCustomPp1 of
84+
Just pp -> pp
85+
Nothing ->
86+
error $
87+
unlines
88+
[ "package-with-hooks: could not find custom-pp1 pre-processor in the program database."
89+
, "Component: " ++ show compNm ]
90+
customPp2Prog = simpleProgram "custom-pp2"
91+
mbCustomPp2 = lookupProgram customPp2Prog progDb
92+
customPp2 = case mbCustomPp2 of
10193
Just pp -> pp
10294
Nothing ->
10395
error $
10496
unlines
105-
[ "package-with-hooks: could not find " ++ show customPpName ++ " pre-processor in the program database."
97+
[ "package-with-hooks: could not find custom-pp2 pre-processor in the program database."
10698
, "Component: " ++ show compNm ]
10799

108-
-- 2. Create a command to run this preprocess, passing input and output file locations.
100+
-- 2. Create a command to run a preprocessor, passing input and output file locations.
109101
let
110-
ppCmd :: Location -> Location
102+
ppCmd :: ConfiguredProgram -> Location -> Location
111103
-> Command ( Verbosity, Maybe (SymbolicPath CWD (Dir Pkg)), ConfiguredProgram, Location, Location ) ( IO () )
112-
ppCmd i o =
104+
ppCmd pp i o =
113105
mkCommand ( static Dict ) ( static ppModule )
114-
( verbosity, mbWorkDir, customPp, i, o )
106+
( verbosity, mbWorkDir, pp, i, o )
115107

116108
-- 3. Get all modules listed in the package description for this component.
117109
let mods = componentModules comp
@@ -122,7 +114,7 @@ preBuildRules
122114
ppMbMods <-
123115
liftIO $
124116
for mods $ \ md -> do
125-
mbPath <- findFileCwdWithExtension' mbWorkDir [ "hs-custompp" ] searchDirs
117+
mbPath <- findFileCwdWithExtension' mbWorkDir [ "hs-custompp1", "hs-custompp2" ] searchDirs
126118
( moduleNameSymbolicPath md )
127119
case mbPath of
128120
Just ( base, rel ) ->
@@ -134,16 +126,21 @@ preBuildRules
134126
let ppMods = catMaybes ppMbMods
135127
liftIO $ putStrLn $ unlines $
136128
"package-with-hooks: hs-custompp modules:"
137-
: ( map ( \ m -> " - " ++ show m ) mods )
129+
: ( map ( \ m -> " - " ++ show m ) ppMods )
138130
-- TODO: declare the corresponding monitored files corresponding to the
139131
-- above search (it would be nice to be able to use findFileWithExtensionMonitored).
140132

141133
-- 5. Declare a rule for each custom-pp module that runs the pre-processor.
142134
for_ ppMods $ \ ( md, inputLoc@( _inputBaseDir, inputRelPath ) ) -> do
143-
let outputBaseLoc = getSymbolicPath $ autogenComponentModulesDir lbi clbi
135+
let ext = takeExtension inputRelPath
136+
customPp = case ext of
137+
".hs-custompp1" -> customPp1
138+
".hs-custompp2" -> customPp2
139+
_ -> error $ "internal error: unhandled extension " ++ ext
140+
outputBaseLoc = getSymbolicPath $ autogenComponentModulesDir lbi clbi
144141
outputLoc = ( outputBaseLoc, replaceExtension inputRelPath "hs" )
145142
registerRule_ ( toShortText $ show md ) $
146-
staticRule ( ppCmd inputLoc outputLoc ) [] ( NE.singleton outputLoc )
143+
staticRule ( ppCmd customPp inputLoc outputLoc ) [] ( NE.singleton outputLoc )
147144

148145
ppModule :: ( Verbosity, Maybe (SymbolicPath CWD (Dir Pkg)), ConfiguredProgram, Location, Location ) -> IO ()
149146
ppModule ( verbosity, mbWorkDir, customPp, ( inputBaseDir, inputRelPath ), ( outputBaseDir, outputRelPath ) ) = do

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
("MyConstant", 1717)

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

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
module Main where
2+
3+
-- custom-build-tool
4+
import CustomBuildTool
5+
( mkCustomBuildTool )
6+
7+
-- package-with-hooks
8+
import Paths_package_with_hooks -- (Cabal autogenerated module)
9+
( getDataFileName )
10+
11+
--------------------------------------------------------------------------------
12+
13+
main :: IO ()
14+
main = do
15+
customDataFile <- getDataFileName "CustomPP2Data.txt"
16+
mkCustomBuildTool "custom-pp2" customDataFile

0 commit comments

Comments
 (0)