couchdb-conduit-0.5.0: Couch DB client library using http-conduit and aeson

Safe HaskellSafe-Infered

Database.CouchDB.Conduit.Generic

Contents

Description

Generic methods for CouchDB documents. Unlike explicit, generic methods uses Data.Generic.

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

 import Control.Monad.IO.Class (liftIO)
 import Data.Generic (Data, Typeable)
 import Database.CouchDB.Conduit
 import Database.CouchDB.Conduit.Generic

 -- | Our doc with instances
 data D = D { f1 :: Int, f2 :: String } deriving (Show, Data, Typeable)
 
 runCouch def $ do
    -- Put new doc and update it
    rev1 <- couchPut "mydb" "my-doc1" "" [] $ D 123 "str"         
    rev2 <- couchPut "mydb" "my-doc1" rev1 [] $ D 1234 "another"

    -- get it and print
    (rev3, d1 :: D) <- couchGet "mydb" "my-doc1" [] 
    liftIO $ print d1

    -- update it in brute-force manner    
    couchPut' "mydb" "my-doc1" [] $ D 12345 "third"    -- notice - no rev
    
    -- get revision and delete
    rev3 <- couchRev "mydb" "my-doc1"
    couchDelete "mydb" "my-doc1" rev3

The main advantage of this approach in the absence of tonns of boilerplate code. The main disadvantage is inability to influence the process of translation to and from JSON.

For details of types see Data.Aeson.Generic. To work with documents in explicit manner, look at Database.CouchDB.Conduit.Explicit.

Synopsis

Accessing documents

couchGetSource

Arguments

:: (MonadCouch m, Data a) 
=> Path

Database

-> Path

Document path

-> Query

Query

-> ResourceT m (Revision, a) 

Load a single object from couch DB.

Manipulating documents

couchPutSource

Arguments

:: (MonadCouch m, Data a) 
=> Path

Database

-> Path

Document path

-> Revision

Document revision. For new docs provide empty string.

-> Query

Query arguments.

-> a

The object to store.

-> ResourceT m Revision 

Put an object in Couch DB with revision, returning the new Revision.

couchPut_Source

Arguments

:: (MonadCouch m, Data a) 
=> Path

Database

-> Path

Document path

-> Query

Query arguments.

-> a

The object to store.

-> ResourceT m Revision 

"Don't care" version of couchPut. Creates document only in its absence.

couchPut'Source

Arguments

:: (MonadCouch m, Data a) 
=> Path

Database

-> Path

Document path

-> Query

Query arguments.

-> a

The object to store.

-> ResourceT m Revision 

Brute force version of couchPut. Creates a document regardless of presence.

Working with views

toType :: (ResourceIO m, Data a) => Conduit Value m aSource

Convert CouchDB view row or row value from View to concrete type.

 res <- couchView "mydesign" "myview" [] $ rowValue =$= toType =$ consume