From 76491aebb1e3f4ea476aa784ca0f75f3b508b217 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Sun, 10 Oct 2010 16:16:47 -0700 Subject: [PATCH] Get things building again --- System/FilePath/Error.hs | 42 ---------------------------------------- System/FilePath/Find.hs | 34 +++++++++++++++++--------------- System/FilePath/Glob.hs | 6 +++--- System/FilePath/Manip.hs | 11 +++++------ filemanip.cabal | 12 ++++++++---- 5 files changed, 34 insertions(+), 71 deletions(-) delete mode 100644 System/FilePath/Error.hs diff --git a/System/FilePath/Error.hs b/System/FilePath/Error.hs deleted file mode 100644 index aabce41..0000000 --- a/System/FilePath/Error.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} - --- | --- Module: System.FilePath.Manip --- Copyright: Sergei Trofimovich --- License: BSD3 --- Maintainer: Bryan O'Sullivan --- 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 diff --git a/System/FilePath/Find.hs b/System/FilePath/Find.hs index 73aa90c..b66ff55 100644 --- a/System/FilePath/Find.hs +++ b/System/FilePath/Find.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module: System.FilePath.Find @@ -110,6 +111,7 @@ module System.FilePath.Find ( , (||?) ) where +import Control.Exception import Control.Monad (foldM, forM, liftM, liftM2) import Control.Monad.State (State(..), evalState) import Data.Bits (Bits, (.&.)) @@ -119,9 +121,9 @@ import System.FilePath ((), takeDirectory, takeExtension, takeFileName) import System.FilePath.GlobPattern (GlobPattern, (~~), (/~)) import System.IO (hPutStrLn, stderr) import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO) -import qualified System.FilePath.Error as E -import qualified System.Posix.Files as F -import qualified System.Posix.Types as T +import qualified System.PosixCompat.Files as F +import qualified System.PosixCompat.Types as T +import Prelude hiding (catch) -- | Information collected during the traversal of a directory. data FileInfo = FileInfo @@ -210,27 +212,27 @@ getDirContents dir = (sort . filter goodName) `liftM` getDirectoryContents dir -- matching the given 'FilterPredicate'. Any errors that occur are -- dealt with by the given handler. findWithHandler :: - (FilePath -> E.Exception -> IO [FilePath]) -- ^ error handler + (FilePath -> IOException -> 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 filter path = - E.handle (errHandler path) $ F.getSymbolicLinkStatus path >>= visit path 0 +findWithHandler errHandler recurse filt path0 = + handle (errHandler path0) $ F.getSymbolicLinkStatus path0 >>= visit path0 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) + names <- catch (getDirContents dir) (errHandler dir) filteredPaths <- forM names $ \name -> do let path = dir name - unsafeInterleaveIO $ E.handle (errHandler path) + unsafeInterleaveIO $ handle (errHandler path) (F.getSymbolicLinkStatus path >>= visit path depth) filterPath dir depth dirSt (concat filteredPaths) filterPath path depth st result = - return $ if evalFI filter path depth st + return $ if evalFI filt path depth st then path:result else result @@ -255,7 +257,7 @@ find = findWithHandler warnOnError -- right-to-left fold, use 'foldr' on the result of 'findWithHandler' -- instead. foldWithHandler - :: (FilePath -> a -> E.Exception -> IO a) -- ^ error handler + :: (FilePath -> a -> IOException -> IO a) -- ^ error handler -> RecursionPredicate -- ^ control recursion into subdirectories -> (a -> FileInfo -> a) -- ^ function to fold with -> a -- ^ seed value for fold @@ -263,18 +265,18 @@ foldWithHandler -> IO a -- ^ final value after folding foldWithHandler errHandler recurse f state path = - E.handle (errHandler path state) $ + handle (errHandler path state) $ F.getSymbolicLinkStatus path >>= visit state path 0 where visit state path depth st = if F.isDirectory st && evalFI recurse path depth st then traverse state path (succ 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) $ + traverse state dir depth dirSt = handle (errHandler dir state) $ getDirContents dir >>= let state' = f state (mkFI dir depth dirSt) in state' `seq` flip foldM state' (\state name -> - E.handle (errHandler dir state) $ + handle (errHandler dir state) $ let path = dir name in F.getSymbolicLinkStatus path >>= visit state path depth) @@ -351,7 +353,7 @@ withLink f = do path <- filePath st <- fileStatus return $ if F.isSymbolicLink st - then unsafePerformIO $ E.handle (const (return Nothing)) $ + then unsafePerformIO $ handle (\(_::IOException) -> return Nothing) $ Just `liftM` f path else Nothing @@ -475,7 +477,7 @@ contains :: FilePath -> FindClause Bool contains p = do d <- filePath return $ unsafePerformIO $ - E.handle (const (return False)) $ + handle (\(_::IOException) -> return False) $ F.getFileStatus (d p) >> return True -- | Lift a binary operator into the 'FindClause' monad, so that it diff --git a/System/FilePath/Glob.hs b/System/FilePath/Glob.hs index 0164608..1a31c63 100644 --- a/System/FilePath/Glob.hs +++ b/System/FilePath/Glob.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ScopedTypeVariables #-} -- | -- Module: System.FilePath.Glob -- Copyright: Bryan O'Sullivan @@ -10,6 +11,7 @@ module System.FilePath.Glob ( namesMatching ) where +import Control.Exception import Control.Monad (forM) import System.FilePath.GlobPattern ((~~)) import System.Directory (doesDirectoryExist, doesFileExist, @@ -17,8 +19,6 @@ import System.Directory (doesDirectoryExist, doesFileExist, import System.FilePath (dropTrailingPathSeparator, splitFileName, ()) import System.IO.Unsafe (unsafeInterleaveIO) -import System.FilePath.Error (handle) - -- | Return a list of names matching a glob pattern. The list is -- generated lazily. namesMatching :: String -> IO [FilePath] @@ -49,7 +49,7 @@ listMatches dirName pat = do dirName' <- if null dirName then getCurrentDirectory else return dirName - names <- unsafeInterleaveIO (handle (const (return [])) $ + names <- unsafeInterleaveIO (handle (\(_::IOException) -> return []) $ getDirectoryContents dirName') let names' = if isHidden pat then filter isHidden names diff --git a/System/FilePath/Manip.hs b/System/FilePath/Manip.hs index 2dad4a9..a8019c0 100644 --- a/System/FilePath/Manip.hs +++ b/System/FilePath/Manip.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances #-} -- | -- Module: System.FilePath.Manip @@ -16,8 +16,7 @@ module System.FilePath.Manip ( , modifyInPlace ) where -import System.FilePath.Error (bracket, bracket_, handle, throwIO) - +import Control.Exception import Control.Monad (liftM) import Data.Bits ((.&.)) import System.Directory (removeFile) @@ -104,11 +103,11 @@ modifyWith after transform path = bracket (openFile path ReadMode) hClose $ \ih -> do (tmpPath, oh) <- mkstemp (path ++ "XXXXXX") let ignore = return () - nukeTmp = handle (const ignore) (removeFile tmpPath) - handle (\e -> nukeTmp >> throwIO e) $ do + nukeTmp = handle (\(_::IOException) -> ignore) (removeFile tmpPath) + handle (\(e::IOException) -> nukeTmp >> throw e) $ do bracket_ ignore (hClose oh) $ readAll ih >>= return . transform >>= writeAll oh - handle (const nukeTmp) $ do + handle (\(_::IOException) -> nukeTmp) $ do mode <- fileMode `liftM` getFileStatus path setFileMode tmpPath (mode .&. 0777) after path tmpPath diff --git a/filemanip.cabal b/filemanip.cabal index 64ed0cf..481eb65 100644 --- a/filemanip.cabal +++ b/filemanip.cabal @@ -1,5 +1,5 @@ Name: filemanip -Version: 0.4.0.0 +Version: 0.3.5.0 License: BSD3 License-File: LICENSE Author: Bryan O'Sullivan @@ -15,12 +15,16 @@ Build-type: Simple Extra-Source-Files: README.markdown 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 Exposed-Modules: System.FilePath.Find, System.FilePath.Glob, System.FilePath.GlobPattern, System.FilePath.Manip - Other-Modules: - System.FilePath.Error