couchdb-enumerator 0.3.2 → 0.3.3

raw patch · 3 files changed

+87/−42 lines, 3 filesdep +lifted-basedep ~monad-controlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: lifted-base

Dependency ranges changed: monad-control

API changes (from Hackage documentation)

Files

• Database/CouchDB/Enumerator.hs +71/−29
• couchdb-enumerator.cabal +4/−3
• tests.hs +12/−10

@@ -1,4 +1,4 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, OverloadedStrings, FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, OverloadedStrings, FlexibleInstances, FlexibleContexts #-}  -- | This module is a very thin wrapper around "Network.HTTP.Enumerator" using the aeson package to parse --   and encode JSON.  The Couch DB HTTP API is the best place to learn about how to use this library.@@ -6,7 +6,6 @@ -- -- > {-# LANGUAGE OverloadedStrings #-} -- > import Control.Monad.IO.Class (liftIO)--- > import Contorl.Monad.Reader -- > import Data.Aeson -- > import qualified Data.ByteString.Lazy as BL -- > import Data.ByteString.UTF8 (fromString)@@ -15,7 +14,7 @@ -- > import Database.CouchDB.Enumerator -- > -- > testCouch :: IO ()--- > testCouch = withCouchConnection "localhost" 5984 "test" $ runReaderT $ do+-- > testCouch = runCouch "localhost" 5984 "test" $ do -- >     -- >    -- Insert some documents.   Note that the dbname passed to withCouchConnection -- >    -- is prepended to the given path, so this is a put to@@ -58,6 +57,7 @@ module Database.CouchDB.Enumerator(     -- * Couch DB Connection       CouchConnection(..)+    , runCouch     , withCouchConnection     , CouchError(..)     , MonadCouch(..)@@ -75,14 +75,17 @@      -- * Connection Pooling     -- $pool++    -- * Yesod Integration+    -- $yesod ) where  import           Control.Applicative import           Control.Exception (Exception, throw, bracket) import           Control.Monad.IO.Class (MonadIO, liftIO)-import           Control.Monad.IO.Control (MonadControlIO, liftIOOp) import           Control.Monad.Trans.Class (MonadTrans, lift)-import           Control.Monad.Trans.Reader (ReaderT, ask)+import           Control.Monad.Trans.Control (MonadBaseControl, liftBaseOp)+import           Control.Monad.Trans.Reader (ReaderT, ask, runReaderT) import qualified Data.Aeson as A import qualified Data.Aeson.Encode as AE import           Data.Attoparsec@@ -111,12 +114,17 @@ }  -- | Connect to a CouchDB database, call the supplied function, and then close the connection.-withCouchConnection :: (MonadControlIO m) => String    -- ^ host-                                          -> Int       -- ^ port-                                          -> String    -- ^ database name-                                          -> (CouchConnection -> m a) -- ^ function to run-                                          -> m a-withCouchConnection h p db f = liftIOOp (bracket H.newManager H.closeManager) go+-- +--   If you create your own instance of 'MonadCouch' instead of using 'runCouch', this function+--   will help you create the 'CouchConnection'.  On the other hand, if you want to implement+--   connection pooling, you will not be able to use withCouchConnection and must create the+--   connection yourself.+withCouchConnection :: (MonadBaseControl IO m) => String    -- ^ host+                                               -> Int       -- ^ port+                                               -> String    -- ^ database name+                                               -> (CouchConnection -> m a) -- ^ function to run+                                               -> m a+withCouchConnection h p db f = liftBaseOp (bracket H.newManager H.closeManager) go     where go m = f $ CouchConnection (BU8.fromString h) p m db  -- | A Couch DB Error.  If the error comes from http, the http status code is also given.  Non-http errors@@ -132,6 +140,25 @@ instance (MonadIO m) => MonadCouch (ReaderT CouchConnection m) where     couchConnection = ask +-- | Run a sequence of CouchDB actions.+--+--   The functions below to access CouchDB require a 'MonadCouch' instance to access the connection+--   information.  'ReaderT' is an instance of 'MonadCouch', and /runCouch/ runs a sequence of database+--   actions using 'ReaderT'.  See the top of this page for an example using /runCouch/.+--+--   The main reason to not use /runCouch/ is to obtain more control over connection pooling.+--   Also, if your db code is part of a larger monad, it makes sense to just make the larger monad+--   an instance of 'MonadCouch' and skip the intermediate ReaderT, since then performance is+--   improved by eliminating one monad from the final transformer stack.+--+--   This function is a combination of 'withCouchConnection' and 'runReaderT'+runCouch :: (MonadIO m, MonadBaseControl IO m) => String    -- ^ host+                                               -> Int       -- ^ port+                                               -> String    -- ^ database name+                                               -> ReaderT CouchConnection m a -- ^ CouchDB actions+                                               -> m a+runCouch h p d = withCouchConnection h p d . runReaderT+ -- | A path to a Couch DB Object. type Path = String @@ -323,7 +350,9 @@  -- $pool -- The 'H.Manager' stored in the CouchConnection maintains a pool of open connections in an IORef,--- but keeps a maximum of one open connection per (host,port) pair.+-- but keeps a maximum of one open connection per (host,port) pair.  Also, each time 'runCouch' or+-- 'withCouchConnection' is called, a new manager (and thus new connections) is created and destroyed.+-- -- For more precise control over pooling, use the  -- <http://hackage.haskell.org/package/resource-pool> or -- <http://hackage.haskell.org/package/pool> packages combined with the@@ -336,26 +365,39 @@ -- >                => Pool Manager -> String -> Int -> String -> ReaderT CouchConnection m a -> m a -- > runPooledCouch p host port dbname c = withResource p $ \m -> do -- >    runReaderT c $ CouchConnection (BU8.fromString host) port m dbname------ A typical use of runPooledCouch in a web server like snap is the following:++-- $yesod+-- Integrating couchdb-enumerator with yesod looks something the way the scaffold sets up the+-- YesodPersist instance. ----- > someSnapDBStuff :: (MonadCouch m, MonadSnap m) => m a--- > someSnapDBStuff = ...+-- > data MyFoundation = MyFoundation +-- >     { ... (normal yesod stuff in the foundation type)+-- >     , connPool     :: Data.Pool.Pool H.Manager+-- >     , dbLocation   :: B.ByteString+-- >     , databaseName :: String+-- >     } -- >--- > mySnap :: MonadSnap m => Pool Manager -> m a--- > mySnap p = route [ ("/echo/:stuff", echo)--- >                  , ("/foo", pooled someSnapDBStuff)--- >                  , ("/bar", pooled somethingElse)--- >                  ]--- >    where pooled = runPooledCouch p "localhost" 5984 "test"+-- > newtype CouchDBPersist m a = CouchDBPersist { unCouchDBPersist :: ReaderT CouchConnection m a }+-- >     deriving (Monad, MonadIO, MonadTrans, Functor, Applicative, MonadTransControl,+-- >               MonadBaseControl, MonadPlus, MonadCouch) -- >--- > launch :: Config Snap () -> IO ()--- > launch config = do p <- createPool newManager closeManager 1 (fromInteger 10) 100--- >                    httpServe config $ mySnap p+-- > instance YesodPersist MyFoundation where+-- >     type YesodPersistBackend = CouchDBPersist+-- >     runDB r = do pool <- connPool <$> getYesod+-- >                  loc <- dbLocation <$> getYesod+-- >                  db <- databaseName <$> getYesod+-- >                  Data.Pool.withPool' pool $ \m ->+-- >                      runReaderT (unCouchDBPersist r) $ CouchConnection loc 5984 m db ----- When an incoming connection for the /foo/ path arrives, the /runPooledCouch/ action will be--- executed.  This will pull a manager out of the pool and run the /someSnapDBStuff/ action, returning--- the manager to the pool once /someSnapDBStuff/ is finished.  In this code, each manager will--- be used by at most one thread at a time so each manager will contain exactly one open HTTP connection.+-- Then you can write handler code as follows:+--+-- > getFooR :: PersonID -> Handler RepPlain+-- > getFooR p = do+-- >    person <- runDB $ couchGet p []+-- >    return $ RepPlain $ toContent $ Aeson.encode $ maybe Aeson.null person+--+-- Alternatively, you don't need to make your Foundation an instance of YesodPersist, you could+-- supply your own runCouchDB function which is just a version of runDB specialized to your foundation+-- and just use that from the handlers.  -- vim: set expandtab:set tabstop=4:

