packages feed

FileManip 0.1 → 0.2

raw patch · 5 files changed

+108/−10 lines, 5 files

Files

FileManip.cabal view
@@ -1,5 +1,5 @@ Name:		FileManip-Version:	0.1+Version:	0.2 License:	LGPL License-File:	COPYING.LIB Author:		Bryan O'Sullivan <bos@serpentine.com>@@ -13,6 +13,7 @@ GHC-Options:    -Wall -O2 Exposed-Modules: 	System.FilePath.Find,+	System.FilePath.Glob, 	System.FilePath.GlobPattern, 	System.FilePath.Manip Extra-Source-Files: README
README view
@@ -4,6 +4,28 @@ This package provides functions and combinators for searching, matching, and manipulating files. +It provides four modules.++System.FilePath.Find lets you search a filesystem hierarchy efficiently:++  find always (extension ==? ".pl") >>= mapM_ remove++System.FilePath.GlobPattern lets you perform glob-style pattern+matching, without going through a regexp engine:++  "foo.c" ~~ "*.c"  ==> True++System.FilePath.Glob lets you do simple glob-style file name searches:++  namesMatching "*/*.c"  ==>  ["foo/bar.c"]++System.FilePath.Manip lets you rename files procedurally, edit files+in place, or save old copies as backups:++  modifyWithBackup (<.> "bak")+                   (unlines . map (takeWhile (/= ',')) . lines)+                   "myPoorFile.csv"+  To build and install: 
System/FilePath/Find.hs view
@@ -249,10 +249,11 @@  -- | Search a directory recursively, with recursion controlled by a -- 'RecursionPredicate'.  Fold over all files found.  Any errors that--- occur are dealt with by the given handler.  The fold function is--- run from \"left\" to \"right\", so it should be strict in its left--- argument to avoid space leaks.  If you need a right-to-left fold,--- use 'foldr' on the result of 'findWithHandler' instead.+-- occur are dealt with by the given handler.  The fold is strict, and+-- run from \"left\" to \"right\", so the folded function should be+-- strict in its left argument to avoid space leaks.  If you need a+-- right-to-left fold, use 'foldr' on the result of 'findWithHandler'+-- instead. foldWithHandler     :: (FilePath -> a -> E.Exception -> IO a) -- ^ error handler     -> RecursionPredicate -- ^ control recursion into subdirectories@@ -267,10 +268,12 @@   where visit state path depth st =             if F.isDirectory st && evalFI recurse path depth st             then traverse state path (succ depth) st-            else return (f state (mkFI path depth st))+            else let state' = f state (mkFI path depth st)+                 in state' `seq` return state'         traverse state dir depth dirSt = E.handle (errHandler dir state) $             getDirContents dir >>=-                flip foldM (f state (mkFI dir depth dirSt)) (\state name ->+                let state' = f state (mkFI dir depth dirSt)+                in state' `seq` flip foldM state' (\state name ->                     E.handle (errHandler dir state) $                     let path = dir </> name                     in F.getSymbolicLinkStatus path >>= visit state path depth)
+ System/FilePath/Glob.hs view
@@ -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
System/FilePath/GlobPattern.hs view
@@ -32,12 +32,12 @@ --  -- * @[!/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.