Commit ee0ed0b9 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Generalise findProgramOnSearchPath to calculate locations looked in

But in this patch, don't actually return them yet, so not yet changing
the resturn type.

The purpose here is change monitoring. In cabal-install we want to be
able to automatically re-run various actions when the build environment
changes, including when programs have changed (e.g. due to a $PATH
change, finding the compiler in a different location). The basic
information required for such change monitoring is not only the location
where a program was ultimately found, but all the locations where it was
looked for and not found. Otherwise one will miss the case where having
previously found the program in one location, later on the program
appears earlier in the search path. In this case a build system should
notice and react, but if it only monitors the ultimate location where
the program was found then this is impossible. The build system also
needs to monitor the locations where the program was not found, to make
sure it is still not there. This principle actually applies anytime we
have a file search (e.g. hs-source-dirs), programs are just one example.
parent 7d4fbb26
......@@ -28,6 +28,7 @@ module Distribution.Simple.Program.Find (
defaultProgramSearchPath,
findProgramOnSearchPath,
programSearchPathAsPATHVar,
getSystemSearchPath,
) where
import Distribution.Verbosity
......@@ -36,16 +37,22 @@ import Distribution.Simple.Utils
( debug, doesExecutableExist )
import Distribution.System
( OS(..), buildOS )
import System.Directory
#if MIN_VERSION_directory(1,2,1)
import qualified System.Directory as Directory
( findExecutable )
#endif
import Distribution.Compat.Environment
( getEnvironment )
import System.FilePath
( (</>), (<.>), splitSearchPath, searchPathSeparator )
import System.FilePath as FilePath
( (</>), (<.>), splitSearchPath, searchPathSeparator, getSearchPath
, takeDirectory )
import Data.List
( intercalate )
( intercalate, nub )
import Distribution.Compat.Binary
import GHC.Generics
#if defined(mingw32_HOST_OS)
import qualified System.Win32
#endif
-- | A search path to use when locating executables. This is analogous
-- to the unix @$PATH@ or win32 @%PATH%@ but with the ability to use
......@@ -74,49 +81,65 @@ findProgramOnSearchPath :: Verbosity -> ProgramSearchPath
-> FilePath -> IO (Maybe FilePath)
findProgramOnSearchPath verbosity searchpath prog = do
debug verbosity $ "Searching for " ++ prog ++ " in path."
res <- tryPathElems searchpath
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
Just (path, _) -> debug verbosity ("Found " ++ prog ++ " at "++ path)
return (fmap fst res)
where
tryPathElems [] = return Nothing
tryPathElems (pe:pes) = do
tryPathElems :: [[FilePath]] -> [ProgramSearchPathEntry]
-> IO (Maybe (FilePath, [FilePath]))
tryPathElems _ [] = return Nothing
tryPathElems tried (pe:pes) = do
res <- tryPathElem pe
case res of
Nothing -> tryPathElems pes
Just _ -> return res
(Nothing, notfoundat) -> tryPathElems (notfoundat : tried) pes
(Just foundat, notfoundat) -> return (Just (foundat, alltried))
where
alltried = concat (reverse (notfoundat : tried))
tryPathElem :: ProgramSearchPathEntry -> IO (Maybe FilePath, [FilePath])
tryPathElem (ProgramSearchPathDir dir) =
findFirstExe [ dir </> prog <.> ext | ext <- extensions ]
where
-- Possible improvement: on Windows, read the list of extensions from
-- the PATHEXT environment variable. By default PATHEXT is ".com; .exe;
-- .bat; .cmd".
extensions = case buildOS of
Windows -> ["", "exe"]
Ghcjs -> ["", "exe"]
_ -> [""]
findFirstExe [ dir </> prog <.> ext | ext <- exeExtensions ]
tryPathElem ProgramSearchPathDefault = do
-- 'findExecutable' doesn't check that the path really refers to an
-- executable on Windows (at least with GHC < 7.8). See
-- https://ghc.haskell.org/trac/ghc/ticket/2184
mExe <- findExecutable prog
-- On windows, getSystemSearchPath is not guaranteed 100% correct so we
-- use findExecutable and then approximate the not-found-at locations.
tryPathElem ProgramSearchPathDefault | buildOS == Windows = do
mExe <- findExecutable prog
syspath <- getSystemSearchPath
case mExe of
Just exe -> do
exeExists <- doesExecutableExist exe
if exeExists
then return mExe
else return Nothing
_ -> return mExe
Nothing ->
let notfoundat = [ dir </> prog | dir <- syspath ] in
return (Nothing, notfoundat)
Just foundat -> do
let founddir = takeDirectory foundat
notfoundat = [ dir </> prog
| dir <- takeWhile (/= founddir) syspath ]
return (Just foundat, notfoundat)
-- On other OSs we can just do the simple thing
tryPathElem ProgramSearchPathDefault = do
dirs <- getSystemSearchPath
findFirstExe [ dir </> prog <.> ext | dir <- dirs, ext <- exeExtensions ]
-- Possible improvement: on Windows, read the list of extensions from
-- the PATHEXT environment variable. By default PATHEXT is ".com; .exe;
-- .bat; .cmd".
exeExtensions = case buildOS of
Windows -> ["", "exe"]
Ghcjs -> ["", "exe"]
_ -> [""]
findFirstExe [] = return Nothing
findFirstExe (f:fs) = do
isExe <- doesExecutableExist f
if isExe
then return (Just f)
else findFirstExe fs
findFirstExe :: [FilePath] -> IO (Maybe FilePath, [FilePath])
findFirstExe = go []
where
go fs' [] = return (Nothing, reverse fs')
go fs' (f:fs) = do
isExe <- doesExecutableExist f
if isExe
then return (Just f, reverse fs')
else go (f:fs') fs
-- | Interpret a 'ProgramSearchPath' to construct a new @$PATH@ env var.
-- Note that this is close but not perfect because on Windows the search
......@@ -130,3 +153,40 @@ programSearchPathAsPATHVar searchpath = do
getEntries ProgramSearchPathDefault = do
env <- getEnvironment
return (maybe [] splitSearchPath (lookup "PATH" env))
-- | Get the system search path. On Unix systems this is just the @$PATH@ env
-- var, but on windows it's a bit more complicated.
--
getSystemSearchPath :: IO [FilePath]
getSystemSearchPath = fmap nub $ do
#if defined(mingw32_HOST_OS)
processdir <- liftM takeDirectory (Win32.getModuleFileName Win32.nullHANDLE)
currentdir <- getCurrentDirectory
systemdir <- Win32.getSystemDirectory
windowsdir <- Win32.getWindowsDirectory
pathdirs <- FilePath.getSearchPath
let path = processdir : currentdir
: systemdir : windowsdir
: pathdirs
return path
#else
FilePath.getSearchPath
#endif
findExecutable :: FilePath -> IO (Maybe FilePath)
#if MIN_VERSION_directory(1,2,1)
findExecutable = Directory.findExecutable
#else
findExecutable prog = do
-- With directory < 1.2.1 'findExecutable' doesn't check that the path
-- really refers to an executable.
mExe <- findExecutable prog
case mExe of
Just exe -> do
exeExists <- doesExecutableExist exe
if exeExists
then return mExe
else return Nothing
_ -> return mExe
#endif
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