116 lines
3.4 KiB
Haskell
116 lines
3.4 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
|
|
module GHCup.Prelude.File.Search (
|
|
module GHCup.Prelude.File.Search
|
|
, ProcessError(..)
|
|
, CapturedProcess(..)
|
|
) where
|
|
|
|
import GHCup.Types(ProcessError(..), CapturedProcess(..))
|
|
|
|
import Control.Monad.Reader
|
|
import Data.Maybe
|
|
import Data.Text ( Text )
|
|
import Data.Void
|
|
import GHC.IO.Exception
|
|
import System.Directory hiding ( removeDirectory
|
|
, removeDirectoryRecursive
|
|
, removePathForcibly
|
|
, findFiles
|
|
)
|
|
import System.FilePath
|
|
import Text.Regex.Posix
|
|
|
|
|
|
import qualified Data.Text as T
|
|
import qualified Text.Megaparsec as MP
|
|
import Control.Exception.Safe (handleIO)
|
|
import System.Directory.Internal.Prelude (ioeGetErrorType)
|
|
|
|
|
|
|
|
-- | Search for a file in the search paths.
|
|
--
|
|
-- Catches `PermissionDenied` and `NoSuchThing` and returns `Nothing`.
|
|
searchPath :: [FilePath] -> FilePath -> IO (Maybe FilePath)
|
|
searchPath paths needle = go paths
|
|
where
|
|
go [] = pure Nothing
|
|
go (x : xs) =
|
|
handleIO (\e -> if ioeGetErrorType e `elem` [InappropriateType, PermissionDenied, NoSuchThing] then go xs else ioError e)
|
|
$ do
|
|
contents <- listDirectory x
|
|
findM (isMatch x) contents >>= \case
|
|
Just _ -> pure $ Just (x </> needle)
|
|
Nothing -> go xs
|
|
isMatch basedir p = do
|
|
if p == needle
|
|
then isExecutable (basedir </> needle)
|
|
else pure False
|
|
|
|
isExecutable :: FilePath -> IO Bool
|
|
isExecutable file = executable <$> getPermissions file
|
|
|
|
-- TODO: inlined from GHCup.Prelude
|
|
findM ~p = foldr (\x -> ifM (p x) (pure $ Just x)) (pure Nothing)
|
|
ifM ~b ~t ~f = do
|
|
b' <- b
|
|
if b' then t else f
|
|
|
|
|
|
-- | Check wether a binary is shadowed by another one that comes before
|
|
-- it in PATH. Returns the path to said binary, if any.
|
|
isShadowed :: FilePath -> IO (Maybe FilePath)
|
|
isShadowed p = do
|
|
let dir = takeDirectory p
|
|
let fn = takeFileName p
|
|
spaths <- liftIO getSearchPath
|
|
if dir `elem` spaths
|
|
then do
|
|
let shadowPaths = takeWhile (/= dir) spaths
|
|
searchPath shadowPaths fn
|
|
else pure Nothing
|
|
|
|
|
|
-- | Check whether the binary is in PATH. This returns only `True`
|
|
-- if the directory containing the binary is part of PATH.
|
|
isInPath :: FilePath -> IO Bool
|
|
isInPath p = do
|
|
let dir = takeDirectory p
|
|
let fn = takeFileName p
|
|
spaths <- liftIO getSearchPath
|
|
if dir `elem` spaths
|
|
then isJust <$> searchPath [dir] fn
|
|
else pure False
|
|
|
|
|
|
-- | Follows the first match in case of Regex.
|
|
expandFilePath :: [Either FilePath Regex] -> IO [FilePath]
|
|
expandFilePath = go ""
|
|
where
|
|
go :: FilePath -> [Either FilePath Regex] -> IO [FilePath]
|
|
go p [] = pure [p]
|
|
go p (x:xs) = do
|
|
case x of
|
|
Left s -> go (p </> s) xs
|
|
Right regex -> do
|
|
fps <- findFiles p regex
|
|
res <- forM fps $ \fp -> go (p </> fp) xs
|
|
pure $ mconcat res
|
|
|
|
|
|
findFiles :: FilePath -> Regex -> IO [FilePath]
|
|
findFiles path regex = do
|
|
contents <- listDirectory path
|
|
pure $ filter (match regex) contents
|
|
|
|
|
|
findFiles' :: FilePath -> MP.Parsec Void Text a -> IO [FilePath]
|
|
findFiles' path parser = do
|
|
contents <- listDirectory path
|
|
pure $ filter (\fp -> either (const False) (const True) $ MP.parse parser "" (T.pack fp)) contents
|
|
|
|
|