CouchDB 0.8.1.2 → 0.10.1

raw patch · 6 files changed

+111/−11 lines, 6 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CouchDB.cabal +3/−3
• LICENSE +1/−1
• README +3/−3
• src/Database/CouchDB.hs +27/−1
• src/Database/CouchDB/HTTP.hs +23/−0
• src/Database/CouchDB/Unsafe.hs +54/−3

@@ -1,7 +1,7 @@ Name:           CouchDB-Version:        0.8.1.2+Version:        0.10.1 Cabal-Version:	>= 1.2.4-Copyright:      Copyright (c) 2008 Arjun Guha and Brendan Hickey+Copyright:      Copyright (c) 2008-2009 Arjun Guha and Brendan Hickey License:        BSD3 License-file:   LICENSE Author:         Arjun Guha, Brendan Hickey@@ -19,7 +19,7 @@   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:     

@@ -1,4 +1,4 @@-Copyright (c) 2008, Arjun Guha and Brendan Hickey+Copyright (c) 2008-2009, Arjun Guha and Brendan Hickey. All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -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.

@@ -4,6 +4,11 @@     CouchMonad   , runCouchDB   , runCouchDB'+   -- * Explicit Connections+  , CouchConn()+  , runCouchDBWith  +  , createCouchConn+  , closeCouchConn     -- * Databases   , DB   , db@@ -14,6 +19,7 @@   , Doc   , Rev   , doc+  , rev   , isDocString   , newNamedDoc   , newDoc@@ -21,7 +27,9 @@   , deleteDoc   , forceDeleteDoc   , getDocPrim+  , getDocRaw   , getDoc+  , getAllDocs   , getAndUpdateDoc   , getAllDocIds   -- * Views@@ -66,7 +74,7 @@ isFirstDocChar = isDBChar  isDocChar ch = (ch >= 'A' && ch <='Z') || (ch >= 'a' && ch <= 'z') -  || (ch >= '0' && ch <= '9') || ch `elem` "@._"+  || (ch >= '0' && ch <= '9') || ch `elem` "-@._"  isDBString :: String -> Bool isDBString [] =  False@@ -113,6 +121,10 @@       | otherwise =           ("",ch:rest) +-- |Returns a Rev+rev :: String -> Rev+rev = Rev . toJSString          + -- |Returns a safe document name.  Signals an error if the name is -- invalid. doc :: String -> Doc@@ -189,6 +201,17 @@   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.@@ -201,6 +224,9 @@   case r of     Nothing -> return Nothing     Just (_,rev,obj) -> return $ Just (doc,Rev rev,obj)++getDocRaw :: DB -> Doc -> CouchMonad (Maybe String)+getDocRaw db doc =  U.getDocRaw (show db) (show doc)  getAndUpdateDoc :: (JSON a)                 => DB -- ^database

@@ -9,6 +9,10 @@   , Response (..)   , runCouchDB   , runCouchDB'+  , CouchConn()+  , createCouchConn+  , runCouchDBWith+  , closeCouchConn   ) where  import Data.IORef@@ -120,3 +124,22 @@ -- |Connects to the CouchDB server at localhost:5984. runCouchDB' :: CouchMonad a -> IO a runCouchDB' = runCouchDB "127.0.0.1" 5984++-- |Run a CouchDB computation with an existing CouchDB connection.+runCouchDBWith :: CouchConn -> CouchMonad a -> IO a+runCouchDBWith conn (CouchMonad f) = fmap fst $ f conn++-- |Create a CouchDB connection for use with runCouchDBWith.+createCouchConn :: String -- ^hostname+                -> Int    -- ^port+                -> IO (CouchConn)+createCouchConn hostname port = do+  let uriAuth = URIAuth "" hostname (':':(show port))+  let baseURI = URI "http:" (Just uriAuth) "" "" ""+  c <- openTCPConnection hostname port+  conn <- newIORef c+  return (CouchConn conn baseURI hostname port)++-- |Closes an open CouchDB connection+closeCouchConn :: CouchConn -> IO ()+closeCouchConn (CouchConn conn _ _ _) = readIORef conn >>= close

@@ -12,9 +12,11 @@   , deleteDoc   , forceDeleteDoc   , getDocPrim+  , getDocRaw   , getDoc   , getAndUpdateDoc   , getAllDocIds+  , getAllDocs   -- * Views   -- $views   , CouchView (..)@@ -36,9 +38,10 @@  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) request' path method = request path [] method [] ""  -- |Creates a new database.  Throws an exception if the database already@@ -176,6 +179,19 @@     (4,0,4) -> return Nothing -- doc does not exist     code -> fail $ "getDocPrim: " ++ show code ++ " error" +-- |Gets a document as a Maybe String.  Returns the raw result of what +-- couchdb returns.  Returns Nothing if the doc does not exist.+getDocRaw :: String -> String -> CouchMonad (Maybe String)+getDocRaw db doc = do+  r <- request' (db ++ "/" ++ doc) GET+  case rspCode r of+    (2,0,0) -> do+      return $ Just (rspBody r)+    (4,0,4) -> return Nothing -- doc does not exist+    code -> fail $ "getDocRaw: " ++ show code ++ " error"+++ getAndUpdateDoc :: (JSON a)                 => String -- ^database                 -> String -- ^document name@@ -262,6 +278,41 @@ 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@@ -271,7 +322,7 @@           -> CouchMonad [(JSString, a)] queryView db viewSet view args = do   let args' = map (\(k,v) -> (k,encode v)) args-  let url' = concat [db,"/_view/",viewSet,"/",view]+  let url' = concat [db, "/_design/", viewSet, "/_view/", view]   r <- request url' args' GET [] ""   case rspCode r of     (2,0,0) -> do@@ -289,7 +340,7 @@             -> CouchMonad [String] queryViewKeys db viewSet view args = do   let args' = map (\(k,v) -> (k,encode v)) args-  let url' = concat [db,"/_view/",viewSet,"/",view]+  let url' = concat [db, "/_design/", viewSet, "/_view/", view]   r <- request url' args' GET [] ""   case rspCode r of     (2,0,0) -> do