{-# LANGUAGE FlexibleContexts #-}

module Network.AMQP.Lifted
       ( consumeMsgs
       , consumeMsgs'
       )
       where

import qualified Network.AMQP as A
import Network.AMQP.Types
import Control.Monad.Trans.Control
import Data.Text (Text)
import Control.Monad

-- | Lifted version of 'Network.AMQP.consumeMsgs' (please look there for documentation).

--

-- In addition, while the callback function @(('Message', 'Envelope') -> m ())@

-- has access to the captured state, all its side-effects in m are discarded.

consumeMsgs :: MonadBaseControl IO m
            => A.Channel
            -> Text -- ^ Specifies the name of the queue to consume from.

            -> A.Ack
            -> ((A.Message, A.Envelope) -> m ())
            -> m A.ConsumerTag
consumeMsgs :: Channel -> Text -> Ack -> ((Message, Envelope) -> m ()) -> m Text
consumeMsgs Channel
chan Text
queueName Ack
ack (Message, Envelope) -> m ()
callback =
    (RunInBase m IO -> IO Text) -> m Text
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith ((RunInBase m IO -> IO Text) -> m Text)
-> (RunInBase m IO -> IO Text) -> m Text
forall a b. (a -> b) -> a -> b
$ \RunInBase m IO
runInIO ->
        Channel -> Text -> Ack -> ((Message, Envelope) -> IO ()) -> IO Text
A.consumeMsgs Channel
chan Text
queueName Ack
ack (IO (StM m ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (StM m ()) -> IO ())
-> ((Message, Envelope) -> IO (StM m ()))
-> (Message, Envelope)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> IO (StM m ())
RunInBase m IO
runInIO (m () -> IO (StM m ()))
-> ((Message, Envelope) -> m ())
-> (Message, Envelope)
-> IO (StM m ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Message, Envelope) -> m ()
callback)

-- | an extended version of @consumeMsgs@ that allows you to define a consumer cancellation callback and include arbitrary arguments.

consumeMsgs' :: MonadBaseControl IO m
             => A.Channel
             -> Text -- ^ Specifies the name of the queue to consume from.

             -> A.Ack
             -> ((A.Message, A.Envelope) -> m ())
             -> (ConsumerTag -> m ())
             -> FieldTable
             -> m A.ConsumerTag
consumeMsgs' :: Channel
-> Text
-> Ack
-> ((Message, Envelope) -> m ())
-> (Text -> m ())
-> FieldTable
-> m Text
consumeMsgs' Channel
chan Text
queueName Ack
ack (Message, Envelope) -> m ()
callback Text -> m ()
cancelled FieldTable
args =
    (RunInBase m IO -> IO Text) -> m Text
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith ((RunInBase m IO -> IO Text) -> m Text)
-> (RunInBase m IO -> IO Text) -> m Text
forall a b. (a -> b) -> a -> b
$ \RunInBase m IO
runInIO ->
        Channel
-> Text
-> Ack
-> ((Message, Envelope) -> IO ())
-> (Text -> IO ())
-> FieldTable
-> IO Text
A.consumeMsgs' Channel
chan Text
queueName Ack
ack (IO (StM m ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (StM m ()) -> IO ())
-> ((Message, Envelope) -> IO (StM m ()))
-> (Message, Envelope)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> IO (StM m ())
RunInBase m IO
runInIO (m () -> IO (StM m ()))
-> ((Message, Envelope) -> m ())
-> (Message, Envelope)
-> IO (StM m ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Message, Envelope) -> m ()
callback) (IO (StM m ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (StM m ()) -> IO ())
-> (Text -> IO (StM m ())) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> IO (StM m ())
RunInBase m IO
runInIO (m () -> IO (StM m ())) -> (Text -> m ()) -> Text -> IO (StM m ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m ()
cancelled) FieldTable
args