All tests passed

Signed-off-by: Alexander Dorofeev <aka.spin@gmail.com>

couchdb-conduit.cabal

@@ -50,7 +50,12 @@ library
   exposed-modules:  
                     Database.CouchDB.Conduit,
                     Database.CouchDB.Conduit.DB,
-                    Database.CouchDB.Conduit.LowLevel
+                    Database.CouchDB.Conduit.Design,
+                    Database.CouchDB.Conduit.Explicit,
+                    Database.CouchDB.Conduit.Generic,
+                    Database.CouchDB.Conduit.Implicit,
+                    Database.CouchDB.Conduit.LowLevel,
+                    Database.CouchDB.Conduit.View
   other-modules:    
                     Database.CouchDB.Conduit.Internal.Doc,
                     Database.CouchDB.Conduit.Internal.Parser,
@@ -90,7 +95,10 @@ test-suite test
   hs-source-dirs:  test
   main-is:         Main.hs
   other-modules:   
-                   Database.CouchDB.Conduit.Test.Util,
                    CouchDBAuth,
-                   Database.CouchDB.Conduit.Test.Base
+                   Database.CouchDB.Conduit.Test.Base,
+                   Database.CouchDB.Conduit.Test.Explicit,
+                   Database.CouchDB.Conduit.Test.Generic,
+                   Database.CouchDB.Conduit.Test.Util,
+                   Database.CouchDB.Conduit.Test.View
 

src/Database/CouchDB/Conduit.hs

@@ -47,7 +47,6 @@ module Database.CouchDB.Conduit (
 
 ) where
 
-import Data.Conduit (ResourceT)
 import Database.CouchDB.Conduit.Internal.Connection
 import qualified Database.CouchDB.Conduit.Internal.Doc as D
 

src/Database/CouchDB/Conduit/DB.hs

@@ -22,7 +22,6 @@ import Control.Monad (void)
 
 import qualified Data.ByteString as B
 import qualified Data.Aeson as A
-import Data.Conduit (ResourceT)
 
 import qualified Network.HTTP.Conduit as H
 import qualified Network.HTTP.Types as HT

tmp/src/Database/CouchDB/Conduit/Design.hs → src/Database/CouchDB/Conduit/Design.hs

@@ -17,7 +17,6 @@ import qualified Data.Text.Encoding as TE
 import qualified Data.HashMap.Lazy as M
 import qualified Data.Aeson as A
 import qualified Data.Aeson.Types as AT
-import Data.Conduit (ResourceT)
 
 import Database.CouchDB.Conduit.Internal.Connection 
         (MonadCouch, CouchError, Path, mkPath, Revision)
@@ -31,7 +30,7 @@ couchPutView :: MonadCouch m =>
     -> Path                 -- ^ View name
     -> B.ByteString         -- ^ Map function
     -> Maybe B.ByteString   -- ^ Reduce function
-    -> ResourceT m ()
+    -> m ()
 couchPutView db designName viewName mapF reduceF = do
     (_, A.Object d) <- getDesignDoc path
     void $ couchPutWith' A.encode path [] $ inferViews (purge_ d)
@@ -52,7 +51,7 @@ couchPutView db designName viewName mapF reduceF = do
 
 getDesignDoc :: MonadCouch m => 
        Path 
-    -> ResourceT m (Revision, AT.Value)
+    -> m (Revision, AT.Value)
 getDesignDoc designName = catch 
         (couchGetWith A.Success designName [])
         (\(_ :: CouchError) -> return (B.empty, AT.emptyObject))

tmp/src/Database/CouchDB/Conduit/Explicit.hs → src/Database/CouchDB/Conduit/Explicit.hs

@@ -52,7 +52,7 @@ module Database.CouchDB.Conduit.Explicit (
 ) where
 
 import qualified Data.Aeson as A
-import Data.Conduit (Conduit(..), MonadResource, ResourceT)
+import Data.Conduit (Conduit(..), MonadResource)
 
 import Network.HTTP.Types (Query)
 
@@ -71,7 +71,7 @@ couchGet :: (MonadCouch m, A.FromJSON a) =>
        Path         -- ^ Database
     -> Path         -- ^ Document path
     -> Query     -- ^ Query
-    -> ResourceT m (Revision, a)
+    -> m (Revision, a)
 couchGet db p = couchGetWith A.fromJSON (mkPath [db, p])
 
 -- | Put an 'A.FromJSON' object in Couch DB with revision, returning the 
@@ -82,7 +82,7 @@ couchPut :: (MonadCouch m, A.ToJSON a) =>
     -> Revision    -- ^ Document revision. For new docs provide empty string.
     -> Query    -- ^ Query arguments.
     -> a           -- ^ The object to store.
