Get things building again
This commit is contained in:
parent
9a21d9a8dc
commit
76491aebb1
5 changed files with 34 additions and 71 deletions
|
@ -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
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue