diff --git a/FileManipCompat.cabal b/FileManipCompat.cabal new file mode 100644 --- /dev/null +++ b/FileManipCompat.cabal @@ -0,0 +1,29 @@ +Name: FileManipCompat +Version: 0.1 +License: BSD3 +License-File: LICENSE +Author: Bryan O'Sullivan +Maintainer: Thomas Hartman +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 + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -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 diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/System/FilePath/FindCompat.hs b/System/FilePath/FindCompat.hs new file mode 100644 --- /dev/null +++ b/System/FilePath/FindCompat.hs @@ -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 +