{-# LANGUAGE OverloadedStrings #-}

module Network.AMQP.Worker.Queue where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Text (Text)
import Network.AMQP (ExchangeOpts (..), QueueOpts (..))
import qualified Network.AMQP as AMQP

import Network.AMQP.Worker.Connection (Connection, exchange, withChannel)
import Network.AMQP.Worker.Key (Binding, Key (..), KeySegment, Routing, bindingKey, keyText)

-- | Declare a direct queue, which will receive messages published with the exact same routing key
--
-- > newUsers :: Queue User
-- > newUsers = Worker.direct (key "users" & word "new")
direct :: Key Routing msg -> Queue msg
direct :: forall msg. Key Routing msg -> Queue msg
direct Key Routing msg
key = forall msg. Key Binding msg -> QueueName -> Queue msg
Queue (forall a msg. KeySegment a => Key a msg -> Key Binding msg
bindingKey Key Routing msg
key) (forall a msg. KeySegment a => Key a msg -> QueueName
keyText Key Routing msg
key)

-- | Declare a topic queue, which will receive messages that match using wildcards
--
-- > anyUsers :: Queue User
-- > anyUsers = Worker.topic "anyUsers" (key "users" & star)
topic :: KeySegment a => Key a msg -> QueueName -> Queue msg
topic :: forall a msg. KeySegment a => Key a msg -> QueueName -> Queue msg
topic Key a msg
key QueueName
name = forall msg. Key Binding msg -> QueueName -> Queue msg
Queue (forall a msg. KeySegment a => Key a msg -> Key Binding msg
bindingKey Key a msg
key) QueueName
name

type QueueName = Text

data Queue msg
    = Queue (Key Binding msg) QueueName
    deriving (Int -> Queue msg -> ShowS
forall msg. Int -> Queue msg -> ShowS
forall msg. [Queue msg] -> ShowS
forall msg. Queue msg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Queue msg] -> ShowS
$cshowList :: forall msg. [Queue msg] -> ShowS
show :: Queue msg -> String
$cshow :: forall msg. Queue msg -> String
showsPrec :: Int -> Queue msg -> ShowS
$cshowsPrec :: forall msg. Int -> Queue msg -> ShowS
Show, Queue msg -> Queue msg -> Bool
forall msg. Queue msg -> Queue msg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Queue msg -> Queue msg -> Bool
$c/= :: forall msg. Queue msg -> Queue msg -> Bool
== :: Queue msg -> Queue msg -> Bool
$c== :: forall msg. Queue msg -> Queue msg -> Bool
Eq)

-- | Queues must be bound before you publish messages to them, or the messages will not be saved.
--
-- > let queue = Worker.direct (key "users" & word "new") :: Queue User
-- > conn <- Worker.connect (fromURI "amqp://guest:guest@localhost:5672")
-- > Worker.bindQueue conn queue
bindQueue :: (MonadIO m) => Connection -> Queue msg -> m ()
bindQueue :: forall (m :: * -> *) msg.
MonadIO m =>
Connection -> Queue msg -> m ()
bindQueue Connection
conn (Queue Key Binding msg
key QueueName
name) =
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall b. Connection -> (Channel -> IO b) -> IO b
withChannel Connection
conn forall a b. (a -> b) -> a -> b
$ \Channel
chan -> do
        let options :: QueueOpts
options = QueueOpts
AMQP.newQueue{queueName :: QueueName
queueName = QueueName
name}
        let exg :: ExchangeOpts
exg = ExchangeOpts
AMQP.newExchange{exchangeName :: QueueName
exchangeName = (Connection -> QueueName
exchange Connection
conn), exchangeType :: QueueName
exchangeType = QueueName
"topic"}
        ()
_ <- Channel -> ExchangeOpts -> IO ()
AMQP.declareExchange Channel
chan ExchangeOpts
exg
        (QueueName, Int, Int)
_ <- Channel -> QueueOpts -> IO (QueueName, Int, Int)
AMQP.declareQueue Channel
chan QueueOpts
options
        ()
_ <- Channel -> QueueName -> QueueName -> QueueName -> IO ()
AMQP.bindQueue Channel
chan QueueName
name (Connection -> QueueName
exchange Connection
conn) (forall a msg. KeySegment a => Key a msg -> QueueName
keyText Key Binding msg
key)
        forall (m :: * -> *) a. Monad m => a -> m a
return ()