Commit 84c4ddce authored by Duncan Coutts's avatar Duncan Coutts
Browse files

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.
parent 34a2c8cf
......@@ -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
......
......@@ -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"
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
-----------------------------------------------------------------------------
-- |
-- 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))
......@@ -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
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment