diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
index 0f2b6edef4c84d7d827d76eaa6c23170a890ee72..42731fd9b5228df7118bd6728b301e4efe5785f1 100644
--- a/Cabal/Cabal.cabal
+++ b/Cabal/Cabal.cabal
@@ -183,6 +183,7 @@ library
Distribution.Simple.Program.Ar
Distribution.Simple.Program.Builtin
Distribution.Simple.Program.Db
+ Distribution.Simple.Program.Find
Distribution.Simple.Program.GHC
Distribution.Simple.Program.HcPkg
Distribution.Simple.Program.Hpc
diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs
index 0500465f661a07998cf7697b7a0427b7bf083b8b..ffc1bc7206b4dc9262e20512c3a5f2ab892d12b7 100644
--- a/Cabal/Distribution/Simple/GHC.hs
+++ b/Cabal/Distribution/Simple/GHC.hs
@@ -98,7 +98,8 @@ import Distribution.Package
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.Program
( Program(..), ConfiguredProgram(..), ProgramConfiguration
- , ProgramLocation(..), rawSystemProgram
+ , ProgramLocation(..), ProgramSearchPath
+ , rawSystemProgram
, rawSystemProgramStdout, rawSystemProgramStdoutConf
, getProgramInvocationOutput
, requireProgramVersion, requireProgram, getProgramOutput
@@ -214,28 +215,30 @@ targetPlatform ghcInfo = platformFromTriple =<< lookup "Target platform" ghcInfo
-- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg(.exe)
--
-guessToolFromGhcPath :: FilePath -> ConfiguredProgram -> Verbosity
+guessToolFromGhcPath :: Program -> ConfiguredProgram
+ -> Verbosity -> ProgramSearchPath
-> IO (Maybe FilePath)
-guessToolFromGhcPath tool ghcProg verbosity
- = do let path = programPath ghcProg
+guessToolFromGhcPath tool ghcProg verbosity searchpath
+ = do let toolname = programName tool
+ path = programPath ghcProg
dir = takeDirectory path
versionSuffix = takeVersionSuffix (dropExeExtension path)
- guessNormal = dir </> tool <.> exeExtension
- guessGhcVersioned = dir </> (tool ++ "-ghc" ++ versionSuffix)
+ guessNormal = dir </> toolname <.> exeExtension
+ guessGhcVersioned = dir </> (toolname ++ "-ghc" ++ versionSuffix)
<.> exeExtension
- guessVersioned = dir </> (tool ++ versionSuffix) <.> exeExtension
+ guessVersioned = dir </> (toolname ++ versionSuffix) <.> exeExtension
guesses | null versionSuffix = [guessNormal]
| otherwise = [guessGhcVersioned,
guessVersioned,
guessNormal]
- info verbosity $ "looking for tool " ++ show tool
+ info verbosity $ "looking for tool " ++ toolname
++ " near compiler in " ++ dir
exists <- mapM doesFileExist guesses
case [ file | (file, True) <- zip guesses exists ] of
-- If we can't find it near ghc, fall back to the usual
-- method.
- [] -> findProgramLocation verbosity tool
- (fp:_) -> do info verbosity $ "found " ++ tool ++ " in " ++ fp
+ [] -> programFindLocation tool verbosity searchpath
+ (fp:_) -> do info verbosity $ "found " ++ toolname ++ " in " ++ fp
return (Just fp)
where takeVersionSuffix :: FilePath -> String
@@ -256,8 +259,9 @@ guessToolFromGhcPath tool ghcProg verbosity
-- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg(.exe)
--
-guessGhcPkgFromGhcPath :: ConfiguredProgram -> Verbosity -> IO (Maybe FilePath)
-guessGhcPkgFromGhcPath = guessToolFromGhcPath "ghc-pkg"
+guessGhcPkgFromGhcPath :: ConfiguredProgram
+ -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath)
+guessGhcPkgFromGhcPath = guessToolFromGhcPath ghcPkgProgram
-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
-- corresponding hsc2hs, we try looking for both a versioned and unversioned
@@ -267,8 +271,9 @@ guessGhcPkgFromGhcPath = guessToolFromGhcPath "ghc-pkg"
-- > /usr/local/bin/hsc2hs-6.6.1(.exe)
-- > /usr/local/bin/hsc2hs(.exe)
--
-guessHsc2hsFromGhcPath :: ConfiguredProgram -> Verbosity -> IO (Maybe FilePath)
-guessHsc2hsFromGhcPath = guessToolFromGhcPath "hsc2hs"
+guessHsc2hsFromGhcPath :: ConfiguredProgram
+ -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath)
+guessHsc2hsFromGhcPath = guessToolFromGhcPath hsc2hsProgram
-- | Adjust the way we find and configure gcc and ld
--
@@ -313,19 +318,19 @@ configureToolchain ghcProg ghcInfo =
binPrefix = ""
-- on Windows finding and configuring ghc's gcc and ld is a bit special
- findProg :: Program -> [FilePath] -> Verbosity -> IO (Maybe FilePath)
+ findProg :: Program -> [FilePath] -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath)
findProg prog locations
| isWindows = \verbosity -> look locations verbosity
| otherwise = programFindLocation prog
where
- look [] verbosity = do
+ look [] verbosity searchpath = do
warn verbosity ("Couldn't find " ++ programName prog
++ " where I expected it. Trying the search path.")
- programFindLocation prog verbosity
- look (f:fs) verbosity = do
+ programFindLocation prog verbosity searchpath
+ look (f:fs) verbosity searchpath = do
exists <- doesFileExist f
if exists then return (Just f)
- else look fs verbosity
+ else look fs verbosity searchpath
ccFlags = getFlags "C compiler flags"
gccLinkerFlags = getFlags "Gcc Linker flags"
diff --git a/Cabal/Distribution/Simple/LHC.hs b/Cabal/Distribution/Simple/LHC.hs
index 6697de3bacce14af9627a326f84e71b518c6a91b..a0420de7096ae37a18316dcc8e76114bcf887460 100644
--- a/Cabal/Distribution/Simple/LHC.hs
+++ b/Cabal/Distribution/Simple/LHC.hs
@@ -90,8 +90,9 @@ import Distribution.Package
( Package(..) )
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.Program
- ( Program(..), ConfiguredProgram(..), ProgramConfiguration, ProgArg
- , ProgramLocation(..), rawSystemProgram, rawSystemProgramConf
+ ( Program(..), ConfiguredProgram(..), ProgramConfiguration
+ , ProgramSearchPath, ProgramLocation(..)
+ , rawSystemProgram, rawSystemProgramConf
, rawSystemProgramStdout, rawSystemProgramStdoutConf
, requireProgramVersion
, userMaybeSpecifyPath, programPath, lookupProgram, addKnownProgram
@@ -181,12 +182,13 @@ configureToolchain lhcProg =
isWindows = case buildOS of Windows -> True; _ -> False
-- on Windows finding and configuring ghc's gcc and ld is a bit special
- findProg :: Program -> FilePath -> Verbosity -> IO (Maybe FilePath)
- findProg prog location | isWindows = \verbosity -> do
+ findProg :: Program -> FilePath
+ -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath)
+ findProg prog location | isWindows = \verbosity searchpath -> do
exists <- doesFileExist location
if exists then return (Just location)
else do warn verbosity ("Couldn't find " ++ programName prog ++ " where I expected it. Trying the search path.")
- programFindLocation prog verbosity
+ programFindLocation prog verbosity searchpath
| otherwise = programFindLocation prog
configureGcc :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
diff --git a/Cabal/Distribution/Simple/Program.hs b/Cabal/Distribution/Simple/Program.hs
index c57d5534d5fcc2a1c606e8294ffcd891ad8c6cc3..b43edc2e2a15286b8c79bf94ca0182c2ca15e738 100644
--- a/Cabal/Distribution/Simple/Program.hs
+++ b/Cabal/Distribution/Simple/Program.hs
@@ -35,6 +35,8 @@
module Distribution.Simple.Program (
-- * Program and functions for constructing them
Program(..)
+ , ProgramSearchPath
+ , ProgramSearchPathEntry(..)
, simpleProgram
, findProgramLocation
, findProgramVersion
@@ -67,6 +69,8 @@ module Distribution.Simple.Program (
, addKnownPrograms
, lookupKnownProgram
, knownPrograms
+ , getProgramSearchPath
+ , setProgramSearchPath
, userSpecifyPath
, userSpecifyPaths
, userMaybeSpecifyPath
diff --git a/Cabal/Distribution/Simple/Program/Builtin.hs b/Cabal/Distribution/Simple/Program/Builtin.hs
index 48446fab6cbbd5461bcdf54119f8417f699fd753..b8789ca4b14a3bd5959da2d592bc3556e09abac4 100644
--- a/Cabal/Distribution/Simple/Program/Builtin.hs
+++ b/Cabal/Distribution/Simple/Program/Builtin.hs
@@ -47,8 +47,10 @@ module Distribution.Simple.Program.Builtin (
import Distribution.Simple.Program.Types
( Program(..), simpleProgram )
+import Distribution.Simple.Program.Find
+ ( findProgramOnSearchPath )
import Distribution.Simple.Utils
- ( findProgramLocation, findProgramVersion )
+ ( findProgramVersion )
-- ------------------------------------------------------------
-- * Known programs
@@ -233,7 +235,7 @@ cpphsProgram = (simpleProgram "cpphs") {
hscolourProgram :: Program
hscolourProgram = (simpleProgram "hscolour") {
- programFindLocation = \v -> findProgramLocation v "HsColour",
+ programFindLocation = \v p -> findProgramOnSearchPath v p "HsColour",
programFindVersion = findProgramVersion "-version" $ \str ->
-- Invoking "HsColour -version" gives a string like "HsColour 1.7"
case words str of
diff --git a/Cabal/Distribution/Simple/Program/Db.hs b/Cabal/Distribution/Simple/Program/Db.hs
index c41897faccbd921bfc1888f6bb0dc93d579520c2..43678fcc1e470baf127065bb5d06f103d2b33152 100644
--- a/Cabal/Distribution/Simple/Program/Db.hs
+++ b/Cabal/Distribution/Simple/Program/Db.hs
@@ -32,6 +32,8 @@ module Distribution.Simple.Program.Db (
addKnownPrograms,
lookupKnownProgram,
knownPrograms,
+ getProgramSearchPath,
+ setProgramSearchPath,
userSpecifyPath,
userSpecifyPaths,
userMaybeSpecifyPath,
@@ -52,10 +54,13 @@ module Distribution.Simple.Program.Db (
import Distribution.Simple.Program.Types
( Program(..), ProgArg, ConfiguredProgram(..), ProgramLocation(..) )
+import Distribution.Simple.Program.Find
+ ( ProgramSearchPath, defaultProgramSearchPath
+ , findProgramOnSearchPath, programSearchPathAsPATHVar )
import Distribution.Simple.Program.Builtin
( builtinPrograms )
import Distribution.Simple.Utils
- ( die, findProgramLocation )
+ ( die )
import Distribution.Version
( Version, VersionRange, isAnyVersion, withinRange )
import Distribution.Text
@@ -88,6 +93,7 @@ import System.Directory
-- 'Program' but also any user-provided arguments and location for the program.
data ProgramDb = ProgramDb {
unconfiguredProgs :: UnconfiguredProgs,
+ progSearchPath :: ProgramSearchPath,
configuredProgs :: ConfiguredProgs
}
@@ -97,8 +103,7 @@ type ConfiguredProgs = Map.Map String ConfiguredProgram
emptyProgramDb :: ProgramDb
-emptyProgramDb = ProgramDb Map.empty Map.empty
-
+emptyProgramDb = ProgramDb Map.empty defaultProgramSearchPath Map.empty
defaultProgramDb :: ProgramDb
defaultProgramDb = restoreProgramDb builtinPrograms emptyProgramDb
@@ -166,6 +171,21 @@ knownPrograms conf =
[ (p,p') | (p,_,_) <- Map.elems (unconfiguredProgs conf)
, let p' = Map.lookup (programName p) (configuredProgs conf) ]
+-- | Get the current 'ProgramSearchPath' used by the 'ProgramDb'.
+-- This is the default list of locations where programs are looked for when
+-- configuring them. This can be overriden for specific programs (with
+-- 'userSpecifyPath'), and specific known programs can modify or ignore this
+-- search path in their own configuration code.
+--
+getProgramSearchPath :: ProgramDb -> ProgramSearchPath
+getProgramSearchPath = progSearchPath
+
+-- | Change the current 'ProgramSearchPath' used by the 'ProgramDb'.
+-- This will affect programs that are configured from here on, so you
+-- should usually set it before configuring any programs.
+--
+setProgramSearchPath :: ProgramSearchPath -> ProgramDb -> ProgramDb
+setProgramSearchPath searchpath db = db { progSearchPath = searchpath }
-- |User-specify this path. Basically override any path information
-- for this program in the configuration. If it's not a known
@@ -272,13 +292,13 @@ configureProgram :: Verbosity
configureProgram verbosity prog conf = do
let name = programName prog
maybeLocation <- case userSpecifiedPath prog conf of
- Nothing -> programFindLocation prog verbosity
+ Nothing -> programFindLocation prog verbosity (progSearchPath conf)
>>= return . fmap FoundOnSystem
Just path -> do
absolute <- doesFileExist path
if absolute
then return (Just (UserSpecified path))
- else findProgramLocation verbosity path
+ else findProgramOnSearchPath verbosity (progSearchPath conf) path
>>= maybe (die notFound) (return . Just . UserSpecified)
where notFound = "Cannot find the program '" ++ name ++ "' at '"
++ path ++ "' or on the path"
@@ -286,12 +306,13 @@ configureProgram verbosity prog conf = do
Nothing -> return conf
Just location -> do
version <- programFindVersion prog verbosity (locationPath location)
+ newPath <- programSearchPathAsPATHVar (progSearchPath conf)
let configuredProg = ConfiguredProgram {
programId = name,
programVersion = version,
programDefaultArgs = [],
programOverrideArgs = userSpecifiedArgs prog conf,
- programOverrideEnv = [],
+ programOverrideEnv = [("PATH", Just newPath)],
programLocation = location
}
configuredProg' <- programPostConf prog verbosity configuredProg
diff --git a/Cabal/Distribution/Simple/Program/Find.hs b/Cabal/Distribution/Simple/Program/Find.hs
new file mode 100644
index 0000000000000000000000000000000000000000..8e7b4eb334d8657a3e5b6998e0ac319a457a5d1e
--- /dev/null
+++ b/Cabal/Distribution/Simple/Program/Find.hs
@@ -0,0 +1,117 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Distribution.Simple.Program.Types
+-- Copyright : Duncan Coutts 2013
+--
+-- Maintainer : cabal-devel@haskell.org
+-- Portability : portable
+--
+-- A somewhat extended notion of the normal program search path concept.
+--
+-- Usually when finding executables we just want to look in the usual places
+-- using the OS's usual method for doing so. In Haskell the normal OS-specific
+-- method is captured by 'findExecutable'. On all common OSs that makes use of
+-- a @PATH@ environment variable, (though on Windows it is not just the @PATH@).
+--
+-- However it is sometimes useful to be able to look in additional locations
+-- without having to change the process-global @PATH@ environment variable.
+-- So we need an extension of the usual 'findExecutable' that can look in
+-- additional locations, either before, after or instead of the normal OS
+-- locations.
+--
+module Distribution.Simple.Program.Find (
+ -- * Program search path
+ ProgramSearchPath,
+ ProgramSearchPathEntry(..),
+ defaultProgramSearchPath,
+ findProgramOnSearchPath,
+ programSearchPathAsPATHVar,
+ ) where
+
+import Distribution.Verbosity
+ ( Verbosity )
+import Distribution.Simple.Utils
+ ( debug )
+import Distribution.System
+ ( OS(..), buildOS )
+import System.Directory
+ ( findExecutable, doesFileExist, Permissions(..), getPermissions )
+import System.Environment
+ ( getEnvironment )
+import System.FilePath
+ ( (</>), (<.>), splitSearchPath, searchPathSeparator )
+import Data.List
+ ( intercalate )
+
+
+-- | A search path to use when locating executables. This is analagous
+-- to the unix @$PATH@ or win32 @%PATH%@ but with the ability to use
+-- the system default method for finding executables ('findExecutable' which
+-- on unix is simply looking on the @$PATH@ but on win32 is a bit more
+-- complicated).
+--
+-- The default to use is @[ProgSearchPathDefault]@ but you can add extra dirs
+-- either before, after or instead of the default, e.g. here we add an extra
+-- dir to search after the usual ones.
+--
+-- > ['ProgramSearchPathDefault', 'ProgramSearchPathDir' dir]
+--
+type ProgramSearchPath = [ProgramSearchPathEntry]
+data ProgramSearchPathEntry =
+ ProgramSearchPathDir FilePath -- ^ A specific dir
+ | ProgramSearchPathDefault -- ^ The system default
+
+defaultProgramSearchPath :: ProgramSearchPath
+defaultProgramSearchPath = [ProgramSearchPathDefault]
+
+findProgramOnSearchPath :: Verbosity -> ProgramSearchPath
+ -> FilePath -> IO (Maybe FilePath)
+findProgramOnSearchPath verbosity searchpath prog = do
+ debug verbosity $ "Searching for " ++ prog ++ " in path."
+ res <- tryPathElems searchpath
+ case res of
+ Nothing -> debug verbosity ("Cannot find " ++ prog ++ " on the path")
+ Just path -> debug verbosity ("Found " ++ prog ++ " at "++ path)
+ return res
+ where
+ tryPathElems [] = return Nothing
+ tryPathElems (pe:pes) = do
+ res <- tryPathElem pe
+ case res of
+ Nothing -> tryPathElems pes
+ Just _ -> return res
+
+ tryPathElem (ProgramSearchPathDir dir) =
+ findFirstExe [ dir </> prog <.> ext | ext <- extensions ]
+ where
+ extensions = case buildOS of
+ Windows -> ["", "exe"]
+ _ -> [""]
+
+ tryPathElem ProgramSearchPathDefault =
+ findExecutable prog
+
+ findFirstExe [] = return Nothing
+ findFirstExe (f:fs) = do
+ exists <- doesFileExist f
+ if exists
+ then do perms <- getPermissions f
+ if executable perms
+ then return (Just f)
+ else findFirstExe fs
+ else findFirstExe fs
+
+
+-- | Interpret a 'ProgramSearchPath' to construct a new @$PATH@ env var.
+-- Note that this is close but not perfect because on Windows the search
+-- algorithm looks at more than just the @%PATH%@.
+programSearchPathAsPATHVar :: ProgramSearchPath -> IO String
+programSearchPathAsPATHVar searchpath = do
+ ess <- mapM getEntries searchpath
+ return (intercalate [searchPathSeparator] (concat ess))
+ where
+ getEntries (ProgramSearchPathDir dir) = return [dir]
+ getEntries ProgramSearchPathDefault = do
+ env <- getEnvironment
+ return (maybe [] splitSearchPath (lookup "PATH" env))
+
diff --git a/Cabal/Distribution/Simple/Program/Types.hs b/Cabal/Distribution/Simple/Program/Types.hs
index f816817626cd15e716af38596dd14f4e1a1e8d7a..1bf51ce082264c8304a5eb06324385b90363d65d 100644
--- a/Cabal/Distribution/Simple/Program/Types.hs
+++ b/Cabal/Distribution/Simple/Program/Types.hs
@@ -17,6 +17,8 @@
module Distribution.Simple.Program.Types (
-- * Program and functions for constructing them
Program(..),
+ ProgramSearchPath,
+ ProgramSearchPathEntry(..),
simpleProgram,
-- * Configured program and related functions
@@ -27,8 +29,9 @@ module Distribution.Simple.Program.Types (
simpleConfiguredProgram,
) where
-import Distribution.Simple.Utils
- ( findProgramLocation )
+import Distribution.Simple.Program.Find
+ ( ProgramSearchPath, ProgramSearchPathEntry(..)
+ , findProgramOnSearchPath )
import Distribution.Version
( Version )
import Distribution.Verbosity
@@ -45,8 +48,11 @@ data Program = Program {
-- | A function to search for the program if its location was not
-- specified by the user. Usually this will just be a call to
- -- @findProgramLocation@.
- programFindLocation :: Verbosity -> IO (Maybe FilePath),
+ -- 'findProgramOnSearchPath'.
+ --
+ -- It is supplied with the prevailing search path which will typically
+ -- just be used as-is, but can be extended or ignored as needed.
+ programFindLocation :: Verbosity -> ProgramSearchPath -> 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.
@@ -116,7 +122,7 @@ programPath = locationPath . programLocation
simpleProgram :: String -> Program
simpleProgram name = Program {
programName = name,
- programFindLocation = \v -> findProgramLocation v name,
+ programFindLocation = \v p -> findProgramOnSearchPath v p name,
programFindVersion = \_ _ -> return Nothing,
programPostConf = \_ p -> return p
}