snaplet-amqp 0.1.3.1 → 1.0.0.0

raw patch · 3 files changed

+83/−40 lines, 3 filesdep +bytestringdep +lensdep +resource-poolPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, lens, resource-pool

API changes (from Hackage documentation)

Files

• README.org +53/−14
• snaplet-amqp.cabal +4/−1
• src/Snap/Snaplet/AMQP.hs +26/−25

@@ -1,32 +1,71 @@ * Welcome!+  [[https://hackage.haskell.org/package/snaplet-amqp][https://img.shields.io/hackage/v/snaplet-amqp.svg?style=flat]]+  [[https://travis-ci.org/ixmatus/snaplet-amqp][https://travis-ci.org/ixmatus/snaplet-amqp.svg?branch=master]]+     =snaplet-amqp= provides a convenience interface to the Haskell AMQP   package.    #+BEGIN_SRC+  {-# LANGUAGE FlexibleInstances #-}+  {-# LANGUAGE OverloadedStrings #-}+  {-# LANGUAGE RecordWildCards   #-}+  {-# LANGUAGE TemplateHaskell   #-}++  module Main where++  ------------------------------------------------------------------------------   import           Control.Lens+  import           Data.ByteString.Char8 as C8+  import           Network.AMQP   import           Snap-  import           Snap.Snaplet   import           Snap.Snaplet.AMQP-  import Network.AMQP +  ------------------------------------------------------------------------------   data App = App-      { _amqp    :: Snaplet AmqpState }+      { _amqp :: Snaplet AmqpState+      }    makeLenses ''App -  instance HasAmqpConn (Handler b App) where-      getAmqpConn = with amqp getAmqpConn+  instance HasAmqpPool (Handler b App) where+      getAmqpPool = with amqp getAmqpPool +  ------------------------------------------------------------------------------+  -- | The application's routes.+  routes :: [(ByteString, Handler App App ())]+  routes = [ ("/"   , writeText "hello")+           , ("test", fooHandler)+           ]++  fooHandler :: Handler App App ()+  fooHandler = do+      let serverQueue = "myQueue"+          exchange'   = "myExchange"+          routingKey  = "myKey"++      _ <- runAmqp $ \(_, chan) -> do+          _ <- declareQueue chan newQueue {queueName = serverQueue}++          declareExchange chan newExchange { exchangeName = exchange'+                                           , exchangeType = "headers"+                                           }+          bindQueue chan serverQueue exchange' routingKey++          publishMsg chan exchange' routingKey+              newMsg {msgBody = "AMQP Snaplet!",+                      msgDeliveryMode = Just Persistent}++      modifyResponse $ setResponseCode 204+++  ------------------------------------------------------------------------------+  -- | The application initializer.   app :: SnapletInit App App   app = makeSnaplet "app" "An snaplet example application." Nothing $ do-      a <- nestSnaplet "amqp" amqp initAMQP-      addRoutes appRoutes -- Your routes, I haven't defined any here-      return $ App a--  handler = do-      runAmqp \(_, chan) -> do-        declareQueue chan newQueue {queueName = "myQueue"}-        declareExchange chan newExchange {exchangeName = "myExchange", exchangeType = "direct"}-        bindQueue chan "myQueue" "myExchange" "myKey"+      m <- nestSnaplet "amqp" amqp $ initAMQP+      addRoutes routes+      return $ App m +  main :: IO ()+  main = serveSnaplet defaultConfig app   #+END_SRC

@@ -1,5 +1,5 @@ Name:                snaplet-amqp-Version:             0.1.3.1+Version:             1.0.0.0 Synopsis:            Snap framework snaplet for the AMQP library Homepage:            https://github.com/ixmatus/snaplet-amqp License:             BSD3@@ -46,7 +46,10 @@   Build-Depends:     base                >= 4.4     && < 5,     snap                >= 0.13    && < 0.14,+    resource-pool       >= 0.2     && < 0.3,     amqp                >= 0.10    && < 0.11,+    bytestring          >= 0.9     && < 11,+    lens                >= 4       && < 5,     transformers        >= 0.4     && < 0.5,     configurator        >= 0.3     && < 0.4,     network             >= 2.5     && < 2.7,

@@ -8,15 +8,16 @@ module Snap.Snaplet.AMQP   ( initAMQP   , runAmqp-  , mkAmqpConn+  , mkAmqpPool   , AmqpState   (..)-  , HasAmqpConn (..)+  , HasAmqpPool (..)   ) where  import           Control.Monad.State import           Control.Monad.Trans.Reader import           Data.Configurator import           Data.Configurator.Types+import           Data.Pool import           Network.AMQP               (Channel, Connection,                                              ConnectionOpts (..),                                              closeConnection,@@ -26,26 +27,26 @@ import           Snap.Snaplet  --------------------------------------------------------------------------------type AmqpC = (Connection, Channel)+type AmqpPool = Pool Connection -newtype AmqpState = AmqpState { amqpConn :: AmqpC }+newtype AmqpState = AmqpState { amqpPool :: AmqpPool }  --------------------------------------------------------------------------------class MonadIO m => HasAmqpConn m where-    getAmqpConn :: m AmqpC+class MonadIO m => HasAmqpPool m where+    getAmqpPool :: m AmqpPool -instance HasAmqpConn (Handler b AmqpState) where-    getAmqpConn = gets amqpConn+instance HasAmqpPool (Handler b AmqpState) where+    getAmqpPool = gets amqpPool -instance MonadIO m => HasAmqpConn (ReaderT AmqpC m) where-    getAmqpConn = ask+instance MonadIO m => HasAmqpPool (ReaderT AmqpPool m) where+    getAmqpPool = ask  -- | Initialize the AMQP Snaplet. initAMQP :: SnapletInit b AmqpState initAMQP = makeSnaplet "amqp" description datadir $ do-    c <- mkSnapletAmqpConn+    c <- mkSnapletAmqpPoolonn -    onUnload (closeConnection $ fst c)+    -- onUnload (closeConnection $ fst c)      return $ AmqpState c @@ -55,15 +56,15 @@  ------------------------------------------------------------------------------- -- | Constructs a connection in a snaplet context.-mkSnapletAmqpConn :: (MonadIO (m b v), MonadSnaplet m) => m b v AmqpC-mkSnapletAmqpConn = do+mkSnapletAmqpPoolonn :: (MonadIO (m b v), MonadSnaplet m) => m b v AmqpPool+mkSnapletAmqpPoolonn = do   conf <- getSnapletUserConfig-  mkAmqpConn conf+  mkAmqpPool conf  ------------------------------------------------------------------------------- -- | Constructs a connect from Config.-mkAmqpConn :: MonadIO m => Config -> m AmqpC-mkAmqpConn conf = do+mkAmqpPool :: MonadIO m => Config -> m AmqpPool+mkAmqpPool conf = do   host  <- liftIO $ require conf "host"   port  <- liftIO $ require conf "port"   vhost <- liftIO $ require conf "vhost"@@ -75,13 +76,13 @@                    , coVHost   = vhost                    , coAuth    = [plain login pass]                    }--  conn  <- liftIO $ openConnection'' connOpts-  chan  <- liftIO $ openChannel conn--  return (conn, chan)+  return =<< liftIO $ createPool (openConnection'' connOpts) closeConnection 1 30 10  ---------------------------------------------------------------------------------- | Runs an AMQP action in any monad with a HasAmqpConn instance.-runAmqp :: (HasAmqpConn m) => (AmqpC -> b) -> m b-runAmqp action = getAmqpConn >>= return . action+-- | Runs an AMQP action in any monad with a HasAmqpPoolonn instance.+runAmqp :: (HasAmqpPool m) => ((Connection, Channel) -> b) -> m b+runAmqp action = do+    pool <- getAmqpPool+    return =<< liftIO $ withResource pool $ \conn -> do+        chan <- openChannel conn+        return $ action (conn, chan)