module Codec.Archive.Monad ( handle
, ignore
, runArchiveM
, withCStringArchiveM
, useAsCStringLenArchiveM
, allocaBytesArchiveM
, bracketM
, ArchiveM
) where
import Codec.Archive.Types
import Control.Exception (bracket)
import Control.Monad (void)
import Control.Monad.Except (ExceptT, runExceptT, throwError)
import Control.Monad.IO.Class
import Data.ByteString (useAsCStringLen)
import qualified Data.ByteString 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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
runArchiveM :: ArchiveM a -> IO (Either ArchiveResult a)
runArchiveM :: ArchiveM a -> IO (Either ArchiveResult a)
runArchiveM = ArchiveM a -> IO (Either ArchiveResult a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
handle :: IO ArchiveResult -> ArchiveM ()
handle :: IO ArchiveResult -> ArchiveM ()
handle act :: IO ArchiveResult
act = do
ArchiveResult
res <- IO ArchiveResult -> ExceptT ArchiveResult IO ArchiveResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ArchiveResult
act
case ArchiveResult
res of
ArchiveOk -> () -> ArchiveM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ArchiveRetry -> () -> ArchiveM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
x :: ArchiveResult
x -> ArchiveResult -> ArchiveM ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ArchiveResult
x
flipExceptIO :: IO (Either a b) -> ExceptT a IO b
flipExceptIO :: IO (Either a b) -> ExceptT a IO b
flipExceptIO act :: IO (Either a b)
act = do
Either a b
res <- IO (Either a b) -> ExceptT a IO (Either a b)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Either a b)
act
case Either a b
res of
Right x :: b
x -> b -> ExceptT a IO b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
x
Left y :: a
y -> a -> ExceptT a IO b
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 :: (a -> (b -> IO (Either c d)) -> IO (Either c d))
-> a -> (b -> ExceptT c IO d) -> ExceptT c IO d
genBracket f :: a -> (b -> IO (Either c d)) -> IO (Either c d)
f x :: 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 :: 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 :: 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 :: 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
useAsCStringLen
bracketM :: IO a
-> (a -> IO b)
-> (a -> ArchiveM c)
-> ArchiveM c
bracketM :: IO a -> (a -> IO b) -> (a -> ArchiveM c) -> ArchiveM c
bracketM get :: IO a
get free :: a -> IO b
free act :: a -> ArchiveM c
act =
IO (Either ArchiveResult c) -> ArchiveM c
forall a b. IO (Either a b) -> ExceptT a IO b
flipExceptIO (IO (Either ArchiveResult c) -> ArchiveM c)
-> IO (Either ArchiveResult c) -> ArchiveM c
forall a b. (a -> b) -> a -> b
$
IO a
-> (a -> IO b)
-> (a -> IO (Either ArchiveResult c))
-> IO (Either ArchiveResult c)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO a
get a -> IO b
free (ArchiveM c -> IO (Either ArchiveResult c)
forall a. ArchiveM a -> IO (Either ArchiveResult a)
runArchiveM(ArchiveM c -> IO (Either ArchiveResult c))
-> (a -> ArchiveM c) -> a -> IO (Either ArchiveResult c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> ArchiveM c
act)