Henry Laxen June 1, 2008

Why

My former website, which I started about ten years ago, is really beginning to show its age. The dynamic part of it was written with perl, MySQL, and HTML::Mason, which was (and in many respects still is) good technology, but about once a month or so I get an email that some page or other crashed. Getting those last few bugs out of your perl code, especially after not looking at it for a few years, can be a very daunting task. So my project for the foreseeable future is to redo the site with new bright and shiny technology. For this I've chosen Haskell, happstack, and CouchDB. The first step in the transition is getting my data out of MYSQL and getting it into CouchDB. My hope is that by documenting my experience, I can save others who choose the same (or similar) path some of the pain and frustration I experienced during this transition.

Another Why

Although I have been learning and using Haskell for more than a year now, my feeble mind has a very hard time getting itself around the documentation. Yes, if you are really brilliant, the documentation provided is sometimes necessary, but rarely sufficient, to understand what the code does. Personally, I like to learn by example, and thus far examples are severely lacking in most of the Haskell documentation I have encountered. My hope is that by reading this paper, you will be able to avoid many of the blind alleys I had to go down in order to produce working code. It may not be the best or most elegant solution to the problem, but at least you have something to start with. It reminds me of what my best friend used to tell me: Better is the enemy of good.

One comment before we begin. This code runs on my system, but of course it won't run on yours. I doubt you have MySQL tables laid out like mine, and that your usernames and passwords are the same. However, with minimal editing, there is no reason why you couldn't make all of this code run on your system, and learn a lot in the process.

So let's get started. Here is the table that describes what data I am keeping about each user. My goal is to get something similar into a CouchDB database and use Haskell to do the conversion.


    CREATE TABLE `User` (
      `user_id` int(10) unsigned NOT NULL auto_increment,
      `user_key` varchar(40) NOT NULL default '',
      `first_name` varchar(40) NOT NULL default '',
      `last_name` varchar(40) default NULL,
      `password` varchar(40) NOT NULL default '',
      `email` varchar(40) default NULL,
      `alternate_email` varchar(40) default NULL,
      `email_bounce` int(11) default NULL,
      `email_active` char(1) default NULL,
      `last_visit` date default NULL,
      `next_to_last_visit` date default NULL,
      PRIMARY KEY  (`user_id`),
      UNIQUE KEY `user_key` (`user_key`)
    )   

The first thing I wanted to do is just use Haskell to fetch a few rows of my data, and take a look at it. I proceeded as follows:

