Add Glob module, update docs.
This commit is contained in:
parent
cac0d2da66
commit
8b28c0feee
5 changed files with 110 additions and 3 deletions
72
System/FilePath/Glob.hs
Normal file
72
System/FilePath/Glob.hs
Normal file
|
@ -0,0 +1,72 @@
|
|||
-- |
|
||||
-- Module: System.FilePath.Glob
|
||||
-- Copyright: Bryan O'Sullivan
|
||||
-- License: LGPL
|
||||
-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
|
||||
-- Stability: unstable
|
||||
-- Portability: everywhere
|
||||
|
||||
module System.FilePath.Glob (
|
||||
namesMatching
|
||||
) where
|
||||
|
||||
import Control.Exception (handle)
|
||||
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)
|
||||
|
||||
-- | Return a list of names matching a glob pattern. The list is
|
||||
-- generated lazily.
|
||||
namesMatching :: String -> IO [FilePath]
|
||||
namesMatching pat
|
||||
| not (isPattern pat) = do
|
||||
exists <- doesNameExist pat
|
||||
return (if exists then [pat] else [])
|
||||
| otherwise = do
|
||||
case splitFileName pat of
|
||||
("", baseName) -> do
|
||||
curDir <- getCurrentDirectory
|
||||
listMatches curDir baseName
|
||||
(dirName, baseName) -> do
|
||||
dirs <- if isPattern dirName
|
||||
then namesMatching (dropTrailingPathSeparator dirName)
|
||||
else return [dirName]
|
||||
let listDir = if isPattern baseName
|
||||
then listMatches
|
||||
else listPlain
|
||||
pathNames <- forM dirs $ \dir -> do
|
||||
baseNames <- listDir dir baseName
|
||||
return (map (dir </>) baseNames)
|
||||
return (concat pathNames)
|
||||
where isPattern = any (`elem` "[*?")
|
||||
|
||||
listMatches :: FilePath -> String -> IO [String]
|
||||
listMatches dirName pat = do
|
||||
dirName' <- if null dirName
|
||||
then getCurrentDirectory
|
||||
else return dirName
|
||||
names <- unsafeInterleaveIO (handle (const (return [])) $
|
||||
getDirectoryContents dirName')
|
||||
let names' = if isHidden pat
|
||||
then filter isHidden names
|
||||
else filter (not . isHidden) names
|
||||
return (filter (~~ pat) names')
|
||||
where isHidden ('.':_) = True
|
||||
isHidden _ = False
|
||||
|
||||
listPlain :: FilePath -> String -> IO [String]
|
||||
listPlain dirName baseName = do
|
||||
exists <- if null baseName
|
||||
then doesDirectoryExist dirName
|
||||
else doesNameExist (dirName </> baseName)
|
||||
return (if exists then [baseName] else [])
|
||||
|
||||
doesNameExist :: FilePath -> IO Bool
|
||||
doesNameExist name = do
|
||||
fileExists <- doesFileExist name
|
||||
if fileExists
|
||||
then return True
|
||||
else doesDirectoryExist name
|
|
@ -32,12 +32,12 @@ import System.FilePath (pathSeparator)
|
|||
--
|
||||
-- * @[!/range/]@ matches any character /not/ in /range/.
|
||||
--
|
||||
-- There are three extensions to the traditional glob syntax, taken
|
||||
-- from modern Unix shells.
|
||||
--
|
||||
-- * @\\@ escapes a character that might otherwise have special
|
||||
-- meaning. For a literal @\"\\\"@ character, use @\"\\\\\"@.
|
||||
--
|
||||
-- There are two extensions to the traditional glob syntax, taken from
|
||||
-- modern Unix shells.
|
||||
--
|
||||
-- * @**@ matches everything, including a directory separator.
|
||||
--
|
||||
-- * @(/s1/|/s2/|/.../)@ matches any of the strings /s1/, /s2/, etc.
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue