Updates for 0.10; added getAllDocs

CouchDB.cabal

@@ -1,5 +1,5 @@
 Name:           CouchDB
-Version:        0.8.1.3
+Version:        0.10.0
 Cabal-Version:	>= 1.2.4
 Copyright:      Copyright (c) 2008-2009 Arjun Guha and Brendan Hickey
 License:        BSD3
@@ -19,7 +19,7 @@ Library
   Hs-Source-Dirs:
     src
   Build-Depends:
-    base, mtl, containers, network, HTTP>=4000.0.4, json>=0.4.3
+    base >= 4 && < 5, mtl, containers, network, HTTP>=4000.0.4, json>=0.4.3
   ghc-options:
     -fwarn-incomplete-patterns
   Extensions:     

README

@@ -1,4 +1,4 @@
-CouchDB 0.8.1
--------------
+CouchDB 0.10.0
+--------------
 
-This release is for CouchDB 0.8.1.
+This release is for CouchDB 0.10.0.

src/Database/CouchDB.hs

@@ -24,6 +24,7 @@ module Database.CouchDB
   , getDocPrim
   , getDocRaw
   , getDoc
+  , getAllDocs
   , getAndUpdateDoc
   , getAllDocIds
   -- * Views
@@ -195,6 +196,17 @@ getDoc db doc = do
   case r of
     Nothing -> return Nothing
     Just (_,rev,val) -> return $ Just (doc,Rev rev,val)
+
+
+getAllDocs :: JSON a
+           => DB
+          -> [(String, JSValue)] -- ^query parameters
+          -> CouchMonad [(Doc, a)]
+getAllDocs db args = do
+  rows <- U.getAllDocs (show db) args
+  return $ map (\(doc,val) -> (Doc doc,val)) rows
+
+
 -- |Gets a document as a raw JSON value.  Returns the document id,
 -- revision and value as a 'JSObject'.  These fields are queried lazily,
 -- and may fail later if the response from the server is malformed.

src/Database/CouchDB/Unsafe.hs

@@ -16,6 +16,7 @@ module Database.CouchDB.Unsafe
   , getDoc
   , getAndUpdateDoc
   , getAllDocIds
+  , getAllDocs
   -- * Views
   -- $views
   , CouchView (..)
@@ -37,7 +38,7 @@ assertJSObject o = fail $ "expected a JSON object; received: " ++ encode o
 
 couchResponse :: String -> [(String,JSValue)]
 couchResponse respBody = case decode respBody of
-  Error s -> error s
+  Error s -> error $ "couchResponse: s"
   Ok r -> fromJSObject r
 
 request' :: String -> RequestMethod -> CouchMonad (Response String)
@@ -277,6 +278,41 @@ toRow (JSObject objVal) = (key,value) where
 toRow val =
   error $ "toRow: expected row to be an object, received " ++ show val
 
+
+getAllDocs :: JSON a
+           => String -- ^databse
+           -> [(String, JSValue)] -- ^query parameters
+          -- |Returns a list of rows.  Each row is a key, value pair.
+          -> CouchMonad [(JSString, a)]
+getAllDocs db args = do
+  let args' = map (\(k,v) -> (k,encode v)) args
+  let url' = concat [db, "/_all_docs"]
+  r <- request url' args' GET [] ""
+  case rspCode r of
+    (2,0,0) -> do
+      let result = couchResponse (rspBody r)
+      let (JSArray rows) = fromJust $ lookup "rows" result
+      return $ map toRowDoc rows
+    otherwise -> error $ "getAllDocs: " ++ show r
+
+
+toRowDoc :: JSON a => JSValue -> (JSString,a)
+toRowDoc (JSObject objVal) = (key,value) where
+   obj = fromJSObject objVal
+   key = case lookup "id" obj of
+     Just (JSString s) -> s
+     Just v -> error $ "toRowDoc: expected id to be a string, got " ++ show v
+     Nothing -> error $ "toRowDoc: row does not have an id field in " 
+                        ++ show obj
+   value = case lookup "doc" obj of
+     Just v -> case readJSON v of
+       Ok v' -> v'
+       Error s -> error s
+     Nothing -> error $ "toRowDoc: row does not have a value in " ++ show obj
+toRowDoc val =
+  error $ "toRowDoc: expected row to be an object, received " ++ show val
+
+
 queryView :: (JSON a)
           => String  -- ^database
           -> String  -- ^design