> {-# LANGUAGE DeriveDataTypeable #-}
> import qualified Database.HSQL.MySQL as My
> import Database.HSQL
> import Database.CouchDB
> import Data.Ratio
> import Control.Monad
> import Text.JSON
> import Text.JSON.Pretty
> import Text.JSON.Generic
> import Data.Data
> import Data.Char
> import Data.Maybe

Since I already wrote this code once, I discovered a few patterns that I used over and over again. I've put them here at the beginning, to make life a little easier.

> type QueryViewResult = (Database.CouchDB.Doc,JSValue)
> type JSObjectItem = (String, JSValue)
>   
> user = db "user"
> aFew = take 3
>
> unJSObject :: JSValue -> [(String, JSValue)]
> unJSObject (JSObject x) = fromJSObject x
> ppJSON :: JSValue -> IO ()  -- pretty print a JSON value
> ppJSON = putStrLn . render . pp_value

Now lets grab some data from MySQL and have a look at it:

> openDB :: IO Connection
> openDB = 
>   My.connect "localhost.localdomain" "dbName" "dbUser" "dbPassword"
> getSqlData :: Connection -> String -> IO ([(String, SqlType, Bool)], [[String]])
> getSqlData con sqlStatement = do
>  stmt <- query con sqlStatement
>  let fields = getFieldsTypes stmt
>  let fieldnames = map (\(a,_,_) -> a) $ getFieldsTypes stmt
>  values <- forEachRow (\st s -> do
>   v <- mapM (getFieldValue st) fieldnames
>   -- when something dies, put a "print (head v)" here
>   return $ s ++ [v]
>   ) stmt []
>  return (fields,values)
> 
> run1 :: IO ([(String, SqlType, Bool)], [[String]])
> run1 = do
>   conn <- openDB
>   getSqlData conn "select * from User"
> 
> test1 = do
>   (fields,values) <- run1
>   putStrLn (show fields)
>   print $ aFew values

which on my system printed out the following (reformatted):


      [("user_id",SqlInteger,False),
      ("user_key",SqlVarChar 40,False),
      ("first_name",SqlVarChar 40,False),
      ("last_name",SqlVarChar 40,True),
      ("password",SqlVarChar 40,False),
      ("email",SqlVarChar 40,True),
      ("alternate_email",SqlVarChar 40,True),
      ("email_bounce",SqlInteger,True),
      ("email_active",SqlChar 1,True),
      ("last_visit",SqlDate,True),
      ("next_to_last_visit",SqlDate,True)]

       [["1","williamxx","William","Hudsun","xxxxxx","dynamicg@a.com",
         "dynamicg@a.com","0","1","2005-01-01","2005-01-01"],
       ["2","deanxxx","Dean","Murrisun","xxxxxx","dinum@a.com",
         "dinum@a.com","0","1","2003-02-24","2003-02-04"],
       ["3","calandcindixxx","Cal and Cindi","Huuver","xxxxxx",
         "lucumutiunusa@a.com",
         "calandcindi@a.com","0","1","2003-12-08","2005-01-01"]]

Great, we can get data out of the MySQL database. The next step is to convert it to a JSON value, so that we can stick it into a CouchDB database. While I'm at it, I thought I should clean up some of the datatypes and I might as well use Haskell to write a little code for me. So I tried the following:

> type ConvertSqlToJSON = SqlType -> String -> JSValue 
> cv1 :: ConvertSqlToJSON   -- > cv1 = convert value
> cv1 (SqlChar 1) x =    JSBool (x/="0") -- convert to a Bool
> cv1 (SqlVarChar _) x = JSString (toJSString x)
> cv1 SqlInteger x =     JSRational False ((read x)%1)
> cv1 SqlDate x =        JSString (toJSString x) -- convert to String
> 
> cd1 :: (String,SqlType,Bool) -> String  -- > cd1 = convert to data
> cd1 (s,SqlInteger,_) =   s ++ " :: Int,\n"
> cd1 (s,SqlChar 1,_) =    s ++ " :: Bool,\n"
> cd1 (s,SqlVarChar _,_) = s ++ " :: String,\n"
> cd1 (s,SqlDate,_) =      s ++ " :: String,\n"
> 
> sqlToJSON :: [String] -> [SqlType] -> [String] -> 
>              ConvertSqlToJSON -> JSValue
> sqlToJSON names types value convertF =  makeObj (zip names values)
>   where
>     values = map (uncurry convertF) (zip types value)
> 
> run2  = do
>   (fields,values) <- run1
>   let (names,types,_) = unzip3 fields
>   jvalues <- forM (aFew values) (\x -> do
>         return $ sqlToJSON names types x cv1)
>   return (concatMap cd1 fields, jvalues)
> 
> test2 = do
>   (fields,values) <- run2
>   putStrLn fields
>   print values
>     

Now running test2 produced:

    user_id :: Int,
    user_key :: String,
    first_name :: String,
    last_name :: String,
    password :: String,
    email :: String,
    alternate_email :: String,
    email_bounce :: Int,
    email_active :: Bool,
    last_visit :: String,
    next_to_last_visit :: String,

which I copied and pasted into:

     data User = User {
     ...
       } deriving (Eq,Ord,Read,Show,Typeable, Data)

and something horrible like:

    JSONObject {fromJSObject = [("user_id",JSRational False (1 %
    1)),("user_key",JSString (JSONString {fromJSString =
    "williamlolohud"})),("first_name",JSString (JSONString
    {fromJSString = "William"})),("last_name",JSString (JSONString
    {fromJSString = "Hudson"})),("password",JSString (JSONString
    {fromJSString = "xxxxxx"})),("email",JSString (JSONString
    {fromJSString =
    "dynamicg@a.com"})),("alternate_email",JSString (JSONString
    {fromJSString = "dynamicg@a.com"})),("email_bounce",JSRational
    False (0 % 1)),("email_active",JSBool
    True),("last_visit",JSString (JSONString {fromJSString =
    "2005-01-01"})),("next_to_last_visit",JSString (JSONString
    {fromJSString = "2005-01-01"}))]} ...

I would have been much better off doing:

> test3 = do
>   (_,jvalues) <- run2
>   mapM_ ppJSON (aFew jvalues)    

resulting in:

     {"user_id": 1, "user_key": "williamlolohud",
      "first_name": "William", "last_name": "Hudson",
      "password": "xxxxxx", "email": "dynamicg@a.com",
      "alternate_email": "dynamicg@a.com", "email_bounce": 0,
      "email_active": true, "last_visit": "2005-01-01",
      "next_to_last_visit": "2005-01-01"}
     {"user_id": 2, "user_key": "deandino", "first_name": "Dean",
      "last_name": "Morrison", "password": "xxxxxx",
      "email": "dinom@a.com",
      "alternate_email": "dinom@a.com", "email_bounce": 0,
      "email_active": true, "last_visit": "2003-02-24",
      "next_to_last_visit": "2003-02-04"}
     {"user_id": 3, "user_key": "calandcindiroy",
      "first_name": "Cal and Cindi", "last_name": "Hoover",
      "password": "xxxxxx", "email": "locomotionusa@a.com",
      "alternate_email": "calandcindi@a.com", "email_bounce": 0,
      "email_active": true, "last_visit": "2003-12-08",
      "next_to_last_visit": "2005-01-01"}
> showUser :: String -> IO ()
> showUser idString = do
>   Just (_,_,jvalue) <- runCouchDB' $ getDoc user (doc idString)
>   ppJSON jvalue
>   

Now that looks like it might actually be right. Now let's see if we can stick this into a CouchDB database. I created a database named user using the futon interface, and then proceeded with:

> test4 = do
>   (fields,values) <- run1
>   let (names,types,_) = unzip3 fields
>   runCouchDB' $ do
>     mapM_ (\x -> newDoc user (sqlToJSON names types x cv1)) values
> 

and a few minutes later I am rewarded with a database containing 1846 documents, each one looking like:

    _id	"000c6bddf83a6662d1a54bacdb059bc1"
    _rev	"1-2462198463"
    alternate_email	"ecodwelling@a.com"
    email	"maas.k@a.com"
    email_active	true
    email_bounce	0
    first_name	"Kenneth"
    last_name	"Maas"
    last_visit	"2004-10-31"
    next_to_last_visit	"2004-10-15"
    password	"xxxxxx"
    user_id	1140
    user_key	"kennethcrab"

Great, we have a bunch of data to play with. Now let's see if we can grab it and put it inside of a Haskell data type. Just so you don't have to scroll back, earlier we defined:

> 
> data SqlUser = SqlUser {
>   user_id :: Int,
>   user_key :: String,
>   first_name :: String,
>   last_name :: String,
>   password :: String,
>   email :: String,
>   alternate_email :: String,
>   email_bounce :: Int,
>   email_active :: Bool,
>   last_visit :: String,
>   next_to_last_visit :: String 
>   } deriving (Eq,Ord,Read,Show,Typeable, Data)
> 

So now lets grab a CouchDB doc and see if we can stick it in our data type. getDoc returns a bunch of stuff besides the actual JSON data, so we define justDoc to unwrap it at get at the data we are interested in.

> 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"
>     
> test5 = do
>   d1 <- runCouchDB' $ do
>     d2 <-  getDoc user (doc "000c6bddf83a6662d1a54bacdb059bc1")
>     return (justDoc d2 :: SqlUser) 
>   print d1
>     

resulting in:

     SqlUser {user_id = 1140, user_key = "kennethcrab", first_name =
     "Kenneth", last_name = "Maas", password = "xxxxxx", email =
     "maas.k@a.com", alternate_email =
     "ecodwelling@a.com", email_bounce = 0, email_active =
     True, last_visit = "2004-10-31", next_to_last_visit =
     "2004-10-15"}

A real live Haskell data type! Cool. So, what I want to do now, is remove the user_key field, and add a field to the document identifying the type of the document, namely {docType:"user"}. While I'm at it, I'll convert the names to a more Haskell-esqe look by removing the underscores, and capitalizing the next letter. Furthermore, I want to do this for all of the documents in the database. Time to roll out a couple more CouchDB functions, namely getAllDocIds and getAndUpdateDoc.

> rename :: String -> String
> rename s = prefix ++ fix rest
>   where 
>     (prefix,rest) = span (== '_') s   -- ignore leading _'s
>     fix (x:'_':y:ys) = x : (toUpper y) : fix ys
>     fix (x:xs) = x : fix xs
>     fix [] = []
>   
> tidyUser :: [JSObjectItem] -> [JSObjectItem]
> tidyUser x = addType . renameKeys . removeFields $ x
>   where
>     removeFields = filter (\(x,_) -> x /= "user_key")
>     renameKeys = map (\(x,y) -> (rename x,y))
>     addType = flip (++) [("docType",showJSON "user")]
> 
> test6 = do
>   runCouchDB' $ do
>     ids <- getAllDocIds user
>     forM_ ids (\x -> do
>       getAndUpdateDoc user x update)
>   where
>     update z = return $ toJSObject .  tidyUser . fromJSObject $ z
> 

if we now run showUser on some random _id we will see:


     {"_id": "000c6bddf83a6662d1a54bacdb059bc1", "_rev": "4-10419220",
      "userId": 1140, "firstName": "Kenneth", "lastName": "Maas",
      "password": "xxxxxx", "email": "maas.k@a.com",
      "alternateEmail": "ecodwelling@a.com", "emailBounce": 0,
      "emailActive": true, "lastVisit": "2004-10-31",
      "nextToLastVisit": "2004-10-15", "docType": "user"}

Life is good. The keys have been converted, the user_key field has been removed, and the docType field has been added. What I did next was to go back to the futon interface and compact the database. This resulted in all of the previous revisions (the docs with the underscores) being removed. But since I'm coming from a MySQL background, you can bet I have other tables lying around that reference the user table. In fact, one of the apps available on my website is a kind of multiple listing service for the home buyers and sellers in the area. My goal was to try to clean up the byzantine real estate practices that are common down here by providing publically accessible information. (I'm still working on that one.)

