From 24fb1f9a5a294e2f013c11fe59875e312b3acfc8 Mon Sep 17 00:00:00 2001
From: Duncan Coutts <duncan@haskell.org>
Date: Fri, 17 Aug 2007 03:38:41 +0000
Subject: [PATCH] Rewrite the Program abstraction and the ProgramConfiguration
database Also make the follow on changes to everything that uses Program. The
notion of a program is now split into the abstract notion of a program that
we know about and might be able to configure, and a configured program that
we can actually run. The ProgramConfiguration database is similarly split. We
still keep user-supplied loation and arguments and use them when we configure
programs. The abstract Program now has functions to search for the program on
the system and for finding the version number. This allows for more generic
configuration of programs.
---
Distribution/Compiler.hs | 4 +-
Distribution/PreProcess.hs | 29 +-
Distribution/Program.hs | 759 +++++++++++++++++-----------
Distribution/Setup.hs | 34 +-
Distribution/Simple.hs | 11 +-
Distribution/Simple/Configure.hs | 96 ++--
Distribution/Simple/GHC.hs | 126 ++---
Distribution/Simple/Haddock.hs | 26 +-
Distribution/Simple/Hugs.hs | 24 +-
Distribution/Simple/JHC.hs | 23 +-
Distribution/Simple/NHC.hs | 23 +-
Distribution/Simple/Register.hs | 2 +-
Distribution/Simple/SetupWrapper.hs | 7 +-
Distribution/Simple/SrcDist.hs | 22 +-
14 files changed, 653 insertions(+), 533 deletions(-)
diff --git a/Distribution/Compiler.hs b/Distribution/Compiler.hs
index e4258ad8ff..4232131fa9 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 6e5bca3f18..3ea4b77ec3 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 8fcd116251..538efe6e79 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 8e5119b3a4..b8d1d3aa88 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 228b0c4ab4..5b1077dd79 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 25456f43bb..f7a32eede1 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 99e895f0d3..7f62fb6b28 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 5341f397d1..7109835d15 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 68597d636c..45b650b2eb 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 0c667a7a8c..7ff58418c9 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 a1304f7586..a7a9c40657 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 21378b2e7c..0e4fb8cbb7 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 18dea4200a..66e056a07d 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 1df47aeea5..bc4139bed6 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
--
GitLab