Commits

John Lenz committed 99df149

Convert Generic.hs to unix line endings and update some of the comments

  • Participants
  • Parent commits e8252eb

Comments (0)

Files changed (2)

File src/Database/CouchDB/Enumerator/Generic.hs

-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses #-}
-
-{- | Generic version.
-
-The biggest difficulty in use generics with CouchDB is @system@ fields /_id/ 
-and /_rev/. For example - standart CouchDB response:
-
-> {
->    "_id": "gen_doc3",
->    "_rev": "11-52b4f9b471de393fab82313b9d8571c1",
->    "foo": 3,
->    "bar": "haha"
-> }
-
-The problem is /underscore/ fields. @couchdb-enumerator@ uses 'Data.Aeson' 
-for JSON. But 'Aeson' in version /0.4.0.0/ has a bug that prevents properly 
-convert JSON to 'Generics'. But it's not a real problem.
-
-The real problem is /_rev/ field. When you need to update exiting document via 
-/PUT/ request, you /must/ include /_rev/ field in JSON. But, for new 
-documents, field /_rev/ should be omitted.
-
-'Generic' solves this problem by divide /_id/ and /_rev/ from data:
-
-> import Data.Data (Data, Typeable)
-> import Data.Bytestring (Bytestring)
-> import Database.CouchDB.Enumerator hiding (couchGet, couchPut)
-> import qualified Database.CouchDB.Enumerator as G
-> 
-> data Rec = Rec {
->     field1 :: Int
->   , field2 :: Bytestring
-> } deriving (Data, Typeable)
-> 
-> testCouch :: IO ()
-> testCouch = runCouch "localhost" 5984 "test" $ do
->    -- Ingest doc
->    rev1 <- G.couchPut "doc1" Nothing [] $ Rec 1 "foo"
->    -- Get doc 
->    G.CouchDoc p r doc1 <- G.couchGet "doc1" []
->    -- New revision
->    rev2 <- G.couchPut "doc1" (Just rev1) [] $ Rec 2 "bar"
-
--}
-
-module Database.CouchDB.Enumerator.Generic (
-    CouchDoc(..),
-    couchGet,
-    couchPut,
-    couchPut'
-) where
-
-import Prelude hiding (catch)
-
-import Control.Monad (mzero)
-import Control.Exception.Lifted (catch, throw)
-import Control.Applicative
-
-import Data.Data (Data)
-
-import qualified Network.HTTP.Types as HT
-
-import Data.Aeson
-import qualified Data.Aeson.Generic as AG
-
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# MultiParamTypeClasses #-}
+
+{- | A convenient wrapper around "Database.CouchDB.Enumerator" and "Data.Aeson.Generic"
+
+The aeson library has the ability to encode and decode JSON using the generic
+Data and Typeable classes via the "Data.Aeson.Generic" module.  It isn't too
+hard to use 'AG.fromJSON' and 'AG.toJSON' combined with the functions in
+"Database.CouchDB.Enumerator", except that in several cases Couch DB uses
+system fields /_id/ and /_rev/ which present a small difficulty.
+
+For example, Couch DB will return an object like the following
+
+> {
+>    "_id": "somedoc",
+>    "_rev": "11-52b4f9b471de393fab82313b9d8571c1",
+>    "foo": 3,
+>    "bar": true
+> }
+
+Also, occasionally (not always) the /_rev/ field must be present in an object
+that is sent to Couch DB during a PUT.
+
+The short wrapper functions in this module take care of handling the /_id/
+and /_rev/ fields separately from the encoding and decoding to the generic
+data structure.
+
+> import Data.Data (Data, Typeable)
+> import Data.Bytestring (Bytestring)
+> import Database.CouchDB.Enumerator hiding (couchGet, couchPut)
+> import qualified Database.CouchDB.Enumerator.Generic as G
+> 
+> data Rec = Rec {
+>     field1 :: Int
+>   , field2 :: ByteString
+> } deriving (Data, Typeable)
+> 
+> testCouch :: IO ()
+> testCouch = runCouch "localhost" 5984 "test" $ do
+>    -- Insert doc
+>    rev1 <- G.couchPut "doc1" Nothing [] $ Rec 1 "foo"
+>    -- Get doc 
+>    G.CouchDoc p r doc1 <- G.couchGet "doc1" []
+>    -- New revision
+>    rev2 <- G.couchPut "doc1" (Just rev1) [] $ Rec 2 "bar"
+-}
+
+module Database.CouchDB.Enumerator.Generic (
+    CouchDoc(..),
+    couchGet,
+    couchPut,
+    couchPut'
+) where
+
+import Prelude hiding (catch)
+
+import Control.Monad (mzero)
+import Control.Exception.Lifted (catch, throw)
+import Control.Applicative
+
+import Data.Data (Data)
+
+import qualified Network.HTTP.Types as HT
+
+import Data.Aeson
+import qualified Data.Aeson.Generic as AG
+
 import Database.CouchDB.Enumerator hiding (couchGet, couchPut)
 import qualified Database.CouchDB.Enumerator as CE (couchGet, couchPutRev)
