-- | Optimised directory traversal using 'FilePattern' values.
--   All results are guaranteed to be sorted.
--
--   /Case Sensitivity/: these traversals are optimised to reduce the number of IO operations
--   performed. In particular, if the relevant subdirectories can be determined in
--   advance it will use 'doesDirectoryExist' rather than 'getDirectoryContents'.
--   However, on case-insensitive file systems, if there is a directory @foo@,
--   then @doesDirectoryExist \"FOO\"@ will report @True@, but @FOO@ won't be a result
--   returned by 'getDirectoryContents', which may result in different search results
--   depending on whether a certain optimisations kick in.
--
--   If these optimisation differences are absolutely unacceptable use 'getDirectoryFilesIgnoreSlow'.
--   However, normally these differences are not a problem.
module System.FilePattern.Directory(
    FilePattern,
    getDirectoryFiles,
    getDirectoryFilesIgnore,
    getDirectoryFilesIgnoreSlow
    ) where

import Control.Monad.Extra
import Data.Functor
import Data.List
import System.Directory
import System.FilePath
import System.FilePattern.Core
import System.FilePattern.Step
import Prelude


-- | Get the files below a certain root that match any of the 'FilePattern' values. Only matches
--   files, not directories. Avoids traversing into directories that it can detect won't have
--   any matches in.
--
-- > getDirectoryFiles "myproject/src" ["**/*.h","**/*.c"]
--
--   If there are certain directories/files that should not be explored, use 'getDirectoryFilesIgnore'.
--
--   /Warning/: on case-insensitive file systems certain optimisations can cause surprising results.
--   See the top of the module for details.
getDirectoryFiles :: FilePath -> [FilePattern] -> IO [FilePath]
getDirectoryFiles :: FilePath -> [FilePath] -> IO [FilePath]
getDirectoryFiles FilePath
dir [FilePath]
match = Bool -> FilePath -> [FilePath] -> [FilePath] -> IO [FilePath]
operation Bool
False FilePath
dir [FilePath]
match []



