{-# LANGUAGE ScopedTypeVariables #-}
module System.FilePath.Glob (
namesMatching
) where
import Control.Exception
import Control.Monad (forM)
import System.FilePath.GlobPattern ((~~))
import System.Directory (doesDirectoryExist, doesFileExist,
getCurrentDirectory, getDirectoryContents)
import System.FilePath (dropTrailingPathSeparator, splitFileName, (</>))
import System.IO.Unsafe (unsafeInterleaveIO)
namesMatching :: String -> IO [FilePath]
namesMatching :: String -> IO [String]
namesMatching String
pat
| Bool -> Bool
not (String -> Bool
isPattern String
pat) = do
Bool
exists <- String -> IO Bool
doesNameExist String
pat
[String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (if Bool
exists then [String
pat] else [])
| Bool
otherwise = do
case String -> (String, String)
splitFileName String
pat of
(String
"", String
baseName) -> do
String
curDir <- IO String
getCurrentDirectory
String -> String -> IO [String]
listMatches String
curDir String
baseName
(String
dirName, String
baseName) -> do
[String]
dirs <- if String -> Bool
isPattern String
dirName
then String -> IO [String]
namesMatching (String -> String
dropTrailingPathSeparator String
dirName)
else [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String
dirName]
let listDir :: String -> String -> IO [String]
listDir = if String -> Bool
isPattern String
baseName
then String -> String -> IO [String]
listMatches
else String -> String -> IO [String]
listPlain
[[String]]
pathNames <- [String] -> (String -> IO [String]) -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
dirs ((String -> IO [String]) -> IO [[String]])
-> (String -> IO [String]) -> IO [[String]]
forall a b. (a -> b) -> a -> b
$ \String
dir -> do
[String]
baseNames <- String -> String -> IO [String]
listDir String
dir String
baseName
[String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
dir String -> String -> String
</>) [String]
baseNames)
[String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
pathNames)
where isPattern :: String -> Bool
isPattern = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"[*?")
listMatches :: FilePath -> String -> IO [String]
listMatches :: String -> String -> IO [String]
listMatches String
dirName String
pat = do
String
dirName' <- if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
dirName
then IO String
getCurrentDirectory
else String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
dirName
[String]
names <- IO [String] -> IO [String]
forall a. IO a -> IO a
unsafeInterleaveIO ((IOException -> IO [String]) -> IO [String] -> IO [String]
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
_::IOException) -> [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []) (IO [String] -> IO [String]) -> IO [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$
String -> IO [String]
getDirectoryContents String
dirName')
let names' :: [String]
names' = if String -> Bool
isHidden String
pat
then (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isHidden [String]
names
else (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isHidden) [String]
names
[String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
~~ String
pat) [String]
names')
where isHidden :: String -> Bool
isHidden (Char
'.':String
_) = Bool
True
isHidden String
_ = Bool
False
listPlain :: FilePath -> String -> IO [String]
listPlain :: String -> String -> IO [String]
listPlain String
dirName String
baseName = do
Bool
exists <- if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
baseName
then String -> IO Bool
doesDirectoryExist String
dirName
else String -> IO Bool
doesNameExist (String
dirName String -> String -> String
</> String
baseName)
[String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (if Bool
exists then [String
baseName] else [])
doesNameExist :: FilePath -> IO Bool
doesNameExist :: String -> IO Bool
doesNameExist String
name = do
Bool
fileExists <- String -> IO Bool
doesFileExist String
name
if Bool
fileExists
then Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else String -> IO Bool
doesDirectoryExist String
name