Get things building again

This commit is contained in:
Bryan O'Sullivan 2010-10-10 16:16:47 -07:00
parent 9a21d9a8dc
commit 76491aebb1
5 changed files with 34 additions and 71 deletions

View File

@ -1,42 +0,0 @@
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
-- |
-- Module: System.FilePath.Manip
-- Copyright: Sergei Trofimovich
-- License: BSD3
-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
-- Stability: unstable
-- Portability: Unix-like systems (requires flexible instances)
module System.FilePath.Error
(
bracket
, bracket_
, catch
, handle
, throwIO
, Exception
) where
import qualified Control.Exception.Extensible as EE
import Prelude hiding (catch)
-- we can catch any exceptions if we need to
-- type Exception = SomeException
type Exception = EE.IOException
-- we just pin down 'EE.Exception e' to local Exception
bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket = EE.bracket
bracket_ :: IO a -> IO b -> IO c -> IO c
bracket_ = EE.bracket_
catch :: IO a -> (Exception -> IO a) -> IO a
catch = EE.catch
handle :: (Exception -> IO a) -> IO a -> IO a
handle = EE.handle
throwIO :: (EE.Exception e) => e -> IO a
throwIO = EE.throwIO

View File

@ -1,4 +1,5 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | -- |
-- Module: System.FilePath.Find -- Module: System.FilePath.Find
@ -110,6 +111,7 @@ module System.FilePath.Find (
, (||?) , (||?)
) where ) where
import Control.Exception
import Control.Monad (foldM, forM, liftM, liftM2) import Control.Monad (foldM, forM, liftM, liftM2)
import Control.Monad.State (State(..), evalState) import Control.Monad.State (State(..), evalState)
import Data.Bits (Bits, (.&.)) import Data.Bits (Bits, (.&.))
@ -119,9 +121,9 @@ import System.FilePath ((</>), takeDirectory, takeExtension, takeFileName)
import System.FilePath.GlobPattern (GlobPattern, (~~), (/~)) import System.FilePath.GlobPattern (GlobPattern, (~~), (/~))
import System.IO (hPutStrLn, stderr) import System.IO (hPutStrLn, stderr)
import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO) import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO)
import qualified System.FilePath.Error as E import qualified System.PosixCompat.Files as F
import qualified System.Posix.Files as F import qualified System.PosixCompat.Types as T
import qualified System.Posix.Types as T import Prelude hiding (catch)
-- | Information collected during the traversal of a directory. -- | Information collected during the traversal of a directory.
data FileInfo = FileInfo data FileInfo = FileInfo
@ -210,27 +212,27 @@ getDirContents dir = (sort . filter goodName) `liftM` getDirectoryContents dir
-- matching the given 'FilterPredicate'. Any errors that occur are -- matching the given 'FilterPredicate'. Any errors that occur are
-- dealt with by the given handler. -- dealt with by the given handler.
findWithHandler :: findWithHandler ::
(FilePath -> E.Exception -> IO [FilePath]) -- ^ error handler (FilePath -> IOException -> IO [FilePath]) -- ^ error handler
-> RecursionPredicate -- ^ control recursion into subdirectories -> RecursionPredicate -- ^ control recursion into subdirectories
-> FilterPredicate -- ^ decide whether a file appears in the result -> FilterPredicate -- ^ decide whether a file appears in the result
-> FilePath -- ^ directory to start searching -> FilePath -- ^ directory to start searching
-> IO [FilePath] -- ^ files that matched the 'FilterPredicate' -> IO [FilePath] -- ^ files that matched the 'FilterPredicate'
findWithHandler errHandler recurse filter path = findWithHandler errHandler recurse filt path0 =
E.handle (errHandler path) $ F.getSymbolicLinkStatus path >>= visit path 0 handle (errHandler path0) $ F.getSymbolicLinkStatus path0 >>= visit path0 0
where visit path depth st = where visit path depth st =
if F.isDirectory st && evalFI recurse path depth st if F.isDirectory st && evalFI recurse path depth st
then unsafeInterleaveIO (traverse path (succ depth) st) then unsafeInterleaveIO (traverse path (succ depth) st)
else filterPath path depth st [] else filterPath path depth st []
traverse dir depth dirSt = do traverse dir depth dirSt = do
names <- E.catch (getDirContents dir) (errHandler dir) names <- catch (getDirContents dir) (errHandler dir)
filteredPaths <- forM names $ \name -> do filteredPaths <- forM names $ \name -> do
let path = dir </> name let path = dir </> name
unsafeInterleaveIO $ E.handle (errHandler path) unsafeInterleaveIO $ handle (errHandler path)
(F.getSymbolicLinkStatus path >>= visit path depth) (F.getSymbolicLinkStatus path >>= visit path depth)
filterPath dir depth dirSt (concat filteredPaths) filterPath dir depth dirSt (concat filteredPaths)
filterPath path depth st result = filterPath path depth st result =
return $ if evalFI filter path depth st return $ if evalFI filt path depth st
then path:result then path:result
else result else result
@ -255,7 +257,7 @@ find = findWithHandler warnOnError
-- right-to-left fold, use 'foldr' on the result of 'findWithHandler' -- right-to-left fold, use 'foldr' on the result of 'findWithHandler'
-- instead. -- instead.
foldWithHandler foldWithHandler
:: (FilePath -> a -> E.Exception -> IO a) -- ^ error handler :: (FilePath -> a -> IOException -> IO a) -- ^ error handler
-> RecursionPredicate -- ^ control recursion into subdirectories -> RecursionPredicate -- ^ control recursion into subdirectories
-> (a -> FileInfo -> a) -- ^ function to fold with -> (a -> FileInfo -> a) -- ^ function to fold with
-> a -- ^ seed value for fold -> a -- ^ seed value for fold
@ -263,18 +265,18 @@ foldWithHandler
-> IO a -- ^ final value after folding -> IO a -- ^ final value after folding
foldWithHandler errHandler recurse f state path = foldWithHandler errHandler recurse f state path =
E.handle (errHandler path state) $ handle (errHandler path state) $
F.getSymbolicLinkStatus path >>= visit state path 0 F.getSymbolicLinkStatus path >>= visit state path 0
where visit state path depth st = where visit state path depth st =
if F.isDirectory st && evalFI recurse path depth st if F.isDirectory st && evalFI recurse path depth st
then traverse state path (succ depth) st then traverse state path (succ depth) st
else let state' = f state (mkFI path depth st) else let state' = f state (mkFI path depth st)
in state' `seq` return state' in state' `seq` return state'
traverse state dir depth dirSt = E.handle (errHandler dir state) $ traverse state dir depth dirSt = handle (errHandler dir state) $
getDirContents dir >>= getDirContents dir >>=
let state' = f state (mkFI dir depth dirSt) let state' = f state (mkFI dir depth dirSt)
in state' `seq` flip foldM state' (\state name -> in state' `seq` flip foldM state' (\state name ->
E.handle (errHandler dir state) $ handle (errHandler dir state) $
let path = dir </> name let path = dir </> name
in F.getSymbolicLinkStatus path >>= visit state path depth) in F.getSymbolicLinkStatus path >>= visit state path depth)
@ -351,7 +353,7 @@ withLink f = do
path <- filePath path <- filePath
st <- fileStatus st <- fileStatus
return $ if F.isSymbolicLink st return $ if F.isSymbolicLink st
then unsafePerformIO $ E.handle (const (return Nothing)) $ then unsafePerformIO $ handle (\(_::IOException) -> return Nothing) $
Just `liftM` f path Just `liftM` f path
else Nothing else Nothing
@ -475,7 +477,7 @@ contains :: FilePath -> FindClause Bool
contains p = do contains p = do
d <- filePath d <- filePath
return $ unsafePerformIO $ return $ unsafePerformIO $
E.handle (const (return False)) $ handle (\(_::IOException) -> return False) $
F.getFileStatus (d </> p) >> return True F.getFileStatus (d </> p) >> return True
-- | Lift a binary operator into the 'FindClause' monad, so that it -- | Lift a binary operator into the 'FindClause' monad, so that it