-    -> ResourceT m Revision      
+    -> m Revision      
 couchPut db p = couchPutWith A.encode (mkPath [db, p])
 
 -- | \"Don't care\" version of 'couchPut'. Creates document only in its 
@@ -92,7 +92,7 @@ couchPut_ :: (MonadCouch m, A.ToJSON a) =>
     -> Path         -- ^ Document path
     -> Query    -- ^ Query arguments.
     -> a           -- ^ The object to store.
-    -> ResourceT m Revision      
+    -> m Revision      
 couchPut_ db p = couchPutWith_ A.encode (mkPath [db, p])
 
 -- | Brute force version of 'couchPut'. Creates a document regardless of 
@@ -102,7 +102,7 @@ couchPut' :: (MonadCouch m, A.ToJSON a) =>
     -> Path         -- ^ Document path
     -> Query    -- ^ Query arguments.
     -> a           -- ^ The object to store.
-    -> ResourceT m Revision      
+    -> m Revision      
 couchPut' db p = couchPutWith' A.encode (mkPath [db, p])
 
 ------------------------------------------------------------------------------

tmp/src/Database/CouchDB/Conduit/Generic.hs → src/Database/CouchDB/Conduit/Generic.hs

@@ -51,7 +51,7 @@ module Database.CouchDB.Conduit.Generic (
 import Data.Generics (Data)
 import qualified    Data.Aeson as A
 import qualified    Data.Aeson.Generic as AG
-import Data.Conduit (Conduit(..), MonadResource, ResourceT)
+import Data.Conduit (Conduit(..), MonadResource)
 
 import Network.HTTP.Types (Query)
 
@@ -66,7 +66,7 @@ couchGet :: (MonadCouch m, Data a) =>
        Path         -- ^ Database
     -> Path         -- ^ Document path
     -> Query     -- ^ Query
-    -> ResourceT m (Revision, a)
+    -> m (Revision, a)
 couchGet db p = couchGetWith AG.fromJSON (mkPath [db, p])  
 
 -- | Put an object in Couch DB with revision, returning the new Revision.
@@ -76,7 +76,7 @@ couchPut :: (MonadCouch m, Data a) =>
     -> Revision     -- ^ Document revision. For new docs provide empty string.
     -> Query        -- ^ Query arguments.
     -> a            -- ^ The object to store.
-    -> ResourceT m Revision      
+    -> m Revision      
 couchPut db p = couchPutWith AG.encode (mkPath [db, p])
 
 -- | \"Don't care\" version of 'couchPut'. Creates document only in its 
@@ -86,7 +86,7 @@ couchPut_ :: (MonadCouch m, Data a) =>
     -> Path         -- ^ Document path
     -> Query    -- ^ Query arguments.
     -> a           -- ^ The object to store.
-    -> ResourceT m Revision      
+    -> m Revision      
 couchPut_ db p = couchPutWith_ AG.encode (mkPath [db, p])
 
 -- | Brute force version of 'couchPut'. Creates a document regardless of 
@@ -96,7 +96,7 @@ couchPut' :: (MonadCouch m, Data a) =>
     -> Path         -- ^ Document path
     -> Query    -- ^ Query arguments.
     -> a           -- ^ The object to store.
-    -> ResourceT m Revision      
+    -> m Revision      
 couchPut' db p = couchPutWith' AG.encode (mkPath [db, p])
 
 ------------------------------------------------------------------------------

tmp/src/Database/CouchDB/Conduit/Implicit.hs → src/Database/CouchDB/Conduit/Implicit.hs

@@ -13,7 +13,6 @@ module Database.CouchDB.Conduit.Implicit (
 
 import qualified Data.Aeson as A
 import qualified Data.ByteString.Lazy as BL (ByteString)
-import Data.Conduit (ResourceT)
 
 import Database.CouchDB.Conduit.Internal.Connection 
         (MonadCouch(..), Path, mkPath, Revision)
@@ -30,7 +29,7 @@ couchGet :: MonadCouch m =>
     -> Path                       -- ^ Document path.
     -> Path                       -- ^ Document path.
     -> Query                      -- ^ Query
-    -> ResourceT m (Revision, a)
+    -> m (Revision, a)
 couchGet f db p = couchGetWith f (mkPath [db, p])
 
 -- | Put document, with given encoder
@@ -42,7 +41,7 @@ couchPut :: MonadCouch m =>
                             -- ^ empty string.
    -> Query                 -- ^ Query arguments.
    -> a                     -- ^ The object to store.
-   -> ResourceT m Revision
+   -> m Revision
 couchPut f db p = couchPutWith f (mkPath [db, p])
 
 -- | \"Don't care\" version of 'couchPut'. Creates document only in its 
@@ -53,7 +52,7 @@ couchPut_ :: MonadCouch m =>
    -> Path                  -- ^ Document path.
    -> Query                 -- ^ Query arguments.
    -> a                     -- ^ The object to store.
-   -> ResourceT m Revision
+   -> m Revision
 couchPut_ f db p = couchPutWith_ f (mkPath [db, p])
 
 -- | Brute force version of 'couchPut'. Creates a document regardless of 
@@ -64,6 +63,6 @@ couchPut' :: MonadCouch m =>
    -> Path                  -- ^ Document path.
    -> Query                 -- ^ Query arguments.
    -> a                     -- ^ The object to store.
-   -> ResourceT m Revision
+   -> m Revision
 couchPut' f db p = couchPutWith' f (mkPath [db, p])
 

src/Database/CouchDB/Conduit/Internal/Connection.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}

src/Database/CouchDB/Conduit/Internal/Doc.hs

@@ -16,14 +16,13 @@ import              Prelude hiding (catch)
 
 import Control.Monad (void)
 import Control.Exception.Lifted (catch, throw)
-import Control.Monad.Trans.Class (lift)
 
 import Data.Maybe (fromJust)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text.Encoding as TE
 import qualified Data.Aeson as A
-import Data.Conduit (($$), ResourceT)
+import Data.Conduit (($$),)
 import qualified Data.Conduit.Attoparsec as CA
 
 import qualified Network.HTTP.Conduit as H

src/Database/CouchDB/Conduit/LowLevel.hs

@@ -21,16 +21,13 @@ import              Prelude hiding (catch)
 
 import Control.Exception.Lifted (catch, throw)
 import Control.Exception (SomeException)
-import Control.Monad.Trans.Class (lift)
-import Control.Monad.Base (liftBase)
 
-import Data.Maybe (fromJust)
 import qualified Data.ByteString as B
 import qualified Data.Aeson as A
 import qualified Data.HashMap.Lazy as M
 import Data.String.Conversions ((<>), cs)
 
-import Data.Conduit (Source, ($$), ResourceT, runResourceT)
+import Data.Conduit (Source, ($$))
 import Data.Conduit.Attoparsec (sinkParser)
 
 import qualified Network.HTTP.Conduit as H
@@ -45,24 +42,16 @@ type CouchResponse m = H.Response (Source m B.ByteString)
 --   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 :: MonadCouch m =>
---       HT.Method                -- ^ Method
---    -> Path                     -- ^ Correct 'Path' with escaped fragments.
---                                --   'couchPrefix' will be prepended to path.
---    -> HT.RequestHeaders        -- ^ Headers
---    -> HT.Query                 -- ^ Query args
---    -> H.RequestBody m          -- ^ Request body
---    -> (CouchResponse m -> m (CouchResponse m))
---                                -- ^ Protect function. See 'protect'
---    -> m (CouchResponse m)
-couch :: MonadCouch m =>
-                    HT.Method
-                    -> B.ByteString
-                    -> HT.RequestHeaders
-                    -> HT.Query
-                    -> H.RequestBody m
-                    -> (CouchResponse m -> m b)
-                    -> m b
+couch :: MonadCouch m =>
+       HT.Method                -- ^ Method
+    -> Path                     -- ^ Correct 'Path' with escaped fragments.
+                                --   'couchPrefix' will be prepended to path.
+    -> HT.RequestHeaders        -- ^ Headers
+    -> HT.Query                 -- ^ Query args
+    -> H.RequestBody m          -- ^ Request body
+    -> (CouchResponse m -> m (CouchResponse m))
+                                -- ^ Protect function. See 'protect'
+    -> m (CouchResponse m)
 couch meth path = 
     couch' meth withPrefix
   where
@@ -72,16 +61,16 @@ couch meth path =
 
 -- | More generalized version of 'couch'. Instead 'Path' it takes function
 --   what takes prefix and returns a path.
---couch' :: MonadCouch m =>
---       HT.Method                -- ^ Method
---    -> (Path -> Path)           -- ^ 'couchPrefix'->Path function. Output must 
---                                --   be correct 'Path' with escaped fragments.
---    -> HT.RequestHeaders        -- ^ Headers
---    -> HT.Query                 -- ^ Query args
---    -> H.RequestBody m          -- ^ Request body
---    -> (CouchResponse m -> m (CouchResponse m))
---                                -- ^ Protect function. See 'protect'
---    -> m (CouchResponse m)
+couch' :: MonadCouch m =>
+       HT.Method                -- ^ Method
+    -> (Path -> Path)           -- ^ 'couchPrefix'->Path function. Output must 
+                                --   be correct 'Path' with escaped fragments.
+    -> HT.RequestHeaders        -- ^ Headers
+    -> HT.Query                 -- ^ Query args
+    -> H.RequestBody m          -- ^ Request body
+    -> (CouchResponse m -> m (CouchResponse m))
+                                -- ^ Protect function. See 'protect'
+    -> m (CouchResponse m)
 couch' meth pathFn hdrs qs reqBody protectFn =  do
     (manager, conn) <- couchConnection
     let req = H.def 
@@ -106,11 +95,11 @@ couch' meth pathFn hdrs qs reqBody protectFn =  do
 --   extract \"reason\" message.
 --   
 --   To protect from typical errors use 'protect''.
---protect :: MonadCouch m => 
---       [Int]             -- ^ Good codes
---    -> (CouchResponse m -> m (CouchResponse m)) -- ^ handler
---    -> CouchResponse m   -- ^ Response
---    -> m (CouchResponse m)
+protect :: MonadCouch m => 
+       [Int]             -- ^ Good codes
+    -> (CouchResponse m -> m (CouchResponse m)) -- ^ handler
+    -> CouchResponse m   -- ^ Response
+    -> m (CouchResponse m)
 protect goodCodes h ~resp@(H.Response (HT.Status sc sm) _ _ bsrc)
     | sc == 304 = throw NotModified
     | sc `elem` goodCodes = h resp

tmp/src/Database/CouchDB/Conduit/View.hs → src/Database/CouchDB/Conduit/View.hs

@@ -50,7 +50,6 @@ module Database.CouchDB.Conduit.View
 )
  where
 