So,

> run7 :: IO ([(String, SqlType, Bool)], [[String]])
> run7 = do
>   conn <- openDB
>   getSqlData conn "select * from mops_buyer"
> test7 = do
>   (fields,values) <- run7
>   print fields
>   print $ aFew values

which results in:


     [("buyer_id",SqlInteger,False),("user_id",SqlInteger,False),
      ("search_district",SqlChar 20,True),("search_type",SqlChar 20,True),
      ("search_bedrooms",SqlReal,True),("search_bathrooms",SqlReal,True),
      ("low_price",SqlReal,True),("high_price",SqlReal,True),
      ("search_currency",SqlChar 1,True),("display_order",SqlChar 1,True)]

     [["175","831","1","2","2","1","0","1e+07","2","1"],
      ["2","31","1","12","2","1","0","75000","2","1"],
      ["3","32","1","12","2","2","0","125000","2","1"]]

Now my plan is that instead of having a separate document that holds the buyer data, I'll just pull it into an object in the existing user document. In essence I'm doing a join, based on the user_id field present in a buyer row. I also want to clean up the data while I'm at it. But before we go there, let's take a look at how we can create and run views.

> test8 = do
>   runCouchDB' $ do
>     newView "user" "mops" -- (mops = Mazatlan Online Property System)
>        [ ViewMap "byuserid" 
>                  "function(doc) {emit(doc.userId, doc);}" ] 
> limit :: JSObjectItem
> limit = ("limit", showJSON (3::Int))
> test9 = do
>   a :: [QueryViewResult] <- runCouchDB' $ do
>       queryView user  (doc "/_design/mops") (doc "byuserid") 
>           [ limit ] 
>   mapM_ (ppJSON . snd) a

