Commits

Anonymous committed aec265f

Generic view functions

Comments (0)

Files changed (2)

src/Database/CouchDB/Enumerator/Generic.hs

 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# MultiParamTypeClasses #-}
 
 {- | A convenient wrapper around "Database.CouchDB.Enumerator" and "Data.Aeson.Generic"
 
 -}
 
 module Database.CouchDB.Enumerator.Generic (
+    -- * Couch DB documents API for Generic
     CouchDoc(..),
     couchGet,
     couchPut,
-    couchPut'
+    couchPut',
+    -- * Couch DB views API for Generic
+    consumeView,
+    parseGeneric
 ) where
 
 import Prelude hiding (catch)
 import Control.Applicative
 
 import Data.Data (Data)
+import Data.Aeson
+import qualified Data.Aeson.Generic as AG
+
+import Data.Enumerator (($=), ($$), Enumeratee, Iteratee, run_)
+import qualified Data.Enumerator.List as EL (map, consume)
 
 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)
 
      -> 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"
+    case fromJSON $ Object res of
+        Success (DocSig i r) -> return $ CouchDoc i r $ parseObjToGen res
+        _ ->  throw $ CouchError Nothing "Error parse signature."
 
 -- | Put an object in Couch DB, returning the new Revision. 
 couchPut :: (MonadCouch m, Data a) =>
     couchPut p rev1 q a
   where
     handler (CouchError (Just 404) _) = return ""
-    handler e = throw e 
+    handler e = throw e
 
+-- | Strictly consumes all view result. Use this if all view data is 
+--   mandatory and all errors must be handled.
+consumeView :: (MonadCouch m, Data a) =>
+       Path        -- ^ the dbname is prepended to this string to 
+                   --   form the full path.
+    -> HT.Query    -- ^ Query arguments.
+    -> m [a]
+consumeView p q = 
+    run_ $ couchView p q $= extractViewValue $= parseGeneric $$ EL.consume
+
+-- | Parse 'Object' from 'extractViewValue'.
+parseGeneric :: (Monad m, Data a) => Enumeratee Object a m b    
+parseGeneric = EL.map parseObjToGen
+
+-- | Parse 'Value' to generic.
+parseObjToGen :: Data a => Object -> a
+parseObjToGen v = case AG.fromJSON $ Object v of
+    Success s -> s
+    _ -> throw $ CouchError Nothing "Error parse to Generic"

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 Control.Monad.IO.Class (liftIO)
 
 import Data.Data (Typeable, Data)
 import Data.ByteString (ByteString)
+import qualified Data.Text as T
 import Data.Text.Encoding
 
+import Data.Aeson
+import qualified Data.Enumerator.List as EL
+import           Data.Enumerator hiding (map, mapM)
+
 import Database.CouchDB.Enumerator
 import qualified Database.CouchDB.Enumerator.Generic as CG
 
 tests :: Test
 tests = testGroup "Generic" [
-      testCase "Put and Get" case_forsed
+      testCase "Put and Get" case_forsed,
+      testCase "Iter View" case_view,
+      testCase "Strict View" case_viewConsume
     ]
+
+-- | View value
+data DumpV = DumpV {rev :: String} deriving (Show, Eq, Data, Typeable)
     
 data SimpleDoc = SimpleDoc {
     simpleFoo :: Int,
 } deriving (Show, Eq, Data, Typeable)
 
 case_forsed :: Assertion
-case_forsed = runCouch "localhost" 5984 "testcouchdbenum" $ do
+case_forsed = runCouch "localhost" 5984 "test_cdbe_gen" $ do
     couchPutDb ""
-    r <- CG.couchPut' "gen_doc" [] genDoc 
-    liftIO $ print r
+    _ <- CG.couchPut' "gen_doc" [] $ genDoc 0 
+    CG.CouchDoc _ _ r <- CG.couchGet "gen_doc" [] 
+    liftIO $ r @=? genDoc 0
+    couchDeleteDb ""
     return ()
 
-genDoc :: SimpleDoc
-genDoc = SimpleDoc 2 3 $ encodeUtf8 "И проч"
+case_view :: Assertion
+case_view = runCouch "localhost" 5984 "test_cdbe_gen_view" $ do
+    couchPutDb ""
+    couchPut_ "_design/dataviews" [] viewObj
+    mapM_ (\n -> CG.couchPut' (show n) [] $ genDoc n) ([1..5] :: [Int])
+    r <- run_ $ couchView "dataviews/_view/my" [] 
+            $= extractViewValue $= CG.parseGeneric $$ EL.consume
+    mapM_ (\(ex, f) -> liftIO $ ex @=? f) 
+            $ zip r $ map genDoc ([1..5] :: [Int])
+    couchDeleteDb ""
+
+case_viewConsume :: Assertion
+case_viewConsume = runCouch "localhost" 5984 "test_cdbe_gen_view" $ do
+    couchPutDb ""
+    couchPut_ "_design/dataviews" [] viewObj
+    mapM_ (\n -> CG.couchPut' (show n) [] $ genDoc n) ([1..5] :: [Int])
+    r <- CG.consumeView "dataviews/_view/my" [] 
+    mapM_ (\(ex, f) -> liftIO $ ex @=? f) 
+            $ zip r $ map genDoc ([1..5] :: [Int])
+    couchDeleteDb ""
+
+viewObj :: Value
+viewObj = object 
+    [ "language" .= ("javascript" :: T.Text)
+    , "views" .= object [ "my"  .= object
+        [ "map" .= ("function(doc) {emit(null, doc); }" :: T.Text) ]
+    ] ]
+
+genDoc :: Int -> SimpleDoc
+genDoc n = SimpleDoc n n $ encodeUtf8 "И проч"