Add type annotations to Example.hs

This commit is contained in:
Fujimura Daisuke 2014-03-02 14:54:56 +09:00
parent 6e4decfa95
commit 16e4fdce26

View file

@ -3,12 +3,14 @@
import Database.MongoDB import Database.MongoDB
import Control.Monad.Trans (liftIO) import Control.Monad.Trans (liftIO)
main :: IO ()
main = do main = do
pipe <- runIOE $ connect (host "127.0.0.1") pipe <- runIOE $ connect (host "127.0.0.1")
e <- access pipe master "baseball" run e <- access pipe master "baseball" run
close pipe close pipe
print e print e
run :: Action IO ()
run = do run = do
clearTeams clearTeams
insertTeams insertTeams
@ -16,18 +18,24 @@ run = do
nationalLeagueTeams >>= printDocs "National League Teams" nationalLeagueTeams >>= printDocs "National League Teams"
newYorkTeams >>= printDocs "New York Teams" newYorkTeams >>= printDocs "New York Teams"
clearTeams :: Action IO ()
clearTeams = delete (select [] "team") clearTeams = delete (select [] "team")
insertTeams :: Action IO [Value]
insertTeams = insertMany "team" [ insertTeams = insertMany "team" [
["name" =: "Yankees", "home" =: ["city" =: "New York", "state" =: "NY"], "league" =: "American"], ["name" =: "Yankees", "home" =: ["city" =: "New York", "state" =: "NY"], "league" =: "American"],
["name" =: "Mets", "home" =: ["city" =: "New York", "state" =: "NY"], "league" =: "National"], ["name" =: "Mets", "home" =: ["city" =: "New York", "state" =: "NY"], "league" =: "National"],
["name" =: "Phillies", "home" =: ["city" =: "Philadelphia", "state" =: "PA"], "league" =: "National"], ["name" =: "Phillies", "home" =: ["city" =: "Philadelphia", "state" =: "PA"], "league" =: "National"],
["name" =: "Red Sox", "home" =: ["city" =: "Boston", "state" =: "MA"], "league" =: "American"] ] ["name" =: "Red Sox", "home" =: ["city" =: "Boston", "state" =: "MA"], "league" =: "American"] ]
allTeams :: Action IO [Document]
allTeams = rest =<< find (select [] "team") {sort = ["home.city" =: 1]} allTeams = rest =<< find (select [] "team") {sort = ["home.city" =: 1]}
nationalLeagueTeams :: Action IO [Document]
nationalLeagueTeams = rest =<< find (select ["league" =: "National"] "team") nationalLeagueTeams = rest =<< find (select ["league" =: "National"] "team")
newYorkTeams :: Action IO [Document]
newYorkTeams = rest =<< find (select ["home.state" =: "NY"] "team") {project = ["name" =: 1, "league" =: 1]} newYorkTeams = rest =<< find (select ["home.state" =: "NY"] "team") {project = ["name" =: 1, "league" =: 1]}
printDocs :: String -> [Document] -> Action IO ()
printDocs title docs = liftIO $ putStrLn title >> mapM_ (print . exclude ["_id"]) docs printDocs title docs = liftIO $ putStrLn title >> mapM_ (print . exclude ["_id"]) docs