Generic.hs

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}


-- | Generic tests. For tests make database "testcouchdbenum"
module Database.CouchDB.Enumerator.Test.Generic where

import Test.Framework (testGroup, Test)
import Test.Framework.Providers.HUnit (testCase)
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 "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,
    simpleBar :: Int,
    simpleStr :: ByteString
} deriving (Show, Eq, Data, Typeable)

case_forsed :: Assertion
case_forsed = runCouch "localhost" 5984 "test_cdbe_gen" $ do
    couchPutDb ""
    _ <- CG.couchPut' "gen_doc" [] $ genDoc 0 
    CG.CouchDoc _ _ r <- CG.couchGet "gen_doc" [] 
    liftIO $ r @=? genDoc 0
    couchDeleteDb ""
    return ()

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 "И проч"