which results in:

     {"_id": "3c98d483cde5d7da899b8f4ea877bd38", "_rev": "2-2948703597",
      "userId": 1, "firstName": "William", "lastName": "Hudson",
      "password": "xxxxxx", "email": "dynamicg@a.com",
      "alternateEmail": "dynamicg@a.com", "emailBounce": 0,
      "emailActive": true, "lastVisit": "2005-01-01",
      "nextToLastVisit": "2005-01-01", "docType": "user"}
     {"_id": "932e15f0e3f00f769013cc5788becbcf", "_rev": "2-1437920368",
      "userId": 2, "firstName": "Dean", "lastName": "Morrison",
      "password": "xxxxxx", "email": "dinom@a.com",
      "alternateEmail": "dinom@a.com", "emailBounce": 0,
      "emailActive": true, "lastVisit": "2003-02-24",
      "nextToLastVisit": "2003-02-04", "docType": "user"}
     {"_id": "2832c0b77b1a3c35b6eb663da19c5772", "_rev": "2-2783322955",
      "userId": 3, "firstName": "Cal and Cindi", "lastName": "Hoover",
      "password": "xxxxxx", "email": "locomotionusa@a.com",
      "alternateEmail": "calandcindi@a.com", "emailBounce": 0,
      "emailActive": true, "lastVisit": "2003-12-08",
      "nextToLastVisit": "2005-01-01", "docType": "user"}

