module Codec.Archive.Internal.Monad ( handle
, ignore
, lenient
, runArchiveM
, throwArchiveM
, withCStringArchiveM
, useAsCStringLenArchiveM
, allocaBytesArchiveM
, ArchiveM
) where
import Codec.Archive.Types
import Control.Exception (throw)
import Control.Monad (void)
import Control.Monad.Except (ExceptT, runExceptT, throwError)
import Control.Monad.IO.Class
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS
import Foreign.C.String
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (Ptr)
type ArchiveM = ExceptT ArchiveResult IO
ignore :: IO ArchiveResult -> ArchiveM ()
ignore :: IO ArchiveResult -> ArchiveM ()
ignore = ExceptT ArchiveResult IO ArchiveResult -> ArchiveM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT ArchiveResult IO ArchiveResult -> ArchiveM ())
-> (IO ArchiveResult -> ExceptT ArchiveResult IO ArchiveResult)
-> IO ArchiveResult
-> ArchiveM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ArchiveResult -> ExceptT ArchiveResult IO ArchiveResult
forall a. IO a -> ExceptT ArchiveResult IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
throwArchiveM :: ArchiveM a -> IO a
throwArchiveM :: forall a. ArchiveM a -> IO a
throwArchiveM = (Either ArchiveResult a -> a)
-> IO (Either ArchiveResult a) -> IO a
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ArchiveResult -> a) -> (a -> a) -> Either ArchiveResult a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ArchiveResult -> a
forall a e. Exception e => e -> a
throw a -> a
forall a. a -> a
id) (IO (Either ArchiveResult a) -> IO a)
-> (ArchiveM a -> IO (Either ArchiveResult a))
-> ArchiveM a
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArchiveM a -> IO (Either ArchiveResult a)
forall a. ArchiveM a -> IO (Either ArchiveResult a)
runArchiveM
runArchiveM :: ArchiveM a -> IO (Either ArchiveResult a)
runArchiveM :: forall a. ArchiveM a -> IO (Either ArchiveResult a)
runArchiveM = ExceptT ArchiveResult IO a -> IO (Either ArchiveResult a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
lenient :: IO ArchiveResult -> ArchiveM ()
lenient :: IO ArchiveResult -> ArchiveM ()
lenient IO ArchiveResult
act = do
ArchiveResult
res <- IO ArchiveResult -> ExceptT ArchiveResult IO ArchiveResult
forall a. IO a -> ExceptT ArchiveResult IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ArchiveResult
act
case ArchiveResult
res of
ArchiveResult
ArchiveFatal -> ArchiveResult -> ArchiveM ()
forall a e. Exception e => e -> a
throw ArchiveResult
res
ArchiveResult
ArchiveEOF -> ArchiveResult -> ArchiveM ()
forall a e. Exception e => e -> a
throw ArchiveResult
res
ArchiveResult
_ -> () -> ArchiveM ()
forall a. a -> ExceptT ArchiveResult IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
handle :: IO ArchiveResult -> ArchiveM ()
handle :: IO ArchiveResult -> ArchiveM ()
handle IO ArchiveResult
act = do
ArchiveResult
res <- IO ArchiveResult -> ExceptT ArchiveResult IO ArchiveResult
forall a. IO a -> ExceptT ArchiveResult IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ArchiveResult
act
case ArchiveResult
res of
ArchiveResult
ArchiveOk -> () -> ArchiveM ()
forall a. a -> ExceptT ArchiveResult IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ArchiveResult
ArchiveRetry -> () -> ArchiveM ()
forall a. a -> ExceptT ArchiveResult IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ArchiveResult
x -> ArchiveResult -> ArchiveM ()
forall a. ArchiveResult -> ExceptT ArchiveResult IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ArchiveResult
x
flipExceptIO :: IO (Either a b) -> ExceptT a IO b
flipExceptIO :: forall a b. IO (Either a b) -> ExceptT a IO b
flipExceptIO IO (Either a b)
act = do
Either a b
res <- IO (Either a b) -> ExceptT a IO (Either a b)
forall a. IO a -> ExceptT a IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Either a b)
act
case Either a b
res of
Right b
x -> b -> ExceptT a IO b
forall a. a -> ExceptT a IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
x
Left a
y -> a -> ExceptT a IO b
forall a. a -> ExceptT a IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError a
y
genBracket :: (a -> (b -> IO (Either c d)) -> IO (Either c d))
-> a
-> (b -> ExceptT c IO d)
-> ExceptT c IO d
genBracket :: forall a b c d.
(a -> (b -> IO (Either c d)) -> IO (Either c d))
-> a -> (b -> ExceptT c IO d) -> ExceptT c IO d
genBracket a -> (b -> IO (Either c d)) -> IO (Either c d)
f a
x = IO (Either c d) -> ExceptT c IO d
forall a b. IO (Either a b) -> ExceptT a IO b
flipExceptIO (IO (Either c d) -> ExceptT c IO d)
-> ((b -> ExceptT c IO d) -> IO (Either c d))
-> (b -> ExceptT c IO d)
-> ExceptT c IO d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b -> IO (Either c d)) -> IO (Either c d)
f a
x ((b -> IO (Either c d)) -> IO (Either c d))
-> ((b -> ExceptT c IO d) -> b -> IO (Either c d))
-> (b -> ExceptT c IO d)
-> IO (Either c d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExceptT c IO d -> IO (Either c d)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT c IO d -> IO (Either c d))
-> (b -> ExceptT c IO d) -> b -> IO (Either c d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
allocaBytesArchiveM :: Int -> (Ptr a -> ExceptT b IO c) -> ExceptT b IO c
allocaBytesArchiveM :: forall a b c. Int -> (Ptr a -> ExceptT b IO c) -> ExceptT b IO c
allocaBytesArchiveM = (Int -> (Ptr a -> IO (Either b c)) -> IO (Either b c))
-> Int -> (Ptr a -> ExceptT b IO c) -> ExceptT b IO c
forall a b c d.
(a -> (b -> IO (Either c d)) -> IO (Either c d))
-> a -> (b -> ExceptT c IO d) -> ExceptT c IO d
genBracket Int -> (Ptr a -> IO (Either b c)) -> IO (Either b c)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes
withCStringArchiveM :: String -> (CString -> ExceptT a IO b) -> ExceptT a IO b
withCStringArchiveM :: forall a b. String -> (CString -> ExceptT a IO b) -> ExceptT a IO b
withCStringArchiveM = (String -> (CString -> IO (Either a b)) -> IO (Either a b))
-> String -> (CString -> ExceptT a IO b) -> ExceptT a IO b
forall a b c d.
(a -> (b -> IO (Either c d)) -> IO (Either c d))
-> a -> (b -> ExceptT c IO d) -> ExceptT c IO d
genBracket String -> (CString -> IO (Either a b)) -> IO (Either a b)
forall a. String -> (CString -> IO a) -> IO a
withCString
useAsCStringLenArchiveM :: BS.ByteString -> (CStringLen -> ExceptT a IO b) -> ExceptT a IO b
useAsCStringLenArchiveM :: forall a b.
ByteString -> (CStringLen -> ExceptT a IO b) -> ExceptT a IO b
useAsCStringLenArchiveM = (ByteString -> (CStringLen -> IO (Either a b)) -> IO (Either a b))
-> ByteString -> (CStringLen -> ExceptT a IO b) -> ExceptT a IO b
forall a b c d.
(a -> (b -> IO (Either c d)) -> IO (Either c d))
-> a -> (b -> ExceptT c IO d) -> ExceptT c IO d
genBracket ByteString -> (CStringLen -> IO (Either a b)) -> IO (Either a b)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.unsafeUseAsCStringLen