diff options
Diffstat (limited to 'Utility/Path.hs')
| -rw-r--r-- | Utility/Path.hs | 78 |
1 files changed, 47 insertions, 31 deletions
diff --git a/Utility/Path.hs b/Utility/Path.hs index 6bd407e..cfda748 100644 --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -18,11 +18,12 @@ module Utility.Path ( segmentPaths', runSegmentPaths, runSegmentPaths', - inPath, - searchPath, dotfile, splitShortExtensions, relPathDirToFileAbs, + inSearchPath, + searchPath, + searchPathContents, ) where import System.FilePath.ByteString @@ -30,11 +31,13 @@ import qualified System.FilePath as P import qualified Data.ByteString as B import Data.List import Data.Maybe +import Control.Monad import Control.Applicative import Prelude import Utility.Monad import Utility.SystemDirectory +import Utility.Exception #ifdef mingw32_HOST_OS import Data.Char @@ -136,33 +139,6 @@ runSegmentPaths c a paths = segmentPaths c paths <$> a paths runSegmentPaths' :: (Maybe RawFilePath -> a -> r) -> (a -> RawFilePath) -> ([RawFilePath] -> IO [a]) -> [RawFilePath] -> IO [[r]] runSegmentPaths' si c a paths = segmentPaths' si c paths <$> a paths -{- Checks if a command is available in PATH. - - - - The command may be fully-qualified, in which case, this succeeds as - - long as it exists. -} -inPath :: String -> IO Bool -inPath command = isJust <$> searchPath command - -{- Finds a command in PATH and returns the full path to it. - - - - The command may be fully qualified already, in which case it will - - be returned if it exists. - - - - Note that this will find commands in PATH that are not executable. - -} -searchPath :: String -> IO (Maybe FilePath) -searchPath command - | P.isAbsolute command = check command - | otherwise = P.getSearchPath >>= getM indir - where - indir d = check $ d P.</> command - check f = firstM doesFileExist -#ifdef mingw32_HOST_OS - [f, f ++ ".exe"] -#else - [f] -#endif - {- Checks if a filename is a unix dotfile. All files inside dotdirs - count as dotfiles. -} dotfile :: RawFilePath -> Bool @@ -189,8 +165,7 @@ splitShortExtensions' maxextension = go [] (base, ext) = splitExtension f len = B.length ext -{- This requires the first path to be absolute, and the - - second path cannot contain ../ or ./ +{- This requires both paths to be absolute and normalized. - - On Windows, if the paths are on different drives, - a relative path is not possible and the path is simply @@ -214,3 +189,44 @@ relPathDirToFileAbs from to #ifdef mingw32_HOST_OS normdrive = map toLower . takeWhile (/= ':') . fromRawFilePath . takeDrive #endif + +{- Checks if a command is available in PATH. + - + - The command may be fully-qualified, in which case, this succeeds as + - long as it exists. -} +inSearchPath :: String -> IO Bool +inSearchPath command = isJust <$> searchPath command + +{- Finds a command in PATH and returns the full path to it. + - + - The command may be fully qualified already, in which case it will + - be returned if it exists. + - + - Note that this will find commands in PATH that are not executable. + -} +searchPath :: String -> IO (Maybe FilePath) +searchPath command + | P.isAbsolute command = check command + | otherwise = P.getSearchPath >>= getM indir + where + indir d = check $ d P.</> command + check f = firstM doesFileExist +#ifdef mingw32_HOST_OS + [f, f ++ ".exe"] +#else + [f] +#endif + +{- Finds commands in PATH that match a predicate. Note that the predicate + - matches on the basename of the command, but the full path to it is + - returned. + - + - Note that this will find commands in PATH that are not executable. + -} +searchPathContents :: (FilePath -> Bool) -> IO [FilePath] +searchPathContents p = + filterM doesFileExist + =<< (concat <$> (P.getSearchPath >>= mapM go)) + where + go d = map (d P.</>) . filter p + <$> catchDefaultIO [] (getDirectoryContents d) |