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