-import Control.Monad.Trans.Class (lift)
 import Control.Applicative ((<|>))
 import Control.Exception.Lifted (throw)
 
@@ -62,7 +61,7 @@ import qualified Data.HashMap.Lazy as M
 import qualified Data.Aeson as A
 import Data.Attoparsec
 
-import Data.Conduit (MonadResource, ResourceT,
+import Data.Conduit (MonadResource, 
                         Source, Conduit, Sink, ($$), ($=), 
                         sequenceSink, SequencedSinkResponse(..),
                         )
@@ -258,7 +257,7 @@ couchView :: MonadCouch m =>
     -> Path                 -- ^ Design document
     -> Path                 -- ^ View name
     -> HT.Query             -- ^ Query parameters
-    -> ResourceT m (Source m A.Object)
+    -> m (Source m A.Object)
 couchView db design view q = do
     H.Response _ _ _ bsrc <- couch HT.methodGet 
             (viewPath db design view)
@@ -282,10 +281,10 @@ couchView' :: MonadCouch m =>
     -> Path                 -- ^ View name
     -> HT.Query             -- ^ Query parameters
     -> Sink A.Object m a    -- ^ Sink for handle view rows.
-    -> ResourceT m a
+    -> m a
 couchView' db design view q sink = do
     raw <- couchView db design view q
-    lift $ raw $$ sink
+    raw $$ sink
 
 -- | Run CouchDB view in manner like 'H.http' using @POST@ (since CouchDB 0.9).
 --   It's convenient in case that @keys@ paremeter too big for @GET@ query 
@@ -302,7 +301,7 @@ couchViewPost :: (MonadCouch m, A.ToJSON a) =>
     -> Path                 -- ^ View name
     -> HT.Query             -- ^ Query parameters
     -> a                    -- ^ View @keys@. Must be list or cortege.
-    -> ResourceT m (Source m A.Object)    
+    -> m (Source m A.Object)    
 couchViewPost db design view q ks = do
     H.Response _ _ _ bsrc <- couch HT.methodPost 
             (viewPath db design view)  
@@ -321,10 +320,10 @@ couchViewPost' :: (MonadCouch m, A.ToJSON a) =>
     -> HT.Query             -- ^ Query parameters
     -> a                    -- ^ View @keys@. Must be list or cortege.
     -> Sink A.Object m a    -- ^ Sink for handle view rows.
-    -> ResourceT m a
+    -> m a
 couchViewPost' db design view q ks sink = do
     raw <- couchViewPost db design view q ks
-    lift $ raw $$ sink
+    raw $$ sink
 
 -- | Conduit for extract \"value\" field from CouchDB view row.
 rowValue :: Monad m => Conduit A.Object m A.Value