add searchPathContents
And rename related functions for consistency.
This commit is contained in:
parent
aec2cf0abe
commit
1b63132ca3
18 changed files with 60 additions and 49 deletions
|
@ -57,7 +57,7 @@ nonBatchCommandMaker = id
|
|||
getBatchCommandMaker :: IO BatchCommandMaker
|
||||
getBatchCommandMaker = do
|
||||
#ifndef mingw32_HOST_OS
|
||||
nicers <- filterM (inPath . fst)
|
||||
nicers <- filterM (inSearchPath . fst)
|
||||
[ ("nice", [])
|
||||
, ("ionice", ["-c3"])
|
||||
, ("nocache", [])
|
||||
|
|
|
@ -411,7 +411,7 @@ keyBlock public ls = unlines
|
|||
- is returned.
|
||||
-}
|
||||
testHarness :: FilePath -> GpgCmd -> IO a -> IO (Maybe a)
|
||||
testHarness tmpdir cmd a = ifM (inPath (unGpgCmd cmd))
|
||||
testHarness tmpdir cmd a = ifM (inSearchPath (unGpgCmd cmd))
|
||||
( bracket (eitherToMaybe <$> tryNonAsync setup) cleanup go
|
||||
, return Nothing
|
||||
)
|
||||
|
@ -439,7 +439,7 @@ testHarness tmpdir cmd a = ifM (inPath (unGpgCmd cmd))
|
|||
-- other daemons. Stop them when done. This only affects
|
||||
-- daemons started for the GNUPGHOME that was used.
|
||||
-- Older gpg may not support this, so ignore failure.
|
||||
stopgpgagent = whenM (inPath "gpgconf") $
|
||||
stopgpgagent = whenM (inSearchPath "gpgconf") $
|
||||
void $ boolSystem "gpgconf" [Param "--kill", Param "all"]
|
||||
|
||||
go (Just _) = Just <$> a
|
||||
|
|
|
@ -169,4 +169,4 @@ runWormHoleProcess p consumer =
|
|||
ExitFailure _ -> False
|
||||
|
||||
isInstalled :: IO Bool
|
||||
isInstalled = inPath "wormhole"
|
||||
isInstalled = inSearchPath "wormhole"
|
||||
|
|
|
@ -18,11 +18,12 @@ module Utility.Path (
|
|||
segmentPaths',
|
||||
runSegmentPaths,
|
||||
runSegmentPaths',
|
||||
inPath,
|
||||
searchPath,
|
||||
dotfile,
|
||||
splitShortExtensions,
|
||||
relPathDirToFileAbs,
|
||||
inSearchPath,
|
||||
searchPath,
|
||||
searchPathContents,
|
||||
) where
|
||||
|
||||
import System.FilePath.ByteString
|
||||
|
@ -35,6 +36,7 @@ import Prelude
|
|||
|
||||
import Utility.Monad
|
||||
import Utility.SystemDirectory
|
||||
import Utility.Exception
|
||||
|
||||
#ifdef mingw32_HOST_OS
|
||||
import Data.Char
|
||||
|
@ -136,33 +138,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
|
||||
|
@ -213,3 +188,39 @@ 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. -}
|
||||
searchPathContents :: (FilePath -> Bool) -> IO [FilePath]
|
||||
searchPathContents p = concat <$> (P.getSearchPath >>= mapM go)
|
||||
where
|
||||
go d = map (d P.</>) . filter p
|
||||
<$> catchDefaultIO [] (getDirectoryContents d)
|
||||
|
|
|
@ -46,11 +46,11 @@ findShellCommand f = do
|
|||
[] -> defcmd
|
||||
(c:ps) -> do
|
||||
let ps' = map Param ps ++ [File f]
|
||||
-- If the command is not inPath,
|
||||
-- If the command is not inSearchPath,
|
||||
-- take the base of it, and run eg "sh"
|
||||
-- which in some cases on windows will work
|
||||
-- despite it not being inPath.
|
||||
ok <- inPath c
|
||||
-- despite it not being inSearchPath.
|
||||
ok <- inSearchPath c
|
||||
return (if ok then c else takeFileName c, ps')
|
||||
_ -> defcmd
|
||||
#endif
|
||||
|
|
|
@ -71,7 +71,7 @@ mkSuCommand :: String -> [CommandParam] -> IO (Maybe SuCommand)
|
|||
#ifndef mingw32_HOST_OS
|
||||
mkSuCommand cmd ps = do
|
||||
pwd <- getCurrentDirectory
|
||||
firstM (\(SuCommand _ p _) -> inPath p) =<< selectcmds pwd
|
||||
firstM (\(SuCommand _ p _) -> inSearchPath p) =<< selectcmds pwd
|
||||
where
|
||||
selectcmds pwd = ifM (inx <||> (not <$> atconsole))
|
||||
( return (graphicalcmds pwd ++ consolecmds pwd)
|
||||
|
|
|
@ -191,4 +191,4 @@ varLibDir :: FilePath
|
|||
varLibDir = "/var/lib"
|
||||
|
||||
torIsInstalled :: IO Bool
|
||||
torIsInstalled = inPath "tor"
|
||||
torIsInstalled = inSearchPath "tor"
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue