{-# 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 :: [FilePath] -> FilePath -> IO (Maybe FilePath)
searchPath [FilePath]
paths FilePath
needle = [FilePath] -> IO (Maybe FilePath)
go [FilePath]
paths
 where
  go :: [FilePath] -> IO (Maybe FilePath)
go [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
  go (FilePath
x : [FilePath]
xs) =
    forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
e -> if IOException -> IOErrorType
ioeGetErrorType IOException
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [IOErrorType
InappropriateType, IOErrorType
PermissionDenied, IOErrorType
NoSuchThing] then [FilePath] -> IO (Maybe FilePath)
go [FilePath]
xs else forall a. IOException -> IO a
ioError IOException
e)
      forall a b. (a -> b) -> a -> b
$ do
          [FilePath]
contents <- FilePath -> IO [FilePath]
listDirectory FilePath
x
          forall {t :: * -> *} {m :: * -> *} {a}.
(Foldable t, Monad m) =>
(a -> m Bool) -> t a -> m (Maybe a)
findM (FilePath -> FilePath -> IO Bool
isMatch FilePath
x) [FilePath]
contents forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just FilePath
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
== FilePath
needle
      then FilePath -> IO Bool
isExecutable (FilePath
basedir FilePath -> FilePath -> FilePath
</> FilePath
needle)
      else 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Permissions
getPermissions FilePath
file

  -- TODO: inlined from GHCup.Prelude
  findM :: (a -> m Bool) -> t a -> m (Maybe a)
findM ~a -> m Bool
p = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x -> forall {m :: * -> *} {b}. Monad m => m Bool -> m b -> m b -> m b
ifM (a -> m Bool
p a
x) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
x)) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)
  ifM :: m Bool -> m b -> m b -> m b
ifM ~m Bool
b ~m b
t ~m b
f = do
    Bool
b' <- m Bool
b
    if Bool
b' then m b
t else m b
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 :: 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [FilePath]
getSearchPath
  if FilePath
dir forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
spaths
  then do
    let shadowPaths :: [FilePath]
shadowPaths = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= FilePath
dir) [FilePath]
spaths
    [FilePath] -> FilePath -> IO (Maybe FilePath)
searchPath [FilePath]
shadowPaths FilePath
fn
  else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
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 :: 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [FilePath]
getSearchPath
  if FilePath
dir forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
spaths
  then forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath] -> FilePath -> IO (Maybe FilePath)
searchPath [FilePath
dir] FilePath
fn
  else forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False


-- | Follows the first match in case of Regex.
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 [] = 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 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
fps 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
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (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' :: forall a. FilePath -> Parsec Void Text a -> IO [FilePath]
findFiles' FilePath
path Parsec Void Text a
parser = do
  [FilePath]
contents <- FilePath -> IO [FilePath]
listDirectory FilePath
path
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\FilePath
fp -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Bool
False) (forall a b. a -> b -> a
const Bool
True) forall a b. (a -> b) -> a -> b
$ 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