ghcup-hs/lib/GHCup/Prelude/File/Search.hs

116 lines
3.4 KiB
Haskell
Raw Permalink Normal View History

{-# LANGUAGE CPP #-}
2021-05-14 21:09:45 +00:00
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
2022-05-21 20:54:18 +00:00
module GHCup.Prelude.File.Search (
module GHCup.Prelude.File.Search
, ProcessError(..)
, CapturedProcess(..)
) where
2021-05-14 21:09:45 +00:00
import GHCup.Types(ProcessError(..), CapturedProcess(..))
2021-05-14 21:09:45 +00:00
import Control.Monad.Reader
import Data.Maybe
2021-09-19 11:50:51 +00:00
import Data.Text ( Text )
import Data.Void
2021-05-14 21:09:45 +00:00
import GHC.IO.Exception
import System.Directory hiding ( removeDirectory
, removeDirectoryRecursive
, removePathForcibly
, findFiles
)
2021-05-14 21:09:45 +00:00
import System.FilePath
import Text.Regex.Posix
2022-05-14 15:58:11 +00:00
2021-09-19 11:50:51 +00:00
import qualified Data.Text as T
import qualified Text.Megaparsec as MP
2022-05-21 20:54:18 +00:00
import Control.Exception.Safe (handleIO)
import System.Directory.Internal.Prelude (ioeGetErrorType)
2021-05-14 21:09:45 +00:00
-- | 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) =
2022-05-21 20:54:18 +00:00
handleIO (\e -> if ioeGetErrorType e `elem` [InappropriateType, PermissionDenied, NoSuchThing] then go xs else ioError e)
2021-05-14 21:09:45 +00:00
$ 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
2022-05-21 20:54:18 +00:00
-- 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
2021-05-14 21:09:45 +00:00
-- | 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
2022-02-05 18:11:56 +00:00
-- | 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
2021-05-14 21:09:45 +00:00
findFiles :: FilePath -> Regex -> IO [FilePath]
findFiles path regex = do
contents <- listDirectory path
pure $ filter (match regex) contents
2021-09-19 11:50:51 +00:00
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