38d691a10f
Running git-annex linux builds in termux seems to work well enough that the only reason to keep the Android app would be to support Android 4-5, which the old Android app supported, and which I don't know if the termux method works on (although I see no reason why it would not). According to [1], Android 4-5 remains on around 29% of devices, down from 51% one year ago. [1] https://www.statista.com/statistics/271774/share-of-android-platforms-on-mobile-devices-with-android-os/ This is a rather large commit, but mostly very straightfoward removal of android ifdefs and patches and associated cruft. Also, removed support for building with very old ghc < 8.0.1, and with yesod < 1.4.3, and without concurrent-output, which were only being used by the cross build. Some documentation specific to the Android app (screenshots etc) needs to be updated still. This commit was sponsored by Brett Eisenberg on Patreon.
113 lines
3.5 KiB
Haskell
113 lines
3.5 KiB
Haskell
{- Simple IO exception handling (and some more)
|
|
-
|
|
- Copyright 2011-2016 Joey Hess <id@joeyh.name>
|
|
-
|
|
- License: BSD-2-clause
|
|
-}
|
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# OPTIONS_GHC -fno-warn-tabs #-}
|
|
|
|
module Utility.Exception (
|
|
module X,
|
|
giveup,
|
|
catchBoolIO,
|
|
catchMaybeIO,
|
|
catchDefaultIO,
|
|
catchMsgIO,
|
|
catchIO,
|
|
tryIO,
|
|
bracketIO,
|
|
catchNonAsync,
|
|
tryNonAsync,
|
|
tryWhenExists,
|
|
catchIOErrorType,
|
|
IOErrorType(..),
|
|
catchPermissionDenied,
|
|
) where
|
|
|
|
import Control.Monad.Catch as X hiding (Handler)
|
|
import qualified Control.Monad.Catch as M
|
|
import Control.Exception (IOException, AsyncException)
|
|
import Control.Exception (SomeAsyncException)
|
|
import Control.Monad
|
|
import Control.Monad.IO.Class (liftIO, MonadIO)
|
|
import System.IO.Error (isDoesNotExistError, ioeGetErrorType)
|
|
import GHC.IO.Exception (IOErrorType(..))
|
|
|
|
import Utility.Data
|
|
|
|
{- Like error, this throws an exception. Unlike error, if this exception
|
|
- is not caught, it won't generate a backtrace. So use this for situations
|
|
- where there's a problem that the user is excpected to see in some
|
|
- circumstances. -}
|
|
giveup :: [Char] -> a
|
|
giveup = errorWithoutStackTrace
|
|
|
|
{- Catches IO errors and returns a Bool -}
|
|
catchBoolIO :: MonadCatch m => m Bool -> m Bool
|
|
catchBoolIO = catchDefaultIO False
|
|
|
|
{- Catches IO errors and returns a Maybe -}
|
|
catchMaybeIO :: MonadCatch m => m a -> m (Maybe a)
|
|
catchMaybeIO a = catchDefaultIO Nothing $ a >>= (return . Just)
|
|
|
|
{- Catches IO errors and returns a default value. -}
|
|
catchDefaultIO :: MonadCatch m => a -> m a -> m a
|
|
catchDefaultIO def a = catchIO a (const $ return def)
|
|
|
|
{- Catches IO errors and returns the error message. -}
|
|
catchMsgIO :: MonadCatch m => m a -> m (Either String a)
|
|
catchMsgIO a = do
|
|
v <- tryIO a
|
|
return $ either (Left . show) Right v
|
|
|
|
{- catch specialized for IO errors only -}
|
|
catchIO :: MonadCatch m => m a -> (IOException -> m a) -> m a
|
|
catchIO = M.catch
|
|
|
|
{- try specialized for IO errors only -}
|
|
tryIO :: MonadCatch m => m a -> m (Either IOException a)
|
|
tryIO = M.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`
|
|
[ M.Handler (\ (e :: AsyncException) -> throwM e)
|
|
, M.Handler (\ (e :: SomeAsyncException) -> throwM e)
|
|
, M.Handler (\ (e :: SomeException) -> onerr e)
|
|
]
|
|
|
|
tryNonAsync :: MonadCatch m => m a -> m (Either SomeException a)
|
|
tryNonAsync a = go `catchNonAsync` (return . Left)
|
|
where
|
|
go = do
|
|
v <- a
|
|
return (Right v)
|
|
|
|
{- Catches only DoesNotExist exceptions, and lets all others through. -}
|
|
tryWhenExists :: MonadCatch m => m a -> m (Maybe a)
|
|
tryWhenExists a = do
|
|
v <- tryJust (guard . isDoesNotExistError) a
|
|
return (eitherToMaybe v)
|
|
|
|
{- Catches only IO exceptions of a particular type.
|
|
- Ie, use HardwareFault to catch disk IO errors. -}
|
|
catchIOErrorType :: MonadCatch m => IOErrorType -> (IOException -> m a) -> m a -> m a
|
|
catchIOErrorType errtype onmatchingerr a = catchIO a onlymatching
|
|
where
|
|
onlymatching e
|
|
| ioeGetErrorType e == errtype = onmatchingerr e
|
|
| otherwise = throwM e
|
|
|
|
catchPermissionDenied :: MonadCatch m => (IOException -> m a) -> m a -> m a
|
|
catchPermissionDenied = catchIOErrorType PermissionDenied
|