structured-mongoDB-0.1: examples/mongoExample.hs

{-# 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.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