ghcup-hs/lib/GHCup/Utils/File/Common.hs

112 lines
3.4 KiB
Haskell
Raw Normal View History

2021-05-14 21:09:45 +00:00
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module GHCup.Utils.File.Common (
module GHCup.Utils.File.Common
, ProcessError(..)
, CapturedProcess(..)
) where
2021-05-14 21:09:45 +00:00
import GHCup.Utils.Prelude
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 Optics hiding ((<|), (|>))
2022-02-05 18:11:56 +00:00
import System.Directory hiding (findFiles)
2021-05-14 21:09:45 +00:00
import System.FilePath
import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
import Text.Regex.Posix
2021-09-19 11:50:51 +00:00
import qualified Data.Text as T
2021-05-14 21:09:45 +00:00
import qualified Data.ByteString.Lazy as BL
2021-09-19 11:50:51 +00:00
import qualified Text.Megaparsec as MP
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) =
hideErrorDefM [InappropriateType, PermissionDenied, NoSuchThing] (go xs)
$ 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
-- | 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
findFilesDeep :: FilePath -> Regex -> IO [FilePath]
findFilesDeep path regex = do
contents <- getDirectoryContentsRecursive 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
checkFileAlreadyExists :: (MonadIO m) => FilePath -> m Bool
checkFileAlreadyExists fp = liftIO $ doesFileExist fp