{-# 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
  , logExtraProgramSearchPath
  , getSystemSearchPath
  , getExtraPathEnv
  , simpleProgram
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Compat.Environment
import Distribution.Simple.Program.Types
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

defaultProgramSearchPath :: ProgramSearchPath
defaultProgramSearchPath :: ProgramSearchPath
defaultProgramSearchPath = [ProgramSearchPathEntry
ProgramSearchPathDefault]

logExtraProgramSearchPath
  :: Verbosity
  -> [FilePath]
  -> IO ()
logExtraProgramSearchPath :: Verbosity -> [FilePath] -> IO ()
logExtraProgramSearchPath Verbosity
verbosity [FilePath]
extraPaths =
  Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ())
-> ([FilePath] -> FilePath) -> [FilePath] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unlines ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$
    FilePath
"Including the following directories in PATH:"
      FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"- " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) [FilePath]
extraPaths

findProgramOnSearchPath
  :: Verbosity
  -> ProgramSearchPath
  -> FilePath
  -> IO (Maybe (FilePath, [FilePath]))
findProgramOnSearchPath :: Verbosity
-> ProgramSearchPath
-> FilePath
-> IO (Maybe (FilePath, [FilePath]))
findProgramOnSearchPath Verbosity
verbosity ProgramSearchPath
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]]
-> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
tryPathElems [] ProgramSearchPath
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]]
-> ProgramSearchPath -> 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 : ProgramSearchPath
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]]
-> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
tryPathElems ([FilePath]
notfoundat [FilePath] -> [[FilePath]] -> [[FilePath]]
forall a. a -> [a] -> [a]
: [[FilePath]]
tried) ProgramSearchPath
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

-- | Adds some paths to the "PATH" entry in the key-value environment provided
-- or if there is none, looks up @$PATH@ in the real environment.
getExtraPathEnv
  :: Verbosity
  -> [(String, Maybe String)]
  -> [FilePath]
  -> IO [(String, Maybe String)]
getExtraPathEnv :: Verbosity
-> [(FilePath, Maybe FilePath)]
-> [FilePath]
-> IO [(FilePath, Maybe FilePath)]
getExtraPathEnv Verbosity
_ [(FilePath, Maybe FilePath)]
_ [] = [(FilePath, Maybe FilePath)] -> IO [(FilePath, Maybe FilePath)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
getExtraPathEnv Verbosity
verbosity [(FilePath, Maybe FilePath)]
env [FilePath]
extras = do
  Maybe FilePath
mb_path <- case FilePath -> [(FilePath, Maybe FilePath)] -> Maybe (Maybe FilePath)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
"PATH" [(FilePath, Maybe FilePath)]
env of
    Just Maybe FilePath
x -> Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
x
    Maybe (Maybe FilePath)
Nothing -> FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"PATH"
  Verbosity -> [FilePath] -> IO ()
logExtraProgramSearchPath Verbosity
verbosity [FilePath]
extras
  let extra :: FilePath
extra = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate [Char
searchPathSeparator] [FilePath]
extras
      path' :: FilePath
path' = case Maybe FilePath
mb_path of
        Maybe FilePath
Nothing -> FilePath
extra
        Just FilePath
path -> FilePath
extra FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char
searchPathSeparator Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
path
  [(FilePath, Maybe FilePath)] -> IO [(FilePath, Maybe FilePath)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath
"PATH", FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path')]

-- | 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 :: ProgramSearchPath -> IO FilePath
programSearchPathAsPATHVar ProgramSearchPath
searchpath = do
  [[FilePath]]
ess <- (ProgramSearchPathEntry -> IO [FilePath])
-> ProgramSearchPath -> 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 ProgramSearchPath
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

-- | Make a simple named program.
--
-- By default we'll just search for it in the path and not try to find the
-- version name. You can override these behaviours if necessary, eg:
--
-- > (simpleProgram "foo") { programFindLocation = ... , programFindVersion ... }
simpleProgram :: String -> Program
simpleProgram :: FilePath -> Program
simpleProgram FilePath
name =
  Program
    { programName :: FilePath
programName = FilePath
name
    , programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
programFindLocation = \Verbosity
v ProgramSearchPath
p -> Verbosity
-> ProgramSearchPath
-> FilePath
-> IO (Maybe (FilePath, [FilePath]))
findProgramOnSearchPath Verbosity
v ProgramSearchPath
p FilePath
name
    , programFindVersion :: Verbosity -> FilePath -> IO (Maybe Version)
programFindVersion = \Verbosity
_ FilePath
_ -> Maybe Version -> IO (Maybe Version)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Version
forall a. Maybe a
Nothing
    , programPostConf :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
programPostConf = \Verbosity
_ ConfiguredProgram
p -> ConfiguredProgram -> IO ConfiguredProgram
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ConfiguredProgram
p
    , programNormaliseArgs :: Maybe Version -> PackageDescription -> [FilePath] -> [FilePath]
programNormaliseArgs = \Maybe Version
_ PackageDescription
_ -> [FilePath] -> [FilePath]
forall a. a -> a
id
    }