{-# LANGUAGE CPP #-}
#ifndef MIN_VERSION_directory
#if __GLASGOW_HASKELL__ >= 711
#define MIN_VERSION_directory(a,b,c) 1
#else
#define MIN_VERSION_directory(a,b,c) 0
#endif
#endif
module System.Directory.Extra(
module System.Directory,
#if !MIN_VERSION_directory(1,2,3)
withCurrentDirectory,
#endif
createDirectoryPrivate,
listContents, listDirectories, listFiles, listFilesInside, listFilesRecursive
) where
import System.Directory
import Control.Monad.Extra
import System.FilePath
import Data.List
#if !MIN_VERSION_directory(1,2,3)
import Control.Exception
#endif
#ifndef mingw32_HOST_OS
import qualified System.Posix
#endif
#if !MIN_VERSION_directory(1,2,3)
withCurrentDirectory :: FilePath -> IO a -> IO a
withCurrentDirectory dir act =
bracket getCurrentDirectory setCurrentDirectory $ const $ do
setCurrentDirectory dir; act
#endif
listContents :: FilePath -> IO [FilePath]
listContents :: FilePath -> IO [FilePath]
listContents FilePath
dir = do
[FilePath]
xs <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
[FilePath] -> IO [FilePath]
forall a. a -> IO a
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. Ord a => [a] -> [a]
sort [FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
x | FilePath
x <- [FilePath]
xs, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') FilePath
x]
listDirectories :: FilePath -> IO [FilePath]
listDirectories :: FilePath -> IO [FilePath]
listDirectories FilePath
dir = (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesDirectoryExist ([FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
listContents FilePath
dir
listFiles :: FilePath -> IO [FilePath]
listFiles :: FilePath -> IO [FilePath]
listFiles FilePath
dir = (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesFileExist ([FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
listContents FilePath
dir
listFilesRecursive :: FilePath -> IO [FilePath]
listFilesRecursive :: FilePath -> IO [FilePath]
listFilesRecursive = (FilePath -> IO Bool) -> FilePath -> IO [FilePath]
listFilesInside (IO Bool -> FilePath -> IO Bool
forall a b. a -> b -> a
const (IO Bool -> FilePath -> IO Bool) -> IO Bool -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
listFilesInside :: (FilePath -> IO Bool) -> FilePath -> IO [FilePath]
listFilesInside :: (FilePath -> IO Bool) -> FilePath -> IO [FilePath]
listFilesInside FilePath -> IO Bool
test FilePath
dir = IO Bool -> IO [FilePath] -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (IO Bool -> IO Bool
forall (m :: * -> *). Functor m => m Bool -> m Bool
notM (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
test (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
dropTrailingPathSeparator FilePath
dir) ([FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ do
([FilePath]
dirs,[FilePath]
files) <- (FilePath -> IO Bool) -> [FilePath] -> IO ([FilePath], [FilePath])
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM FilePath -> IO Bool
doesDirectoryExist ([FilePath] -> IO ([FilePath], [FilePath]))
-> IO [FilePath] -> IO ([FilePath], [FilePath])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
listContents FilePath
dir
[FilePath]
rest <- (FilePath -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM ((FilePath -> IO Bool) -> FilePath -> IO [FilePath]
listFilesInside FilePath -> IO Bool
test) [FilePath]
dirs
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
files [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
rest
createDirectoryPrivate :: String -> IO ()
#ifdef mingw32_HOST_OS
createDirectoryPrivate s = createDirectory s
#else
createDirectoryPrivate :: FilePath -> IO ()
createDirectoryPrivate FilePath
s = FilePath -> FileMode -> IO ()
System.Posix.createDirectory FilePath
s FileMode
0o700
#endif