structured-mongoDB-0.1: Structured MongoDB interface

Database.MongoDB.Structured

Description

This module exports a structued interface to MongoDB. Specifically, Haskell record types are used (in place of BSON) to represent documents which can be inserted and retrieved from a MongoDB. Data types corresponding to fields of a document are used in forming well-typed queries, as opposed to strings. This module re-exports the Database.MongoDB.Structured.Types module, which exports a Structured type class --- this class is used to convert Haskell record types to and from BSON documents. The module Database.MongoDB.Structured.Query exports an interface similar to Database.MongoDB.Query which can be used to insert, query, update, delete, etc. record types from a Mongo DB.

Though users may provide their own instances for Structured (and Selectable, used in composing well-typed queries), we provide a Template Haskell function (deriveStructured) that can be used to automatically do this. See Database.MongoDB.Structured.Deriving.TH.

The example below shows how to use the structued MongoDB interface:

    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE TypeSynonymInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    import Database.MongoDB.Structured
    import Database.MongoDB.Structured.Deriving.TH
    import Control.Monad.Trans (liftIO)
    import Data.Typeable
    import Control.Monad (mapM_)
    import Control.Monad.IO.Class
    import Data.Bson (Value)
    import Data.Maybe (isJust, fromJust)

    data Address = Address { addrId :: SObjId
                           , city   :: String
                           , state  :: String
                           } deriving (Show, Eq, Typeable)
    $(deriveStructured ''Address)

    data Team = Team { teamId :: SObjId
                     , name   :: String
                     , home   :: Address
                     , league :: String
                     } deriving (Show, Eq, Typeable)
    $(deriveStructured ''Team)

    main = do
       pipe <- runIOE $ connect (host "127.0.0.1")
       e <- access pipe master "baseball" run
       close pipe
       print e

    run = do
       clearTeams
       insertTeams
       allTeams >>= printDocs "All Teams"
       nationalLeagueTeams >>= printDocs "National League Teams"
       newYorkTeams >>= printDocs "New York Teams"

    -- Delete all teams:
    clearTeams :: Action IO ()
    clearTeams = delete (select ( (.*) :: QueryExp Team))

    insertTeams :: Action IO [Value]
    insertTeams = insertMany [
       Team { teamId = noSObjId
            , name   = "Yankees"
            , home   = Address { addrId = noSObjId
                               , city  = "New York"
                               , state = "NY"
                               }
            , league = "American"}
      , Team { teamId = noSObjId
             , name   = "Mets"
             , home   = Address { addrId = noSObjId
                                , city  = "New York"
                                , state = "NY"
                                }
             , league = "National"}
      , Team { teamId = noSObjId
             , name   = "Phillies"
             , home   = Address { addrId = noSObjId
                                , city  = "Philadelphia"
                                , state = "PA"
                                }
             , league = "National"}
      , Team { teamId = noSObjId
             , name   = "Red Sox"
             , home   = Address { addrId = noSObjId
                                , city  = "Boston"
                                , state = "MA"
                                }
             , league = "National"}
      ]

    allTeams :: Action IO [Maybe Team]
    allTeams = let query = (select ((.*) :: QueryExp Team))
                                { sort = [asc (Home .! City)]}
               in find query >>= rest
               
    nationalLeagueTeams :: Action IO [Maybe Team]
    nationalLeagueTeams = rest =<< find (select (League .== "National"))

    newYorkTeams :: Action IO [Maybe Team]
    newYorkTeams = rest =<< find (select (Home .! State .== "NY"))

    printDocs :: MonadIO m => String -> [Maybe Team] -> m ()
    printDocs title teams' = liftIO $ do
      let teams = (map fromJust) . filter (isJust) $ teams'
      putStrLn title 
      mapM_ (putStrLn . show) teams

Documentation