{- |
 Module      : System.Posix.Recursive.ByteString.Unsafe-- Copyright   : (c) Marek Fajkus
 License     : BSD3

 Maintainer  : marek.faj@gmail.com

 All modules profided by @unix-recursive@ expose similar API.
 Make sure you're using the module wich best fits your needs based on:
   - Working  with 'RawFilePath' (faster and more packed) or 'FilePath' (slower but easier to work with safely)
   - Exception free (Default) or @Unsafe@ variants of functions

 = Usage

 This module is designed to be imported as @qualified@:

 > import qualified System.Posix.Recursive.ByteString.Unsafe as PosixRecursive

 __Results__

 All functions return will return root path (the one they accept in argument) as a first item in the list:

 > head <$> PosixRecursive.list "System"
 > >>> "System"

 Other than that, this library __provides no guarantees about the order in which files appear in the resulting list__
 to make it possible to change the underlaying strategy in future versions.

 __Laziness__

 All IO operations are __guaranteed to be lazy and have constanct space characteristic__.
 Only the IO required by lazy computation will be performed so for instance running code like:

 > take 20 <$> PosixRecursive.listDirectories "/"

 Will perform only minimal ammount of IO needed to collect 20 directories on a root partition
-}
module System.Posix.Recursive.ByteString.Unsafe (
    -- * Basic Listing
    -- $basic_listing
    list,
    followList,
    listMatching,
    followListMatching,

    -- * File Type Based Listing
    -- $type_based
    listDirectories,
    listRegularFiles,
    listSymbolicLinks,

    -- * Custom Listing
    -- $custom
    Conf (..),
    defConf,
    listCustom,
) where

import Control.Exception (bracket)
import Data.Foldable (fold)
import System.IO.Unsafe (unsafeInterleaveIO)

import qualified Data.ByteString as BS
import System.Posix.ByteString.FilePath (RawFilePath)

import qualified System.Posix.Directory.ByteString as Posix
import qualified System.Posix.Files.ByteString as Posix

import System.Posix.Recursive.ByteString (Conf (..), defConf)


-- Helpers

