module System.FilePath.Glob.Directory (globDir) where
import Control.Monad (forM)
import Data.List ((\\), partition)
import System.Directory (doesDirectoryExist, getDirectoryContents)
import System.FilePath ((</>))
import System.FilePath.Glob.Base
import System.FilePath.Glob.Match (match)
import System.FilePath.Glob.Utils (getRecursiveContents, nubOrd, pathParts)
data TypedPattern
= Any Pattern
| Dir Pattern
| AnyDir Pattern
deriving Show
globDir :: [Pattern] -> FilePath -> IO ([[FilePath]], [FilePath])
globDir pats dir = do
results <- mapM (\p -> globDir' (separate p) dir) pats
let (matches, others) = unzip results
return (matches, nubOrd (concat others) \\ concat matches)
globDir' :: [TypedPattern] -> FilePath -> IO ([FilePath], [FilePath])
globDir' pats dir = do
raw <- getDirectoryContents dir
let entries = raw \\ [".",".."]
results <- forM entries $ \e -> matchTypedAndGo pats e (dir </> e)
let (matches, others) = unzip results
return (concat matches, concat others)
matchTypedAndGo :: [TypedPattern]
-> FilePath -> FilePath
-> IO ([FilePath], [FilePath])
matchTypedAndGo [] _ _ = return ([], [])
matchTypedAndGo [Any p] path absPath =
if match p path
then return ([absPath], [])
else doesDirectoryExist absPath >>= didn'tMatch absPath
matchTypedAndGo (Dir p:ps) path absPath = do
isDir <- doesDirectoryExist absPath
if isDir && match p path
then globDir' ps absPath
else didn'tMatch absPath isDir
matchTypedAndGo (AnyDir p:ps) path absPath = do
isDir <- doesDirectoryExist absPath
let pat = unseparate ps
case null (unPattern p) || match p path of
True | isDir -> fmap (partition (any (match pat) . pathParts))
(getRecursiveContents absPath)
True | match pat path -> return ([absPath], [])
_ -> didn'tMatch absPath isDir
matchTypedAndGo _ _ _ = error "Glob.matchTypedAndGo :: internal error"
didn'tMatch :: FilePath -> Bool -> IO ([FilePath], [FilePath])
didn'tMatch absPath isDir = (fmap $ (,) []) $
if isDir
then getRecursiveContents absPath
else return [absPath]
separate :: Pattern -> [TypedPattern]
separate = go [] . unPattern
where
go [] [] = []
go gr [] = [Any $ f gr]
go gr (ExtSeparator:PathSeparator:ps) = go gr ps
go gr ( PathSeparator:ps) = ( Dir $ f gr) : go [] ps
go gr ( AnyDirectory:ps) = (AnyDir $ f gr) : go [] ps
go gr ( p:ps) = go (p:gr) ps
f = Pattern . reverse
unseparate :: [TypedPattern] -> Pattern
unseparate = Pattern . foldr f []
where
f (AnyDir p) ts = unPattern p ++ AnyDirectory : ts
f ( Dir p) ts = unPattern p ++ PathSeparator : ts
f (Any p) ts = unPattern p ++ ts