-- | Get the files below a certain root matching any of the first set of 'FilePattern' values,
--   but don't return any files which match any ignore pattern (the final argument).
--   Typically the ignore pattens will end with @\/**@, e.g. @.git\/**@.
--
-- > getDirectoryFilesIgnore "myproject/src" ["**/*.h","**/*.c"] [".git/**"]
--
--   /Warning/: on case-insensitive file systems certain optimisations can cause surprising results.
--   See the top of the module for details.
getDirectoryFilesIgnore :: FilePath -> [FilePattern] -> [FilePattern] -> IO [FilePath]
getDirectoryFilesIgnore :: FilePath -> [FilePath] -> [FilePath] -> IO [FilePath]
getDirectoryFilesIgnore = Bool -> FilePath -> [FilePath] -> [FilePath] -> IO [FilePath]
operation Bool
False


-- | Like 'getDirectoryFilesIgnore' but that the optimisations that may change behaviour on a
--   case-insensitive file system. Note that this function will never return more results
--   then 'getDirectoryFilesIgnore', and may return less. However, it will obey invariants
--   such as:
--
-- > getDirectoryFilesIgnoreSlow root [x] [] ++ getDirectoryFilesIgnoreSlow root [y] []
-- >     == getDirectoryFilesIgnoreSlow root [x,y] []
--
--   In contrast 'getDirectoryFilesIgnore' only guarantees that invariant on
--   case-sensitive file systems.
getDirectoryFilesIgnoreSlow :: FilePath -> [FilePattern] -> [FilePattern] -> IO [FilePath]
getDirectoryFilesIgnoreSlow :: FilePath -> [FilePath] -> [FilePath] -> IO [FilePath]
getDirectoryFilesIgnoreSlow = Bool -> FilePath -> [FilePath] -> [FilePath] -> IO [FilePath]
operation Bool
True


operation :: Bool -> FilePath -> [FilePattern] -> [FilePattern] -> IO [FilePath]
operation :: Bool -> FilePath -> [FilePath] -> [FilePath] -> IO [FilePath]
operation Bool
slow FilePath
rootBad [FilePath]
yes [FilePath]
no = FilePath -> Step () -> Step () -> IO [FilePath]
forall a a.
(Eq a, Eq a) =>
FilePath -> Step a -> Step a -> IO [FilePath]
f [] ([FilePath] -> Step ()
step_ [FilePath]
yes) ([FilePath] -> Step ()
step_ [FilePath]
no)
    where
        -- normalise out Windows vs other behaviour around "", make sure we end with /
        root :: FilePath
root = if FilePath
rootBad FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"" then FilePath
"./" else FilePath -> FilePath
addTrailingPathSeparator FilePath
rootBad

        -- parts is a series of path components joined with trailing / characters
        f :: FilePath -> Step a -> Step a -> IO [FilePath]
f FilePath
parts Step a
yes Step a
no
            | StepNext
StepEverything <- Step a -> StepNext
forall a. Step a -> StepNext
stepNext Step a
no = [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
            | Bool -> Bool
not Bool
slow, StepOnly [FilePath]
xs <- Step a -> StepNext
forall a. Step a -> StepNext
stepNext Step a
yes = FilePath -> Step a -> Step a -> [FilePath] -> IO [FilePath]
g FilePath
parts Step a
yes Step a
no [FilePath]
xs
            | Bool
otherwise = do
                [FilePath]
xs <- (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
getDirectoryContents (FilePath
root FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
parts)
                FilePath -> Step a -> Step a -> [FilePath] -> IO [FilePath]
g FilePath
parts Step a
yes Step a
no [FilePath]
xs

        g :: FilePath -> Step a -> Step a -> [FilePath] -> IO [FilePath]
g FilePath
parts Step a
yes Step a
no [FilePath]
xs =
            [FilePath] -> (FilePath -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => [a] -> (a -> m [b]) -> m [b]
concatForM ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
xs) ((FilePath -> IO [FilePath]) -> IO [FilePath])
-> (FilePath -> IO [FilePath]) -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ \FilePath
x -> do
                let path :: FilePath
path = FilePath
root FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
parts FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x
                -- deliberately shadow since using yes/no from now on would be wrong
                Step a
yes <- Step a -> IO (Step a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step a -> IO (Step a)) -> Step a -> IO (Step a)
forall a b. (a -> b) -> a -> b
$ Step a -> FilePath -> Step a
forall a. Step a -> FilePath -> Step a
stepApply Step a
yes FilePath
x
                Step a
no <- Step a -> IO (Step a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step a -> IO (Step a)) -> Step a -> IO (Step a)
forall a b. (a -> b) -> a -> b
$ Step a -> FilePath -> Step a
forall a. Step a -> FilePath -> Step a
stepApply Step a
no FilePath
x
                Maybe Bool
isFile <- Bool -> IO Bool -> IO (Maybe Bool)
forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
whenMaybe (Step a -> [(a, [FilePath])]
forall a. Step a -> [(a, [FilePath])]
stepDone Step a
yes [(a, [FilePath])] -> [(a, [FilePath])] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] Bool -> Bool -> Bool
&& Step a -> [(a, [FilePath])]
forall a. Step a -> [(a, [FilePath])]
stepDone Step a
no [(a, [FilePath])] -> [(a, [FilePath])] -> Bool
forall a. Eq a => a -> a -> Bool
== []) (FilePath -> IO Bool
doesFileExist FilePath
path)
                case Maybe Bool
isFile of
                    Just Bool
True -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath
parts FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x]
                    Maybe Bool
_ | StepNext
StepEverything <- Step a -> StepNext
forall a. Step a -> StepNext
stepNext Step a
no -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                      | StepOnly [] <- Step a -> StepNext
forall a. Step a -> StepNext
stepNext Step a
yes -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                      | Bool
otherwise -> do
                        -- Here we used to assume that getDirectoryContents means something exists,
                        -- doesFileExists is False, therefore this must be a directory.
                        -- That's not true in the presence of symlinks.
                        Bool
b <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
                        if Bool -> Bool
not Bool
b then [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [] else FilePath -> Step a -> Step a -> IO [FilePath]
f (FilePath
parts FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/") Step a
yes Step a
no