View File

@ -1,3 +1,4 @@
{-# LANGUAGE ScopedTypeVariables #-}
-- | -- |
-- Module: System.FilePath.Glob -- Module: System.FilePath.Glob
-- Copyright: Bryan O'Sullivan -- Copyright: Bryan O'Sullivan
@ -10,6 +11,7 @@ module System.FilePath.Glob (
namesMatching namesMatching
) where ) where
import Control.Exception
import Control.Monad (forM) import Control.Monad (forM)
import System.FilePath.GlobPattern ((~~)) import System.FilePath.GlobPattern ((~~))
import System.Directory (doesDirectoryExist, doesFileExist, import System.Directory (doesDirectoryExist, doesFileExist,
@ -17,8 +19,6 @@ import System.Directory (doesDirectoryExist, doesFileExist,
import System.FilePath (dropTrailingPathSeparator, splitFileName, (</>)) import System.FilePath (dropTrailingPathSeparator, splitFileName, (</>))
import System.IO.Unsafe (unsafeInterleaveIO) import System.IO.Unsafe (unsafeInterleaveIO)
import System.FilePath.Error (handle)
-- | Return a list of names matching a glob pattern. The list is -- | Return a list of names matching a glob pattern. The list is
-- generated lazily. -- generated lazily.
namesMatching :: String -> IO [FilePath] namesMatching :: String -> IO [FilePath]
@ -49,7 +49,7 @@ listMatches dirName pat = do
dirName' <- if null dirName dirName' <- if null dirName
then getCurrentDirectory then getCurrentDirectory
else return dirName else return dirName
names <- unsafeInterleaveIO (handle (const (return [])) $ names <- unsafeInterleaveIO (handle (\(_::IOException) -> return []) $
getDirectoryContents dirName') getDirectoryContents dirName')
let names' = if isHidden pat let names' = if isHidden pat
then filter isHidden names then filter isHidden names

View File

@ -1,4 +1,4 @@
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances #-}
-- | -- |
-- Module: System.FilePath.Manip -- Module: System.FilePath.Manip
@ -16,8 +16,7 @@ module System.FilePath.Manip (
, modifyInPlace , modifyInPlace
) where ) where
import System.FilePath.Error (bracket, bracket_, handle, throwIO) import Control.Exception
import Control.Monad (liftM) import Control.Monad (liftM)
import Data.Bits ((.&.)) import Data.Bits ((.&.))
import System.Directory (removeFile) import System.Directory (removeFile)
@ -104,11 +103,11 @@ modifyWith after transform path =
bracket (openFile path ReadMode) hClose $ \ih -> do bracket (openFile path ReadMode) hClose $ \ih -> do
(tmpPath, oh) <- mkstemp (path ++ "XXXXXX") (tmpPath, oh) <- mkstemp (path ++ "XXXXXX")
let ignore = return () let ignore = return ()
nukeTmp = handle (const ignore) (removeFile tmpPath) nukeTmp = handle (\(_::IOException) -> ignore) (removeFile tmpPath)
handle (\e -> nukeTmp >> throwIO e) $ do handle (\(e::IOException) -> nukeTmp >> throw e) $ do
bracket_ ignore (hClose oh) $ bracket_ ignore (hClose oh) $
readAll ih >>= return . transform >>= writeAll oh readAll ih >>= return . transform >>= writeAll oh
handle (const nukeTmp) $ do handle (\(_::IOException) -> nukeTmp) $ do
mode <- fileMode `liftM` getFileStatus path mode <- fileMode `liftM` getFileStatus path
setFileMode tmpPath (mode .&. 0777) setFileMode tmpPath (mode .&. 0777)
after path tmpPath after path tmpPath

View File

@ -1,5 +1,5 @@
Name: filemanip Name: filemanip
Version: 0.4.0.0 Version: 0.3.5.0
License: BSD3 License: BSD3
License-File: LICENSE License-File: LICENSE
Author: Bryan O'Sullivan <bos@serpentine.com> Author: Bryan O'Sullivan <bos@serpentine.com>
@ -15,12 +15,16 @@ Build-type: Simple
Extra-Source-Files: README.markdown Extra-Source-Files: README.markdown
Library Library
build-depends: base < 5, bytestring, directory, filepath, mtl, unix-compat
if !os(windows)
build-depends: unix
if impl(ghc >= 6.10)
build-depends:
base >= 4
GHC-Options: -Wall GHC-Options: -Wall
Exposed-Modules: Exposed-Modules:
System.FilePath.Find, System.FilePath.Find,
System.FilePath.Glob, System.FilePath.Glob,
System.FilePath.GlobPattern, System.FilePath.GlobPattern,
System.FilePath.Manip System.FilePath.Manip
Other-Modules:
System.FilePath.Error