John Lenz avatar John Lenz committed fed46bc

Use the MonadReader class instead of defining a custom CouchMonad class,
and remove CouchMonad and CouchT.

Comments (0)

Files changed (3)

Database/CouchDB/Enumerator.hs

-{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, OverloadedStrings #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, OverloadedStrings, 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.
 --
 -- > {-# 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)
 -- > import Database.CouchDB.Enumerator
 -- >
 -- > testCouch :: IO ()
--- > testCouch = withCouchConnection "localhost" 5984 "test" $ runCouchT $ do
+-- > testCouch = withCouchConnection "localhost" 5984 "test" $ runReaderT $ do
 -- >    
 -- >    -- Insert some documents.   Note that the dbname passed to withCouchConnection
 -- >    -- is prepended to the given path, so this is a put to
       CouchConnection(..)
     , withCouchConnection
     , CouchError(..)
-    , CouchMonad(..)
 
     -- * Accessing Couch DB
     , Path
     , extractViewValue
     , couch
 
-    -- * A ReaderT CouchMonad
-    , CouchT(..)
-    , runCouchT
-
     -- * Connection Pooling
     -- $pool
 ) where
 
 import           Control.Applicative
 import           Control.Exception (Exception, throw, bracket)
-import           Control.Monad (MonadPlus(..))
 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, runReaderT)
+import           Control.Monad.Trans (MonadTrans, lift)
+import           Control.Monad.Reader (MonadReader(..))
 import qualified Data.Aeson as A
 import           Data.Attoparsec
 import           Data.Attoparsec.Enumerator (iterParser)
     deriving (Show,Typeable)
 instance Exception CouchError
 
--- | A monad which allows access to the couch connection.
-class (MonadIO m) => CouchMonad m where
-    couchConnection :: m CouchConnection
-
 -- | A path to a Couch DB Object.
 type Path = String
 
 -- | The most general method of accessing CouchDB.  This is a very thin wrapper around 'H.http'.  Most of the
 --   time you should use one of the other access functions, but this function is needed for example to write
 --   and read attachments that are not in JSON format.
-couch :: (CouchMonad m) => HT.Method                    -- ^ Method
-                        -> Path                         -- ^ The dbname from the connection is prepended to
-                                                        --   this path.
-                        -> HT.Query                     -- ^ Query arguments
-                        -> Iteratee B.ByteString m a    -- ^ Iteratee to process the response if no error occurs.
-                        -> H.RequestBody m              -- ^ Body
-                        -> Iteratee B.ByteString m a
+couch :: (MonadIO m, MonadReader CouchConnection m) 
+      => HT.Method                    -- ^ Method
+      -> Path                         -- ^ The dbname from the connection is prepended to
+                                      --   this path.
+      -> HT.Query                     -- ^ Query arguments
+      -> Iteratee B.ByteString m a    -- ^ Iteratee to process the response if no error occurs.
+      -> H.RequestBody m              -- ^ Body
+      -> Iteratee B.ByteString m a
 couch m p q i b = Iteratee $ do