-
--- | CouchDB document with path (_id) and revision
-data CouchDoc a = CouchDoc Path Revision a deriving (Show)
-
--- | Doc signature. Just for parse
-data DocSig = DocSig String Revision
-
-instance FromJSON DocSig where
-    parseJSON (Object v) = DocSig <$>
-        v .: "_id" <*>
-        v .:? "_rev" .!= ""
-    parseJSON _ = mzero
-
--- | Load a single object from couch DB.
-couchGet :: (MonadCouch m, Data a) => 
-        Path        -- ^ the dbname is prepended to this string to 
-                    --   form the full path.
-     -> HT.Query    -- ^ Query arguments.
-     -> m (CouchDoc a)
-couchGet p q = do
-    res <- CE.couchGet p q
-    case (AG.fromJSON $ Object res, fromJSON $ Object res) of
-        (Success s, Success (DocSig i r)) -> return $ CouchDoc i r s
-        _ ->  throw $ CouchError Nothing "Parse error"
-
--- | Put an object in Couch DB, returning the new Revision. 
-couchPut :: (MonadCouch m, Data a) =>
-       Path             -- ^ the dbname is prepended to this string to 
-                        --   form the full path.
-    -> Revision         -- ^ Revision. Empty string for new documents.
-    -> HT.Query         -- ^ Query arguments.
-    -> a                -- ^ Data
-    -> m Revision
-couchPut p r q a = 
-    CE.couchPutRev p r q $ AG.toJSON a
-    
--- | Brute force version of 'couchPut'. Stores document regardless of presence
---   in database (catches 'couchRev' 'CouchError' /404/). 
---
---   This version is slover that 'couchPut' because first tries to get document 
---   revision.  
-couchPut' :: (MonadCouch m, Data a) =>
-       Path         -- ^ the dbname is prepended to this string to 
-                    --   form the full path.
-    -> HT.Query     -- ^ Query arguments.
-    -> a            -- ^ Data
-    -> m Revision    
-couchPut' p q a = do
-    rev1 <- catch (couchRev p) handler
-    couchPut p rev1 q a
-  where
-    handler (CouchError (Just 404) _) = return ""
-    handler e = throw e 
-
+
+-- | CouchDB document with path and revision.
+data CouchDoc a = CouchDoc Path Revision a deriving (Show)
+
+-- | Doc signature. Just for parsing.
+data DocSig = DocSig String Revision
+
+instance FromJSON DocSig where
+    parseJSON (Object v) = DocSig <$>
+        v .: "_id" <*>
+        v .:? "_rev" .!= ""
+    parseJSON _ = mzero
+
+-- | Load a single object from couch DB.
+couchGet :: (MonadCouch m, Data a) => 
+        Path        -- ^ the dbname is prepended to this string to 
+                    --   form the full path.
+     -> HT.Query    -- ^ Query arguments.
+     -> m (CouchDoc a)
+couchGet p q = do
+    res <- CE.couchGet p q
+    case (AG.fromJSON $ Object res, fromJSON $ Object res) of
+        (Success s, Success (DocSig i r)) -> return $ CouchDoc i r s
+        _ ->  throw $ CouchError Nothing "Parse error"
+
+-- | Put an object in Couch DB, returning the new Revision. 
+couchPut :: (MonadCouch m, Data a) =>
+       Path             -- ^ the dbname is prepended to this string to 
+                        --   form the full path.
+    -> Revision         -- ^ Revision. Empty string for new documents.
+    -> HT.Query         -- ^ Query arguments.
+    -> a                -- ^ Data
+    -> m Revision
+couchPut p r q a = 
+    CE.couchPutRev p r q $ AG.toJSON a
+    
+-- | Brute force version of 'couchPut'. Stores document regardless of presence
+--   in database (catches 'couchRev' 'CouchError' /404/). 
+--
+--   This version is slower that 'couchPut' because it first tries to find the
+--   document revision.  
+--
+--   Also, there are no guarantees that some other thread or
+--   program updated the object (and thus generated a new revision) between loading
+--   the existing revision and deleting the object.  If this occurs, an error will
+--   still be thrown.
+couchPut' :: (MonadCouch m, Data a) =>
+       Path         -- ^ the dbname is prepended to this string to 
+                    --   form the full path.
+    -> HT.Query     -- ^ Query arguments.
+    -> a            -- ^ Data
+    -> m Revision    
+couchPut' p q a = do
+    rev1 <- catch (couchRev p) handler
+    couchPut p rev1 q a
+  where
+    handler (CouchError (Just 404) _) = return ""
+    handler e = throw e 
+

File test/Database/CouchDB/Enumerator/Test/Generic.hs

 
 import Test.Framework (testGroup, Test)
 import Test.Framework.Providers.HUnit (testCase)
-import Test.HUnit (Assertion, (@=?))
+import Test.HUnit (Assertion)
 
-import qualified Control.Exception.Lifted as E
 import Control.Monad.IO.Class (liftIO)
 
 import Data.Data (Typeable, Data)