foldMapA :: (Monoid b, Traversable t, Applicative f) => (a -> f b) -> t a -> f b
foldMapA :: (a -> f b) -> t a -> f b
foldMapA = ((t b -> b) -> f (t b) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t b -> b
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (f (t b) -> f b) -> (t a -> f (t b)) -> t a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((t a -> f (t b)) -> t a -> f b)
-> ((a -> f b) -> t a -> f (t b)) -> (a -> f b) -> t a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> t a -> f (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse


{-# INLINE listDir #-}
listDir :: (RawFilePath -> Bool) -> RawFilePath -> IO [RawFilePath]
listDir :: (RawFilePath -> Bool) -> RawFilePath -> IO [RawFilePath]
listDir RawFilePath -> Bool
predicate RawFilePath
path =
    IO DirStream
-> (DirStream -> IO ())
-> (DirStream -> IO [RawFilePath])
-> IO [RawFilePath]
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        (RawFilePath -> IO DirStream
Posix.openDirStream RawFilePath
path)
        DirStream -> IO ()
Posix.closeDirStream
        ([RawFilePath] -> DirStream -> IO [RawFilePath]
go [])
  where
    go :: [RawFilePath] -> Posix.DirStream -> IO [RawFilePath]
    go :: [RawFilePath] -> DirStream -> IO [RawFilePath]
go [RawFilePath]
acc DirStream
dirp = do
        RawFilePath
e <- DirStream -> IO RawFilePath
Posix.readDirStream DirStream
dirp
        if RawFilePath -> Bool
BS.null RawFilePath
e
            then [RawFilePath] -> IO [RawFilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [RawFilePath]
acc
            else
                if RawFilePath
e RawFilePath -> RawFilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= RawFilePath
"." Bool -> Bool -> Bool
&& RawFilePath
e RawFilePath -> RawFilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= RawFilePath
".."
                    then
                        let fullPath :: RawFilePath
fullPath = RawFilePath
path RawFilePath -> RawFilePath -> RawFilePath
forall a. Semigroup a => a -> a -> a
<> RawFilePath
"/" RawFilePath -> RawFilePath -> RawFilePath
forall a. Semigroup a => a -> a -> a
<> RawFilePath
e
                         in if RawFilePath -> Bool
predicate RawFilePath
fullPath
                                then [RawFilePath] -> DirStream -> IO [RawFilePath]
go (RawFilePath
fullPath RawFilePath -> [RawFilePath] -> [RawFilePath]
forall a. a -> [a] -> [a]
: [RawFilePath]
acc) DirStream
dirp
                                else [RawFilePath] -> DirStream -> IO [RawFilePath]
go [RawFilePath]
acc DirStream
dirp
                    else [RawFilePath] -> DirStream -> IO [RawFilePath]
go [RawFilePath]
acc DirStream
dirp
{- $basic_listing
 Functions for listing contents of directory recursively.
 These functions list all the content they encounter while traversing
 the file system tree including directories, files, symlinks, broken symlinks.

  __Functions from this module will throw 'IOError' if it can't open the directory__
 (i.e. becacuse permission error or other process removing the given path).

 Functions from this section is gurantee to always return the root path as a first element even
 if this path does not exist.

 > PosixRecursive.list "i-dont-exist"
 > >>> ["i-dont-exist"]

 In these cases the root path is considered the same way as symlink
 to non existing location.
-}


{-# INLINE listAll' #-}
listAll' :: Bool -> (RawFilePath -> Bool) -> RawFilePath -> IO [RawFilePath]
listAll' :: Bool -> (RawFilePath -> Bool) -> RawFilePath -> IO [RawFilePath]
listAll' Bool
followSymlinks RawFilePath -> Bool
predicate RawFilePath
path =
    do
        FileStatus
file <- RawFilePath -> IO FileStatus
getFileStatus RawFilePath
path
        if FileStatus -> Bool
Posix.isDirectory FileStatus
file
            then do
                [RawFilePath]
content <- (RawFilePath -> Bool) -> RawFilePath -> IO [RawFilePath]
listDir RawFilePath -> Bool
predicate RawFilePath
path

                [RawFilePath]
next <- IO [RawFilePath] -> IO [RawFilePath]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [RawFilePath] -> IO [RawFilePath])
-> IO [RawFilePath] -> IO [RawFilePath]
forall a b. (a -> b) -> a -> b
$ (RawFilePath -> IO [RawFilePath])
-> [RawFilePath] -> IO [RawFilePath]
forall b (t :: * -> *) (f :: * -> *) a.
(Monoid b, Traversable t, Applicative f) =>
(a -> f b) -> t a -> f b
foldMapA (Bool -> (RawFilePath -> Bool) -> RawFilePath -> IO [RawFilePath]
listAll' Bool
followSymlinks RawFilePath -> Bool
predicate) [RawFilePath]
content
                [RawFilePath] -> IO [RawFilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([RawFilePath] -> IO [RawFilePath])
-> [RawFilePath] -> IO [RawFilePath]
forall a b. (a -> b) -> a -> b
$ [RawFilePath]
content [RawFilePath] -> [RawFilePath] -> [RawFilePath]
forall a. [a] -> [a] -> [a]
++ [RawFilePath]
next
            else [RawFilePath] -> IO [RawFilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  where
    {-# INLINE getFileStatus #-}
    getFileStatus :: RawFilePath -> IO FileStatus
getFileStatus
        | Bool
followSymlinks = RawFilePath -> IO FileStatus
Posix.getFileStatus
        | Bool
otherwise = RawFilePath -> IO FileStatus
Posix.getSymbolicLinkStatus


{-# INLINE listAll'' #-}
listAll'' :: Bool -> (RawFilePath -> Bool) -> RawFilePath -> IO [RawFilePath]
listAll'' :: Bool -> (RawFilePath -> Bool) -> RawFilePath -> IO [RawFilePath]
listAll'' Bool
followSymlinks RawFilePath -> Bool
predicate RawFilePath
path =
    (RawFilePath
path RawFilePath -> [RawFilePath] -> [RawFilePath]
forall a. a -> [a] -> [a]
:) ([RawFilePath] -> [RawFilePath])
-> IO [RawFilePath] -> IO [RawFilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> (RawFilePath -> Bool) -> RawFilePath -> IO [RawFilePath]
listAll' Bool
followSymlinks RawFilePath -> Bool
predicate RawFilePath
path


-- | Like 'list' but uses provided function to test in which 'RawFilePath' to recurse into.
listMatching :: (RawFilePath -> Bool) -> RawFilePath -> IO [RawFilePath]
listMatching :: (RawFilePath -> Bool) -> RawFilePath -> IO [RawFilePath]
listMatching =
    Bool -> (RawFilePath -> Bool) -> RawFilePath -> IO [RawFilePath]
listAll'' Bool
False


-- | Like 'followList' but uses provided function to test in which 'RawFilePath' to recurse into.
followListMatching :: (RawFilePath -> Bool) -> RawFilePath -> IO [RawFilePath]
followListMatching :: (RawFilePath -> Bool) -> RawFilePath -> IO [RawFilePath]
followListMatching =
    Bool -> (RawFilePath -> Bool) -> RawFilePath -> IO [RawFilePath]
listAll'' Bool
True


{- | List all files, directories & symlinks recursively.
 Symlinks are not followed. See 'followList'.
-}
list :: RawFilePath -> IO [RawFilePath]
list :: RawFilePath -> IO [RawFilePath]
list =
    Bool -> (RawFilePath -> Bool) -> RawFilePath -> IO [RawFilePath]
listAll'' Bool
False (Bool -> RawFilePath -> Bool
forall a b. a -> b -> a
const Bool
True)


{- | List all files, directories & symlinks recursively.
 Unlike 'list', symlinks are followed recursively as well.
-}
followList :: RawFilePath -> IO [RawFilePath]
followList :: RawFilePath -> IO [RawFilePath]
followList =
    Bool -> (RawFilePath -> Bool) -> RawFilePath -> IO [RawFilePath]
listAll'' Bool
True (Bool -> RawFilePath -> Bool
forall a b. a -> b -> a
const Bool
True)


{- $custom
 All /File Type Based Listing/ functions are based on top of this interface.
 This part of API exposes exposes access for writing custom filtering functions.

 All paths are tested for filter functions so unreadble files won't appear in the result list:

 > PosixRecursive.listCustom PosixRecursive.defConf "i-dont-exist"
 > >>> []

 It's not possible to turn of this behaviour because this functions must get the 'FileStatus'
 type which requires reading each entry.
-}


{-# INLINE listAccessible' #-}
listAccessible' :: Conf -> RawFilePath -> IO [RawFilePath]
listAccessible' :: Conf -> RawFilePath -> IO [RawFilePath]
listAccessible' Conf{Bool
RawFilePath -> Bool
FileStatus -> RawFilePath -> IO Bool
followSymlinks :: Conf -> Bool
includeFile :: Conf -> FileStatus -> RawFilePath -> IO Bool
filterPath :: Conf -> RawFilePath -> Bool
followSymlinks :: Bool
includeFile :: FileStatus -> RawFilePath -> IO Bool
filterPath :: RawFilePath -> Bool
..} RawFilePath
path =
    do
        FileStatus
file <- RawFilePath -> IO FileStatus
getFileStatus RawFilePath
path
        [RawFilePath]
next <-
            if FileStatus -> Bool
Posix.isDirectory FileStatus
file
                then do
                    [RawFilePath]
content <- (RawFilePath -> Bool) -> RawFilePath -> IO [RawFilePath]
listDir RawFilePath -> Bool
filterPath RawFilePath
path
                    IO [RawFilePath] -> IO [RawFilePath]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [RawFilePath] -> IO [RawFilePath])
-> IO [RawFilePath] -> IO [RawFilePath]
forall a b. (a -> b) -> a -> b
$ (RawFilePath -> IO [RawFilePath])
-> [RawFilePath] -> IO [RawFilePath]
forall b (t :: * -> *) (f :: * -> *) a.
(Monoid b, Traversable t, Applicative f) =>
(a -> f b) -> t a -> f b
foldMapA (Conf -> RawFilePath -> IO [RawFilePath]
listAccessible' Conf :: (RawFilePath -> Bool)
-> (FileStatus -> RawFilePath -> IO Bool) -> Bool -> Conf
Conf{Bool
RawFilePath -> Bool
FileStatus -> RawFilePath -> IO Bool
followSymlinks :: Bool
includeFile :: FileStatus -> RawFilePath -> IO Bool
filterPath :: RawFilePath -> Bool
followSymlinks :: Bool
includeFile :: FileStatus -> RawFilePath -> IO Bool
filterPath :: RawFilePath -> Bool
..}) [RawFilePath]
content
                else [RawFilePath] -> IO [RawFilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

        Bool
include <- FileStatus -> RawFilePath -> IO Bool
includeFile FileStatus
file RawFilePath
path
        if Bool
include
            then [RawFilePath] -> IO [RawFilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([RawFilePath] -> IO [RawFilePath])
-> [RawFilePath] -> IO [RawFilePath]
forall a b. (a -> b) -> a -> b
$ RawFilePath
path RawFilePath -> [RawFilePath] -> [RawFilePath]
forall a. a -> [a] -> [a]
: [RawFilePath]
next
            else [RawFilePath] -> IO [RawFilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [RawFilePath]
next
  where
    {-# INLINE getFileStatus #-}
    getFileStatus :: RawFilePath -> IO FileStatus
getFileStatus
        | Bool
followSymlinks = RawFilePath -> IO FileStatus
Posix.getFileStatus
        | Bool
otherwise = RawFilePath -> IO FileStatus
Posix.getSymbolicLinkStatus


-- | Recursively list files using custom filters.
listCustom :: Conf -> RawFilePath -> IO [RawFilePath]
listCustom :: Conf -> RawFilePath -> IO [RawFilePath]
listCustom =
    Conf -> RawFilePath -> IO [RawFilePath]
listAccessible'


{- $type_based
 Functions for listing specific file type. Reading the file type requires
 ability to read the file.

  __These functions will throw 'IOError' when tring to open unreadable file.__

 Include test is applied even for the root entry (path past in as an argument).
 This means that non existing paths are filtered.

 > PosixRecursive.listDirectories "i-dont-exist"
 > >>> []
-}


-- | List sub directories of given directory.
listDirectories :: RawFilePath -> IO [RawFilePath]
listDirectories :: RawFilePath -> IO [RawFilePath]
listDirectories =
    Conf -> RawFilePath -> IO [RawFilePath]
listAccessible' Conf
defConf{includeFile :: FileStatus -> RawFilePath -> IO Bool
includeFile = \FileStatus
file RawFilePath
_ -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ FileStatus -> Bool
Posix.isDirectory FileStatus
file}


-- | Lists only files (while recursing into directories still).
listRegularFiles :: RawFilePath -> IO [RawFilePath]
listRegularFiles :: RawFilePath -> IO [RawFilePath]
listRegularFiles =
    Conf -> RawFilePath -> IO [RawFilePath]
listAccessible' Conf
defConf{includeFile :: FileStatus -> RawFilePath -> IO Bool
includeFile = \FileStatus
file RawFilePath
_ -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ FileStatus -> Bool
Posix.isRegularFile FileStatus
file}


-- | Lists only symbolic links (while recursing into directories still).
listSymbolicLinks :: RawFilePath -> IO [RawFilePath]
listSymbolicLinks :: RawFilePath -> IO [RawFilePath]
listSymbolicLinks =
    Conf -> RawFilePath -> IO [RawFilePath]
listAccessible' Conf
defConf{includeFile :: FileStatus -> RawFilePath -> IO Bool
includeFile = \FileStatus
file RawFilePath
_ -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ FileStatus -> Bool
Posix.isSymbolicLink FileStatus
file}