{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-} module Database.CouchDB.Conduit.Test.Explicit (tests) where import Test.Framework (testGroup, mutuallyExclusive, Test) import Test.Framework.Providers.HUnit (testCase) import Test.HUnit (Assertion, (@=?)) import Database.CouchDB.Conduit.Test.Util import Control.Exception.Lifted (bracket_) import Control.Monad.IO.Class (liftIO) import Control.Applicative ((<$>), (<*>), empty) import Data.ByteString (ByteString) import Data.Aeson import Data.ByteString.UTF8 (fromString) import Database.CouchDB.Conduit import Database.CouchDB.Conduit.Explicit tests :: Test tests = mutuallyExclusive $ testGroup "Explicit" [ testCase "Just put-get-delete" case_justPutGet, testCase "Mass flow" case_massFlow, testCase "Mass Iter" case_massIter ] data TestDoc = TestDoc { kind :: String, intV :: Int, strV :: String } deriving (Show, Eq) instance FromJSON TestDoc where parseJSON (Object v) = TestDoc <$> v .: "kind" <*> v .: "intV" <*> v .: "strV" parseJSON _ = empty instance ToJSON TestDoc where toJSON (TestDoc k i s) = object ["kind" .= k, "intV" .= i, "strV" .= s] case_justPutGet :: Assertion case_justPutGet = bracket_ setup teardown $ runCouch conn $ do rev <- couchPut "doc-just" "" [] $ TestDoc "doc" 1 "1" rev' <- couchPut "doc-just" rev [] $ TestDoc "doc" 2 "2" rev'' <- couchRev "doc-just" liftIO $ rev' @=? rev'' couchDelete "doc-just" rev'' case_massFlow :: Assertion case_massFlow = bracket_ setup teardown $ runCouch conn $ do revs <- mapM (\n -> couchPut (docn n) "" [] $ TestDoc "doc" n $ show n ) [1..100] liftIO $ length revs @=? 100 revs' <- mapM (\n -> couchRev $ docn n) [1..100] liftIO $ revs @=? revs' liftIO $ length revs' @=? 100 mapM_ (\(n,r) -> couchDelete (docn n) r) $ zip [1..100] revs' where docn n = fromString $ "doc-" ++ show (n :: Int) case_massIter :: Assertion case_massIter = bracket_ setup teardown $ runCouch conn $ mapM_ (\n -> do let name = docn n let d = TestDoc "doc" n $ show n rev <- couchPut name "" [] d couchDelete (docn n) rev _ <- couchPut name "" [] d rev'' <- couchPut' name [] d (_, d') <- couchGet name [] liftIO $ d @=? d' couchDelete (docn n) rev'' ) [1..100] where docn n = fromString $ "doc-" ++ show (n :: Int) setup :: IO () setup = setupDB dbName teardown :: IO () teardown = tearDB dbName conn :: CouchConnection conn = def {couchDB = dbName} dbName :: ByteString dbName = "cdbc_test_explicit"