module HaskellWorks.Aws.Sqs.Conduit
  ( sqsSink
  , sqsSource
  ) where

import Control.Monad.IO.Class
import Control.Monad.Trans            (lift)
import Data.Conduit
import Data.Text
import Network.AWS                    hiding (await, response)
import Network.AWS.SQS.ReceiveMessage
import Network.AWS.SQS.SendMessage

import qualified Network.AWS as AWS

sqsSink :: MonadAWS m => SendMessage -> Conduit Text m SendMessageResponse
sqsSink :: SendMessage -> Conduit Text m SendMessageResponse
sqsSink SendMessage
sendMessage = do
  Maybe Text
maybeM <- ConduitT Text SendMessageResponse m (Maybe Text)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
  case Maybe Text
maybeM of
    Just Text
m -> do
      SendMessageResponse
resp <- m SendMessageResponse
-> ConduitT Text SendMessageResponse m SendMessageResponse
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m SendMessageResponse
 -> ConduitT Text SendMessageResponse m SendMessageResponse)
-> m SendMessageResponse
-> ConduitT Text SendMessageResponse m SendMessageResponse
forall a b. (a -> b) -> a -> b
$ SendMessage -> m (Rs SendMessage)
forall (m :: * -> *) a. (MonadAWS m, AWSRequest a) => a -> m (Rs a)
send SendMessage
sendMessage
      SendMessageResponse -> Conduit Text m SendMessageResponse
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield SendMessageResponse
resp
      SendMessage -> Conduit Text m SendMessageResponse
forall (m :: * -> *).
MonadAWS m =>
SendMessage -> Conduit Text m SendMessageResponse
sqsSink SendMessage
sendMessage
    Maybe Text
Nothing -> () -> Conduit Text m SendMessageResponse
forall (m :: * -> *) a. Monad m => a -> m a
return ()

sqsSource :: MonadAWS m => ReceiveMessage -> Source m ReceiveMessageResponse
sqsSource :: ReceiveMessage -> Source m ReceiveMessageResponse
sqsSource ReceiveMessage
receiveMessage = do
  ReceiveMessageResponse
m <- m ReceiveMessageResponse
-> ConduitT () ReceiveMessageResponse m ReceiveMessageResponse
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ReceiveMessageResponse
 -> ConduitT () ReceiveMessageResponse m ReceiveMessageResponse)
-> m ReceiveMessageResponse
-> ConduitT () ReceiveMessageResponse m ReceiveMessageResponse
forall a b. (a -> b) -> a -> b
$ ReceiveMessage -> m (Rs ReceiveMessage)
forall (m :: * -> *) a. (MonadAWS m, AWSRequest a) => a -> m (Rs a)
send ReceiveMessage
receiveMessage
  ReceiveMessageResponse -> Source m ReceiveMessageResponse
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ReceiveMessageResponse
m
  ReceiveMessage -> Source m ReceiveMessageResponse
forall (m :: * -> *).
MonadAWS m =>
ReceiveMessage -> Source m ReceiveMessageResponse
sqsSource ReceiveMessage
receiveMessage