diff --git a/Distribution/Compiler.hs b/Distribution/Compiler.hs
index e4258ad8ff5e05d6aed29d3b4c94fcdb3bfa4bea..4232131fa9b95500d14a673e2a03dbb8a7c50763 100644
--- a/Distribution/Compiler.hs
+++ b/Distribution/Compiler.hs
@@ -78,8 +78,8 @@ data CompilerFlavor
data Compiler = Compiler {
compilerFlavor :: CompilerFlavor,
compilerId :: PackageIdentifier,
- compilerProg :: Program,
- compilerPkgTool :: Program,
+ compilerProg :: ConfiguredProgram,
+ compilerPkgTool :: ConfiguredProgram,
compilerExtensions :: [(Extension, Flag)]
}
deriving (Show, Read)
diff --git a/Distribution/PreProcess.hs b/Distribution/PreProcess.hs
index 6e5bca3f186ba963bc2279fb0f12afce41839d30..3ea4b77ec38f40d7c92b7572505c93fbb5437703 100644
--- a/Distribution/PreProcess.hs
+++ b/Distribution/PreProcess.hs
@@ -64,8 +64,11 @@ import Distribution.Compiler (CompilerFlavor(..), Compiler(..), compilerVersion)
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
import Distribution.Simple.Utils (createDirectoryIfMissingVerbose, die,
moduleToFilePath, moduleToFilePath2)
-import Distribution.Program (Program(..), lookupProgram', rawSystemProgramConf,
- rawSystemProgram)
+import Distribution.Program (Program(..), ConfiguredProgram(..), lookupProgram,
+ rawSystemProgramConf, rawSystemProgram,
+ greencardProgram, cpphsProgram, hsc2hsProgram,
+ c2hsProgram, happyProgram, alexProgram,
+ haddockProgram)
import Distribution.Version (Version(..))
import Distribution.Verbosity
@@ -275,7 +278,7 @@ ppGreenCard _ lbi
= PreProcessor {
platformIndependent = False,
runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
- rawSystemProgramConf verbosity "greencard" (withPrograms lbi)
+ rawSystemProgramConf verbosity greencardProgram (withPrograms lbi)
(["-tffi", "-o" ++ outFile, inFile])
}
@@ -330,7 +333,7 @@ ppCpphs extraArgs _bi lbi =
PreProcessor {
platformIndependent = False,
runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
- rawSystemProgramConf verbosity "cpphs" (withPrograms lbi) $
+ rawSystemProgramConf verbosity cpphsProgram (withPrograms lbi) $
("-O" ++ outFile) : inFile
: "--noline" : "--strip"
: extraArgs
@@ -341,14 +344,14 @@ ppCpphs extraArgs _bi lbi =
-- -optP-P only if the Haddock version is prior to 0.8.
use_optP_P :: LocalBuildInfo -> Bool
use_optP_P lbi
- = case lookupProgram' "haddock" (withPrograms lbi) of
- Just (Program { programVersion = Just version })
+ = case lookupProgram haddockProgram (withPrograms lbi) of
+ Just (ConfiguredProgram { programVersion = Just version })
| version >= Version [0,8] [] -> False
_ -> True
ppHsc2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppHsc2hs bi lbi = pp
- where pp = standardPP lbi "hsc2hs" flags
+ where pp = standardPP lbi hsc2hsProgram flags
flags = hcDefines (compiler lbi)
++ map ("--cflag=" ++) (getCcFlags bi)
++ map ("--lflag=" ++) (getLdFlags bi)
@@ -370,7 +373,7 @@ ppC2hs bi lbi
platformIndependent = False,
runPreProcessor = \(inBaseDir, inRelativeFile)
(outBaseDir, outRelativeFile) verbosity ->
- rawSystemProgramConf verbosity "c2hs" (withPrograms lbi) $
+ rawSystemProgramConf verbosity c2hsProgram (withPrograms lbi) $
["--include=" ++ dir | dir <- hsSourceDirs bi ]
++ ["--cppopts=" ++ opt | opt <- cppOptions bi lbi]
++ ["--output-dir=" ++ outBaseDir,
@@ -405,24 +408,24 @@ versionInt (Version { versionBranch = n1:n2:_ })
ppHappy :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppHappy _ lbi = pp { platformIndependent = True }
- where pp = standardPP lbi "happy" (hcFlags hc)
+ where pp = standardPP lbi happyProgram (hcFlags hc)
hc = compilerFlavor (compiler lbi)
hcFlags GHC = ["-agc"]
hcFlags _ = []
ppAlex :: BuildInfo -> LocalBuildInfo -> PreProcessor
ppAlex _ lbi = pp { platformIndependent = True }
- where pp = standardPP lbi "alex" (hcFlags hc)
+ where pp = standardPP lbi alexProgram (hcFlags hc)
hc = compilerFlavor (compiler lbi)
hcFlags GHC = ["-g"]
hcFlags _ = []
-standardPP :: LocalBuildInfo -> String -> [String] -> PreProcessor
-standardPP lbi progName args =
+standardPP :: LocalBuildInfo -> Program -> [String] -> PreProcessor
+standardPP lbi prog args =
PreProcessor {
platformIndependent = False,
runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
- rawSystemProgramConf verbosity progName (withPrograms lbi)
+ rawSystemProgramConf verbosity prog (withPrograms lbi)
(args ++ ["-o", outFile, inFile])
}
diff --git a/Distribution/Program.hs b/Distribution/Program.hs
index 8fcd11625191ee91c26113bc25305b0f349c2669..538efe6e794ec6e6082be2340bc914072297920f 100644
--- a/Distribution/Program.hs
+++ b/Distribution/Program.hs
@@ -23,219 +23,485 @@
-- hook user the ability to get the above flags and such so that they
-- don't have to write all the PATH logic inside Setup.lhs.
-module Distribution.Program(
- -- * Program-Related types
- Program(..)
- , ProgramLocation(..)
- , ProgramConfiguration(..)
- -- * Helper functions
- , withProgramFlag
- , programOptsFlag
- , programOptsField
- , programPath
- , findProgram
- , findProgramAndVersion
- , defaultProgramConfiguration
- , updateProgram
- , maybeUpdateProgram
- , userSpecifyPath
- , userSpecifyArgs
- , lookupProgram
- , lookupProgram' --TODO eliminate this export
- , lookupPrograms
- , rawSystemProgram
- , rawSystemProgramConf
- , simpleProgram
- , simpleProgramAt
- -- * Programs that Cabal knows about
- , ghcProgram
- , ghcPkgProgram
- , nhcProgram
- , jhcProgram
- , hugsProgram
- , ranlibProgram
- , arProgram
- , happyProgram
- , alexProgram
- , hsc2hsProgram
- , c2hsProgram
- , cpphsProgram
- , hscolourProgram
- , haddockProgram
- , greencardProgram
- , ldProgram
- , cppProgram
- , pfesetupProgram
- ) where
+module Distribution.Program (
+ -- * Program and functions for constructing them
+ Program(..)
+ , simpleProgram
+ , searchPath
+ , findProgramVersion
+
+ -- * Configured program and related functions
+ , ConfiguredProgram(..)
+ , programPath
+ , ProgArg
+ , ProgramLocation(..)
+ , rawSystemProgram
+
+ -- * The collection of unconfigured and configured progams
+ , builtinPrograms
+
+ -- * The collection of configured programs we can run
+ , ProgramConfiguration
+ , emptyProgramConfiguration
+ , defaultProgramConfiguration
+ , addKnownProgram
+ , knownPrograms
+ , userSpecifyPath
+ , userMaybeSpecifyPath
+ , userSpecifyArgs
+ , lookupProgram
+ , updateProgram
+ , configureAllKnownPrograms
+ , requireProgram
+ , rawSystemProgramConf
+
+ -- * Programs that Cabal knows about
+ , ghcProgram
+ , ghcPkgProgram
+ , nhcProgram
+ , hmakeProgram
+ , jhcProgram
+ , hugsProgram
+ , ffihugsProgram
+ , ranlibProgram
+ , arProgram
+ , happyProgram
+ , alexProgram
+ , hsc2hsProgram
+ , c2hsProgram
+ , cpphsProgram
+ , hscolourProgram
+ , haddockProgram
+ , greencardProgram
+ , ldProgram
+ , tarProgram
+ , cppProgram
+ , pfesetupProgram
+ ) where
import qualified Distribution.Compat.Map as Map
import Distribution.Compat.Directory (findExecutable)
import Distribution.Simple.Utils (die, rawSystemExit, rawSystemStdout)
-import Distribution.System
-import Distribution.Version (Version, readVersion)
+import Distribution.Version (Version, readVersion, showVersion,
+ VersionRange(..), withinRange, showVersionRange)
import Distribution.Verbosity
import System.Directory (doesFileExist)
-import Control.Monad (when)
-
--- |Represents a program which cabal may call.
-data Program
- = Program { -- |The simple name of the program, eg. ghc
- programName :: String
- -- |The name of this program's binary, eg. ghc-6.4
- ,programBinName :: String
- -- |The version of this program, if it is known
- ,programVersion :: Maybe Version
- -- |Default command-line args for this program
- ,programArgs :: [String]
- -- |Location of the program. eg. \/usr\/bin\/ghc-6.4
- ,programLocation :: ProgramLocation
- } deriving (Read, Show)
-
--- |Similar to Maybe, but tells us whether it's specifed by user or
+import Control.Monad (when, join, foldM)
+import Control.Exception as Exception (catch)
+
+-- | Represents a program which can be configured.
+data Program = Program {
+ -- | The simple name of the program, eg. ghc
+ programName :: String,
+
+ -- | A function to search for the program if it's location was not
+ -- specified by the user. Usually this will just be a
+ programFindLocation :: Verbosity -> IO (Maybe FilePath),
+
+ -- | Try to find the version of the program. For many programs this is
+ -- not possible or is not necessary so it's ok to return Nothing.
+ programFindVersion :: Verbosity -> FilePath -> IO (Maybe Version)
+ }
+
+type ProgArg = String
+
+data ConfiguredProgram = ConfiguredProgram {
+ -- | Just the name again
+ programId :: String,
+
+ -- | The version of this program, if it is known.
+ programVersion :: Maybe Version,
+
+ -- | Default command-line args for this program.
+ -- These flags will appear first on the command line, so they can be
+ -- overridden by subsequent flags.
+ programArgs :: [ProgArg],
+
+ -- | Location of the program. eg. @\/usr\/bin\/ghc-6.4@
+ programLocation :: ProgramLocation
+ } deriving (Read, Show)
+
+-- | Where a program was found. Also tells us whether it's specifed by user or
-- not. This includes not just the path, but the program as well.
-data ProgramLocation
- = EmptyLocation -- ^Like Nothing
- | UserSpecified FilePath
+data ProgramLocation
+ = UserSpecified { locationPath :: FilePath }
-- ^The user gave the path to this program,
-- eg. --ghc-path=\/usr\/bin\/ghc-6.6
- | FoundOnSystem FilePath
+ | FoundOnSystem { locationPath :: FilePath }
-- ^The location of the program, as located by searching PATH.
deriving (Read, Show)
--- |The configuration is a collection of 'Program's. It's a mapping from the
--- name of the program (eg. ghc) to the Program.
-data ProgramConfiguration = ProgramConfiguration (Map.Map String Program)
+-- ------------------------------------------------------------
+-- * Programs functions
+-- ------------------------------------------------------------
--- Read & Show instances are based on listToFM
+-- | The full path of a configured program.
+programPath :: ConfiguredProgram -> FilePath
+programPath = locationPath . programLocation
+-- | Make a simple named program.
+--
+-- By default we'll just search for it in the path and not try to find the
+-- version name. You can override these behaviours if necessary, eg:
+--
+-- > simpleProgram "foo" { programFindLocation = ... , programFindVersion ... }
+--
+simpleProgram :: String -> Program
+simpleProgram name =
+ Program name (searchPath name) (\_ _ -> return Nothing)
+
+-- | Look for a program on the path.
+searchPath :: FilePath -> Verbosity -> IO (Maybe FilePath)
+searchPath prog verbosity = do
+ when (verbosity >= deafening) $
+ putStrLn $ "searching for " ++ prog ++ " in path."
+ res <- findExecutable prog
+ when (verbosity >= deafening) $ case res of
+ Nothing -> putStrLn ("Cannot find " ++ prog ++ " on the path")
+ Just path -> putStrLn ("found " ++ prog ++ " at "++ path)
+ return res
+
+-- | Look for a program and try to find it's version number. It can accept
+-- either an absolute path or the name of a program binary, in which case we
+-- will look for the program on the path.
+--
+findProgramVersion :: ProgArg -- ^ version args
+ -> (String -> String) -- ^ function to select version
+ -- number from program output
+ -> Verbosity
+ -> FilePath -- ^ location
+ -> IO (Maybe Version)
+findProgramVersion versionArg selectVersion verbosity path = do
+ str <- rawSystemStdout verbosity path [versionArg]
+ `Exception.catch` \_ -> return ""
+ let version = readVersion (selectVersion str)
+ case version of
+ Nothing -> when (verbosity >= normal) $
+ putStrLn $ "cannot determine version of " ++ path ++ " :\n"
+ ++ show str
+ Just v -> when (verbosity >= deafening) $
+ putStrLn $ path ++ " is version " ++ showVersion v
+ return version
+
+-- ------------------------------------------------------------
+-- * Programs database
+-- ------------------------------------------------------------
+
+-- | The configuration is a collection of information about programs. It
+-- contains information both about configured programs and also about programs
+-- that we are yet to configure.
+--
+-- The idea is that we start from a collection of unconfigured programs and one
+-- by one we try to configure them at which point we move them into the
+-- configured collection. For unconfigured programs we record not just the
+-- 'Program' but also any user-provided arguments and location for the program.
+data ProgramConfiguration = ProgramConfiguration {
+ unconfiguredProgs :: UnconfiguredProgs,
+ configuredProgs :: ConfiguredProgs
+ }
+type UnconfiguredProgram = (Program, Maybe FilePath, [ProgArg])
+type UnconfiguredProgs = Map.Map String UnconfiguredProgram
+type ConfiguredProgs = Map.Map String ConfiguredProgram
+
+emptyProgramConfiguration :: ProgramConfiguration
+emptyProgramConfiguration = ProgramConfiguration Map.empty Map.empty
+
+defaultProgramConfiguration :: ProgramConfiguration
+defaultProgramConfiguration =
+ foldl (flip addKnownProgram) emptyProgramConfiguration builtinPrograms
+
+-- internal helpers:
+updateUnconfiguredProgs :: (UnconfiguredProgs -> UnconfiguredProgs)
+ -> ProgramConfiguration -> ProgramConfiguration
+updateUnconfiguredProgs update conf =
+ conf { unconfiguredProgs = update (unconfiguredProgs conf) }
+updateConfiguredProgs :: (ConfiguredProgs -> ConfiguredProgs)
+ -> ProgramConfiguration -> ProgramConfiguration
+updateConfiguredProgs update conf =
+ conf { configuredProgs = update (configuredProgs conf) }
+
+-- Read & Show instances are based on listToFM
+-- Note that we only serialise the configured part of the database, this is
+-- because we don't need the unconfigured part after the configure stage, and
+-- additionally because we cannot read/show 'Program' as it contains functions.
instance Show ProgramConfiguration where
- show (ProgramConfiguration s) = show $ Map.toAscList s
+ show = show . Map.toAscList . configuredProgs
instance Read ProgramConfiguration where
- readsPrec p s = [(ProgramConfiguration $ Map.fromList $ s', r)
- | (s', r) <- readsPrec p s ]
+ readsPrec p s =
+ [ (emptyProgramConfiguration { configuredProgs = Map.fromList s' }, r)
+ | (s', r) <- readsPrec p s ]
--- |The default list of programs and their arguments. These programs
--- are typically used internally to Cabal.
+-- -------------------------------
+-- Managing unconfigured programs
-defaultProgramConfiguration :: ProgramConfiguration
-defaultProgramConfiguration = progListToFM
- [ hscolourProgram
- , haddockProgram
- , happyProgram
- , alexProgram
- , hsc2hsProgram
- , c2hsProgram
- , cpphsProgram
- , greencardProgram
- , pfesetupProgram
- , ranlibProgram
- , simpleProgram "runghc"
- , simpleProgram "runhugs"
- , arProgram
- , ldProgram
- , tarProgram
- ]
--- haddock is currently the only one that really works.
-{- [ ghcProgram
- , ghcPkgProgram
- , nhcProgram
- , hugsProgram
- , cppProgram
- ]-}
-
--- |The flag for giving a path to this program. eg. --with-alex=\/usr\/bin\/alex
-withProgramFlag :: Program -> String
-withProgramFlag Program{programName=n} = "with-" ++ n
-
--- |The flag for giving args for this program.
--- eg. --haddock-options=-s http:\/\/foo
-programOptsFlag :: Program -> String
-programOptsFlag Program{programName=n} = n ++ "-options"
-
--- |The foo.cabal field for giving args for this program.
--- eg. haddock-options: -s http:\/\/foo
-programOptsField :: Program -> String
-programOptsField = programOptsFlag
-
--- |The full path of a configured program.
+-- | Add a known program that we may configure later
+addKnownProgram :: Program -> ProgramConfiguration -> ProgramConfiguration
+addKnownProgram prog = updateUnconfiguredProgs $
+ Map.insert (programName prog) (prog, Nothing, [])
+
+knownPrograms :: ProgramConfiguration -> [(Program, Maybe ConfiguredProgram)]
+knownPrograms conf =
+ [ (p,p') | (p,_,_) <- Map.elems (unconfiguredProgs conf)
+ , let p' = Map.lookup (programName p) (configuredProgs conf) ]
+
+-- |User-specify this path. Basically override any path information
+-- for this program in the configuration. If it's not a known
+-- program ignore it.
+userSpecifyPath :: String -- ^Program name
+ -> FilePath -- ^user-specified path to the program
+ -> ProgramConfiguration -> ProgramConfiguration
+userSpecifyPath name path = updateUnconfiguredProgs $
+ flip Map.update name $ \(prog, _, args) -> Just (prog, Just path, args)
+
+userMaybeSpecifyPath :: String -> Maybe FilePath
+ -> ProgramConfiguration -> ProgramConfiguration
+userMaybeSpecifyPath _ Nothing conf = conf
+userMaybeSpecifyPath name (Just path) conf = userSpecifyPath name path conf
+
+-- |User-specify the arguments for this program. Basically override
+-- any args information for this program in the configuration. If it's
+-- not a known program, ignore it..
+userSpecifyArgs :: String -- ^Program name
+ -> [ProgArg] -- ^user-specified args
+ -> ProgramConfiguration
+ -> ProgramConfiguration
+userSpecifyArgs name args' = updateUnconfiguredProgs $
+ flip Map.update name $ \(prog, path, args) -> Just (prog, path, args ++ args')
+
+userSpecifiedPath :: Program -> ProgramConfiguration -> Maybe FilePath
+userSpecifiedPath prog =
+ join . fmap (\(_,p,_)->p) . Map.lookup (programName prog) . unconfiguredProgs
+
+userSpecifiedArgs :: Program -> ProgramConfiguration -> [ProgArg]
+userSpecifiedArgs prog =
+ maybe [] (\(_,_,as)->as) . Map.lookup (programName prog) . unconfiguredProgs
+
+-- -----------------------------
+-- Managing configured programs
+
+-- | Try to find a configured program
+lookupProgram :: Program -> ProgramConfiguration -> Maybe ConfiguredProgram
+lookupProgram prog = Map.lookup (programName prog) . configuredProgs
+
+-- | Update a configured program in the database.
+updateProgram :: ConfiguredProgram -> ProgramConfiguration
+ -> ProgramConfiguration
+updateProgram prog = updateConfiguredProgs $
+ Map.insert (programId prog) prog
+
+-- ---------------------------
+-- Configuring known programs
+
+-- | Try to configure a specific program. If the program is already included in
+-- the colleciton of unconfigured programs then we use any user-supplied
+-- location and arguments. If the program gets configured sucessfully it gets
+-- added to the configured collection.
--
--- * This is a partial function, it is not defined for programs with an
--- EmptyLocation.
-programPath :: Program -> FilePath
-programPath program =
- case programLocation program of
- UserSpecified p -> p
- FoundOnSystem p -> p
- EmptyLocation -> error "programPath EmptyLocation"
-
--- | Look for a program. It can accept either an absolute path or the name of
--- a program binary, in which case we will look for the program on the path.
+-- Note that it is not a failure if the program cannot be configured. It's only
+-- a failure if the user supplied a location and the program could not be found
+-- at that location.
--
-findProgram :: Verbosity -> String -> Maybe FilePath -> IO Program
-findProgram verbosity prog maybePath = do
- location <- case maybePath of
- Nothing -> searchPath verbosity prog
+-- The reason for it not being a failure at this stage is that we don't know up
+-- front all the programs we will need, so we try to configure them all.
+-- To verify that a program was actually sucessfully configured use
+-- 'requireProgram'.
+--
+configureProgram :: Verbosity
+ -> Program
+ -> ProgramConfiguration
+ -> IO ProgramConfiguration
+configureProgram verbosity prog conf = do
+ let name = programName prog
+ maybeLocation <- case userSpecifiedPath prog conf of
+ Nothing -> programFindLocation prog verbosity
+ >>= return . fmap FoundOnSystem
Just path -> do
absolute <- doesFileExist path
if absolute
- then return (UserSpecified path)
- else searchPath verbosity path
- return (simpleProgramAt prog location)
+ then return (Just (UserSpecified path))
+ else searchPath path verbosity
+ >>= maybe (die notFound) (return . Just . UserSpecified)
+ where notFound = "Cannot find " ++ name ++ " at "
+ ++ path ++ " or on the path"
+ case maybeLocation of
+ Nothing -> return conf
+ Just location -> do
+ version <- programFindVersion prog verbosity (locationPath location)
+ let configuredProg = ConfiguredProgram {
+ programId = name,
+ programVersion = version,
+ programArgs = userSpecifiedArgs prog conf,
+ programLocation = location
+ }
+ return (updateConfiguredProgs (Map.insert name configuredProg) conf)
+
+-- | Try to configure all the known programs that have not yet been configured.
+configureAllKnownPrograms :: Verbosity
+ -> ProgramConfiguration
+ -> IO ProgramConfiguration
+configureAllKnownPrograms verbosity conf =
+ foldM (flip (configureProgram verbosity)) conf
+ [ prog | (prog,_,_) <- Map.elems (unconfiguredProgs conf
+ `Map.difference` configuredProgs conf) ]
+
+-- | Check that a program is configured and available to be run.
+--
+-- Additionally check that the version of the program number is suitable.
+-- For example 'AnyVersion' or @'orLaterVersion' ('Version' [1,0] [])@
+--
+-- It raises an exception if the program could not be configured or the version
+-- is unsuitable, otherwise it returns the configured program.
+requireProgram :: Verbosity -> Program -> VersionRange -> ProgramConfiguration
+ -> IO (ConfiguredProgram, ProgramConfiguration)
+requireProgram verbosity prog range conf = do
+
+ -- If it's not already been configured, try to configure it now
+ conf' <- case lookupProgram prog conf of
+ Nothing -> configureProgram verbosity prog conf
+ Just _ -> return conf
+
+ case lookupProgram prog conf' of
+ Nothing -> die notFound
+ Just configuredProg
+ | range == AnyVersion -> return (configuredProg, conf')
+ Just configuredProg@ConfiguredProgram { programLocation = location } ->
+ case programVersion configuredProg of
+ Just version
+ | withinRange version range -> return (configuredProg, conf')
+ | otherwise -> die (badVersion version location)
+ Nothing -> die (noVersion location)
+
+ where notFound = programName prog ++ versionRequirement
+ ++ " is required but it could not be found."
+ badVersion v l = programName prog ++ versionRequirement
+ ++ " is required but the version found at "
+ ++ locationPath l ++ " is version " ++ showVersion v
+ noVersion l = programName prog ++ versionRequirement
+ ++ " is required but the version of "
+ ++ locationPath l ++ " could not be determined."
+ versionRequirement
+ | range == AnyVersion = ""
+ | otherwise = " version " ++ showVersionRange range
-searchPath :: Verbosity -> FilePath -> IO ProgramLocation
-searchPath verbosity prog = do
- when (verbosity >= verbose) $
- putStrLn $ "searching for " ++ prog ++ " in path."
- res <- findExecutable prog
- case res of
- Nothing -> die ("Cannot find " ++ prog ++ " on the path")
- Just path -> do when (verbosity >= verbose) $
- putStrLn ("found " ++ prog ++ " at "++ path)
- return (FoundOnSystem path)
+-- ------------------------------------------------------------
+-- * Running programs
+-- ------------------------------------------------------------
--- | Look for a program and try to find it's version number. It can accept
--- either an absolute path or the name of a program binary, in which case we
--- will look for the program on the path.
---
-findProgramAndVersion :: Verbosity
- -> String -- ^ program binary name
- -> Maybe FilePath -- ^ possible location
- -> String -- ^ version args
- -> (String -> String) -- ^ function to select version
- -- number from program output
- -> IO Program
-findProgramAndVersion verbosity name maybePath versionArg selectVersion = do
- prog <- findProgram verbosity name maybePath
- str <- rawSystemStdout verbosity (programPath prog) [versionArg]
- case readVersion (selectVersion str) of
- Just v -> return prog { programVersion = Just v }
- _ -> die ("cannot determine version of " ++ name ++ " :\n" ++ show str)
+-- | Runs the given configured program.
+rawSystemProgram :: Verbosity -- ^Verbosity
+ -> ConfiguredProgram -- ^The program to run
+ -> [ProgArg] -- ^Any /extra/ arguments to add
+ -> IO ()
+rawSystemProgram verbosity prog extraArgs
+ = rawSystemExit verbosity (programPath prog) (programArgs prog ++ extraArgs)
+
+-- | Looks up the given program in the program configuration and runs it.
+rawSystemProgramConf :: Verbosity -- ^verbosity
+ -> Program -- ^The program to run
+ -> ProgramConfiguration -- ^look up the program here
+ -> [ProgArg] -- ^Any /extra/ arguments to add
+ -> IO ()
+rawSystemProgramConf verbosity prog programConf extraArgs =
+ case lookupProgram prog programConf of
+ Nothing -> die (programName prog ++ " command not found")
+ Just configuredProg -> rawSystemProgram verbosity configuredProg extraArgs
-- ------------------------------------------------------------
--- * cabal programs
+-- * Known programs
-- ------------------------------------------------------------
+-- | The default list of programs.
+-- These programs are typically used internally to Cabal.
+builtinPrograms :: [Program]
+builtinPrograms =
+ [
+ -- compilers and related progs
+ ghcProgram
+ , ghcPkgProgram
+ , hugsProgram
+ , ffihugsProgram
+ , nhcProgram
+ , hmakeProgram
+ , jhcProgram
+ -- preprocessors
+ , hscolourProgram
+ , haddockProgram
+ , happyProgram
+ , alexProgram
+ , hsc2hsProgram
+ , c2hsProgram
+ , cpphsProgram
+ , greencardProgram
+ , pfesetupProgram
+ -- platform toolchain
+ , ranlibProgram
+ , arProgram
+ , ldProgram
+ , tarProgram
+ ]
+
ghcProgram :: Program
-ghcProgram = simpleProgram "ghc"
+ghcProgram = (simpleProgram "ghc") {
+ programFindVersion = findProgramVersion "--numeric-version" id
+ }
ghcPkgProgram :: Program
-ghcPkgProgram = simpleProgram "ghc-pkg"
+ghcPkgProgram = (simpleProgram "ghc-pkg") {
+ programFindVersion = findProgramVersion "--version" $ \str ->
+ -- Invoking "ghc-pkg --version" gives a string like
+ -- "GHC package manager version 6.4.1"
+ case words str of
+ (_:_:_:_:ver:_) -> ver
+ _ -> ""
+ }
nhcProgram :: Program
nhcProgram = simpleProgram "nhc"
-jhcProgram :: Program
-jhcProgram = simpleProgram "jhc"
+hmakeProgram :: Program
+hmakeProgram = (simpleProgram "hmake") {
+ programFindVersion = findProgramVersion "--version" $ \str ->
+ case words str of
+ (_:ver:_) -> ver
+ _ -> ""
+ }
+jhcProgram :: Program
+jhcProgram = (simpleProgram "jhc") {
+ programFindVersion = findProgramVersion "--version" $ \str ->
+ case words str of
+ (_:ver:_) -> ver
+ _ -> ""
+ }
+
+-- AArgh! Finding the version of hugs or ffihugs is almost impossible.
hugsProgram :: Program
hugsProgram = simpleProgram "hugs"
+ffihugsProgram :: Program
+ffihugsProgram = simpleProgram "ffihugs"
+
happyProgram :: Program
-happyProgram = simpleProgram "happy"
+happyProgram = (simpleProgram "happy") {
+ programFindVersion = findProgramVersion "--version" $ \str ->
+ -- Invoking "happy --version" gives a string like
+ -- "Happy Version 1.16 Copyright (c) ...."
+ case words str of
+ (_:_:ver:_) -> ver
+ _ -> ""
+ }
alexProgram :: Program
-alexProgram = simpleProgram "alex"
+alexProgram = (simpleProgram "alex") {
+ programFindVersion = findProgramVersion "--version" $ \str ->
+ -- Invoking "alex --version" gives a string like
+ -- "Alex version 2.1.0, (c) 2003 Chris Dornan and Simon Marlow"
+ case words str of
+ (_:_:ver:_) -> takeWhile (`elem` ('.':['0'..'9'])) ver
+ _ -> ""
+ }
+
ranlibProgram :: Program
ranlibProgram = simpleProgram "ranlib"
@@ -244,29 +510,53 @@ arProgram :: Program
arProgram = simpleProgram "ar"
hsc2hsProgram :: Program
-hsc2hsProgram = simpleProgram "hsc2hs"
+hsc2hsProgram = (simpleProgram "hsc2hs") {
+ programFindVersion = findProgramVersion "--version" $ \str ->
+ -- Invoking "hsc2hs --version" gives a string like "hsc2hs version 0.66"
+ case words str of
+ (_:_:ver:_) -> ver
+ _ -> ""
+ }
c2hsProgram :: Program
-c2hsProgram = simpleProgram "c2hs"
+c2hsProgram = (simpleProgram "c2hs") {
+ programFindVersion = findProgramVersion "--numeric-version" id
+ }
cpphsProgram :: Program
-cpphsProgram = simpleProgram "cpphs"
+cpphsProgram = (simpleProgram "cpphs") {
+ programFindVersion = findProgramVersion "--version" $ \str ->
+ -- Invoking "cpphs --version" gives a string like "cpphs 1.3"
+ case words str of
+ (_:ver:_) -> ver
+ _ -> ""
+ }
hscolourProgram :: Program
-hscolourProgram = (simpleProgram "hscolour"){ programBinName = "HsColour" }
+hscolourProgram = (simpleProgram "hscolour") {
+ programFindLocation = searchPath "HsColour",
+ programFindVersion = findProgramVersion "-version" $ \str ->
+ -- Invoking "HsColour -version" gives a string like "HsColour 1.7"
+ case words str of
+ (_:ver:_) -> ver
+ _ -> ""
+ }
haddockProgram :: Program
-haddockProgram = simpleProgram "haddock"
+haddockProgram = (simpleProgram "haddock") {
+ programFindVersion = findProgramVersion "--version" $ \str ->
+ -- Invoking "haddock --version" gives a string like
+ -- "Haddock version 0.8, (c) Simon Marlow 2006"
+ case words str of
+ (_:_:ver:_) -> takeWhile (`elem` ('.':['0'..'9'])) ver
+ _ -> ""
+ }
greencardProgram :: Program
greencardProgram = simpleProgram "greencard"
ldProgram :: Program
-ldProgram = case os of
- Windows MingW ->
- Program "ld" "ld" Nothing []
- (FoundOnSystem "<what-your-hs-compiler-shipped-with>")
- _ -> simpleProgram "ld"
+ldProgram = simpleProgram "ld"
tarProgram :: Program
tarProgram = simpleProgram "tar"
@@ -276,114 +566,3 @@ cppProgram = simpleProgram "cpp"
pfesetupProgram :: Program
pfesetupProgram = simpleProgram "pfesetup"
-
--- ------------------------------------------------------------
--- * helpers
--- ------------------------------------------------------------
-
--- |Looks up a program in the given configuration. If there's no
--- location information in the configuration, then we use IO to look
--- on the system in PATH for the program. If the program is not in
--- the configuration at all, we return Nothing. FIX: should we build
--- a simpleProgram in that case? Do we want a way to specify NOT to
--- find it on the system (populate programLocation).
-
-lookupProgram :: String -- simple name of program
- -> ProgramConfiguration
- -> IO (Maybe Program) -- the full program
-lookupProgram name conf =
- case lookupProgram' name conf of
- Nothing -> return Nothing
- Just p@Program{ programLocation= configLoc
- , programBinName = binName}
- -> do newLoc <- case configLoc of
- EmptyLocation
- -> do maybeLoc <- findExecutable binName
- return $ maybe EmptyLocation FoundOnSystem maybeLoc
- a -> return a
- return $ Just p{programLocation=newLoc}
-
-lookupPrograms :: ProgramConfiguration -> IO [(String, Maybe Program)]
-lookupPrograms conf@(ProgramConfiguration fm) = do
- let l = Map.elems fm
- mapM (\p -> do fp <- lookupProgram (programName p) conf
- return (programName p, fp)
- ) l
-
--- |User-specify this path. Basically override any path information
--- for this program in the configuration. If it's not a known
--- program, add it.
-userSpecifyPath :: String -- ^Program name
- -> FilePath -- ^user-specified path to filename
- -> ProgramConfiguration
- -> ProgramConfiguration
-userSpecifyPath name path conf'@(ProgramConfiguration conf)
- = case Map.lookup name conf of
- Just p -> updateProgram p{programLocation=UserSpecified path} conf'
- Nothing -> updateProgram (simpleProgramAt name (UserSpecified path))
- conf'
-
--- |User-specify the arguments for this program. Basically override
--- any args information for this program in the configuration. If it's
--- not a known program, add it.
-userSpecifyArgs :: String -- ^Program name
- -> String -- ^user-specified args
- -> ProgramConfiguration
- -> ProgramConfiguration
-userSpecifyArgs name args conf'@(ProgramConfiguration conf)
- = case Map.lookup name conf of
- Just p -> updateProgram p{programArgs=(words args)} conf'
- Nothing -> updateProgram (Program name name Nothing (words args) EmptyLocation) conf'
-
--- |Update this program's entry in the configuration.
-updateProgram :: Program -> ProgramConfiguration -> ProgramConfiguration
-updateProgram p@Program{programName=n} (ProgramConfiguration conf)
- = ProgramConfiguration $ Map.insert n p conf
-
--- |Same as updateProgram but no changes if you pass in Nothing.
-maybeUpdateProgram :: Maybe Program -> ProgramConfiguration -> ProgramConfiguration
-maybeUpdateProgram m c = maybe c (\p -> updateProgram p c) m
-
--- |Runs the given program.
-rawSystemProgram :: Verbosity -- ^Verbosity
- -> Program -- ^The program to run
- -> [String] -- ^Any /extra/ arguments to add
- -> IO ()
-rawSystemProgram _ prog@(Program { programLocation = EmptyLocation }) _
- = die ("Error: Could not find location for program: " ++ programName prog)
-rawSystemProgram verbosity prog extraArgs
- = rawSystemExit verbosity (programPath prog) (programArgs prog ++ extraArgs)
-
-rawSystemProgramConf :: Verbosity -- ^verbosity
- -> String -- ^The name of the program to run
- -> ProgramConfiguration -- ^look up the program here
- -> [String] -- ^Any /extra/ arguments to add
- -> IO ()
-rawSystemProgramConf verbosity progName programConf extraArgs
- = do prog <- do mProg <- lookupProgram progName programConf
- case mProg of
- Nothing -> (die (progName ++ " command not found"))
- Just h -> return h
- rawSystemProgram verbosity prog extraArgs
-
-
--- ------------------------------------------------------------
--- * Internal helpers
--- ------------------------------------------------------------
-
-lookupProgram' :: String -> ProgramConfiguration -> Maybe Program
-lookupProgram' s (ProgramConfiguration conf) = Map.lookup s conf
-
-progListToFM :: [Program] -> ProgramConfiguration
-progListToFM progs = foldl
- (\ (ProgramConfiguration conf')
- p@(Program {programName=n})
- -> ProgramConfiguration (Map.insert n p conf'))
- (ProgramConfiguration Map.empty)
- progs
-
-simpleProgram :: String -> Program
-simpleProgram s = simpleProgramAt s EmptyLocation
-
-simpleProgramAt :: String -> ProgramLocation -> Program
-simpleProgramAt s l = Program s s Nothing [] l
diff --git a/Distribution/Setup.hs b/Distribution/Setup.hs
index 8e5119b3a4bf991b1e16b1fcacd80f10e86ff5df..b8d1d3aa889fa97ecaac555363bdcf4938db5ae1 100644
--- a/Distribution/Setup.hs
+++ b/Distribution/Setup.hs
@@ -77,11 +77,10 @@ import Test.HUnit (Test(..))
import Distribution.Compiler (CompilerFlavor(..), Compiler(..))
import Distribution.Simple.Utils (die)
-import Distribution.Program(ProgramConfiguration(..),
- userSpecifyPath, userSpecifyArgs)
+import Distribution.Program (Program(..), ProgramConfiguration,
+ knownPrograms, userSpecifyPath, userSpecifyArgs)
import Data.List(find)
import Data.Char( toLower )
-import Distribution.Compat.Map (keys)
import Distribution.GetOpt
import Distribution.Verbosity
import System.FilePath (normalise)
@@ -571,14 +570,16 @@ configureCmd progConf = Cmd {
}
programArgsOptions :: ProgramConfiguration -> [OptDescr (Flag a)]
-programArgsOptions (ProgramConfiguration conf) = map f (keys conf)
- where f name = Option "" [name ++ "-args"] (reqArgArg (ProgramArgs name))
- ("give the args to " ++ name)
+programArgsOptions conf =
+ [ Option "" [name ++ "-args"] (reqArgArg (ProgramArgs name))
+ ("give the args to " ++ name)
+ | (Program { programName = name }, _) <- knownPrograms conf ]
withProgramOptions :: ProgramConfiguration -> [OptDescr (Flag a)]
-withProgramOptions (ProgramConfiguration conf) = map f (keys conf)
- where f name = Option "" ["with-" ++ name] (reqPathArg (WithProgram name))
- ("give the path to " ++ name)
+withProgramOptions conf =
+ [ Option "" ["with-" ++ name] (reqPathArg (WithProgram name))
+ ("give the path to " ++ name)
+ | (Program { programName = name }, _) <- knownPrograms conf ]
reqPathArg :: (FilePath -> a) -> ArgDescr a
reqPathArg constr = ReqArg (constr . normalise) "PATH"
@@ -606,12 +607,15 @@ parseConfigureArgs progConf = parseArgs (configureCmd progConf) updateCfg
updateCfg t HugsFlag = t { configHcFlavor = Just Hugs }
updateCfg t (WithCompiler path) = t { configHcPath = Just path }
updateCfg t (WithHcPkg path) = t { configHcPkg = Just path }
- updateCfg t (ProgramArgs name args) = t { configPrograms = (userSpecifyArgs
- name
- args (configPrograms t))}
- updateCfg t (WithProgram name path) = t { configPrograms = (userSpecifyPath
- name
- path (configPrograms t))}
+ updateCfg t (ProgramArgs name args) = t { configPrograms =
+ userSpecifyArgs
+ --TODO: using words here is not good, it breaks for paths with spaces
+ name (words args)
+ (configPrograms t) }
+ updateCfg t (WithProgram name path) = t { configPrograms =
+ userSpecifyPath
+ name path
+ (configPrograms t) }
updateCfg t WithVanillaLib = t { configVanillaLib = True }
updateCfg t WithoutVanillaLib = t { configVanillaLib = False, configGHCiLib = False }
updateCfg t WithProfLib = t { configProfLib = True }
diff --git a/Distribution/Simple.hs b/Distribution/Simple.hs
index 228b0c4ab45cd13280574b56c99bc8da8b8bcf71..5b1077dd79b6ff157e3342ed5445b725501cfb67 100644
--- a/Distribution/Simple.hs
+++ b/Distribution/Simple.hs
@@ -69,8 +69,8 @@ module Distribution.Simple (
import Distribution.Compiler
import Distribution.Package --must not specify imports, since we're exporting moule.
import Distribution.PackageDescription
-import Distribution.Program(Program(..), ProgramConfiguration(..),
- defaultProgramConfiguration, updateProgram,
+import Distribution.Program(Program(..), ProgramConfiguration,
+ defaultProgramConfiguration, addKnownProgram,
pfesetupProgram, rawSystemProgramConf)
import Distribution.PreProcess (knownSuffixHandlers, ppSuffixes,
removePreprocessedPackage,
@@ -277,7 +277,7 @@ defaultMain__ margs mhooks mdescr = do
-- into cabal.
allPrograms :: UserHooks
-> ProgramConfiguration -- combine defaults w/ user programs
-allPrograms h = foldl (flip updateProgram)
+allPrograms h = foldl (flip addKnownProgram)
defaultProgramConfiguration
(hookedPrograms h)
@@ -449,11 +449,8 @@ pfe pkg_descr _lbi hooks (PFEFlags verbosity) = do
preprocessSources pkg_descr lbi False verbosity pps
inFiles <- getModulePaths lbi bi mods
let verbFlags = if verbosity >= deafening then ["-v"] else []
- rawSystemProgramConf verbosity
- (programName pfesetupProgram)
- (withPrograms lbi)
+ rawSystemProgramConf verbosity pfesetupProgram (withPrograms lbi)
("noplogic" : "cpp" : verbFlags ++ inFiles)
- return ()
-- --------------------------------------------------------------------------
diff --git a/Distribution/Simple/Configure.hs b/Distribution/Simple/Configure.hs
index 25456f43bb4b14f5c69d574d96e84e14f4465845..f7a32eede1cd455bc8d870150e2a7e38cae542b0 100644
--- a/Distribution/Simple/Configure.hs
+++ b/Distribution/Simple/Configure.hs
@@ -81,9 +81,8 @@ import Distribution.PackageDescription
import Distribution.ParseUtils
( showDependency )
import Distribution.Program
- ( Program(..), ProgramLocation(..), ProgramConfiguration(..), programPath
- , lookupProgram, lookupPrograms, updateProgram, maybeUpdateProgram
- , findProgramAndVersion )
+ ( Program(..), ProgramLocation(..), ConfiguredProgram(..), programPath
+ , ProgramConfiguration, configureAllKnownPrograms, knownPrograms )
import Distribution.Setup
( ConfigFlags(..), CopyDest(..) )
import Distribution.Simple.InstallDirs
@@ -189,7 +188,7 @@ configure :: ( Either GenericPackageDescription PackageDescription
configure (pkg_descr0, pbi) cfg
= do
-- detect compiler
- comp <- configCompilerAux cfg
+ (comp, programsConfig) <- configCompilerAux cfg
let version = compilerVersion comp
flavor = compilerFlavor comp
@@ -270,14 +269,8 @@ configure (pkg_descr0, pbi) cfg
show flavor ++ " does not support the following extensions:\n " ++
concat (intersperse ", " (map show exts))
- foundPrograms <- lookupPrograms (configPrograms cfg)
-
- let newConfig = foldr (\(_, p) c -> maybeUpdateProgram p c)
- (configPrograms cfg) foundPrograms
-
- -- TODO: get version checking integrated into the Program abstraction
- newConfig' <- findHaddockVersion (configVerbose cfg) newConfig
- newConfig'' <- findHscolourVersion (configVerbose cfg) newConfig'
+ programsConfig' <- configureAllKnownPrograms (configVerbose cfg)
+ programsConfig
split_objs <-
if not (configSplitObjs cfg)
@@ -296,7 +289,7 @@ configure (pkg_descr0, pbi) cfg
scratchDir=distPref </> "scratch",
packageDeps=dep_pkgs,
localPkgDescr=pkg_descr,
- withPrograms=newConfig'',
+ withPrograms=programsConfig',
withVanillaLib=configVanillaLib cfg,
withProfLib=configProfLib cfg,
withProfExe=configProfExe cfg,
@@ -323,7 +316,8 @@ configure (pkg_descr0, pbi) cfg
message $ "Compiler version: " ++ showVersion version
message $ "Using package tool: " ++ compilerPkgToolPath comp
- mapM_ (uncurry reportProgram) foundPrograms
+ sequence_ [ reportProgram prog configuredProg
+ | (prog, configuredProg) <- knownPrograms programsConfig' ]
return lbi
@@ -346,18 +340,17 @@ setDepByVersion (Dependency s (ThisVersion v)) = PackageIdentifier s v
-- otherwise, just set it to empty
setDepByVersion (Dependency s _) = PackageIdentifier s (Version [] [])
-
-reportProgram :: String -> Maybe Program -> IO ()
-reportProgram _ (Just Program{ programName=name
- , programLocation=EmptyLocation})
- = message ("No " ++ name ++ " found")
-reportProgram _ (Just Program{ programName=name
- , programLocation=FoundOnSystem p})
- = message ("Using " ++ name ++ " found on system at: " ++ p)
-reportProgram _ (Just Program{ programName=name
- , programLocation=UserSpecified p})
- = message ("Using " ++ name ++ " given by user at: " ++ p)
-reportProgram name Nothing = message ("No " ++ name ++ " found")
+reportProgram :: Program -> Maybe ConfiguredProgram -> IO ()
+reportProgram prog Nothing
+ = message $ "No " ++ programName prog ++ " found"
+reportProgram prog (Just configuredProg)
+ = message $ "Using " ++ programName prog ++ version ++ location
+ where location = case programLocation configuredProg of
+ FoundOnSystem p -> " found on system at: " ++ p
+ UserSpecified p -> " given by user at: " ++ p
+ version = case programVersion configuredProg of
+ Nothing -> ""
+ Just v -> " version " ++ showVersion v
hackageUrl :: String
hackageUrl = "http://hackage.haskell.org/cgi-bin/hackage-scripts/package/"
@@ -404,54 +397,25 @@ getInstalledPackages comp user verbosity = do
-- -----------------------------------------------------------------------------
-- Determining the compiler details
-configCompilerAux :: ConfigFlags -> IO Compiler
+configCompilerAux :: ConfigFlags -> IO (Compiler, ProgramConfiguration)
configCompilerAux cfg = configCompiler (configHcFlavor cfg)
(configHcPath cfg)
(configHcPkg cfg)
+ (configPrograms cfg)
(configVerbose cfg)
configCompiler :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath
- -> Verbosity -> IO Compiler
-configCompiler Nothing _ _ _ = die "Unknown compiler"
-configCompiler (Just hcFlavor) hcPath hcPkg verbosity
- = case hcFlavor of
- GHC -> GHC.configure hcPath hcPkg verbosity
- JHC -> JHC.configure hcPath hcPkg verbosity
- Hugs -> Hugs.configure hcPath hcPkg verbosity
- NHC -> NHC.configure hcPath hcPkg verbosity
+ -> ProgramConfiguration -> Verbosity
+ -> IO (Compiler, ProgramConfiguration)
+configCompiler Nothing _ _ _ _ = die "Unknown compiler"
+configCompiler (Just hcFlavor) hcPath hcPkg conf verbosity = do
+ case hcFlavor of
+ GHC -> GHC.configure verbosity hcPath hcPkg conf
+ JHC -> JHC.configure verbosity hcPath hcPkg conf
+ Hugs -> Hugs.configure verbosity hcPath hcPkg conf
+ NHC -> NHC.configure verbosity hcPath hcPkg conf
_ -> die "Unknown compiler"
-findHscolourVersion :: Verbosity -> ProgramConfiguration -> IO ProgramConfiguration
-findHscolourVersion verbosity conf = do
- mHsColour <- lookupProgram "hscolour" conf
- case mHsColour of
- Nothing -> return conf
- Just Program { programLocation = EmptyLocation } -> return conf
- Just prog -> do
- -- Invoking "HsColour -version" gives a string like "HsColour 1.7"
- prog' <- findProgramAndVersion verbosity (programBinName prog)
- (Just $ programPath prog) "-version" $ \str ->
- case words str of
- (_:ver:_) -> ver
- _ -> ""
- return (updateProgram prog' { programName = "hscolour" } conf)
-
-findHaddockVersion :: Verbosity -> ProgramConfiguration -> IO ProgramConfiguration
-findHaddockVersion verbosity conf = do
- mHaddock <- lookupProgram "haddock" conf
- case mHaddock of
- Nothing -> return conf
- Just Program { programLocation = EmptyLocation } -> return conf
- Just prog -> do
- -- Invoking "haddock --version" gives a string like
- -- "Haddock version 0.8, (c) Simon Marlow 2006"
- prog' <- findProgramAndVersion verbosity (programBinName prog)
- (Just $ programPath prog) "--version" $ \str ->
- case words str of
- (_:_:ver:_) -> takeWhile (`elem` ('.':['0'..'9'])) ver
- _ -> ""
- return (updateProgram prog' conf)
-
pCheck :: [(a, [Char])] -> [a]
pCheck rs = [ r | (r,s) <- rs, all isSpace s ]
diff --git a/Distribution/Simple/GHC.hs b/Distribution/Simple/GHC.hs
index 99e895f0d3722e13e0d87bd48cdbd3c8688df88f..7f62fb6b2898d1c4b7af64a59b47258fec01c48b 100644
--- a/Distribution/Simple/GHC.hs
+++ b/Distribution/Simple/GHC.hs
@@ -59,13 +59,15 @@ import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Utils
import Distribution.Package ( PackageIdentifier(..), showPackageId )
import Distribution.Program ( rawSystemProgram, rawSystemProgramConf,
- Program(..), ProgramConfiguration(..),
- ProgramLocation(..), programPath,
- findProgram, findProgramAndVersion,
- simpleProgramAt, lookupProgram,
- arProgram, ranlibProgram )
+ Program(..), ConfiguredProgram(..),
+ ProgramConfiguration, addKnownProgram,
+ userMaybeSpecifyPath, requireProgram,
+ programPath, lookupProgram,
+ ghcProgram, ghcPkgProgram,
+ arProgram, ranlibProgram, ldProgram )
import Distribution.Compiler
-import Distribution.Version ( Version(..) )
+import Distribution.Version ( Version(..), showVersion,
+ VersionRange(..), orLaterVersion )
import qualified Distribution.Simple.GHCPackageConfig as GHC
( localPackageConfig,
canReadLocalPackageConfig )
@@ -92,17 +94,33 @@ import IO as Try
-- -----------------------------------------------------------------------------
-- Configuring
-configure :: Maybe FilePath -> Maybe FilePath -> Verbosity -> IO Compiler
-configure hcPath hcPkgPath verbosity = do
-
- -- find ghc and version number
- ghcProg <- findProgramAndVersion verbosity "ghc" hcPath "--numeric-version" id
-
- -- find ghc-pkg
- ghcPkgProg <- case hcPkgPath of
- Just _ -> findProgram verbosity "ghc" hcPkgPath
- Nothing -> guessGhcPkgFromGhcPath verbosity ghcProg
- -- TODO: santity check: the versions of ghc-pkg and ghc should be the same.
+configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
+ -> ProgramConfiguration -> IO (Compiler, ProgramConfiguration)
+configure verbosity hcPath hcPkgPath conf = do
+
+ (ghcProg, conf') <- requireProgram verbosity ghcProgram
+ (orLaterVersion (Version [6,2] []))
+ (userMaybeSpecifyPath "ghc" hcPath conf)
+
+ -- This is slightly tricky, we have to configure ghc first, then we use the
+ -- location of ghc to help find ghc-pkg in the case that the user did not
+ -- specify the location of ghc-pkg directly:
+ (ghcPkgProg, conf'') <- requireProgram verbosity ghcPkgProgram {
+ programFindLocation = guessGhcPkgFromGhcPath ghcProg
+ }
+ (orLaterVersion (Version [0] []))
+ (userMaybeSpecifyPath "ghc-pkg" hcPkgPath conf')
+
+ -- finding ghc's local ld is a bit tricky as it's not on the path:
+ let conf''' = case os of
+ Windows _ ->
+ let compilerDir = takeDirectory (programPath ghcProg)
+ baseDir = takeDirectory compilerDir
+ binInstallLd = baseDir </> "gcc-lib" </> "ld.exe"
+ in addKnownProgram ldProgram {
+ programFindLocation = \_ -> return (Just binInstallLd)
+ } conf''
+ _ -> conf''
let Just version = programVersion ghcProg
isSep c = isSpace c || (c == ',')
@@ -114,13 +132,15 @@ configure hcPath hcPkgPath verbosity = do
| extStr <- breaks isSep exts
, (ext, "") <- reads extStr ++ reads ("No" ++ extStr) ]
else return oldLanguageExtensions
- return Compiler {
+
+ let comp = Compiler {
compilerFlavor = GHC,
compilerId = PackageIdentifier "ghc" version,
compilerProg = ghcProg,
compilerPkgTool = ghcPkgProg,
compilerExtensions = languageExtensions
- }
+ }
+ return (comp, conf''')
-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
-- corresponding ghc-pkg, we try looking for both a versioned and unversioned
@@ -129,8 +149,8 @@ configure hcPath hcPkgPath verbosity = do
-- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg(.exe)
--
-guessGhcPkgFromGhcPath :: Verbosity -> Program -> IO Program
-guessGhcPkgFromGhcPath verbosity ghcProg
+guessGhcPkgFromGhcPath :: ConfiguredProgram -> Verbosity -> IO (Maybe FilePath)
+guessGhcPkgFromGhcPath ghcProg verbosity
= do let path = programPath ghcProg
dir = takeDirectory path
versionSuffix = takeVersionSuffix (dropExeExtension path)
@@ -142,10 +162,10 @@ guessGhcPkgFromGhcPath verbosity ghcProg
putStrLn $ "looking for package tool: ghc-pkg near compiler in " ++ dir
exists <- mapM doesFileExist guesses
case [ file | (file, True) <- zip guesses exists ] of
- [] -> die "Cannot find package tool: ghc-pkg"
+ [] -> return Nothing
(pkgtool:_) -> do when (verbosity >= verbose) $
putStrLn $ "found package tool in " ++ pkgtool
- return (simpleProgramAt "ghc-pkg" (FoundOnSystem pkgtool))
+ return (Just pkgtool)
where takeVersionSuffix :: FilePath -> String
takeVersionSuffix = reverse . takeWhile (`elem ` "0123456789.-") . reverse
@@ -281,7 +301,6 @@ build pkg_descr lbi verbosity = do
Try.try (removeFile profLibName) -- first remove library if it exists
Try.try (removeFile ghciLibName) -- first remove library if it exists
- ld <- findLdProgram lbi
let arArgs = ["q"++ (if verbosity >= deafening then "v" else "")]
++ [libName]
arObjArgs =
@@ -306,15 +325,12 @@ build pkg_descr lbi verbosity = do
exists <- doesFileExist ghciLibName
-- SDM: we always remove ghciLibName above, so isn't this
-- always False? What is this stuff for anyway?
- rawSystemLd verbosity ld
- (args ++ if exists then [ghciLibName] else [])
+ rawSystemProgramConf verbosity ldProgram (withPrograms lbi)
+ (args ++ if exists then [ghciLibName] else [])
renameFile (ghciLibName <.> "tmp") ghciLibName
- runAr = rawSystemProgramConf verbosity "ar" (withPrograms lbi)
+ runAr = rawSystemProgramConf verbosity arProgram (withPrograms lbi)
- rawSystemLd = case os of
- Windows MingW -> rawSystemExit
- _ -> rawSystemPathExit
--TODO: discover this at configure time on unix
maxCommandLineSize = 30 * 1024
@@ -466,21 +482,6 @@ mkGHCiLibName :: FilePath -- ^file Prefix
-> String
mkGHCiLibName pref lib = pref </> ("HS" ++ lib) <.> ".o"
-
-findLdProgram :: LocalBuildInfo -> IO FilePath
-findLdProgram lbi
- = case os of
- Windows MingW ->
- do let compilerDir = takeDirectory $ compilerPath (compiler lbi)
- baseDir = takeDirectory compilerDir
- binInstallLd = baseDir </> "gcc-lib" </> "ld.exe"
- mb <- lookupProgram "ld" (withPrograms lbi)
- case fmap programLocation mb of
- Just (UserSpecified s) -> return s
- -- assume we're using an installed copy of GHC..
- _ -> return binInstallLd
- _ -> return "ld"
-
-- -----------------------------------------------------------------------------
-- Building a Makefile
@@ -501,9 +502,10 @@ makefile pkg_descr lbi flags = do
packageId | versionBranch ghc_vers >= [6,4]
= showPackageId (package pkg_descr)
| otherwise = pkgName (package pkg_descr)
- mbAr <- lookupProgram "ar" (withPrograms lbi)
- let arProg = mbAr `programOrElse` "ar"
- ld <- findLdProgram lbi
+ (arProg, _) <- requireProgram (makefileVerbose flags) arProgram AnyVersion
+ (withPrograms lbi)
+ (ldProg, _) <- requireProgram (makefileVerbose flags) ldProgram AnyVersion
+ (withPrograms lbi)
let builddir = buildDir lbi
let decls = [
("modules", unwords (exposedModules lib ++ otherModules bi)),
@@ -521,8 +523,8 @@ makefile pkg_descr lbi flags = do
("C_SRCS", unwords (cSources bi)),
("GHC_CC_OPTS", unwords (ghcCcOptions lbi bi (buildDir lbi))),
("GHCI_LIB", mkGHCiLibName builddir (showPackageId (package pkg_descr))),
- ("AR", arProg),
- ("LD", ld)
+ ("AR", programPath arProg),
+ ("LD", programPath ldProg)
]
hPutStrLn h "# DO NOT EDIT! Automatically generated by Cabal\n"
hPutStrLn h (unlines (map (\(a,b)-> a ++ " = " ++ munge b) decls))
@@ -574,15 +576,11 @@ installLib verbosity programConf hasVanilla hasProf hasGHCi pref buildPref
-- use ranlib or ar -s to build an index. this is necessary
-- on some systems like MacOS X. If we can't find those,
-- don't worry too much about it.
- let ranlibProgName = programName $ ranlibProgram
- mRanlibProg <- lookupProgram ranlibProgName programConf
- case foundProg mRanlibProg of
+ case lookupProgram ranlibProgram programConf of
Just rl -> do ifVanilla $ rawSystemProgram verbosity rl [libTargetLoc]
ifProf $ rawSystemProgram verbosity rl [profLibTargetLoc]
- Nothing -> do let arProgName = programName $ arProgram
- mArProg <- lookupProgram arProgName programConf
- case mArProg of
+ Nothing -> case lookupProgram arProgram programConf of
Just ar -> do ifVanilla $ rawSystemProgram verbosity ar ["-s", libTargetLoc]
ifProf $ rawSystemProgram verbosity ar ["-s", profLibTargetLoc]
Nothing -> setupMessage verbosity "Warning: Unable to generate index for library (missing ranlib and ar)" pd
@@ -592,19 +590,3 @@ installLib verbosity programConf hasVanilla hasProf hasGHCi pref buildPref
ifGHCi action = when hasGHCi (action >> return ())
installLib _ _ _ _ _ _ _ PackageDescription{library=Nothing}
= die $ "Internal Error. installLibGHC called with no library."
-
--- Also checks whether the program was actually found.
-foundProg :: Maybe Program -> Maybe Program
-foundProg Nothing = Nothing
-foundProg (Just Program{programLocation=EmptyLocation}) = Nothing
-foundProg x = x
-
-programOrElse :: Maybe Program -> FilePath -> FilePath
-mb_prog `programOrElse` q =
- case mb_prog of
- Nothing -> q
- Just Program{programLocation=l} ->
- case l of
- UserSpecified x -> x
- FoundOnSystem x -> x
- EmptyLocation -> q
diff --git a/Distribution/Simple/Haddock.hs b/Distribution/Simple/Haddock.hs
index 5341f397d1cdc04c5ebbe34bbf163629493da87d..7109835d15a2606d1104af35ceec3f6b34da2f9a 100644
--- a/Distribution/Simple/Haddock.hs
+++ b/Distribution/Simple/Haddock.hs
@@ -51,7 +51,7 @@ import Distribution.Compat.ReadP(readP_to_S)
import Distribution.Package (showPackageId)
import Distribution.PackageDescription
import Distribution.ParseUtils(Field(..), readFields, parseCommaList, parseFilePathQ)
-import Distribution.Program(lookupProgram, Program(..), programPath,
+import Distribution.Program(ConfiguredProgram(..), requireProgram, programPath,
hscolourProgram, haddockProgram, rawSystemProgram)
import Distribution.PreProcess (ppCpp', ppUnlit, preprocessSources,
PPSuffixHandler, runSimplePreProcessor)
@@ -72,8 +72,8 @@ import Language.Haskell.Extension
-- Base
import System.Directory(removeFile)
-import Control.Monad(liftM, when, unless, join)
-import Data.Maybe ( isJust, fromMaybe, catMaybes )
+import Control.Monad (liftM, when, join)
+import Data.Maybe ( isJust, catMaybes )
import Distribution.Compat.Directory(removeDirectoryRecursive, copyFile)
import System.FilePath((</>), (<.>), splitFileName, splitExtension,
@@ -99,10 +99,8 @@ haddock pkg_descr lbi suffixes haddockFlags@HaddockFlags {
when hsColour $ hscolour pkg_descr lbi suffixes $
HscolourFlags hsColourCss doExes verbosity
- confHaddock <- do let programConf = withPrograms lbi
- let haddockPath = programName haddockProgram
- mHaddock <- lookupProgram haddockPath programConf
- maybe (die "haddock command not found") return mHaddock
+ (confHaddock, _) <- requireProgram verbosity haddockProgram
+ (orLaterVersion (Version [0,6] [])) (withPrograms lbi)
let tmpDir = buildDir lbi </> "tmp"
createDirectoryIfMissingVerbose verbosity True tmpDir
@@ -117,8 +115,7 @@ haddock pkg_descr lbi suffixes haddockFlags@HaddockFlags {
let outputFlag = if haddockHoogle haddockFlags
then "--hoogle"
else "--html"
- let version = fromMaybe (error "could not find haddock version")
- (programVersion confHaddock)
+ let Just version = programVersion confHaddock
let have_src_hyperlink_flags = version >= Version [0,8] []
have_new_flags = version > Version [0,8] []
let comp = compiler lbi
@@ -260,15 +257,8 @@ haddock pkg_descr lbi suffixes haddockFlags@HaddockFlags {
hscolour :: PackageDescription -> LocalBuildInfo -> [PPSuffixHandler] -> HscolourFlags -> IO ()
hscolour pkg_descr lbi suffixes (HscolourFlags stylesheet doExes verbosity) = do
- confHscolour <- do let programConf = withPrograms lbi
- let hscolourPath = programName hscolourProgram
- mHscol <- lookupProgram hscolourPath programConf
- maybe (die "HsColour command not found") return mHscol
-
- let version = fromMaybe (error "could not find hscolour version")
- (programVersion confHscolour)
- haveLines = version >= Version [1,8] []
- unless haveLines $ die "hscolour version >= 1.8 required"
+ (confHscolour, _) <- requireProgram verbosity hscolourProgram
+ (orLaterVersion (Version [1,8] [])) (withPrograms lbi)
createDirectoryIfMissingVerbose verbosity True $ hscolourPref pkg_descr
preprocessSources pkg_descr lbi False verbosity suffixes
diff --git a/Distribution/Simple/Hugs.hs b/Distribution/Simple/Hugs.hs
index 68597d636c4a519629fddfd824ed85006f1ea07e..45b650b2eb6c84f8dd268ff0226655dc8e401503 100644
--- a/Distribution/Simple/Hugs.hs
+++ b/Distribution/Simple/Hugs.hs
@@ -51,7 +51,10 @@ import Distribution.PackageDescription
Executable(..), withExe, Library(..),
libModules, hcOptions, autogenModuleName )
import Distribution.Compiler ( Compiler(..), CompilerFlavor(..), Flag )
-import Distribution.Program ( rawSystemProgram, findProgram )
+import Distribution.Program ( ProgramConfiguration, userMaybeSpecifyPath,
+ requireProgram, rawSystemProgram,
+ ffihugsProgram, hugsProgram )
+import Distribution.Version ( Version(..), VersionRange(AnyVersion) )
import Distribution.PreProcess ( ppCpp, runSimplePreProcessor )
import Distribution.PreProcess.Unlit
( unlit )
@@ -81,28 +84,27 @@ import IO ( try )
import Data.List ( nub, sort, isSuffixOf )
import System.Directory ( Permissions(..), getPermissions,
setPermissions )
-import Distribution.Version
-- -----------------------------------------------------------------------------
-- Configuring
-configure :: Maybe FilePath -> Maybe FilePath -> Verbosity -> IO Compiler
-configure hcPath _hcPkgPath verbosity = do
+configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
+ -> ProgramConfiguration -> IO (Compiler, ProgramConfiguration)
+configure verbosity hcPath _hcPkgPath conf = do
- -- find ffihugs
- ffihugsProg <- findProgram verbosity "ffihugs" hcPath
+ (ffihugsProg, conf') <- requireProgram verbosity ffihugsProgram AnyVersion
+ (userMaybeSpecifyPath "ffihugs" hcPath conf)
+ (hugsProg, conf'') <- requireProgram verbosity hugsProgram AnyVersion conf'
- -- find hugs
- hugsProg <- findProgram verbosity "hugs" hcPath
-
- return Compiler {
+ let comp = Compiler {
compilerFlavor = Hugs,
compilerId = PackageIdentifier "hugs" (Version [] []),
compilerProg = ffihugsProg,
compilerPkgTool = hugsProg,
compilerExtensions = hugsLanguageExtensions
- }
+ }
+ return (comp, conf'')
-- | The flags for the supported extensions
hugsLanguageExtensions :: [(Extension, Flag)]
diff --git a/Distribution/Simple/JHC.hs b/Distribution/Simple/JHC.hs
index 0c667a7a8c644c784e9653901e68423301aa70b0..7ff58418c991ad845dd65b87e43be03573409e7f 100644
--- a/Distribution/Simple/JHC.hs
+++ b/Distribution/Simple/JHC.hs
@@ -55,8 +55,10 @@ import Distribution.Simple.LocalBuildInfo
import Distribution.Compiler ( Compiler(..), CompilerFlavor(..), Flag,
extensionsToFlags )
import Language.Haskell.Extension (Extension(..))
-import Distribution.Program ( Program(..), rawSystemProgram,
- findProgramAndVersion )
+import Distribution.Program ( ConfiguredProgram(..), jhcProgram,
+ ProgramConfiguration, userMaybeSpecifyPath,
+ requireProgram, rawSystemProgram )
+import Distribution.Version ( VersionRange(AnyVersion) )
import Distribution.Package ( PackageIdentifier(..), showPackageId )
import Distribution.Simple.Utils( createDirectoryIfMissingVerbose,
copyFileVerbose, exeExtension )
@@ -70,23 +72,22 @@ import Data.List ( nub, intersperse )
-- -----------------------------------------------------------------------------
-- Configuring
-configure :: Maybe FilePath -> Maybe FilePath -> Verbosity -> IO Compiler
-configure hcPath _hcPkgPath verbosity = do
+configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
+ -> ProgramConfiguration -> IO (Compiler, ProgramConfiguration)
+configure verbosity hcPath _hcPkgPath conf = do
- -- find jhc
- jhcProg <- findProgramAndVersion verbosity "jhc" hcPath "--version" $ \str ->
- case words str of
- (_:ver:_) -> ver
- _ -> ""
+ (jhcProg, conf') <- requireProgram verbosity jhcProgram AnyVersion
+ (userMaybeSpecifyPath "jhc" hcPath conf)
let Just version = programVersion jhcProg
- return Compiler {
+ comp = Compiler {
compilerFlavor = JHC,
compilerId = PackageIdentifier "jhc" version,
compilerProg = jhcProg,
compilerPkgTool = jhcProg,
compilerExtensions = jhcLanguageExtensions
- }
+ }
+ return (comp, conf')
-- | The flags for the supported extensions
jhcLanguageExtensions :: [(Extension, Flag)]
diff --git a/Distribution/Simple/NHC.hs b/Distribution/Simple/NHC.hs
index a1304f7586df59ebe9270e5e67794c1f2f372ae8..a7a9c4065750df54bb2d47a9e8f6ad8b588d41f5 100644
--- a/Distribution/Simple/NHC.hs
+++ b/Distribution/Simple/NHC.hs
@@ -53,30 +53,31 @@ import Distribution.Simple.LocalBuildInfo
import Distribution.Compiler ( Compiler(..), CompilerFlavor(..), Flag,
extensionsToFlags )
import Language.Haskell.Extension (Extension(..))
-import Distribution.Program ( rawSystemProgram, findProgramAndVersion )
+import Distribution.Program ( ProgramConfiguration, userMaybeSpecifyPath,
+ requireProgram, hmakeProgram,
+ rawSystemProgram )
+import Distribution.Version ( VersionRange(AnyVersion) )
import Distribution.Verbosity
-- -----------------------------------------------------------------------------
-- Configuring
-configure :: Maybe FilePath -> Maybe FilePath -> Verbosity -> IO Compiler
-configure hcPath _hcPkgPath verbosity = do
+configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
+ -> ProgramConfiguration -> IO (Compiler, ProgramConfiguration)
+configure verbosity hcPath _hcPkgPath conf = do
- -- find hmake
- -- TODO: why are we checking the version of hmake rather than nhc?
- hmakeProg <- findProgramAndVersion verbosity "hmake" hcPath "--version" $ \str ->
- case words str of
- (_:ver:_) -> ver
- _ -> ""
+ (hmakeProg, conf') <- requireProgram verbosity hmakeProgram AnyVersion
+ (userMaybeSpecifyPath "hmake" hcPath conf)
- return Compiler {
+ let comp = Compiler {
compilerFlavor = NHC,
compilerId = error "TODO: nhc compilerId", --PackageIdentifier "nhc" version
compilerProg = hmakeProg,
compilerPkgTool = hmakeProg,
compilerExtensions = nhcLanguageExtensions
- }
+ }
+ return (comp, conf')
-- | The flags for the supported extensions
nhcLanguageExtensions :: [(Extension, Flag)]
diff --git a/Distribution/Simple/Register.hs b/Distribution/Simple/Register.hs
index 21378b2e7cea60d96a0b4ccb41bc9875db42fffc..0e4fb8cbb7814fa1e638790f7d6cb52542e00013 100644
--- a/Distribution/Simple/Register.hs
+++ b/Distribution/Simple/Register.hs
@@ -67,7 +67,7 @@ import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), distPref,
absoluteInstallDirs, toPathTemplate)
import Distribution.Compiler (CompilerFlavor(..), Compiler(..),
compilerPkgToolPath, compilerVersion)
-import Distribution.Program (Program(..), ProgramLocation(..))
+import Distribution.Program (ConfiguredProgram(..), ProgramLocation(..))
import Distribution.Setup (RegisterFlags(..), CopyDest(..), userOverride)
import Distribution.PackageDescription (setupMessage, PackageDescription(..),
BuildInfo(..), Library(..), haddockName)
diff --git a/Distribution/Simple/SetupWrapper.hs b/Distribution/Simple/SetupWrapper.hs
index 18dea4200a7dfab806532ad873f7032c08fb4d6b..66e056a07d2f6034302c190b1b86713e8a2298f2 100644
--- a/Distribution/Simple/SetupWrapper.hs
+++ b/Distribution/Simple/SetupWrapper.hs
@@ -27,7 +27,8 @@ import Distribution.PackageDescription
packageDescription,
PackageDescription(..),
BuildType(..), cabalVersion )
-import System.Console.GetOpt
+import Distribution.Program ( emptyProgramConfiguration )
+import Distribution.GetOpt
import System.Directory
import Distribution.Compat.Exception ( finally )
import Distribution.Verbosity
@@ -63,8 +64,8 @@ setupWrapper args mdir = inDir mdir $ do
pkg_descr_file <- defaultPackageDesc (verbosity flags)
ppkg_descr <- readPackageDescription (verbosity flags) pkg_descr_file
- comp <- configCompiler (Just GHC) (withCompiler flags) (withHcPkg flags)
- normal
+ (comp, _) <- configCompiler (Just GHC) (withCompiler flags) (withHcPkg flags)
+ emptyProgramConfiguration normal
cabal_flag <- configCabalFlag flags (descCabalVersion (packageDescription ppkg_descr)) comp
let
diff --git a/Distribution/Simple/SrcDist.hs b/Distribution/Simple/SrcDist.hs
index 1df47aeea56fdcd8d4e00424eea9f2436823180d..bc4139bed68d699cd029dfcf997634c5c40f27f9 100644
--- a/Distribution/Simple/SrcDist.hs
+++ b/Distribution/Simple/SrcDist.hs
@@ -61,14 +61,15 @@ import Distribution.PackageDescription
(PackageDescription(..), BuildInfo(..), Executable(..), Library(..),
withLib, withExe, setupMessage)
import Distribution.Package (showPackageId, PackageIdentifier(pkgVersion))
-import Distribution.Version (Version(versionBranch))
+import Distribution.Version (Version(versionBranch), VersionRange(AnyVersion))
import Distribution.Simple.Utils (createDirectoryIfMissingVerbose,
smartCopySources, die, findPackageDesc,
- findFile, copyFileVerbose, rawSystemPathExit)
+ findFile, copyFileVerbose)
import Distribution.Setup (SDistFlags(..))
import Distribution.PreProcess (PPSuffixHandler, ppSuffixes, preprocessSources)
import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
-import Distribution.Program ( lookupProgram, ProgramLocation(..), Program(programLocation) )
+import Distribution.Program ( defaultProgramConfiguration, requireProgram,
+ rawSystemProgram, tarProgram )
#ifndef __NHC__
import Control.Exception (finally)
@@ -198,19 +199,14 @@ createArchive :: PackageDescription -- ^info from cabal file
createArchive pkg_descr verbosity mb_lbi tmpDir targetPref = do
let tarBallFilePath = targetPref </> tarBallName pkg_descr
- let tarDefault = "tar"
- tarProgram <-
- case mb_lbi of
- Nothing -> return tarDefault
- Just lbi -> do
- mb <- lookupProgram "tar" (withPrograms lbi)
- case fmap programLocation mb of
- Just (UserSpecified s) -> return s
- _ -> return tarDefault
+
+ (tarProg, _) <- requireProgram verbosity tarProgram AnyVersion
+ (maybe defaultProgramConfiguration withPrograms mb_lbi)
+
-- Hmm: I could well be skating on thinner ice here by using the -C option (=> GNU tar-specific?)
-- [The prev. solution used pipes and sub-command sequences to set up the paths correctly,
-- which is problematic in a Windows setting.]
- rawSystemPathExit verbosity tarProgram
+ rawSystemProgram verbosity tarProg
["-C", tmpDir, "-czf", tarBallFilePath, nameVersion pkg_descr]
-- XXX this should be done back where tmpDir is made, not here
`finally` removeDirectoryRecursive tmpDir