{-# LANGUAGE MultiWayIf #-}

{-|
Module      : Data.VCS.Ignore.FileSystem
Description : Helper functions for working with file system
Copyright   : (c) 2020-2022 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

This module contains mainly helper functions, that are internally used by this
library.
-}

module Data.VCS.Ignore.FileSystem
  ( findPaths
  , listPaths
  , walkPaths
  , toPosixPath
  )
where


import           Control.Monad                  ( forM
                                                , mfilter
                                                )
import           Control.Monad.IO.Class         ( MonadIO
                                                , liftIO
                                                )
import           Data.Maybe                     ( catMaybes
                                                , fromMaybe
                                                )
import           System.Directory               ( doesDirectoryExist
                                                , doesFileExist
                                                , getDirectoryContents
                                                )
import           System.FilePath                ( (</>) )


-- | Recursively finds paths on given path whose filename matches the predicate.
findPaths :: MonadIO m
          => FilePath             -- ^ path to traverse
          -> (FilePath -> m Bool) -- ^ predicate to match filename
          -> m [FilePath]         -- ^ list of found paths
findPaths :: FilePath -> (FilePath -> m Bool) -> m [FilePath]
findPaths FilePath
entryPath FilePath -> m Bool
predicate = [Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe FilePath] -> [FilePath])
-> m [Maybe FilePath] -> m [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> (FilePath -> m (Maybe FilePath)) -> m [Maybe FilePath]
forall (m :: * -> *) a.
MonadIO m =>
FilePath -> (FilePath -> m a) -> m [a]
walkPaths FilePath
entryPath FilePath -> m (Maybe FilePath)
process
 where
  process :: FilePath -> m (Maybe FilePath)
process FilePath
path = (\Bool
p -> if Bool
p then FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path else Maybe FilePath
forall a. Maybe a
Nothing) (Bool -> Maybe FilePath) -> m Bool -> m (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m Bool
predicate FilePath
path


-- | Recursively finds all paths on given path. If file reference is passed
-- instead of directory, such path is returned.
listPaths :: MonadIO m
          => FilePath      -- ^ path to traverse
          -> m [FilePath]  -- ^ list of found paths
listPaths :: FilePath -> m [FilePath]
listPaths FilePath
entryPath = FilePath -> (FilePath -> m FilePath) -> m [FilePath]
forall (m :: * -> *) a.
MonadIO m =>
FilePath -> (FilePath -> m a) -> m [a]
walkPaths FilePath
entryPath FilePath -> m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure


-- | Recursively walks the given path and performs selected action for each
-- found file. Output of this function is:
--
--   * If the given __path is file__, only this single path is processed and
--     returned.
--   * If the given __path is directory__, all subdirectories and files are
--     recursively processed and returned.
--   * If the given __path doesn't exist__, empy list will be returned.
walkPaths :: MonadIO m
          => FilePath          -- ^ path to traverse
          -> (FilePath -> m a) -- ^ function to process path
          -> m [a]             -- ^ result of traversed & processed paths
walkPaths :: FilePath -> (FilePath -> m a) -> m [a]
walkPaths FilePath
entryPath FilePath -> m a
fn = do
  Bool
isDir  <- 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
doesDirectoryExist FilePath
entryPath
  Bool
isFile <- 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
entryPath
  if
    | Bool
isDir     -> FilePath -> m a
fn FilePath
entryPath m a -> (a -> m [a]) -> m [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\a
p -> (a
p a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m [a]
listDirectory FilePath
entryPath)
    | Bool
isFile    -> a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> [a]) -> m a -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m a
fn FilePath
entryPath
    | Bool
otherwise -> [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
 where
  listDirectory :: FilePath -> m [a]
listDirectory FilePath
dir = do
    [FilePath]
names <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
    [[a]]
paths <- [FilePath] -> (FilePath -> m [a]) -> m [[a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ((FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath
".", FilePath
".."]) [FilePath]
names) ((FilePath -> m [a]) -> m [[a]]) -> (FilePath -> m [a]) -> m [[a]]
forall a b. (a -> b) -> a -> b
$ \FilePath
name -> do
      let path :: FilePath
path = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
name
      Bool
isDirectory <- 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
doesDirectoryExist FilePath
path
      if Bool
isDirectory then FilePath -> (FilePath -> m a) -> m [a]
forall (m :: * -> *) a.
MonadIO m =>
FilePath -> (FilePath -> m a) -> m [a]
walkPaths FilePath
path FilePath -> m a
fn else a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> [a]) -> m a -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m a
fn FilePath
path
    [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> m [a]) -> [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
paths


-- | If the given path contains backward slashes (Windows style), converts them
-- into forward ones (Unix style).
--
-- >>> toPosixPath "foo\\bar\\x.txt"
-- "foo/bar/x.txt"
--
-- >>> toPosixPath "foo/bar/x.txt"
-- "foo/bar/x.txt"
toPosixPath :: FilePath -- ^ input filepath to convert
            -> FilePath -- ^ output filepath
toPosixPath :: FilePath -> FilePath
toPosixPath = Char -> Char -> FilePath -> FilePath
forall (f :: * -> *) b. (Functor f, Eq b) => b -> b -> f b -> f b
replace Char
'\\' Char
'/'
  where replace :: b -> b -> f b -> f b
replace b
a b
b = (b -> b) -> f b -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> b) -> f b -> f b) -> (b -> b) -> f b -> f b
forall a b. (a -> b) -> a -> b
$ b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe b
b (Maybe b -> b) -> (b -> Maybe b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Bool) -> Maybe b -> Maybe b
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/= b
a) (Maybe b -> Maybe b) -> (b -> Maybe b) -> b -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe b
forall a. a -> Maybe a
Just