-    conn <- couchConnection
+    conn <- ask
     let req = H.Request { H.method          = m
                         , H.secure          = False
                         , H.checkCerts      = const $ return False
     runIteratee $ H.http req (\s _ -> checkStatus s i) (manager conn)
 
 -- | Load a single object from couch DB.
-couchGet :: (CouchMonad m) => Path       -- ^ the dbname is prepended to this string to form the full path.
-                           -> HT.Query   -- ^ Query arguments.
-                           -> m A.Object
+couchGet :: (MonadIO m, MonadReader CouchConnection m) 
+         => Path       -- ^ the dbname is prepended to this string to form the full path.
+         -> HT.Query   -- ^ Query arguments.
+         -> m A.Object
 couchGet p q = do v <- run_ $ couch HT.methodGet p q (iterParser A.json) (H.RequestBodyBS B.empty)
                   either throw return $ valToObj v
 
 -- | Put an object in Couch DB, returning the new Revision.
-couchPut :: (CouchMonad m, A.ToJSON a) 
+couchPut :: (MonadIO m, MonadReader CouchConnection m, A.ToJSON a) 
          => Path        -- ^ the dbname is prepended to this string to form the full path.
          -> HT.Query    -- ^ Query arguments.
          -> a           -- ^ The object to store.
 
 -- | A version of 'couchPut' which ignores the return value.  This is slightly faster than / _ <- couchPut .../
 --   since the JSON parser is not run.
-couchPut_ :: (CouchMonad m, A.ToJSON a) 
+couchPut_ :: (MonadIO m, MonadReader CouchConnection m, A.ToJSON a) 
           => Path       -- ^ the dbname is prepended to this string to form the full path.
           -> HT.Query   -- ^ Query arguments.
           -> a          -- ^ The object to store.
     where body = H.RequestBodyLBS $ A.encode $ A.toJSON val
 
 -- | Delete the given revision of the object.
-couchDelete :: (CouchMonad m) => Path     -- ^ the dbname is prepended to this string to form the full path. 
-                              -> Revision
-                              -> m ()
+couchDelete :: (MonadIO m, MonadReader CouchConnection m) 
+            => Path     -- ^ the dbname is prepended to this string to form the full path. 
+            -> Revision
+            -> m ()
 couchDelete p r = run_ $ couch HT.methodDelete p [("rev", Just $ TE.encodeUtf8 r)]
                              (yield () EOF) (H.RequestBodyBS B.empty)
 
 -- with the 'extractViewValue' enumeratee, for example:
 --
 -- >  couchView "mydesigndoc/_view/myview" [(fromString "key", Just $ fromString "3")] $= extractViewValue
-couchView :: (CouchMonad m) => Path      -- ^ \/dbname\/_design\/  is prepended to the given path
-                            -> HT.Query  -- ^ Query arguments.
-                            -> Enumerator A.Object m a
+couchView :: (MonadIO m, MonadReader CouchConnection m) 
+          => Path      -- ^ \/dbname\/_design\/  is prepended to the given path
+          -> HT.Query  -- ^ Query arguments.
+          -> Enumerator A.Object m a
 couchView p q step = do s <- lift $ run $ couch HT.methodGet ("_design/" ++ p) q (parseView step) (H.RequestBodyBS B.empty)
                         either throwError returnI s
 
                    (Just (A.Object o)) -> Right o
                    _                   -> Left $ CouchError Nothing "view does not contain value"
 
--- | ReaderT implementation of CouchMonad.
-newtype CouchT m a = CouchT (ReaderT CouchConnection m a)
-    deriving ( Monad, MonadIO, MonadTrans, Functor, Applicative
-             , MonadPlus, Alternative, MonadControlIO)
-
-instance (MonadIO m) => CouchMonad (CouchT m) where
-    couchConnection = CouchT ask
-
--- | Run a Couch DB backend.
-runCouchT :: (Monad m) => CouchT m a -> CouchConnection -> m a
-runCouchT (CouchT r) = runReaderT r
-
 -----------------------------------------------------------------------------------------
 --- Helper Code
 -----------------------------------------------------------------------------------------
 -- <http://hackage.haskell.org/package/pool> packages combined with the
 -- 'H.newManager' and 'H.closeManager' functions.
 --
--- For example, the following code using the resource-pool package runs a CouchT action using a HTTP connection
--- from a pool.
+-- For example, the following code using the resource-pool package runs a /ReaderT CouchConnection m/ action using a
+-- HTTP connection from a pool.
 -- 
 -- > runPooledCouch :: MonadCatchIO m
--- >                => Pool Manager -> String -> Int -> String -> CouchT m a -> m a
+-- >                => Pool Manager -> String -> Int -> String -> ReaderT CouchConnection m a -> m a
 -- > runPooledCouch p host port dbname c = withResource p $ \m -> do
--- >    runCouchT c $ CouchConnection (BU8.fromString host) p m dbname
+-- >    runReaderT c $ CouchConnection (BU8.fromString host) p m dbname
 --
 -- A typical use of runPooledCouch in a web server like snap is the following:
 --
--- > someSnapDBStuff :: (CouchMonad m, MonadSnap m) => m a
+-- > someSnapDBStuff :: (MonadReader CouchConnection m, MonadSnap m) => m a
 -- > someSnapDBStuff = ...
 -- >
 -- > mySnap :: MonadSnap m => Pool Manager -> m a

couchdb-enumerator.cabal

         , http-types >= 0.6 && < 0.7
         , http-enumerator >= 0.6.5.3 && < 0.7
         , monad-control >= 0.2 && < 0.3
+        , mtl >= 2.0 && < 2.1
         , text >= 0.11 && < 0.12
         , transformers >= 0.2 && < 0.3
         , utf8-string >= 0.3 && < 0.4
         , attoparsec-enumerator >= 0.2 && < 0.3
         , base >= 4 && < 5
         , bytestring >= 0.9 && < 0.10
-        , containers >= 0.4 && < 0.5
+        , containers >= 0.3 && < 0.5
         , enumerator >= 0.4 && < 0.5
         , http-types >= 0.6 && < 0.7
         , http-enumerator >= 0.6.5.3 && < 0.7
         , monad-control >= 0.2 && < 0.3
+        , mtl >= 2.0 && < 2.1
         , text >= 0.11 && < 0.12
         , transformers >= 0.2 && < 0.3
         , utf8-string >= 0.3 && < 0.4
 import           Control.Applicative
 import           Control.Exception.Control (throwIO, catch)
 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.Reader
 import           Data.Aeson ((.=))
 import qualified Data.Aeson as A
 import qualified Data.ByteString.UTF8 as BU8
 --- Test Helpers
 ----------------------------------------------------------------------------------
 
+type CouchT m a = ReaderT CouchConnection m a
+
 testCouch :: (CouchT IO a) -> IO ()
-testCouch c = withCouchConnection "www.wuzzeb.org" 5984 "test" (runCouchT c) >> return ()
+testCouch c = withCouchConnection "www.wuzzeb.org" 5984 "test" (runReaderT c) >> return ()
 
 testCouchCase :: String -> (CouchT IO a) -> Test
 testCouchCase s c = testCase s $ testCouch c
             ]
         ]
 
-queryByType :: Integer -> Integer -> Integer -> Enumerator A.Object (CouchT IO) b
+queryByType :: Integer -> Integer -> Integer -> Enumerator A.Object (ReaderT CouchConnection IO) b
 queryByType u g t = couchView path query $= extractViewValue
     where path  = "dataviews/_view/bytype"
           key   = "[" ++ show u ++ "," ++ show g ++ "," ++ show t ++ "]"
           query = [(BU8.fromString "key", Just $ BU8.fromString key)]
 
-queryByGroup :: Integer -> Integer -> Enumerator A.Object (CouchT IO) b
+queryByGroup :: Integer -> Integer -> Enumerator A.Object (ReaderT CouchConnection IO) b
 queryByGroup u g = couchView path query $= extractViewValue
     where path  = "dataviews/_view/bytype"
           skey  = "[" ++ show u ++ "," ++ show g ++ "]"
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.