From HaskellWiki

CouchDB

CouchDB Haskell package is the Haskell interface to the couchDB database software. I appreciate the efforts of Arjun Guha and Brendan Hickey to construct this interface. I think it is an improvement over the original and most convenient to use!

CouchDB is a document oriented datastorage system (with versions) which is geared towards replication. For more information read Anderson, Lehnardt and Slater's book "CouchDB - The definite guide" ([1]).

Examples how to use the Haskell CouchDB interface are not easy to find on the web. I found only one [2], which is probably compiled with an slightly earlier version of CouchDB than the current 0.10.1.

I created this wiki page to make available the simple examples I coded to learn to use CouchDB and to report of some of the not-so-obvious traps beginners could fall into.

Example: Store and retrieve notes

The simple example I selected is the database backend of a "note" application (e.g. Tomboy or any other of the yellow paste-it notes look-alike). The first function is to store a note, as an example on how to store data in couch:

Store note

Here the code for storing a note and retrieving it with the doc id:

{-# LANGUAGE DeriveDataTypeable , ScopedTypeVariables #-} module Notes1 where import Database.CouchDB ( getDoc , newDoc , runCouchDB' , db , Rev ( .. ), Doc ) import Data.Data ( Data , Typeable ) import Text.JSON import Text.JSON.Pretty ( pp_value ) import Text.JSON.Pretty ( render ) import Text.JSON.Generic ( toJSON , fromJSON ) type Strings = [ String ] -- basic data Note = Note { title , text :: String , tags :: Strings } deriving ( Eq , Ord , Show , Read , Typeable , Data ) -- not yet necessary ------ copied from henry laxon ppJSON = putStrLn . render . pp_value justDoc :: ( Data a ) => Maybe ( Doc , Rev , JSValue ) -> a justDoc ( Just ( d , r , x )) = stripResult ( fromJSON x ) where stripResult ( Ok z ) = z stripResult ( Error s ) = error $ "JSON error " ++ s justDoc Nothing = error "No such Document" -------------------------------- mynotes = db "firstnotes1" n0 = Note "a59" "a1 text vv 45" [ "tag1" ] n1 = Note "a56" "a1 text vv 45" [ "tag1" ] n2 = Note "a56" "updated a1 text vv 45" [ "tag1" ] n1j = toJSON n1 -- convNote2js n1 runNotes1 = do ( doc1 , rev1 ) <- runCouchDB' $ newDoc mynotes n1j putStrLn $ "stored note" ++ show doc1 ++ " revision " ++ show rev1 Just ( _ , _ , jvalue ) <- runCouchDB' $ getDoc mynotes doc1 ppJSON jvalue jstuff <- runCouchDB' $ getDoc mynotes doc1 let d = justDoc jstuff :: Note putStrLn $ "found " ++ show d return () -- the output is: --stored noteaa45700981408039346f9c8c73f8701f -- revision 1-7fa1d1116e6ae0c1ee8d4ce89a701fdf --{"_id": "aa45700981408039346f9c8c73f8701f", -- "_rev": "1-7fa1d1116e6ae0c1ee8d4ce89a701fdf", "title": "a56", -- "text": "a1 text vv 45", "tags": ["tag1"]} --found Note {title = "a56", text = "a1 text vv 45", tags = ["tag1"]}

Multiple functions to store and retrieve notes

Notes have a title, a text and a set of tags. We need functions to store a new note, to update the content of a note and to retrieve all notes with a given word in the title, in the text or as a tag; each of these functions return a list of pairs (doc_id, title) from which the correct one is selected and then retrieved with the doc_id.

I have decided that the notes have IDs produced by couchDB; this assures that changes, even changes in title, continue the same object with a new version.

{-# LANGUAGE DeriveDataTypeable , ScopedTypeVariables #-} module Notes2 ( storeNewNote , changeNoteContent , updateNote , deleteNote , retrieveNote , findNoteByTitle , findNoteByTag , findNoteByContent ) where import Database.CouchDB ( rev , deleteDoc , CouchView ( .. ), newView , Doc ( .. ), isDocString , queryView , getAndUpdateDoc , DB ( .. ), getDoc , newDoc , db , doc , newNamedDoc , runCouchDB' , Rev ( .. )) -- , couchViewToJSON) import Data.Data ( Data , Typeable ) import Text.JSON import Text.JSON.Pretty ( pp_value ) import Text.JSON.Pretty ( render ) import Database.CouchDB.JSON ( jsonObject ) import Text.JSON.Generic ( toJSON , fromJSON ) type Strings = [ String ] -- basic -- from Henry Laxen's code: type QueryViewResult = ( Database . CouchDB . Doc , JSValue ) ppJSON = putStrLn . render . pp_value justDoc :: ( Data a ) => Maybe ( Database . CouchDB . Doc , Rev , JSValue ) -> a justDoc ( Just ( d , r , x )) = stripResult ( fromJSON x ) where stripResult ( Ok z ) = z stripResult ( Error s ) = error $ "JSON error " ++ s justDoc Nothing = error "No such Document" ----- docid_doc :: ( Data a ) => QueryViewResult -> ( Doc , a ) docid_doc ( d , x ) = ( d , stripResult . fromJSON $ x ) where stripResult ( Ok z ) = z stripResult ( Error s ) = error $ "JSON error " ++ s --------------------- some example data mynotes = db mynotesString mynotesString = "firstnotes1" -- the name of the couchdb n0 = Note "a59" "a1 text vv 45" [ "tag1" , "tag2" ] n1 = Note "a56" "a1 text vv 45" [ "tag1" , "tag3" ] n2 = Note "a56" "updated a1 text vv 45" [ "tag1" , "tag2" , "tag4" ] ------------------------------- data Note = Note { title , text :: String , tags :: Strings } deriving ( Eq , Ord , Show , Read , Typeable , Data ) -- not yet necessary storeNewNote :: DB -> Note -> IO () storeNewNote db note = do let jnote = toJSON note -- the ID is set by couchdb ( doc , rev ) <- runCouchDB' $ newDoc db jnote putStrLn $ "stored note" ++ show doc ++ " " ++ show rev return () changeNoteContent :: DB -> Doc -> Note -> IO () changeNoteContent db docid newnote = do ret <- runCouchDB' $ getAndUpdateDoc db ( docid ) ( updateNote newnote ) let rev = maybe ( error "update did not succeed" ) id ret putStrLn $ "changed " ++ show rev return () updateNote :: Note -> JSValue -> IO JSValue updateNote new old = return . const ( toJSON new ) $ old deleteNote :: DB -> Doc -> Rev -> IO () deleteNote db id r = do ret <- runCouchDB' $ deleteDoc db ( id , r ) putStrLn $ "deleted " ++ show ret return () retrieveNote :: DB -> Doc -> IO Note retrieveNote db docid = do ret <- runCouchDB' $ getDoc db docid -- :: Maybe (Doc, Rev, JSValue) -- assumes the note title is the key let n = justDoc ret :: Note putStrLn $ "stored note" ++ show n return n findNoteByTitle :: DB -> String -> IO [( Doc , Note )] findNoteByTitle db tit = do putStrLn $ "search by title using view 'titles' " ++ show tit ret :: [ QueryViewResult ] <- runCouchDB' $ do queryView db ( doc designdoc ) ( doc "bytitle" ) [( "key" , toJSON tit )] putStrLn $ show ret let ls = map docid_doc ret putStrLn $ "result " ++ show ls return ls findNoteByTag :: DB -> String -> IO [( Doc , Note )] findNoteByTag db ta = do putStrLn $ "search by title using view 'titles' " ++ show ta ret :: [ QueryViewResult ] <- runCouchDB' $ do queryView db ( doc designdoc ) ( doc "bytags" ) [( "key" , toJSON ta )] putStrLn $ show ret let ls = map docid_doc ret putStrLn $ "result " ++ show ls return ls findNoteByContent :: DB -> String -> IO [( Doc , Note )] findNoteByContent db word = do putStrLn $ "search by title using view 'titles' " ++ show word ret :: [ QueryViewResult ] <- runCouchDB' $ do queryView db ( doc designdoc ) ( doc "bywords" ) [( "key" , toJSON word )] putStrLn $ show ret let ls = map docid_doc ret putStrLn $ "result " ++ show ls return ls -------------------------------------------------- titleView = "function(doc) { if (doc.title && doc.text && doc.tags) \ \ {emit(doc.title, doc._id); } }" titleView2 = ViewMap "bytitle" titleView tagView = "function(doc) { if (doc.title && doc.text && doc.tags) \ \ { var len=doc.tags.length; \ \ for(var i=0; i<len; i++) { \ \ var value = doc.tags[i]; \ \ emit(value, doc._id); } \ \ } \ \ }" -- tried in temporary views of Futon tagView2 = ViewMap "bytags" tagView wordView = "function (doc) { if (doc.title && doc.text && doc.tags) \ \ { var words = doc.text.split (' '); \ \ var len=words.length; \ \ for(var i=0; i<len; i++) { \ \ var value = words[i]; \ \ emit(value, doc._id); } \ \ } \ \ }" -- use ' for strings inside a haskell string -- escapes are not removed when converting to JSON ? wordView2 = ViewMap "bywords" wordView --- setting views: designdoc = "five" -- "six" -- change for each edit -- cannot update! setViews dbstring = do r <- runCouchDB' $ newView dbstring designdoc [ titleView2 , tagView2 , wordView2 ] -- inconsistency: here a string, not a DB type ! putStrLn $ "view stored" return () ---- run2 = do storeNewNote mynotes n0 retrieveNote mynotes ( doc "c4bf00e96e2446ce1508ba055e9b7ef6" ) changeNoteContent mynotes ( doc "c4bf00e96e2446ce1508ba055e9b7ef6" ) n2 retrieveNote mynotes ( doc "c4bf00e96e2446ce1508ba055e9b7ef6" ) return () --stored note68d5cfa3622c4586a7a1bfc695e72765 1-dee34e8ccb4ef3ceb9a7dcfb3d7cd20d --stored noteNote {title = "a1234", text = "a1 text vv 45", tags = ["tag1"]} --changed 2-53bfc49b385805020194a59b39fd5ffb --stored noteNote {title = "a56", text = "updated a1 text vv 45", tags = ["tag1","tag2","tag4"]} -- error when duplicate is not appropriate: --stored note"\"*** Exception: src/Database/CouchDB/Unsafe.hs:80:10-63: Irrefutable pattern failed for pattern (Text.JSON.Types.JSObject errorObj) run3 :: IO () = do setViews mynotesString return () run4 :: IO () = do ls :: [( Doc , Note )] <- findNoteByTitle mynotes "a55" putStrLn $ "found by title " ++ show ls return ()



Notice that the syntax for retrieval has changed since the example code for "converting from MySQL to CouchDB" was written: no preceeding "/_design/" in the name of the view.

= A few suggestions for improvement in the interface Most annoying is that design documents cannot be updated; a new set must be stored with a new name. A function updateView would be useful. The type of newView is not consistent with the other calls - it requires the name of the couchDB as a String, not a DB type. I used couchViewToJSON to test the views i wrote - it could be useful to export it.





Coda

I do not guarantee for the correctness of the code (of course). I hope it is useful. I invite others to contribute their examples or more complex codes so we can learn from each other.

I am currently working on using couchDB and interested to hear comments at frank at geoinfo dot tuwien dot ac dot at.