{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# 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 (ProgramSearchPathEntry -> ProgramSearchPathEntry -> Bool
(ProgramSearchPathEntry -> ProgramSearchPathEntry -> Bool)
-> (ProgramSearchPathEntry -> ProgramSearchPathEntry -> Bool)
-> Eq ProgramSearchPathEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProgramSearchPathEntry -> ProgramSearchPathEntry -> Bool
== :: ProgramSearchPathEntry -> ProgramSearchPathEntry -> Bool
$c/= :: ProgramSearchPathEntry -> ProgramSearchPathEntry -> Bool
/= :: ProgramSearchPathEntry -> ProgramSearchPathEntry -> Bool
Eq, (forall x. ProgramSearchPathEntry -> Rep ProgramSearchPathEntry x)
-> (forall x.
Rep ProgramSearchPathEntry x -> ProgramSearchPathEntry)
-> Generic ProgramSearchPathEntry
forall x. Rep ProgramSearchPathEntry x -> ProgramSearchPathEntry
forall x. ProgramSearchPathEntry -> Rep ProgramSearchPathEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProgramSearchPathEntry -> Rep ProgramSearchPathEntry x
from :: forall x. ProgramSearchPathEntry -> Rep ProgramSearchPathEntry x
$cto :: forall x. Rep ProgramSearchPathEntry x -> ProgramSearchPathEntry
to :: forall x. Rep ProgramSearchPathEntry x -> ProgramSearchPathEntry
Generic, Typeable)
instance Binary ProgramSearchPathEntry
instance Structured ProgramSearchPathEntry
defaultProgramSearchPath :: ProgramSearchPath
defaultProgramSearchPath :: [ProgramSearchPathEntry]
defaultProgramSearchPath = [ProgramSearchPathEntry
ProgramSearchPathDefault]
findProgramOnSearchPath :: Verbosity -> ProgramSearchPath
-> FilePath -> IO (Maybe (FilePath, [FilePath]))
findProgramOnSearchPath :: Verbosity
-> [ProgramSearchPathEntry]
-> FilePath
-> IO (Maybe (FilePath, [FilePath]))
findProgramOnSearchPath Verbosity
verbosity [ProgramSearchPathEntry]
searchpath FilePath
prog = do
Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Searching for " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
prog FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" in path."
Maybe (FilePath, [FilePath])
res <- [[FilePath]]
-> [ProgramSearchPathEntry] -> IO (Maybe (FilePath, [FilePath]))
tryPathElems [] [ProgramSearchPathEntry]
searchpath
case Maybe (FilePath, [FilePath])
res of
Maybe (FilePath, [FilePath])
Nothing -> Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath
"Cannot find " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
prog FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" on the path")
Just (FilePath
path, [FilePath]
_) -> Verbosity -> FilePath -> IO ()
debug Verbosity
verbosity (FilePath
"Found " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
prog FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" at "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path)
Maybe (FilePath, [FilePath]) -> IO (Maybe (FilePath, [FilePath]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (FilePath, [FilePath])
res
where
tryPathElems :: [[FilePath]] -> [ProgramSearchPathEntry]
-> IO (Maybe (FilePath, [FilePath]))
tryPathElems :: [[FilePath]]
-> [ProgramSearchPathEntry] -> IO (Maybe (FilePath, [FilePath]))
tryPathElems [[FilePath]]
_ [] = Maybe (FilePath, [FilePath]) -> IO (Maybe (FilePath, [FilePath]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (FilePath, [FilePath])
forall a. Maybe a
Nothing
tryPathElems [[FilePath]]
tried (ProgramSearchPathEntry
pe:[ProgramSearchPathEntry]
pes) = do
(Maybe FilePath, [FilePath])
res <- ProgramSearchPathEntry -> IO (Maybe FilePath, [FilePath])
tryPathElem ProgramSearchPathEntry
pe
case (Maybe FilePath, [FilePath])
res of
(Maybe FilePath
Nothing, [FilePath]
notfoundat) -> [[FilePath]]
-> [ProgramSearchPathEntry] -> IO (Maybe (FilePath, [FilePath]))
tryPathElems ([FilePath]
notfoundat [FilePath] -> [[FilePath]] -> [[FilePath]]
forall a. a -> [a] -> [a]
: [[FilePath]]
tried) [ProgramSearchPathEntry]
pes
(Just FilePath
foundat, [FilePath]
notfoundat) -> Maybe (FilePath, [FilePath]) -> IO (Maybe (FilePath, [FilePath]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath, [FilePath]) -> Maybe (FilePath, [FilePath])
forall a. a -> Maybe a
Just (FilePath
foundat, [FilePath]
alltried))
where
alltried :: [FilePath]
alltried = [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [[FilePath]]
forall a. [a] -> [a]
reverse ([FilePath]
notfoundat [FilePath] -> [[FilePath]] -> [[FilePath]]
forall a. a -> [a] -> [a]
: [[FilePath]]
tried))
tryPathElem :: ProgramSearchPathEntry -> IO (Maybe FilePath, [FilePath])
tryPathElem :: ProgramSearchPathEntry -> IO (Maybe FilePath, [FilePath])
tryPathElem (ProgramSearchPathDir FilePath
dir) =
[FilePath] -> IO (Maybe FilePath, [FilePath])
findFirstExe [ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
prog FilePath -> FilePath -> FilePath
<.> FilePath
ext | FilePath
ext <- [FilePath]
exeExtensions ]
tryPathElem ProgramSearchPathEntry
ProgramSearchPathDefault | OS
buildOS OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
Windows = do
Maybe FilePath
mExe <- [IO (Maybe FilePath)] -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => [m (Maybe a)] -> m (Maybe a)
firstJustM [ FilePath -> IO (Maybe FilePath)
findExecutable (FilePath
prog FilePath -> FilePath -> FilePath
<.> FilePath
ext) | FilePath
ext <- [FilePath]
exeExtensions ]
[FilePath]
syspath <- IO [FilePath]
getSystemSearchPath
case Maybe FilePath
mExe of
Maybe FilePath
Nothing ->
let notfoundat :: [FilePath]
notfoundat = [ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
prog | FilePath
dir <- [FilePath]
syspath ] in
(Maybe FilePath, [FilePath]) -> IO (Maybe FilePath, [FilePath])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath
forall a. Maybe a
Nothing, [FilePath]
notfoundat)
Just FilePath
foundat -> do
let founddir :: FilePath
founddir = FilePath -> FilePath
takeDirectory FilePath
foundat
notfoundat :: [FilePath]
notfoundat = [ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
prog
| FilePath
dir <- (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
founddir) [FilePath]
syspath ]
(Maybe FilePath, [FilePath]) -> IO (Maybe FilePath, [FilePath])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
foundat, [FilePath]
notfoundat)
tryPathElem ProgramSearchPathEntry
ProgramSearchPathDefault = do
[FilePath]
dirs <- IO [FilePath]
getSystemSearchPath
[FilePath] -> IO (Maybe FilePath, [FilePath])
findFirstExe [ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
prog FilePath -> FilePath -> FilePath
<.> FilePath
ext | FilePath
dir <- [FilePath]
dirs, FilePath
ext <- [FilePath]
exeExtensions ]
findFirstExe :: [FilePath] -> IO (Maybe FilePath, [FilePath])
findFirstExe :: [FilePath] -> IO (Maybe FilePath, [FilePath])
findFirstExe = [FilePath] -> [FilePath] -> IO (Maybe FilePath, [FilePath])
go []
where
go :: [FilePath] -> [FilePath] -> IO (Maybe FilePath, [FilePath])
go [FilePath]
fs' [] = (Maybe FilePath, [FilePath]) -> IO (Maybe FilePath, [FilePath])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath
forall a. Maybe a
Nothing, [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse [FilePath]
fs')
go [FilePath]
fs' (FilePath
f:[FilePath]
fs) = do
Bool
isExe <- FilePath -> IO Bool
doesExecutableExist FilePath
f
if Bool
isExe
then (Maybe FilePath, [FilePath]) -> IO (Maybe FilePath, [FilePath])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
f, [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse [FilePath]
fs')
else [FilePath] -> [FilePath] -> IO (Maybe FilePath, [FilePath])
go (FilePath
fFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
fs') [FilePath]
fs
firstJustM :: Monad m => [m (Maybe a)] -> m (Maybe a)
firstJustM :: forall (m :: * -> *) a. Monad m => [m (Maybe a)] -> m (Maybe a)
firstJustM [] = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
firstJustM (m (Maybe a)
ma:[m (Maybe a)]
mas) = do
Maybe a
a <- m (Maybe a)
ma
case Maybe a
a of
Just a
_ -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
a
Maybe a
Nothing -> [m (Maybe a)] -> m (Maybe a)
forall (m :: * -> *) a. Monad m => [m (Maybe a)] -> m (Maybe a)
firstJustM [m (Maybe a)]
mas
programSearchPathAsPATHVar :: ProgramSearchPath -> IO String
programSearchPathAsPATHVar :: [ProgramSearchPathEntry] -> IO FilePath
programSearchPathAsPATHVar [ProgramSearchPathEntry]
searchpath = do
[[FilePath]]
ess <- (ProgramSearchPathEntry -> IO [FilePath])
-> [ProgramSearchPathEntry] -> IO [[FilePath]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ProgramSearchPathEntry -> IO [FilePath]
getEntries [ProgramSearchPathEntry]
searchpath
FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator] ([[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
ess))
where
getEntries :: ProgramSearchPathEntry -> IO [FilePath]
getEntries (ProgramSearchPathDir FilePath
dir) = [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
dir]
getEntries ProgramSearchPathEntry
ProgramSearchPathDefault = do
[(FilePath, FilePath)]
env <- IO [(FilePath, FilePath)]
getEnvironment
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
-> (FilePath -> [FilePath]) -> Maybe FilePath -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] FilePath -> [FilePath]
splitSearchPath (FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
"PATH" [(FilePath, FilePath)]
env))
getSystemSearchPath :: IO [FilePath]
getSystemSearchPath :: IO [FilePath]
getSystemSearchPath = ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ 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
IO [FilePath]
FilePath.getSearchPath
#endif
#ifdef MIN_VERSION_directory
#if MIN_VERSION_directory(1,2,1)
#define HAVE_directory_121
#endif
#endif
findExecutable :: FilePath -> IO (Maybe FilePath)
#ifdef HAVE_directory_121
findExecutable :: FilePath -> IO (Maybe FilePath)
findExecutable = FilePath -> IO (Maybe FilePath)
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