FileManipCompat (empty) → 0.1

raw patch · 5 files changed

+230/−0 lines, 5 filesdep +basedep +bytestringdep +directorysetup-changed

Dependencies added: base, bytestring, directory, extensible-exceptions, filepath, mtl, unix-compat

Files

• FileManipCompat.cabal +29/−0
• LICENSE +27/−0
• README +50/−0
• Setup.lhs +3/−0
• System/FilePath/FindCompat.hs +121/−0

@@ -0,0 +1,29 @@+Name:               FileManipCompat+Version:            0.1+License:            BSD3+License-File:       LICENSE+Author:             Bryan O'Sullivan <bos@serpentine.com>+Maintainer:         Thomas Hartman <thomashartman1@gmail.com>+Synopsis:           Port of Find function of FileManip lib for use on windows systems+Category:           System+Description:        A Haskell library for working with files and directories.+                    Includes code for pattern matching, finding files,+                    modifying file contents, and more.+Build-type:         Simple+Cabal-version:      >= 1.6+Extra-Source-Files: README++Flag base4+    Description: Choose the even newer, even smaller, split-up base package.++Library+  Build-Depends: bytestring, directory, filepath, mtl, unix-compat, extensible-exceptions+  if flag(base4)+    Build-Depends:       base >= 4 && < 5+  else+    Build-Depends:       base < 4++  GHC-Options:    -Wall+  Exposed-Modules:+          System.FilePath.FindCompat+

@@ -0,0 +1,27 @@+Copyright 2007, 2008 Bryan O'Sullivan.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.

@@ -0,0 +1,50 @@+FileManip: expressive file manipulation+---------------------------------------++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:++  runhaskell Setup configure+  runhaskell Setup build+  runhaskell Setup install+++To understand:++  http://darcs.serpentine.com/filemanip/dist/doc/html/FileManip/++++To contribute:++  darcs get http://darcs.serpentine.com/filemanip+++Contributors:++  Bryan O'Sullivan

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,121 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- from happstack-util/src/Happstack/Util/FileManip.hs,+-- which was derived from FileManip package, which only works on unix.+-- happstack port works on windows as well.+-- repackage here as standalone to remove dependency on happstack, for immediate use with HStringTemplateHelpers.+module System.FilePath.FindCompat (always,find) where++import qualified System.PosixCompat.Files as F+import Control.Monad.State+import qualified Control.Exception.Extensible as E+import System.IO+import Data.List (sort)+import System.Directory (getDirectoryContents)+import System.IO.Unsafe (unsafeInterleaveIO)+import System.FilePath ((</>))+++-- | Information collected during the traversal of a directory.+data FileInfo = FileInfo+    {+      infoPath :: FilePath -- ^ file path+    , infoDepth :: Int -- ^ current recursion depth+    , infoStatus :: F.FileStatus -- ^ status of file+    } deriving (Eq)+instance Eq F.FileStatus where+    a == b = F.deviceID a == F.deviceID b && F.fileID a == F.fileID b ++-- | Construct a 'FileInfo' value.++mkFI :: FilePath -> Int -> F.FileStatus -> FileInfo++mkFI = FileInfo++-- | Monadic container for file information, allowing for clean+-- construction of combinators.  Wraps the 'State' monad, but doesn't+-- allow 'get' or 'put'.+newtype FindClause a = FC { runFC :: State FileInfo a }+    deriving (Functor, Monad)++-- | Run the given 'FindClause' on the given 'FileInfo' and return its+-- result.  This can be useful if you are writing a function to pass+-- to 'fold'.+--+-- Example:+--+-- @+-- myFoldFunc :: a -> 'FileInfo' -> a+-- myFoldFunc a i = let useThisFile = 'evalClause' ('fileName' '==?' \"foo\") i+--                  in if useThisFile+--                     then fiddleWith a+--                     else a+-- @+evalClause :: FindClause a -> FileInfo -> a+evalClause = evalState . runFC++evalFI :: FindClause a+       -> FilePath+       -> Int+       -> F.FileStatus+       -> a+evalFI m p d s = evalClause m (mkFI p d s)++type FilterPredicate = FindClause Bool+type RecursionPredicate = FindClause Bool++-- | List the files in the given directory, sorted, and without \".\"+-- or \"..\".+getDirContents :: FilePath -> IO [FilePath]++getDirContents dir = (sort . filter goodName) `liftM` getDirectoryContents dir+    where goodName "." = False+          goodName ".." = False+          goodName _ = True++-- | Search a directory recursively, with recursion controlled by a+-- 'RecursionPredicate'.  Lazily return a sorted list of all files+-- matching the given 'FilterPredicate'.  Any errors that occur are+-- dealt with by the given handler.+findWithHandler ::+    (FilePath -> E.SomeException -> IO [FilePath]) -- ^ error handler+    -> RecursionPredicate -- ^ control recursion into subdirectories+    -> FilterPredicate -- ^ decide whether a file appears in the result+    -> FilePath -- ^ directory to start searching+    -> IO [FilePath] -- ^ files that matched the 'FilterPredicate'++findWithHandler errHandler recurse filt path =+    E.handle (errHandler path) $ F.getSymbolicLinkStatus path >>= visit path 0+  where visit path' depth st =+            if F.isDirectory st && evalFI recurse path' depth st+              then unsafeInterleaveIO (traverse path' (succ depth) st)+              else filterPath path' depth st []+        traverse dir depth dirSt = do+            names <- E.catch (getDirContents dir) (errHandler dir)+            filteredPaths <- forM names $ \name -> do+                let path' = dir </> name+                unsafeInterleaveIO $ E.handle (errHandler path)+                    (F.getSymbolicLinkStatus path' >>= visit path' depth)+            filterPath dir depth dirSt (concat filteredPaths)+        filterPath path' depth st result =+            return $ if evalFI filt path' depth st+                then path:result+                else result++-- | Search a directory recursively, with recursion controlled by a+-- 'RecursionPredicate'.  Lazily return a sorted list of all files+-- matching the given 'FilterPredicate'.  Any errors that occur are+-- ignored, with warnings printed to 'stderr'.+find :: RecursionPredicate -- ^ control recursion into subdirectories+     -> FilterPredicate -- ^ decide whether a file appears in the result+     -> FilePath -- ^ directory to start searching+     -> IO [FilePath] -- ^ files that matched the 'FilterPredicate'++find = findWithHandler warnOnError+    where warnOnError path err =+              hPutStrLn stderr (path ++ ": " ++ show err) >> return []++-- | Unconditionally return 'True'.+always :: FindClause Bool+always = return True+