From 84c4ddce652cd8f60c57c940abfbe927bb03654f Mon Sep 17 00:00:00 2001
From: Duncan Coutts <duncan@community.haskell.org>
Date: Sat, 10 Aug 2013 21:45:46 +0100
Subject: [PATCH] Add a notion of program search path to the ProgramDb
Previously we would just use the normal system $PATH for finding
programs (unless the Program provided some custom method). Now the
ProgramDb has its own notion of the search path and we use that for
finding programs (by default). The search path can be either specific
directories or the system search method (ie $PATH on unix and something
similar on Win32). The default search path is just the system one.
In addition, this search path is passed on to programs when we invoke
them as the $PATH env var.
---
Cabal/Cabal.cabal | 1 +
Cabal/Distribution/Simple/GHC.hs | 43 ++++---
Cabal/Distribution/Simple/LHC.hs | 12 +-
Cabal/Distribution/Simple/Program.hs | 4 +
Cabal/Distribution/Simple/Program/Builtin.hs | 6 +-
Cabal/Distribution/Simple/Program/Db.hs | 33 +++++-
Cabal/Distribution/Simple/Program/Find.hs | 117 +++++++++++++++++++
Cabal/Distribution/Simple/Program/Types.hs | 16 ++-
8 files changed, 195 insertions(+), 37 deletions(-)
create mode 100644 Cabal/Distribution/Simple/Program/Find.hs
diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
index 0f2b6edef4..42731fd9b5 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 0500465f66..ffc1bc7206 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 6697de3bac..a0420de709 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 c57d5534d5..b43edc2e2a 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 48446fab6c..b8789ca4b1 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 c41897facc..43678fcc1e 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 0000000000..8e7b4eb334
--- /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 f816817626..1bf51ce082 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
}
--
GitLab