mongodb/doc/Example.hs

54 lines
1.9 KiB
Haskell
Raw Permalink Normal View History

{-# LANGUAGE CPP #-}
2014-07-07 05:05:03 +00:00
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ExtendedDefaultRules #-}
module Main (main) where
import Database.MongoDB (Action, Document, Document, Value, access,
close, connect, delete, exclude, find,
host, insertMany, master, project, rest,
2014-07-07 05:05:03 +00:00
select, sort, (=:))
#if (__GLASGOW_HASKELL__ >= 800)
import Control.Monad.IO.Class (liftIO)
#else
import Control.Monad.Trans (liftIO)
#endif
2014-03-02 05:54:56 +00:00
main :: IO ()
main = do
2014-07-07 05:05:03 +00:00
pipe <- connect (host "127.0.0.1")
e <- access pipe master "baseball" run
close pipe
print e
2014-03-02 05:54:56 +00:00
run :: Action IO ()
run = do
clearTeams
insertTeams
2011-07-21 20:39:19 +00:00
allTeams >>= printDocs "All Teams"
nationalLeagueTeams >>= printDocs "National League Teams"
newYorkTeams >>= printDocs "New York Teams"
2014-03-02 05:54:56 +00:00
clearTeams :: Action IO ()
clearTeams = delete (select [] "team")
2014-03-02 05:54:56 +00:00
insertTeams :: Action IO [Value]
insertTeams = insertMany "team" [
2011-07-30 16:49:37 +00:00
["name" =: "Yankees", "home" =: ["city" =: "New York", "state" =: "NY"], "league" =: "American"],
["name" =: "Mets", "home" =: ["city" =: "New York", "state" =: "NY"], "league" =: "National"],
["name" =: "Phillies", "home" =: ["city" =: "Philadelphia", "state" =: "PA"], "league" =: "National"],
["name" =: "Red Sox", "home" =: ["city" =: "Boston", "state" =: "MA"], "league" =: "American"] ]
2014-03-02 05:54:56 +00:00
allTeams :: Action IO [Document]
2011-07-30 16:49:37 +00:00
allTeams = rest =<< find (select [] "team") {sort = ["home.city" =: 1]}
2014-03-02 05:54:56 +00:00
nationalLeagueTeams :: Action IO [Document]
2011-07-30 16:49:37 +00:00
nationalLeagueTeams = rest =<< find (select ["league" =: "National"] "team")
2014-03-02 05:54:56 +00:00
newYorkTeams :: Action IO [Document]
2011-07-30 16:49:37 +00:00
newYorkTeams = rest =<< find (select ["home.state" =: "NY"] "team") {project = ["name" =: 1, "league" =: 1]}
2014-03-02 05:54:56 +00:00
printDocs :: String -> [Document] -> Action IO ()
printDocs title docs = liftIO $ putStrLn title >> mapM_ (print . exclude ["_id"]) docs