    {-# 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."
      res <- [[FilePath]]
    -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
    tryPathElems [] ProgramSearchPath
    searchpath
      case 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)
      return 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
          res <- ProgramSearchPathEntry -> IO (Maybe FilePath, [FilePath])
    tryPathElem ProgramSearchPathEntry
    pe
          case 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
          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]
          syspath <- getSystemSearchPath
          case 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
          dirs <- IO [FilePath]
    getSystemSearchPath
          findFirstExe [dir </> prog <.> ext | dir <- dirs, ext <- 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
              isExe <- FilePath -> IO Bool
    doesExecutableExist FilePath
    f
              if isExe
                then return (Just f, reverse fs')
                else go (f : fs') 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
          a <- m (Maybe a)
    ma
          case 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
      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"
      logExtraProgramSearchPath verbosity extras
      let extra = FilePath -> [FilePath] -> FilePath
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char
    searchPathSeparator] [FilePath]
    extras
          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
      return [("PATH", Just 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
      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
      return (intercalate [searchPathSeparator] (concat 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
          env <- IO [(FilePath, FilePath)]
    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 :: 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
        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
        }