module Amazon.SNS.Verify.Prelude
  ( module X
  , module Amazon.SNS.Verify.Prelude
  ) where

import Prelude as X

import Control.Error (ExceptT, throwE)
import Control.Exception as X (Exception)
import qualified Control.Exception
import Control.Monad as X (join, (<=<))
import Control.Monad.IO.Class as X (MonadIO, liftIO)
import Data.ByteString as X (ByteString)
import Data.Text as X (Text)
import Data.Traversable as X (for)

throwIO :: (MonadIO m, Exception e) => e -> m a
throwIO :: e -> m a
throwIO = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (e -> IO a) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> IO a
forall e a. Exception e => e -> IO a
Control.Exception.throwIO

unTryIO :: (MonadIO m, Exception e) => (a -> e) -> Either a b -> m b
unTryIO :: (a -> e) -> Either a b -> m b
unTryIO a -> e
e = (a -> m b) -> (b -> m b) -> Either a b -> m b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e -> m b
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (e -> m b) -> (a -> e) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> e
e) b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure

unTryE :: (Monad m) => (a -> e) -> Either a b -> ExceptT e m b
unTryE :: (a -> e) -> Either a b -> ExceptT e m b
unTryE a -> e
e = (a -> ExceptT e m b)
-> (b -> ExceptT e m b) -> Either a b -> ExceptT e m b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e -> ExceptT e m b
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (e -> ExceptT e m b) -> (a -> e) -> a -> ExceptT e m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> e
e) b -> ExceptT e m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure

fromMaybeM :: Monad m => m a -> Maybe a -> m a
fromMaybeM :: m a -> Maybe a -> m a
fromMaybeM m a
f = m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a
f a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure