diff options
Diffstat (limited to 'Utility')
-rw-r--r-- | Utility/Directory.hs | 3 | ||||
-rw-r--r-- | Utility/Exception.hs | 28 | ||||
-rw-r--r-- | Utility/FileMode.hs | 1 | ||||
-rw-r--r-- | Utility/Gpg.hs | 1 | ||||
-rw-r--r-- | Utility/Matcher.hs | 8 | ||||
-rw-r--r-- | Utility/Parallel.hs | 1 | ||||
-rw-r--r-- | Utility/Tmp.hs | 15 | ||||
-rw-r--r-- | Utility/Url.hs | 8 | ||||
-rw-r--r-- | Utility/WebApp.hs | 4 |
9 files changed, 40 insertions, 29 deletions
diff --git a/Utility/Directory.hs b/Utility/Directory.hs index ade5ef811..a4429d5b9 100644 --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -11,7 +11,6 @@ module Utility.Directory where import System.IO.Error import System.Directory -import Control.Exception (throw, bracket) import Control.Monad import Control.Monad.IfElse import System.FilePath @@ -114,7 +113,7 @@ moveFile src dest = tryIO (rename src dest) >>= onrename whenM (isdir dest) rethrow viaTmp mv dest undefined where - rethrow = throw e + rethrow = throwM e mv tmp _ = do ok <- boolSystem "mv" [Param "-f", Param src, Param tmp] unless ok $ do diff --git a/Utility/Exception.hs b/Utility/Exception.hs index 13c9d508a..802e9e24b 100644 --- a/Utility/Exception.hs +++ b/Utility/Exception.hs @@ -7,11 +7,25 @@ {-# LANGUAGE ScopedTypeVariables #-} -module Utility.Exception where +module Utility.Exception ( + module X, + catchBoolIO, + catchMaybeIO, + catchDefaultIO, + catchMsgIO, + catchIO, + tryIO, + bracketIO, + catchNonAsync, + tryNonAsync, + tryWhenExists, +) where +import Control.Monad.Catch as X hiding (Handler) +import qualified Control.Monad.Catch as M import Control.Exception (IOException, AsyncException) -import Control.Monad.Catch import Control.Monad +import Control.Monad.IO.Class (liftIO, MonadIO) import System.IO.Error (isDoesNotExistError) import Utility.Data @@ -44,14 +58,20 @@ catchIO = catch tryIO :: MonadCatch m => m a -> m (Either IOException a) tryIO = try +{- bracket with setup and cleanup actions lifted to IO. + - + - Note that unlike catchIO and tryIO, this catches all exceptions. -} +bracketIO :: (MonadMask m, MonadIO m) => IO v -> (v -> IO b) -> (v -> m a) -> m a +bracketIO setup cleanup = bracket (liftIO setup) (liftIO . cleanup) + {- Catches all exceptions except for async exceptions. - This is often better to use than catching them all, so that - ThreadKilled and UserInterrupt get through. -} catchNonAsync :: MonadCatch m => m a -> (SomeException -> m a) -> m a catchNonAsync a onerr = a `catches` - [ Handler (\ (e :: AsyncException) -> throwM e) - , Handler (\ (e :: SomeException) -> onerr e) + [ M.Handler (\ (e :: AsyncException) -> throwM e) + , M.Handler (\ (e :: SomeException) -> onerr e) ] tryNonAsync :: MonadCatch m => m a -> m (Either SomeException a) diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs index c2ef683a8..832250bde 100644 --- a/Utility/FileMode.hs +++ b/Utility/FileMode.hs @@ -11,7 +11,6 @@ module Utility.FileMode where import System.IO import Control.Monad -import Control.Exception (bracket) import System.PosixCompat.Types import Utility.PosixFiles #ifndef mingw32_HOST_OS diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs index 410259b11..dfca82778 100644 --- a/Utility/Gpg.hs +++ b/Utility/Gpg.hs @@ -13,7 +13,6 @@ import Control.Applicative import Control.Concurrent import Control.Monad.IO.Class import qualified Data.Map as M -import Control.Monad.Catch (bracket, MonadMask) import Common import qualified Build.SysConfig as SysConfig diff --git a/Utility/Matcher.hs b/Utility/Matcher.hs index 1ee224ffc..76f8903f5 100644 --- a/Utility/Matcher.hs +++ b/Utility/Matcher.hs @@ -102,13 +102,13 @@ findClose l = in (Group (reverse g), rest) where go c [] = (c, []) -- not picky about extra Close - go c (t:ts) = handle t + go c (t:ts) = dispatch t where - handle Close = (c, ts) - handle Open = + dispatch Close = (c, ts) + dispatch Open = let (c', ts') = go [] ts in go (Group (reverse c') : c) ts' - handle _ = go (One t:c) ts + dispatch _ = go (One t:c) ts {- Checks if a Matcher matches, using a supplied function to check - the value of Operations. -} diff --git a/Utility/Parallel.hs b/Utility/Parallel.hs index 239c81e7b..7966811ab 100644 --- a/Utility/Parallel.hs +++ b/Utility/Parallel.hs @@ -10,7 +10,6 @@ module Utility.Parallel where import Common import Control.Concurrent -import Control.Exception {- Runs an action in parallel with a set of values, in a set of threads. - In order for the actions to truely run in parallel, requires GHC's diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs index 7da5cc284..edd82f5ac 100644 --- a/Utility/Tmp.hs +++ b/Utility/Tmp.hs @@ -14,7 +14,6 @@ import System.Directory import Control.Monad.IfElse import System.FilePath import Control.Monad.IO.Class -import Control.Monad.Catch (bracket, MonadMask) import Utility.Exception import Utility.FileSystemEncoding @@ -33,11 +32,11 @@ viaTmp a file content = bracket setup cleanup use setup = do createDirectoryIfMissing True dir openTempFile dir template - cleanup (tmpfile, handle) = do - _ <- tryIO $ hClose handle + cleanup (tmpfile, h) = do + _ <- tryIO $ hClose h tryIO $ removeFile tmpfile - use (tmpfile, handle) = do - hClose handle + use (tmpfile, h) = do + hClose h a tmpfile content rename tmpfile file @@ -54,10 +53,10 @@ withTmpFileIn :: (MonadIO m, MonadMask m) => FilePath -> Template -> (FilePath - withTmpFileIn tmpdir template a = bracket create remove use where create = liftIO $ openTempFile tmpdir template - remove (name, handle) = liftIO $ do - hClose handle + remove (name, h) = liftIO $ do + hClose h catchBoolIO (removeFile name >> return True) - use (name, handle) = a name handle + use (name, h) = a name h {- Runs an action with a tmp directory located within the system's tmp - directory (or within "." if there is none), then removes the tmp diff --git a/Utility/Url.hs b/Utility/Url.hs index bf2d3859c..4137a5d8b 100644 --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -51,11 +51,11 @@ checkBoth url expected_size uo = do v <- check url expected_size uo return (fst v && snd v) check :: URLString -> Maybe Integer -> UrlOptions -> IO (Bool, Bool) -check url expected_size = handle <$$> exists url +check url expected_size = go <$$> exists url where - handle (False, _) = (False, False) - handle (True, Nothing) = (True, True) - handle (True, s) = case expected_size of + go (False, _) = (False, False) + go (True, Nothing) = (True, True) + go (True, s) = case expected_size of Just _ -> (True, expected_size == s) Nothing -> (True, True) diff --git a/Utility/WebApp.hs b/Utility/WebApp.hs index 0f3378a15..6bcfce919 100644 --- a/Utility/WebApp.hs +++ b/Utility/WebApp.hs @@ -38,10 +38,6 @@ import Data.Byteable #ifdef __ANDROID__ import Data.Endian #endif -#if defined(__ANDROID__) || defined (mingw32_HOST_OS) -#else -import Control.Exception (bracketOnError) -#endif localhost :: HostName localhost = "localhost" |