{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module GHCup.Utils.File.Common (
module GHCup.Utils.File.Common
, ProcessError(..)
, CapturedProcess(..)
) where
import GHCup.Utils.Prelude
import GHCup.Types(ProcessError(..), CapturedProcess(..))
import Control.Monad.Reader
import Data.Maybe
import Data.Text ( Text )
import Data.Void
import GHC.IO.Exception
import Optics hiding ((<|), (|>))
import System.Directory hiding (findFiles)
import System.FilePath
import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
import Text.Regex.Posix
import qualified Data.Text as T
import qualified Data.ByteString.Lazy as BL
import qualified Text.Megaparsec as MP
searchPath :: [FilePath] -> FilePath -> IO (Maybe FilePath)
searchPath :: [FilePath] -> FilePath -> IO (Maybe FilePath)
searchPath [FilePath]
paths FilePath
needle = [FilePath] -> IO (Maybe FilePath)
go [FilePath]
paths
where
go :: [FilePath] -> IO (Maybe FilePath)
go [] = Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
go (FilePath
x : [FilePath]
xs) =
[IOErrorType]
-> IO (Maybe FilePath)
-> IO (Maybe FilePath)
-> IO (Maybe FilePath)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
[IOErrorType] -> m a -> m a -> m a
hideErrorDefM [IOErrorType
InappropriateType, IOErrorType
PermissionDenied, IOErrorType
NoSuchThing] ([FilePath] -> IO (Maybe FilePath)
go [FilePath]
xs)
(IO (Maybe FilePath) -> IO (Maybe FilePath))
-> IO (Maybe FilePath) -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ do
[FilePath]
contents <- FilePath -> IO [FilePath]
listDirectory FilePath
x
(FilePath -> IO Bool) -> [FilePath] -> IO (Maybe FilePath)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM (FilePath -> FilePath -> IO Bool
isMatch FilePath
x) [FilePath]
contents IO (Maybe FilePath)
-> (Maybe FilePath -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just FilePath
_ -> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
x FilePath -> FilePath -> FilePath
</> FilePath
needle)
Maybe FilePath
Nothing -> [FilePath] -> IO (Maybe FilePath)
go [FilePath]
xs
isMatch :: FilePath -> FilePath -> IO Bool
isMatch FilePath
basedir FilePath
p = do
if FilePath
p FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
needle
then FilePath -> IO Bool
isExecutable (FilePath
basedir FilePath -> FilePath -> FilePath
</> FilePath
needle)
else Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
isExecutable :: FilePath -> IO Bool
isExecutable :: FilePath -> IO Bool
isExecutable FilePath
file = Permissions -> Bool
executable (Permissions -> Bool) -> IO Permissions -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Permissions
getPermissions FilePath
file
isShadowed :: FilePath -> IO (Maybe FilePath)
isShadowed :: FilePath -> IO (Maybe FilePath)
isShadowed FilePath
p = do
let dir :: FilePath
dir = FilePath -> FilePath
takeDirectory FilePath
p
let fn :: FilePath
fn = FilePath -> FilePath
takeFileName FilePath
p
[FilePath]
spaths <- IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [FilePath]
getSearchPath
if FilePath
dir FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
spaths
then do
let shadowPaths :: [FilePath]
shadowPaths = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
dir) [FilePath]
spaths
[FilePath] -> FilePath -> IO (Maybe FilePath)
searchPath [FilePath]
shadowPaths FilePath
fn
else Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
isInPath :: FilePath -> IO Bool
isInPath :: FilePath -> IO Bool
isInPath FilePath
p = do
let dir :: FilePath
dir = FilePath -> FilePath
takeDirectory FilePath
p
let fn :: FilePath
fn = FilePath -> FilePath
takeFileName FilePath
p
[FilePath]
spaths <- IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [FilePath]
getSearchPath
if FilePath
dir FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
spaths
then Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (Maybe FilePath -> Bool) -> IO (Maybe FilePath) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath] -> FilePath -> IO (Maybe FilePath)
searchPath [FilePath
dir] FilePath
fn
else Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
expandFilePath :: [Either FilePath Regex] -> IO [FilePath]
expandFilePath :: [Either FilePath Regex] -> IO [FilePath]
expandFilePath = FilePath -> [Either FilePath Regex] -> IO [FilePath]
go FilePath
""
where
go :: FilePath -> [Either FilePath Regex] -> IO [FilePath]
go :: FilePath -> [Either FilePath Regex] -> IO [FilePath]
go FilePath
p [] = [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath
p]
go FilePath
p (Either FilePath Regex
x:[Either FilePath Regex]
xs) = do
case Either FilePath Regex
x of
Left FilePath
s -> FilePath -> [Either FilePath Regex] -> IO [FilePath]
go (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
s) [Either FilePath Regex]
xs
Right Regex
regex -> do
[FilePath]
fps <- FilePath -> Regex -> IO [FilePath]
findFiles FilePath
p Regex
regex
[[FilePath]]
res <- [FilePath] -> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
fps ((FilePath -> IO [FilePath]) -> IO [[FilePath]])
-> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall a b. (a -> b) -> a -> b
$ \FilePath
fp -> FilePath -> [Either FilePath Regex] -> IO [FilePath]
go (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
fp) [Either FilePath Regex]
xs
[FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [[FilePath]] -> [FilePath]
forall a. Monoid a => [a] -> a
mconcat [[FilePath]]
res
findFiles :: FilePath -> Regex -> IO [FilePath]
findFiles :: FilePath -> Regex -> IO [FilePath]
findFiles FilePath
path Regex
regex = do
[FilePath]
contents <- FilePath -> IO [FilePath]
listDirectory FilePath
path
[FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Regex -> FilePath -> Bool
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match Regex
regex) [FilePath]
contents
findFilesDeep :: FilePath -> Regex -> IO [FilePath]
findFilesDeep :: FilePath -> Regex -> IO [FilePath]
findFilesDeep FilePath
path Regex
regex = do
[FilePath]
contents <- FilePath -> IO [FilePath]
getDirectoryContentsRecursive FilePath
path
[FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Regex -> FilePath -> Bool
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match Regex
regex) [FilePath]
contents
findFiles' :: FilePath -> MP.Parsec Void Text a -> IO [FilePath]
findFiles' :: FilePath -> Parsec Void Text a -> IO [FilePath]
findFiles' FilePath
path Parsec Void Text a
parser = do
[FilePath]
contents <- FilePath -> IO [FilePath]
listDirectory FilePath
path
[FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (\FilePath
fp -> (ParseErrorBundle Text Void -> Bool)
-> (a -> Bool) -> Either (ParseErrorBundle Text Void) a -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> ParseErrorBundle Text Void -> Bool
forall a b. a -> b -> a
const Bool
False) (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True) (Either (ParseErrorBundle Text Void) a -> Bool)
-> Either (ParseErrorBundle Text Void) a -> Bool
forall a b. (a -> b) -> a -> b
$ Parsec Void Text a
-> FilePath -> Text -> Either (ParseErrorBundle Text Void) a
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text a
parser FilePath
"" (FilePath -> Text
T.pack FilePath
fp)) [FilePath]
contents
checkFileAlreadyExists :: (MonadIO m) => FilePath -> m Bool
checkFileAlreadyExists :: FilePath -> m Bool
checkFileAlreadyExists FilePath
fp = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
fp