CouchDB 0.8.0.4 → 0.8.1.0

raw patch · 5 files changed

+20/−21 lines, 5 filesdep −hsloggerdep ~HTTPdep ~basedep ~networksetup-changed

Dependencies removed: hslogger

Dependency ranges changed: HTTP, base, network

Files

• CouchDB.cabal +2/−3
• Setup.lhs +8/−3
• src/Database/CouchDB.hs +0/−1
• src/Database/CouchDB/HTTP.hs +2/−9
• src/Database/CouchDB/Unsafe.hs +8/−5

@@ -1,5 +1,5 @@ Name:           CouchDB-Version:        0.8.0.4+Version:        0.8.1.0 Cabal-Version:	>= 1.2.4 Copyright:      Copyright (c) 2008 Arjun Guha and Brendan Hickey License:        BSD3@@ -19,8 +19,7 @@   Hs-Source-Dirs:     src   Build-Depends:-    base >= 3 && < 4, mtl, containers, network>=2.2.0.0, HTTP>=3001.1.3, -    json>=0.3.3, hslogger>=1.0.5+    base, mtl, containers, network, HTTP>=3001.1.4, json>=0.3.3   ghc-options:     -fwarn-incomplete-patterns   Extensions:     

@@ -1,8 +1,13 @@ #!/usr/bin/env runhaskell > import Distribution.Simple-> import qualified Data.List as L-> import System.Directory+> import System.Directory (setCurrentDirectory) > import System.Process (runCommand,waitForProcess)  -> main = defaultMainWithHooks simpleUserHooks+> main = defaultMainWithHooks simpleUserHooks { runTests = tests }++> tests _ _ _ _ = do+>   setCurrentDirectory "src"+>   h <- runCommand "/usr/bin/env runhaskell Database.CouchDB.Tests" +>   waitForProcess h+>   return ()

@@ -32,7 +32,6 @@   , queryViewKeys   ) where -import System.Log.Logger (errorM) import Database.CouchDB.HTTP import Control.Monad import Control.Monad.Trans (liftIO)

@@ -13,7 +13,6 @@  import Data.IORef import Control.Concurrent-import System.Log.Logger (errorM,debugM,infoM) import Network.TCP import Network.Stream import Network.HTTP@@ -46,8 +45,7 @@     m' conn'    fail msg = CouchMonad $ \conn -> do-    errorM "couchdb" msg-    fail "internal error"   +    fail $ "internal error: " ++ msg     instance MonadIO CouchMonad where @@ -94,17 +92,12 @@   let allHeaders = (makeHeaders (length body)) ++ headers    conn <- getConn   let req = Request url method allHeaders body-  liftIO $ debugM "couchdb.http" $ "Starting " ++ show req   let retry 0 = do-        liftIO $ errorM "couchdb.http" $ "request failed: " ++ show req-        fail "server error"+        fail $ "server error: " ++ show req       retry n = do         response <- liftIO $ sendHTTP conn req         case response of           Left err -> do-            liftIO $ infoM "couchdb.http" $ "request failed; " ++ show n ++-              " more tries left.  Error code:  " ++ show err ++ ", request: " ++-              show req             reopenConnection             retry (n-1)           Right val -> return val

@@ -23,15 +23,17 @@   , queryViewKeys   ) where -import System.Log.Logger (errorM) import Database.CouchDB.HTTP import Control.Monad import Control.Monad.Trans (liftIO) import Data.Maybe (fromJust,mapMaybe) import Text.JSON- import qualified Data.List as L +assertJSObject :: JSValue -> CouchMonad JSValue+assertJSObject v@(JSObject _) = return v+assertJSObject o = fail $ "expected a JSON object; received: " ++ encode o+ couchResponse :: String -> [(String,JSValue)] couchResponse respBody = case decode respBody of   Error s -> error s@@ -63,8 +65,8 @@             -- ^Returns 'Left' on a conflict.  Returns 'Right' with the             -- revision number on success. newNamedDoc dbName docName body = do-  r <- request (dbName ++ "/" ++ docName) [] PUT [] -               (encode $ showJSON body)+  obj <- assertJSObject (showJSON body)+  r <- request (dbName ++ "/" ++ docName) [] PUT [] (encode obj)   case rspCode r of     (2,0,1) -> do       let result = couchResponse (rspBody r)@@ -128,7 +130,8 @@       -> a       -- ^document body       -> CouchMonad (JSString,JSString) -- ^ id and rev of new document newDoc db doc = do-  r <- request db [] POST [] (encode $ showJSON doc)+  obj <- assertJSObject (showJSON doc)+  r <- request db [] POST [] (encode obj)   case rspCode r of     (2,0,1) -> do       let result = couchResponse (rspBody r)