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