Now let me explain what is happening here. I wanted to be able to ask the question, is x contained in [y], in perl, knowing that most of the users didn't care if x was contained in [y], namely they were happy with any [y]. Since I was using perl, I came up with this scheme to let strings represent the possible values of [y], and I gave x="1" the special property that it was an element of any [y]. Now that I am converting this to Haskell, it is time to pay the piper and clean things up, so I will translate my perl/sql data into the Contains data type defined below.

> data Contains = Any | Some [Int] deriving (Eq,Ord,Read,Show,Typeable, Data)
> 
> ordering :: [Int]
> ordering = [ord '1' .. ord '9']   ++  
>            [ord 'A' .. ord 'Z']   ++  
>            [ord 'a' .. ord 'z']
> mapFrom :: String -> [Int]
> mapFrom x = map (\c -> (fromJust $ lookup (ord c) (zip ordering [0..]))) x 
> cv2 :: ConvertSqlToJSON
> cv2 (SqlChar 20) x = toJSON $ if x == "1" then Any 
>                                  else Some $ (map (\y -> y-1)) (mapFrom x) 
> cv2 SqlInteger x = toJSON (read x :: Int)
> cv2 SqlReal x = toJSON (read x :: Float)
> cv2 (SqlChar 1) x = toJSON $ head (mapFrom x)
> test10 = do
>   (fields,values) <- run7
>   let (names,types,_) = unzip3 fields
>   jvalues <- forM (aFew values) (\x -> do
>         return $ sqlToJSON names types x cv2)
>   mapM_ ppJSON  jvalues

resulting in:

     {"buyer_id": 175, "user_id": 831, "search_district": "Any",
      "search_type": {"Some": [0]}, "search_bedrooms": 2,
      "search_bathrooms": 1, "low_price": 0, "high_price": 10000000,
      "search_currency": 1, "display_order": 0}
     {"buyer_id": 2, "user_id": 31, "search_district": "Any",
      "search_type": {"Some": [-1, 0]}, "search_bedrooms": 2,
      "search_bathrooms": 1, "low_price": 0, "high_price": 75000,
      "search_currency": 1, "display_order": 0}
     {"buyer_id": 3, "user_id": 32, "search_district": "Any",
      "search_type": {"Some": [-1, 0]}, "search_bedrooms": 2,
      "search_bathrooms": 2, "low_price": 0, "high_price": 125000,
      "search_currency": 1, "display_order": 0}

