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   , logExtraProgramSearchPath
  36   , logExtraProgramOverrideEnv
  37   , getSystemSearchPath
  38   , getExtraPathEnv
  39   , simpleProgram
  40   ) where
  41
  42 import Distribution.Compat.Prelude
  43 import Prelude ()
  44
  45 import Distribution.Compat.Environment
  46 import Distribution.Simple.Program.Types
  47 import Distribution.Simple.Utils
  48 import Distribution.System
  49 import Distribution.Verbosity
  50
  51 import qualified System.Directory as Directory
  52   ( findExecutable
  53   )
  54 import System.FilePath as FilePath
  55   ( getSearchPath
  56   , searchPathSeparator
  57   , splitSearchPath
  58   , takeDirectory
  59   , (<.>)
  60   , (</>)
  61   )
  62 #if defined(mingw32_HOST_OS)
  63 import qualified System.Win32 as Win32
  64 #endif
  65
  66 defaultProgramSearchPath :: ProgramSearchPath
  67 defaultProgramSearchPath = [ProgramSearchPathDefault]
  68
  69 logExtraProgramSearchPath
  70   :: Verbosity
  71   -> [FilePath]
  72   -> IO ()
  73 logExtraProgramSearchPath verbosity extraPaths =
  74   info verbosity . unlines $
  75     "Including the following directories in PATH:"
  76       : map ("- " ++) extraPaths
  77
  78 logExtraProgramOverrideEnv
  79   :: Verbosity
  80   -> [(String, Maybe String)]
  81   -> IO ()
  82 logExtraProgramOverrideEnv verbosity extraEnv =
  83   info verbosity . unlines $
  84     "Including the following environment variable overrides:"
  85       : [ "- " ++ case mbVal of
  86           Nothing -> "unset " ++ var
  87           Just val -> var ++ "=" ++ val
  88         | (var, mbVal) <- extraEnv
  89         ]
  90
  91 findProgramOnSearchPath
  92   :: Verbosity
  93   -> ProgramSearchPath
  94   -> FilePath
  95   -> IO (Maybe (FilePath, [FilePath]))
  96 findProgramOnSearchPath verbosity searchpath prog = do
  97   debug verbosity $ "Searching for " ++ prog ++ " in path."
  98   res <- tryPathElems [] searchpath
  99   case res of
 100     Nothing -> debug verbosity ("Cannot find " ++ prog ++ " on the path")
 101     Just (path, _) -> debug verbosity ("Found " ++ prog ++ " at " ++ path)
 102   return res
 103   where
 104     tryPathElems
 105       :: [[FilePath]]
 106       -> [ProgramSearchPathEntry]
 107       -> IO (Maybe (FilePath, [FilePath]))
 108     tryPathElems _ [] = return Nothing
 109     tryPathElems tried (pe : pes) = do
 110       res <- tryPathElem pe
 111       case res of
 112         (Nothing, notfoundat) -> tryPathElems (notfoundat : tried) pes
 113         (Just foundat, notfoundat) -> return (Just (foundat, alltried))
 114           where
 115             alltried = concat (reverse (notfoundat : tried))
 116
 117     tryPathElem :: ProgramSearchPathEntry -> IO (Maybe FilePath, [FilePath])
 118     tryPathElem (ProgramSearchPathDir dir) =
 119       findFirstExe [dir </> prog <.> ext | ext <- exeExtensions]
 120     -- On windows, getSystemSearchPath is not guaranteed 100% correct so we
 121     -- use findExecutable and then approximate the not-found-at locations.
 122     tryPathElem ProgramSearchPathDefault | buildOS == Windows = do
 123       mExe <- firstJustM [findExecutable (prog <.> ext) | ext <- exeExtensions]
 124       syspath <- getSystemSearchPath
 125       case mExe of
 126         Nothing ->
 127           let notfoundat = [dir </> prog | dir <- syspath]
 128            in return (Nothing, notfoundat)
 129         Just foundat -> do
 130           let founddir = takeDirectory foundat
 131               notfoundat =
 132                 [ dir </> prog
 133                 | dir <- takeWhile (/= founddir) syspath
 134                 ]
 135           return (Just foundat, notfoundat)
 136
 137     -- On other OSs we can just do the simple thing
 138     tryPathElem ProgramSearchPathDefault = do
 139       dirs <- getSystemSearchPath
 140       findFirstExe [dir </> prog <.> ext | dir <- dirs, ext <- exeExtensions]
 141
 142     findFirstExe :: [FilePath] -> IO (Maybe FilePath, [FilePath])
 143     findFirstExe = go []
 144       where
 145         go fs' [] = return (Nothing, reverse fs')
 146         go fs' (f : fs) = do
 147           isExe <- doesExecutableExist f
 148           if isExe
 149             then return (Just f, reverse fs')
 150             else go (f : fs') fs
 151
 152     -- Helper for evaluating actions until the first one returns 'Just'
 153     firstJustM :: Monad m => [m (Maybe a)] -> m (Maybe a)
 154     firstJustM [] = return Nothing
 155     firstJustM (ma : mas) = do
 156       a <- ma
 157       case a of
 158         Just _ -> return a
 159         Nothing -> firstJustM mas
 160
 161 -- | Adds some paths to the "PATH" entry in the key-value environment provided
 162 -- or if there is none, looks up @$PATH@ in the real environment.
 163 getExtraPathEnv
 164   :: Verbosity
 165   -> [(String, Maybe String)]
 166   -> [FilePath]
 167   -> IO [(String, Maybe String)]
 168 getExtraPathEnv _ _ [] = return []
 169 getExtraPathEnv verbosity env extras = do
 170   mb_path <- case lookup "PATH" env of
 171     Just x -> return x
 172     Nothing -> lookupEnv "PATH"
 173   logExtraProgramSearchPath verbosity extras
 174   let extra = intercalate [searchPathSeparator] extras
 175       path' = case mb_path of
 176         Nothing -> extra
 177         Just path -> extra ++ searchPathSeparator : path
 178   return [("PATH", Just path')]
 179
 180 -- | Interpret a 'ProgramSearchPath' to construct a new @$PATH@ env var.
 181 -- Note that this is close but not perfect because on Windows the search
 182 -- algorithm looks at more than just the @%PATH%@.
 183 programSearchPathAsPATHVar :: ProgramSearchPath -> IO String
 184 programSearchPathAsPATHVar searchpath = do
 185   ess <- traverse getEntries searchpath
 186   return (intercalate [searchPathSeparator] (concat ess))
 187   where
 188     getEntries (ProgramSearchPathDir dir) = return [dir]
 189     getEntries ProgramSearchPathDefault = do
 190       env <- getEnvironment
 191       return (maybe [] splitSearchPath (lookup "PATH" env))
 192
 193 -- | Get the system search path. On Unix systems this is just the @$PATH@ env
 194 -- var, but on windows it's a bit more complicated.
 195 getSystemSearchPath :: IO [FilePath]
 196 getSystemSearchPath = fmap nub $ do
 197 #if defined(mingw32_HOST_OS)
 198     processdir <- takeDirectory `fmap` Win32.getModuleFileName Win32.nullHANDLE
 199     currentdir <- Win32.getCurrentDirectory
 200     systemdir  <- Win32.getSystemDirectory
 201     windowsdir <- Win32.getWindowsDirectory
 202     pathdirs   <- FilePath.getSearchPath
 203     let path = processdir : currentdir
 204              : systemdir  : windowsdir
 205              : pathdirs
 206     return path
 207 #else
 208     FilePath.getSearchPath
 209 #endif
 210
 211 #ifdef MIN_VERSION_directory
 212 #if MIN_VERSION_directory(1,2,1)
 213 #define HAVE_directory_121
 214 #endif
 215 #endif
 216
 217 findExecutable :: FilePath -> IO (Maybe FilePath)
 218 #ifdef HAVE_directory_121
 219 findExecutable = Directory.findExecutable
 220 #else
 221 findExecutable prog = do
 222       -- With directory < 1.2.1 'findExecutable' doesn't check that the path
 223       -- really refers to an executable.
 224       mExe <- Directory.findExecutable prog
 225       case mExe of
 226         Just exe -> do
 227           exeExists <- doesExecutableExist exe
 228           if exeExists
 229             then return mExe
 230             else return Nothing
 231         _     -> return mExe
 232 #endif
 233
 234 -- | Make a simple named program.
 235 --
 236 -- By default we'll just search for it in the path and not try to find the
 237 -- version name. You can override these behaviours if necessary, eg:
 238 --
 239 -- > (simpleProgram "foo") { programFindLocation = ... , programFindVersion ... }
 240 simpleProgram :: String -> Program
 241 simpleProgram name =
 242   Program
 243     { programName = name
 244     , programFindLocation = \v p -> findProgramOnSearchPath v p name
 245     , programFindVersion = \_ _ -> return Nothing
 246     , programPostConf = \_ p -> return p
 247     , programNormaliseArgs = \_ _ -> id
 248     }