-- Copied from
--
-- <https://hackage.haskell.org/package/fsutils-0.1.2/docs/src/System-Path.html>
--
-- because:
--
--   * base <4.7 upper bound would require patching, but lib hasn't been updated
--     in 8 years
--   * according to Arya, this code will not be necessary soon
--
-- License file (MIT) was dropped in deps/fsutils

-- | A collection of file system utilities that appear to be missing from
-- Directory, FilePath, Prelude, etc. Some of these may overlap with MissingH
-- but the versions here will probably be more simplistic. Furthermore, this
-- library is focused on this one thing and not a whole bunch of things.
module System.Path
  ( mtreeList,
    fileList,
    walkDir,
    copyDir,
    replaceRoot,
    removeRoot,
    Directory,
    dirPath,
    subDirs,
    files,
    createDir,
    filterUseless,
  )
where

import Control.Monad (filterM, forM_)
import Data.List ((\\))
import System.Directory
import System.FilePath (addTrailingPathSeparator, (</>))

-- | Remove useless paths from a list of paths.
filterUseless :: [FilePath] -> [FilePath]
filterUseless :: [FilePath] -> [FilePath]
filterUseless = ([FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath
".", FilePath
".."])

-- | Returns a list of nodes in a tree via a depth-first walk.
mtreeList :: (Monad m) => (a -> m [a]) -> a -> m [a]
mtreeList :: forall (m :: * -> *) a. Monad m => (a -> m [a]) -> a -> m [a]
mtreeList a -> m [a]
children a
root = do
  [a]
xs <- a -> m [a]
children a
root
  [[a]]
subChildren <- (a -> m [a]) -> [a] -> m [[a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((a -> m [a]) -> a -> m [a]
forall (m :: * -> *) a. Monad m => (a -> m [a]) -> a -> m [a]
mtreeList a -> m [a]
children) [a]
xs
  return $ a
root a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
subChildren

-- | Get a list of files in path, but not recursively. Removes '.' and '..'.
topFileList :: FilePath -> IO [FilePath]
topFileList :: FilePath -> IO [FilePath]
topFileList FilePath
path =
  ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
path FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
filterUseless) (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
getDirectoryContents FilePath
path

-- | Recursively list the contents of a directory. Depth-first.
fileList :: FilePath -> IO [FilePath]
fileList :: FilePath -> IO [FilePath]
fileList = (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
forall (m :: * -> *) a. Monad m => (a -> m [a]) -> a -> m [a]
mtreeList FilePath -> IO [FilePath]
children
  where
    children :: FilePath -> IO [FilePath]
children FilePath
path = do
      Bool
directory <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
      if Bool
directory
        then FilePath -> IO [FilePath]
topFileList FilePath
path
        else [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | We can use this data type to represent the pieces of a directory.
data Directory = Directory
  { -- | The path of the directory itself.
    Directory -> FilePath
dirPath :: FilePath,
    -- | All subdirectories of this directory.
    Directory -> [FilePath]
subDirs :: [FilePath],
    -- | All files contained in this directory.
    Directory -> [FilePath]
files :: [FilePath]
  }
  deriving (Int -> Directory -> FilePath -> FilePath
[Directory] -> FilePath -> FilePath
Directory -> FilePath
(Int -> Directory -> FilePath -> FilePath)
-> (Directory -> FilePath)
-> ([Directory] -> FilePath -> FilePath)
-> Show Directory
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> Directory -> FilePath -> FilePath
showsPrec :: Int -> Directory -> FilePath -> FilePath
$cshow :: Directory -> FilePath
show :: Directory -> FilePath
$cshowList :: [Directory] -> FilePath -> FilePath
showList :: [Directory] -> FilePath -> FilePath
Show)

-- | Creates a Directory instance from a FilePath.
createDir :: FilePath -> IO Directory
createDir :: FilePath -> IO Directory
createDir FilePath
path = do
  [FilePath]
contents <- FilePath -> IO [FilePath]
topFileList FilePath
path
  [FilePath]
subdirs <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesDirectoryExist [FilePath]
contents
  [FilePath]
files <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesFileExist [FilePath]
contents
  return (FilePath -> [FilePath] -> [FilePath] -> Directory
Directory FilePath
path [FilePath]
subdirs [FilePath]
files)

-- | Walk a directory depth-first. Similar to Python's os.walk and fs.core/walk
-- from the fs Clojure library.
walkDir :: FilePath -> IO [Directory]
walkDir :: FilePath -> IO [Directory]
walkDir FilePath
root = FilePath -> IO Directory
createDir FilePath
root IO Directory -> (Directory -> IO [Directory]) -> IO [Directory]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Directory -> IO [Directory]) -> Directory -> IO [Directory]
forall (m :: * -> *) a. Monad m => (a -> m [a]) -> a -> m [a]
mtreeList Directory -> IO [Directory]
children
  where
    children :: Directory -> IO [Directory]
children Directory
path = do
      let dirs :: [FilePath]
dirs = Directory -> [FilePath]
subDirs Directory
path
      (FilePath -> IO Directory) -> [FilePath] -> IO [Directory]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FilePath -> IO Directory
createDir [FilePath]
dirs

-- | Given a root (prefix), remove it from a path. This is useful
-- for getting the filename and subdirs of a path inside of a root.
removeRoot :: FilePath -> FilePath -> FilePath
removeRoot :: FilePath -> FilePath -> FilePath
removeRoot FilePath
prefix = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop (Int -> FilePath -> FilePath)
-> (FilePath -> Int) -> FilePath -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FilePath -> FilePath -> FilePath)
-> FilePath -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
addTrailingPathSeparator FilePath
prefix

-- | Given a root path, a new root path, and a path to be changed,
-- removes the old root from the path and replaces it with to.
replaceRoot :: FilePath -> FilePath -> FilePath -> FilePath
replaceRoot :: FilePath -> FilePath -> FilePath -> FilePath
replaceRoot FilePath
root FilePath
to FilePath
path = FilePath
to FilePath -> FilePath -> FilePath
</> FilePath -> FilePath -> FilePath
removeRoot FilePath
root FilePath
path

-- | Copy a directory recursively. Moves every file, creates every directory.
copyDir :: FilePath -> FilePath -> IO ()
copyDir :: FilePath -> FilePath -> IO ()
copyDir FilePath
from FilePath
to = do
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
to
  [Directory]
walked <- FilePath -> IO [Directory]
walkDir FilePath
from
  [Directory] -> (Directory -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Directory]
walked ((Directory -> IO ()) -> IO ()) -> (Directory -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Directory FilePath
_ [FilePath]
dirs [FilePath]
files) -> do
    (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath -> FilePath
replaceRoot FilePath
from FilePath
to) [FilePath]
dirs
    [FilePath] -> (FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
files ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
path -> FilePath -> FilePath -> IO ()
copyFile FilePath
path (FilePath -> FilePath -> FilePath -> FilePath
replaceRoot FilePath
from FilePath
to FilePath
path)