Whoops, it appears that I forgot how inconsistent I was ten years ago. Apparently the search_type does not have an any choice. I'll have to fix that. This is ugly, but I think the easiest way to do it is to modify the value I get back from the sql before I convert it to JSON. So I'm going to modify test10 to become:

> replace :: Int -> (a -> a) -> [a] -> [a]
> replace i f (y:ys)
>  | i > 0     = y : replace (i - 1) f ys
>  | otherwise = f y : ys
> replace _ _ _ = []
> 
> add1 :: String -> String
> add1 = map (\x -> chr $ (ord x) + 1)
> 
> test11 = do
>   (fields,values) <- run7
>   let (names,types,_) = unzip3 fields
>   jvalues <- forM (aFew values) (\x -> do
>     let y = replace 3 add1 x  -- 3 is the index of the search_type field
>     return $ sqlToJSON names types y cv2
>     )
>   mapM_ ppJSON  jvalues

resulting in:

     {"buyer_id": 175, "user_id": 831, "search_district": "Any",
      "search_type": {"Some": [1]}, "search_bedrooms": 2,
      "search_bathrooms": 1, "low_price": 0, "high_price": 10000000,
      "search_currency": 1, "display_order": 0}
     {"buyer_id": 2, "user_id": 31, "search_district": "Any",
      "search_type": {"Some": [0, 1]}, "search_bedrooms": 2,
      "search_bathrooms": 1, "low_price": 0, "high_price": 75000,
      "search_currency": 1, "display_order": 0}
     {"buyer_id": 3, "user_id": 32, "search_district": "Any",
      "search_type": {"Some": [0, 1]}, "search_bedrooms": 2,
      "search_bathrooms": 2, "low_price": 0, "high_price": 125000,
      "search_currency": 1, "display_order": 0}

Now let's go ahead in stick these rows into CouchDB. I'll Haskellize the names as before, and add one more field, namely docType = mopsBuyer.

> tidyBuyer :: [JSObjectItem] -> [JSObjectItem]
> tidyBuyer x = addType . renameKeys $ x
>   where
>     renameKeys = map (\(x,y) -> (rename x,y))
>     addType = flip (++) [("docType",showJSON "mopsBuyer")]
> 
> test12 = do
>   (fields,values) <- run7
>   let (names,types,_) = unzip3 fields
>   runCouchDB' $ do
>     forM_ values (\x -> do
>       let y = replace 3 add1 x
>       let v = (makeObj . tidyBuyer . unJSObject) $
>                 sqlToJSON names types y cv2
>       newDoc user v
>       )

Okay, at this point I went back into the futon utility, and created a view in a design document. I wrote a simple little javascript program, which I saved as join1 in design document mops as follows:

     function(doc) {
       if (doc.docType == "mopsBuyer") {
         emit([doc.userId,0], doc);
       } else if (doc.docType == "user") {
           emit([doc.userId,1], doc);
      }
     }    

which spits out all of the documents, in sorted order, with mopsBuyer docTypes preceding user docTypes, if they exist. I can use this view to do a join, by incorporating the mopsBuyer docType into a user doc.

> addMopsInfo :: JSValue -> JSValue -> JSValue
> addMopsInfo  buyerDoc  userDoc = addField $ removeUnwanted
>   where
>     notWanted :: [String]
>     notWanted = ["buyerId","userId","docType","_id","_rev"]
>     removeUnwanted :: [JSObjectItem]
>     removeUnwanted = filter (\x -> fst x `notElem` notWanted) 
>                      (unJSObject buyerDoc)
>     addField :: [JSObjectItem] -> JSValue
>     addField x = makeObj $ (unJSObject userDoc) ++ [("mopsBuyer", makeObj x)]
> 
> printView :: QueryViewResult -> IO ()
> printView (docID,jvalue) = do
>   putStrLn $ (show docID) ++ " ->\n   " ++ (render . pp_value ) jvalue
>  
> join2 :: [QueryViewResult] -> IO ()
> join2 [_] = return ()
> join2 []  = return ()
> join2 (x1:x2:xs) = do
>   let isBuyer = isJust $ lookup "buyerId" (unJSObject (snd x1))
>       update = const $ return (addMopsInfo (snd x1) (snd x2))
>   if isBuyer 
>     then do
>       runCouchDB' $ do
>         getAndUpdateDoc user (fst x2) update
>         forceDeleteDoc  user (fst x1)
>       join2 xs
>     else join2 (x2:xs)
>      
> test13 = do
>   r :: [QueryViewResult] <- runCouchDB' $
>       queryView user  (doc "/_design/mops") (doc "join1") []
>   join2 r
>
> test14 = showUser "0071c83f5990ac6efcc761bb7f3d7449"  -- some user who 
>                                                       -- is a mopsBuyer

Running test13 followed by test14 results in:

    {"_id": "00558ccbcce5040cdb1c6e0eafaf123c", "_rev": "3-3763208442",
     "userId": 1498, "firstName": "Mike", "lastName": "Vukasinovich",
     "password": "xxxxxx", "email": "eastcounty@a.com",
     "alternateEmail": "eastcounty@a.com", "emailBounce": 0,
     "emailActive": true, "lastVisit": "2006-04-17",
     "nextToLastVisit": "2006-04-17", "docType": "user",
     "mopsBuyer": {"searchDistrict": "Any",
                   "searchType": {"Some": [0, 1]}, "searchBedrooms": 0,
                   "searchBathrooms": 0, "lowPrice": 0, "highPrice": 10000000,
                   "searchCurrency": 1, "displayOrder": 0}}

Which looks like what I wanted. The mopsBuyer info has been absorbed by the user doc. If we want to start over, we can delete the CouchDB database and regenerate it with:

> runall = test4 >> test6 >> test12 >> test13

Let's stop here and review what we've done. We've grabbed some data from a MySQL database, and looked at what came out with test1. We saw that we can get the names, types, and values of the data. We then wrote some code to convert the sql data to JSON, and a little more code to print out the Haskell data type associated with this MySQL table in test2. In test3 we used the JSON pretty printer to display the converted sql data in a more readable format. Then, in test4 we put the data into a CouchDB database. In test5 we grabbed some data out of the CouchDB database and used the generic JSON conversion to convert it into a Haskell data type. Then, in test6 we updated the CouchDB docs to change both the names and some of the objects of the JSON data. In test7, we took a look at an associated MySQL table, which references keys in the user table defined previously. In test8 we used Haskell to add a new view to CouchDB, and in test9 we used the view to look at the CouchDB database in a different way. In test10 we grabbed some data from the mops_buyer table, converted it to JSON, and took a look at it, realizing that our conversion was in error, which we fixed in test11. Then in test12, we took the result of the conversion, cleaned it up some more, and put it into a bunch of new CouchDB docs, adding a field that told us this doc was a mopsBuyer, and not a user. We then wrote a relatively trivial piece of javascript to view the existing CouchDB data, such that it was displayed with all mopsBuyer type docs just before their associated user type doc. Using this view, we were able to do a join of the mopsBuyer table into the user table in test13. The end result is a bunch of CouchDB documents, each one describing a user of the maztravel.com system. Those users that were interested in learning about new properties for sale had a mopsBuyer field that contained the parameters of the properties they were interesting in learning more about. In addition, the type system of Haskell, forced me, kicking and screaming, to clean up some of the inconsistencies that perl let me get away with when I first built the system ten years ago. Not bad for a days work.

This file is also available as an lhs file if you want to play with it.

Quote of the day:
A dog teaches a boy fidelity, perseverance, and to turn around three times before lying down.
Robert Benchley

Sitemap
Go up to Haskell Go up to Home Page of Nadine Loves Henry
Go back to A Tale of Two Approaches Continue with Cheat Sheet for JinJings MPS Stuff