{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Simple.Program.Find (
ProgramSearchPath,
ProgramSearchPathEntry(..),
defaultProgramSearchPath,
findProgramOnSearchPath,
programSearchPathAsPATHVar,
getSystemSearchPath,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Verbosity
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Compat.Environment
import qualified System.Directory as Directory
( findExecutable )
import System.FilePath as FilePath
( (</>), (<.>), splitSearchPath, searchPathSeparator, getSearchPath
, takeDirectory )
#if defined(mingw32_HOST_OS)
import qualified System.Win32 as Win32
#endif
type ProgramSearchPath = [ProgramSearchPathEntry]
data ProgramSearchPathEntry =
ProgramSearchPathDir FilePath
| ProgramSearchPathDefault
deriving (Eq, Generic)
instance Binary ProgramSearchPathEntry
defaultProgramSearchPath :: ProgramSearchPath
defaultProgramSearchPath = [ProgramSearchPathDefault]
findProgramOnSearchPath :: Verbosity -> ProgramSearchPath
-> FilePath -> IO (Maybe (FilePath, [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 :: [[FilePath]] -> [ProgramSearchPathEntry]
-> IO (Maybe (FilePath, [FilePath]))
tryPathElems _ [] = return Nothing
tryPathElems tried (pe:pes) = do
res <- tryPathElem pe
case res of
(Nothing, notfoundat) -> tryPathElems (notfoundat : tried) pes
(Just foundat, notfoundat) -> return (Just (foundat, alltried))
where
alltried = concat (reverse (notfoundat : tried))
tryPathElem :: ProgramSearchPathEntry -> NoCallStackIO (Maybe FilePath, [FilePath])
tryPathElem (ProgramSearchPathDir dir) =
findFirstExe [ dir </> prog <.> ext | ext <- exeExtensions ]
tryPathElem ProgramSearchPathDefault | buildOS == Windows = do
mExe <- findExecutable prog
syspath <- getSystemSearchPath
case mExe of
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)
tryPathElem ProgramSearchPathDefault = do
dirs <- getSystemSearchPath
findFirstExe [ dir </> prog <.> ext | dir <- dirs, ext <- exeExtensions ]
findFirstExe :: [FilePath] -> NoCallStackIO (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
programSearchPathAsPATHVar :: ProgramSearchPath -> NoCallStackIO String
programSearchPathAsPATHVar searchpath = do
ess <- traverse getEntries searchpath
return (intercalate [searchPathSeparator] (concat ess))
where
getEntries (ProgramSearchPathDir dir) = return [dir]
getEntries ProgramSearchPathDefault = do
env <- getEnvironment
return (maybe [] splitSearchPath (lookup "PATH" env))
getSystemSearchPath :: NoCallStackIO [FilePath]
getSystemSearchPath = fmap nub $ do
#if defined(mingw32_HOST_OS)
processdir <- takeDirectory `fmap` Win32.getModuleFileName Win32.nullHANDLE
currentdir <- Win32.getCurrentDirectory
systemdir <- Win32.getSystemDirectory
windowsdir <- Win32.getWindowsDirectory
pathdirs <- FilePath.getSearchPath
let path = processdir : currentdir
: systemdir : windowsdir
: pathdirs
return path
#else
FilePath.getSearchPath
#endif
#ifdef MIN_VERSION_directory
#if MIN_VERSION_directory(1,2,1)
#define HAVE_directory_121
#endif
#endif
findExecutable :: FilePath -> NoCallStackIO (Maybe FilePath)
#ifdef HAVE_directory_121
findExecutable = Directory.findExecutable
#else
findExecutable prog = do
mExe <- Directory.findExecutable prog
case mExe of
Just exe -> do
exeExists <- doesExecutableExist exe
if exeExists
then return mExe
else return Nothing
_ -> return mExe
#endif