(original) (raw)

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

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 []

getDirectoryFilesIgnore :: FilePath -> [FilePattern] -> [FilePattern] -> IO [FilePath] getDirectoryFilesIgnore :: FilePath -> [FilePath] -> [FilePath] -> IO [FilePath] getDirectoryFilesIgnore = Bool -> FilePath -> [FilePath] -> [FilePath] -> IO [FilePath] operation Bool False

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

    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

    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

            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

                    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