Commit e5d57a19 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Make all the pre-processors use the Program abstraction

parent 736f119c
......@@ -66,6 +66,8 @@ import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
import Distribution.Simple.Utils (createDirectoryIfMissingVerbose,
rawSystemExit, die, dieWithLocation,
moduleToFilePath, moduleToFilePath2)
import Distribution.Program (rawSystemProgramConf,
rawSystemProgram, lookupProgram')
import Distribution.Version (Version(..))
import Distribution.Verbosity
import Control.Monad (when, unless)
......@@ -271,18 +273,13 @@ removePreprocessed searchLocs mods suffixesIn
-- ------------------------------------------------------------
ppGreenCard :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppGreenCard = ppGreenCard' []
ppGreenCard' :: [String] -> BuildInfo -> LocalBuildInfo -> PreProcessor
ppGreenCard' inputArgs _ lbi
= maybe (ppNone "greencard") pp (withGreencard lbi)
where pp greencard =
PreProcessor {
platformIndependent = False,
runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
rawSystemExit verbosity greencard
(["-tffi", "-o" ++ outFile, inFile] ++ inputArgs)
}
ppGreenCard _ lbi
= PreProcessor {
platformIndependent = False,
runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
rawSystemProgramConf verbosity "greencard" (withPrograms lbi)
(["-tffi", "-o" ++ outFile, inFile])
}
-- This one is useful for preprocessors that can't handle literate source.
-- We also need a way to chain preprocessors.
......@@ -300,12 +297,12 @@ ppCpp = ppCpp' []
ppCpp' :: [String] -> BuildInfo -> LocalBuildInfo -> PreProcessor
ppCpp' inputArgs bi lbi =
case withCpphs lbi of
Just path -> PreProcessor {
case lookupProgram' "cpphs" (withPrograms lbi) of
Just cpphs -> PreProcessor {
platformIndependent = False,
runPreProcessor = mkSimplePreProcessor (use_cpphs path)
runPreProcessor = mkSimplePreProcessor (use_cpphs cpphs)
}
Nothing | compilerFlavor hc == GHC
Nothing | compilerFlavor hc == GHC
-> PreProcessor {
platformIndependent = False,
runPreProcessor = mkSimplePreProcessor use_ghc
......@@ -315,7 +312,7 @@ ppCpp' inputArgs bi lbi =
hc = compiler lbi
use_cpphs cpphs inFile outFile verbosity
= rawSystemExit verbosity cpphs cpphsArgs
= rawSystemProgram verbosity cpphs cpphsArgs
where cpphsArgs = ("-O" ++ outFile) : inFile : "--noline" : "--strip"
: extraArgs
......@@ -347,9 +344,8 @@ use_optP_P verbosity lbi
= fmap (< Version [0,8] []) (haddockVersion verbosity lbi)
ppHsc2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppHsc2hs bi lbi
= maybe (ppNone "hsc2hs") pp (withHsc2hs lbi)
where pp n = standardPP n flags
ppHsc2hs bi lbi = pp
where pp = standardPP lbi "hsc2hs" flags
flags = hcDefines (compiler lbi)
++ map ("--cflag=" ++) (getCcFlags bi)
++ map ("--lflag=" ++) (getLdFlags bi)
......@@ -366,14 +362,12 @@ getLdFlags bi = map ("-L" ++) (extraLibDirs bi)
++ ldOptions bi
ppC2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppC2hs bi lbi = maybe (ppNone "c2hs") pp (withC2hs lbi)
where
pp name =
PreProcessor {
ppC2hs bi lbi
= PreProcessor {
platformIndependent = False,
runPreProcessor = \(inBaseDir, inRelativeFile)
(outBaseDir, outRelativeFile) verbosity ->
rawSystemExit verbosity name $
rawSystemProgramConf verbosity "c2hs" (withPrograms lbi) $
["--include=" ++ dir | dir <- hsSourceDirs bi ]
++ ["--cppopts=" ++ opt | opt <- cppOptions bi lbi]
++ ["--output-dir=" ++ outBaseDir,
......@@ -405,27 +399,25 @@ versionInt (Version { versionBranch = n1:n2:_ })
= show n1 ++ take 2 ('0' : show n2)
ppHappy :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppHappy _ lbi
= maybe (ppNone "happy") pp (withHappy lbi)
where pp n = (standardPP n (hcFlags hc)) { platformIndependent = True }
ppHappy _ lbi = pp { platformIndependent = True }
where pp = standardPP lbi "happy" (hcFlags hc)
hc = compilerFlavor (compiler lbi)
hcFlags GHC = ["-agc"]
hcFlags _ = []
ppAlex :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppAlex _ lbi
= maybe (ppNone "alex") pp (withAlex lbi)
where pp n = (standardPP n (hcFlags hc)) { platformIndependent = True }
ppAlex _ lbi = pp { platformIndependent = True }
where pp = standardPP lbi "alex" (hcFlags hc)
hc = compilerFlavor (compiler lbi)
hcFlags GHC = ["-g"]
hcFlags _ = []
standardPP :: String -> [String] -> PreProcessor
standardPP eName args =
standardPP :: LocalBuildInfo -> String -> [String] -> PreProcessor
standardPP lbi progName args =
PreProcessor {
platformIndependent = False,
runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
rawSystemExit verbosity eName (args ++ ["-o", outFile, inFile])
rawSystemProgramConf verbosity progName (withPrograms lbi) (args ++ ["-o", outFile, inFile])
}
ppNone :: String -> PreProcessor
......
......@@ -38,6 +38,7 @@ module Distribution.Program(
, userSpecifyPath
, userSpecifyArgs
, lookupProgram
, lookupProgram' --TODO eliminate one of these
, lookupPrograms
, rawSystemProgram
, rawSystemProgramConf
......@@ -50,6 +51,7 @@ module Distribution.Program(
, hugsProgram
, ranlibProgram
, arProgram
, happyProgram
, alexProgram
, hsc2hsProgram
, c2hsProgram
......@@ -110,6 +112,12 @@ defaultProgramConfiguration :: ProgramConfiguration
defaultProgramConfiguration = progListToFM
[ hscolourProgram
, haddockProgram
, happyProgram
, alexProgram
, hsc2hsProgram
, c2hsProgram
, cpphsProgram
, greencardProgram
, pfesetupProgram
, ranlibProgram
, simpleProgram "runghc"
......@@ -123,16 +131,7 @@ defaultProgramConfiguration = progListToFM
, ghcPkgProgram
, nhcProgram
, hugsProgram
, alexProgram
, hsc2hsProgram
, c2hsProgram
, cpphsProgram
, haddockProgram
, greencardProgram
, ldProgram
, cppProgram
, pfesetupProgram
, ranlib, ar
]-}
-- |The flag for giving a path to this program. eg. --with-alex=\/usr\/bin\/alex
......@@ -168,6 +167,9 @@ jhcProgram = simpleProgram "jhc"
hugsProgram :: Program
hugsProgram = simpleProgram "hugs"
happyProgram :: Program
happyProgram = simpleProgram "happy"
alexProgram :: Program
alexProgram = simpleProgram "alex"
......@@ -314,7 +316,6 @@ rawSystemProgramConf verbosity progName programConf extraArgs
-- * Internal helpers
-- ------------------------------------------------------------
-- Export?
lookupProgram' :: String -> ProgramConfiguration -> Maybe Program
lookupProgram' s (ProgramConfiguration conf) = Map.lookup s conf
......
......@@ -249,13 +249,6 @@ configure (pkg_descr0, pbi) cfg
foundPrograms <- lookupPrograms (configPrograms cfg)
happy <- findProgram "happy" (configHappy cfg)
alex <- findProgram "alex" (configAlex cfg)
hsc2hs <- findProgram "hsc2hs" (configHsc2hs cfg)
c2hs <- findProgram "c2hs" (configC2hs cfg)
cpphs <- findProgram "cpphs" (configCpphs cfg)
greencard <- findProgram "greencard" (configGreencard cfg)
let newConfig = foldr (\(_, p) c -> maybeUpdateProgram p c)
(configPrograms cfg) foundPrograms
......@@ -281,10 +274,6 @@ configure (pkg_descr0, pbi) cfg
packageDeps=dep_pkgs,
localPkgDescr=pkg_descr,
withPrograms=newConfig,
withHappy=happy, withAlex=alex,
withHsc2hs=hsc2hs, withC2hs=c2hs,
withCpphs=cpphs,
withGreencard=greencard,
withVanillaLib=configVanillaLib cfg,
withProfLib=configProfLib cfg,
withProfExe=configProfExe cfg,
......@@ -307,14 +296,7 @@ configure (pkg_descr0, pbi) cfg
message $ "Compiler version: " ++ showVersion ver
message $ "Using package tool: " ++ pkg
mapM (\(s,p) -> reportProgram' s p) foundPrograms
reportProgram "happy" happy
reportProgram "alex" alex
reportProgram "hsc2hs" hsc2hs
reportProgram "c2hs" c2hs
reportProgram "cpphs" cpphs
reportProgram "greencard" greencard
mapM_ (uncurry reportProgram) foundPrograms
return lbi
......@@ -360,21 +342,17 @@ findProgram
findProgram name Nothing = findExecutable name
findProgram _ p = return p
reportProgram :: String -> Maybe FilePath -> IO ()
reportProgram name Nothing = message ("No " ++ name ++ " found")
reportProgram name (Just p) = message ("Using " ++ name ++ ": " ++ p)
reportProgram' :: String -> Maybe Program -> IO ()
reportProgram' _ (Just Program{ programName=name
reportProgram :: String -> Maybe Program -> IO ()
reportProgram _ (Just Program{ programName=name
, programLocation=EmptyLocation})
= message ("No " ++ name ++ " found")
reportProgram' _ (Just Program{ programName=name
reportProgram _ (Just Program{ programName=name
, programLocation=FoundOnSystem p})
= message ("Using " ++ name ++ " found on system at: " ++ p)
reportProgram' _ (Just Program{ programName=name
reportProgram _ (Just Program{ programName=name
, programLocation=UserSpecified p})
= message ("Using " ++ name ++ " given by user at: " ++ p)
reportProgram' name Nothing = message ("No " ++ name ++ " found")
reportProgram name Nothing = message ("No " ++ name ++ " found")
hackageUrl :: String
hackageUrl = "http://hackage.haskell.org/cgi-bin/hackage-scripts/package/"
......
......@@ -110,12 +110,6 @@ data LocalBuildInfo = LocalBuildInfo {
-- any conditionals.
withPrograms :: ProgramConfiguration, -- location and args for all programs
userConf :: Bool, -- ^Was this package configured with --user?
withHappy :: Maybe FilePath, -- ^Might be the location of the Happy executable.
withAlex :: Maybe FilePath, -- ^Might be the location of the Alex executable.
withHsc2hs :: Maybe FilePath, -- ^Might be the location of the Hsc2hs executable.
withC2hs :: Maybe FilePath, -- ^Might be the location of the C2hs executable.
withCpphs :: Maybe FilePath, -- ^Might be the location of the Cpphs executable.
withGreencard :: Maybe FilePath, -- ^Might be the location of the GreenCard executable.
withVanillaLib:: Bool, -- ^Whether to build normal libs.
withProfLib :: Bool, -- ^Whether to build profiling versions of libs.
withProfExe :: Bool, -- ^Whether to build executables for profiling.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment