couchdb-enumerator 0.3.0 → 0.3.1
raw patch · 3 files changed
+34/−35 lines, 3 filesdep ~http-enumeratorPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: http-enumerator
API changes (from Hackage documentation)
Files
- Database/CouchDB/Enumerator.hs +17/−14
- couchdb-enumerator.cabal +3/−3
- tests.hs +14/−18
Database/CouchDB/Enumerator.hs view
@@ -84,6 +84,7 @@ import Control.Monad.Trans.Class (MonadTrans, lift) import Control.Monad.Trans.Reader (ReaderT, ask) import qualified Data.Aeson as A+import qualified Data.Aeson.Encode as AE import Data.Attoparsec import Data.Attoparsec.Enumerator (iterParser) import qualified Data.ByteString as B@@ -150,18 +151,13 @@ -> Iteratee B.ByteString m a couch m p q i b = Iteratee $ do conn <- couchConnection- let req = H.Request { H.method = m- , H.secure = False- , H.checkCerts = const $ error "no cert checking"- , H.host = host conn- , H.port = port conn- , H.path = BU8.fromString ("/" ++ dbname conn ++ "/" ++ p)- , H.queryString = q- , H.requestHeaders = []- , H.requestBody = b- , H.proxy = Nothing- , H.rawBody = False- }+ let req = H.def { H.method = m+ , H.host = host conn+ , H.port = port conn+ , H.path = BU8.fromString ("/" ++ dbname conn ++ "/" ++ p)+ , H.queryString = q+ , H.requestBody = b+ } runIteratee $ H.http req (\s _ -> checkStatus s i) (manager conn) -- | Load a single object from couch DB.@@ -180,7 +176,7 @@ -> m Revision couchPut p q val = do v <- run_ $ couch HT.methodPut p q (iterParser A.json) body either (liftIO . throw) return (valToObj v >>= objToRev)- where body = H.RequestBodyLBS $ A.encode $ A.toJSON val+ where body = jsonToReqBody val -- | A version of 'couchPut' which ignores the return value. This is slightly faster than / _ <- couchPut .../ -- since the JSON parser is not run.@@ -190,7 +186,7 @@ -> a -- ^ The object to store. -> m () couchPut_ p q val = run_ $ couch HT.methodPut p q (yield () EOF) body- where body = H.RequestBodyLBS $ A.encode $ A.toJSON val+ where body = jsonToReqBody val -- | Delete the given revision of the object. couchDelete :: MonadCouch m@@ -238,6 +234,13 @@ ----------------------------------------------------------------------------------------- --- Helper Code -----------------------------------------------------------------------------------------++-- | Converts a json object into a 'H.RequestBodyEnumChunked'+jsonToReqBody :: (A.ToJSON a, Monad m) => a -> H.RequestBody m+jsonToReqBody val = H.RequestBodyEnumChunked enum+ where jbuilder = AE.fromValue $ A.toJSON val+ enum (Continue k) = k (Chunks [jbuilder])+ enum step = returnI step -- | Check status codes from couch db. checkStatus :: Monad m => HT.Status -> Iteratee B.ByteString m b
couchdb-enumerator.cabal view
@@ -1,5 +1,5 @@ Name: couchdb-enumerator-Version: 0.3.0+Version: 0.3.1 Cabal-Version: >= 1.8 License: BSD3 License-File: LICENSE@@ -41,7 +41,7 @@ , containers >= 0.3 && < 0.5 , enumerator >= 0.4 && < 0.5 , http-types >= 0.6 && < 0.7- , http-enumerator >= 0.6.5.3 && < 0.7+ , http-enumerator >= 0.7 && < 0.8 , monad-control >= 0.2 && < 0.3 , text >= 0.11 && < 0.12 , transformers >= 0.2 && < 0.3@@ -61,7 +61,7 @@ , containers >= 0.3 && < 0.5 , enumerator >= 0.4 && < 0.5 , http-types >= 0.6 && < 0.7- , http-enumerator >= 0.6.5.3 && < 0.7+ , http-enumerator >= 0.7 && < 0.8 , monad-control >= 0.2 && < 0.3 , text >= 0.11 && < 0.12 , transformers >= 0.2 && < 0.3
tests.hs view
@@ -17,8 +17,7 @@ import qualified Data.ByteString.UTF8 as BU8 import Data.Enumerator hiding (map, length, head, run, drop) import qualified Data.Enumerator.List as EL-import Data.List (find, deleteBy)-import Data.List (nubBy)+import Data.List (find, deleteBy, nubBy) import qualified Data.Map as M import Data.Maybe (fromJust) import qualified Data.Text as T@@ -51,10 +50,10 @@ type CouchT m a = ReaderT CouchConnection m a -testCouch :: (CouchT IO a) -> IO ()-testCouch c = withCouchConnection "www.wuzzeb.org" 5984 "test" (runReaderT c) >> return ()+testCouch :: CouchT IO a -> IO ()+testCouch c = withCouchConnection "server" 5984 "test" (runReaderT c) >> return () -testCouchCase :: String -> (CouchT IO a) -> Test+testCouchCase :: String -> CouchT IO a -> Test testCouchCase s c = testCase s $ testCouch c testCouchProperty :: (Show a, Arbitrary a) => String -> (Int,Int) -> ([a] -> CouchT IO b) -> Test@@ -65,9 +64,7 @@ -- | Assert that the value is a string, and check that it matches the given string assertStr :: T.Text -> A.Value -> Assertion-assertStr t (A.String t') = if t == t'- then return ()- else assertFailure $ "strings are not equal. expecting " +assertStr t (A.String t') = unless (t == t') $ assertFailure $ "strings are not equal. expecting " ++ T.unpack t ++ " received " ++ T.unpack t' assertStr _ _ = assertFailure "expecting a JSON string" @@ -80,7 +77,7 @@ -- | 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")+ where go = 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 ()@@ -90,9 +87,9 @@ -- | Delete the given object, useful for the start of a test clearObject :: String -> CouchT IO ()-clearObject n = go `catch` \(e@(CouchError i _)) -> if i == Just 404 then return () else throwIO e+clearObject n = go `catch` \(e@(CouchError i _)) -> unless (i == Just 404) $ throwIO e where go = do obj <- couchGet n []- when (not $ M.member "_rev" obj) $ fail "_rev is missing"+ unless (M.member "_rev" obj) $ fail "_rev is missing" let (A.String rev) = fromJust $ M.lookup "_rev" obj couchDelete n rev @@ -141,15 +138,14 @@ lift $ assertObjMember "db_name" (assertStr "test") v missingObjectTest :: CouchT IO ()-missingObjectTest = do- assertRecvError (Just 404) $ couchGet "jaosihaweoghaweiouhawef" []+missingObjectTest = assertRecvError (Just 404) $ couchGet "jaosihaweoghaweiouhawef" [] insertTest :: [(Int,ArbitraryObject,ArbitraryObject)] -> CouchT IO () insertTest objs = do let objs' = nubBy (\(a,_,_) (b,_,_) -> a == b) objs let keys = map (("otest"++) . show . (\(a,_,_) -> a)) objs'- let vals1 = map (\(_,(ArbitraryObject a),_) -> a) objs'- let vals2 = map (\(_,_,(ArbitraryObject a)) -> a) objs'+ let vals1 = map (\(_,ArbitraryObject a,_) -> a) objs'+ let vals2 = map (\(_,_,ArbitraryObject a) -> a) objs' mapM_ clearObject keys @@ -157,7 +153,7 @@ forM_ (zip3 rev keys vals1) $ \(r,k,o) -> checkLoad k $ M.insert "_rev" (A.toJSON r) o - rev2 <- forM (zip3 rev keys vals2) $ \(r,k,o) -> do+ rev2 <- forM (zip3 rev keys vals2) $ \(r,k,o) -> couchPut k [] $ M.insert "_rev" (A.toJSON r) o forM_ (zip3 rev2 keys vals2) $ \(r,k,o) ->@@ -195,7 +191,7 @@ ] addView :: CouchT IO ()-addView = couchPut_ "_design/dataviews" [] $ viewObj where+addView = couchPut_ "_design/dataviews" [] viewObj where viewObj = A.object [ "language" .= ("javascript" :: T.Text) , "views" .= A.object@@ -240,7 +236,7 @@ mapM_ clearObject $ g1key ++ g2key ++ g3key ++ g4key - addView `catch` \e@(CouchError c _) -> if c == Just 409 then return () else throwIO e+ addView `catch` \e@(CouchError c _) -> unless (c == Just 409) $ throwIO e forM_ (zip g1key g1obj ++ zip g2key g2obj ++ zip g3key g3obj ++ zip g4key g4obj) $ \(k,o) -> couchPut_ k [] o