Cabal/src/Distribution/Simple/Program/Find.hs

   1 {-# LANGUAGE CPP #-}
   2 {-# LANGUAGE DeriveDataTypeable #-}
   3 {-# LANGUAGE DeriveGeneric #-}
   4 {-# LANGUAGE FlexibleContexts #-}
   5 {-# LANGUAGE RankNTypes #-}
   6
   7 -----------------------------------------------------------------------------
   8
   9 -- |
  10 -- Module      :  Distribution.Simple.Program.Find
  11 -- Copyright   :  Duncan Coutts 2013
  12 --
  13 -- Maintainer  :  cabal-devel@haskell.org
  14 -- Portability :  portable
  15 --
  16 -- A somewhat extended notion of the normal program search path concept.
  17 --
  18 -- Usually when finding executables we just want to look in the usual places
  19 -- using the OS's usual method for doing so. In Haskell the normal OS-specific
  20 -- method is captured by 'findExecutable'. On all common OSs that makes use of
  21 -- a @PATH@ environment variable, (though on Windows it is not just the @PATH@).
  22 --
  23 -- However it is sometimes useful to be able to look in additional locations
  24 -- without having to change the process-global @PATH@ environment variable.
  25 -- So we need an extension of the usual 'findExecutable' that can look in
  26 -- additional locations, either before, after or instead of the normal OS
  27 -- locations.
  28 module Distribution.Simple.Program.Find
  29   ( -- * Program search path
  30     ProgramSearchPath
  31   , ProgramSearchPathEntry (..)
  32   , defaultProgramSearchPath
  33   , findProgramOnSearchPath
  34   , programSearchPathAsPATHVar
  35   , getSystemSearchPath
  36   ) where
  37
  38 import Distribution.Compat.Prelude
  39 import Prelude ()
  40
  41 import Distribution.Compat.Environment
  42 import Distribution.Simple.Utils
  43 import Distribution.System
  44 import Distribution.Verbosity
  45
  46 import qualified System.Directory as Directory
  47   ( findExecutable
  48   )
  49 import System.FilePath as FilePath
  50   ( getSearchPath
  51   , searchPathSeparator
  52   , splitSearchPath
  53   , takeDirectory
  54   , (<.>)
  55   , (</>)
  56   )
  57 #if defined(mingw32_HOST_OS)
  58 import qualified System.Win32 as Win32
  59 #endif
  60
  61 -- | A search path to use when locating executables. This is analogous
  62 -- to the unix @$PATH@ or win32 @%PATH%@ but with the ability to use
  63 -- the system default method for finding executables ('findExecutable' which
  64 -- on unix is simply looking on the @$PATH@ but on win32 is a bit more
  65 -- complicated).
  66 --
  67 -- The default to use is @[ProgSearchPathDefault]@ but you can add extra dirs
  68 -- either before, after or instead of the default, e.g. here we add an extra
  69 -- dir to search after the usual ones.
  70 --
  71 -- > ['ProgramSearchPathDefault', 'ProgramSearchPathDir' dir]
  72 type ProgramSearchPath = [ProgramSearchPathEntry]
  73
  74 data ProgramSearchPathEntry
  75   = -- | A specific dir
  76     ProgramSearchPathDir FilePath
  77   | -- | The system default
  78     ProgramSearchPathDefault
  79   deriving (Eq, Generic, Typeable)
  80
  81 instance Binary ProgramSearchPathEntry
  82 instance Structured ProgramSearchPathEntry
  83
  84 defaultProgramSearchPath :: ProgramSearchPath
  85 defaultProgramSearchPath = [ProgramSearchPathDefault]
  86
  87 findProgramOnSearchPath
  88   :: Verbosity
  89   -> ProgramSearchPath
  90   -> FilePath
  91   -> IO (Maybe (FilePath, [FilePath]))
  92 findProgramOnSearchPath verbosity searchpath prog = do
  93   debug verbosity $ "Searching for " ++ prog ++ " in path."
  94   res <- tryPathElems [] searchpath
  95   case res of
  96     Nothing -> debug verbosity ("Cannot find " ++ prog ++ " on the path")
  97     Just (path, _) -> debug verbosity ("Found " ++ prog ++ " at " ++ path)
  98   return res
  99   where
 100     tryPathElems
 101       :: [[FilePath]]
 102       -> [ProgramSearchPathEntry]
 103       -> IO (Maybe (FilePath, [FilePath]))
 104     tryPathElems _ [] = return Nothing
 105     tryPathElems tried (pe : pes) = do
 106       res <- tryPathElem pe
 107       case res of
 108         (Nothing, notfoundat) -> tryPathElems (notfoundat : tried) pes
 109         (Just foundat, notfoundat) -> return (Just (foundat, alltried))
 110           where
 111             alltried = concat (reverse (notfoundat : tried))
 112
 113     tryPathElem :: ProgramSearchPathEntry -> IO (Maybe FilePath, [FilePath])
 114     tryPathElem (ProgramSearchPathDir dir) =
 115       findFirstExe [dir </> prog <.> ext | ext <- exeExtensions]
 116     -- On windows, getSystemSearchPath is not guaranteed 100% correct so we
 117     -- use findExecutable and then approximate the not-found-at locations.
 118     tryPathElem ProgramSearchPathDefault | buildOS == Windows = do
 119       mExe <- firstJustM [findExecutable (prog <.> ext) | ext <- exeExtensions]
 120       syspath <- getSystemSearchPath
 121       case mExe of
 122         Nothing ->
 123           let notfoundat = [dir </> prog | dir <- syspath]
 124            in return (Nothing, notfoundat)
 125         Just foundat -> do
 126           let founddir = takeDirectory foundat
 127               notfoundat =
 128                 [ dir </> prog
 129                 | dir <- takeWhile (/= founddir) syspath
 130                 ]
 131           return (Just foundat, notfoundat)
 132
 133     -- On other OSs we can just do the simple thing
 134     tryPathElem ProgramSearchPathDefault = do
 135       dirs <- getSystemSearchPath
 136       findFirstExe [dir </> prog <.> ext | dir <- dirs, ext <- exeExtensions]
 137
 138     findFirstExe :: [FilePath] -> IO (Maybe FilePath, [FilePath])
 139     findFirstExe = go []
 140       where
 141         go fs' [] = return (Nothing, reverse fs')
 142         go fs' (f : fs) = do
 143           isExe <- doesExecutableExist f
 144           if isExe
 145             then return (Just f, reverse fs')
 146             else go (f : fs') fs
 147
 148     -- Helper for evaluating actions until the first one returns 'Just'
 149     firstJustM :: Monad m => [m (Maybe a)] -> m (Maybe a)
 150     firstJustM [] = return Nothing
 151     firstJustM (ma : mas) = do
 152       a <- ma
 153       case a of
 154         Just _ -> return a
 155         Nothing -> firstJustM mas
 156
 157 -- | Interpret a 'ProgramSearchPath' to construct a new @$PATH@ env var.
 158 -- Note that this is close but not perfect because on Windows the search
 159 -- algorithm looks at more than just the @%PATH%@.
 160 programSearchPathAsPATHVar :: ProgramSearchPath -> IO String
 161 programSearchPathAsPATHVar searchpath = do
 162   ess <- traverse getEntries searchpath
 163   return (intercalate [searchPathSeparator] (concat ess))
 164   where
 165     getEntries (ProgramSearchPathDir dir) = return [dir]
 166     getEntries ProgramSearchPathDefault = do
 167       env <- getEnvironment
 168       return (maybe [] splitSearchPath (lookup "PATH" env))
 169
 170 -- | Get the system search path. On Unix systems this is just the @$PATH@ env
 171 -- var, but on windows it's a bit more complicated.
 172 getSystemSearchPath :: IO [FilePath]
 173 getSystemSearchPath = fmap nub $ do
 174 #if defined(mingw32_HOST_OS)
 175     processdir <- takeDirectory `fmap` Win32.getModuleFileName Win32.nullHANDLE
 176     currentdir <- Win32.getCurrentDirectory
 177     systemdir  <- Win32.getSystemDirectory
 178     windowsdir <- Win32.getWindowsDirectory
 179     pathdirs   <- FilePath.getSearchPath
 180     let path = processdir : currentdir
 181              : systemdir  : windowsdir
 182              : pathdirs
 183     return path
 184 #else
 185     FilePath.getSearchPath
 186 #endif
 187
 188 #ifdef MIN_VERSION_directory
 189 #if MIN_VERSION_directory(1,2,1)
 190 #define HAVE_directory_121
 191 #endif
 192 #endif
 193
 194 findExecutable :: FilePath -> IO (Maybe FilePath)
 195 #ifdef HAVE_directory_121
 196 findExecutable = Directory.findExecutable
 197 #else
 198 findExecutable prog = do
 199       -- With directory < 1.2.1 'findExecutable' doesn't check that the path
 200       -- really refers to an executable.
 201       mExe <- Directory.findExecutable prog
 202       case mExe of
 203         Just exe -> do
 204           exeExists <- doesExecutableExist exe
 205           if exeExists
 206             then return mExe
 207             else return Nothing
 208         _     -> return mExe
 209 #endif