{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Simple.Program.Find
-- 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
  , getSystemSearchPath
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Compat.Environment
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Verbosity

import qualified System.Directory as Directory
  ( findExecutable
  )
import System.FilePath as FilePath
  ( getSearchPath
  , searchPathSeparator
  , splitSearchPath
  , takeDirectory
  , (<.>)
  , (</>)
  )
#if defined(mingw32_HOST_OS)
import qualified System.Win32 as 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
-- 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
  = -- | A specific dir
    ProgramSearchPathDir FilePath
  | -- | The system default
    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]
    -- On windows, getSystemSearchPath is not guaranteed 100% correct so we
    -- use findExecutable and then approximate the not-found-at locations.
    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)

    -- On other OSs we can just do the simple thing
    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
f FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
fs') [FilePath]
fs

    -- Helper for evaluating actions until the first one returns 'Just'
    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

-- | 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 :: [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))

-- | 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 :: 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
      -- With directory < 1.2.1 'findExecutable' doesn't check that the path
      -- really refers to an executable.
      mExe <- Directory.findExecutable prog
      case mExe of
        Just exe -> do
          exeExists <- doesExecutableExist exe
          if exeExists
            then return mExe
            else return Nothing
        _     -> return mExe
#endif