@@ -1,5 +1,5 @@ Name:           couchdb-enumerator-Version:        0.3.2+Version:        0.3.3 Cabal-Version:  >= 1.8 License:        BSD3 License-File:	LICENSE@@ -41,7 +41,7 @@         , enumerator >= 0.4 && < 0.5         , http-types >= 0.6 && < 0.7         , http-enumerator >= 0.7 && < 0.8-        , monad-control >= 0.2 && < 0.3+        , monad-control >= 0.3 && < 0.4         , text >= 0.11 && < 0.12         , transformers >= 0.2 && < 0.3         , unordered-containers >= 0.1 && < 0.2@@ -61,13 +61,14 @@         , enumerator >= 0.4 && < 0.5         , http-types >= 0.6 && < 0.7         , http-enumerator >= 0.7 && < 0.8-        , monad-control >= 0.2 && < 0.3+        , monad-control >= 0.3 && < 0.4         , text >= 0.11 && < 0.12         , transformers >= 0.2 && < 0.3         , unordered-containers >= 0.1 && < 0.2         , utf8-string >= 0.3 && < 0.4          , containers+        , lifted-base         , QuickCheck >= 2         , HUnit         , test-framework

@@ -1,16 +1,14 @@-{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Main where -import           Prelude hiding (catch)- import           Control.Applicative-import           Control.Exception.Control (throwIO, catch)+import qualified Control.Exception.Lifted as E import           Control.Monad import           Control.Monad.IO.Class (MonadIO, liftIO)-import           Control.Monad.IO.Control (MonadControlIO) import           Control.Monad.Trans.Class (lift)+import           Control.Monad.Trans.Control (MonadBaseControl) import           Control.Monad.Trans.Reader import           Data.Aeson ((.=)) import qualified Data.Aeson as A@@ -80,10 +78,14 @@     assertBool (T.unpack t ++ " is missing") $ member t x     f $ fromJust $ M.lookup t x +-- | Check an action for a couch error+checkError :: MonadBaseControl IO m => Maybe Int -> m () -> m ()+checkError code m = E.catch m handler+  where handler e@(CouchError c _) = unless (c == code) $ E.throwIO e+ -- | Expect a couch error with the given code-assertRecvError :: (MonadControlIO m) => Maybe Int -> m a -> m ()-assertRecvError code v = go `catch`  \(CouchError c _) -> liftIO (code @=? c)-    where go = v >> liftIO (assertFailure "was expecting a couch error")+assertRecvError :: (MonadIO m, MonadBaseControl IO m) => Maybe Int -> m a -> m ()+assertRecvError code v = checkError code $ v >> liftIO (assertFailure "was expecting a couch error")  -- | Check that an object in the database matches the given value. checkLoad :: String -> A.Object -> CouchT IO ()@@ -93,7 +95,7 @@  -- | Delete the given object, useful for the start of a test clearObject :: String -> CouchT IO ()-clearObject n = go `catch` \(e@(CouchError i _)) -> unless (i == Just 404) $ throwIO e+clearObject n = checkError (Just 404) go   where go = do obj <- couchGet n []                 unless (member "_rev" obj) $ fail "_rev is missing"                 let (A.String rev) = fromJust $ M.lookup "_rev" obj@@ -242,7 +244,7 @@      mapM_ clearObject $ g1key ++ g2key ++ g3key ++ g4key -    addView `catch` \e@(CouchError c _) -> unless (c == Just 409) $ throwIO e+    checkError (Just 409) addView      forM_ (zip g1key g1obj ++ zip g2key g2obj ++ zip g3key g3obj ++ zip g4key g4obj) $ \(k,o) ->         couchPut_ k [] o