Tailing MongoDB OpLog in Haskell

oplog.hs

{-# LANGUAGE OverloadedStrings #-}
module Mongolito where

import Control.Exception
import Control.Monad.IO.Class (liftIO)
import Database.MongoDB
import System.Log.Logger

localDb :: Database
localDb = "local"

opLogColl :: Collection
opLogColl = "oplog.rs"

tailOpLog :: Pipe -> ([Document] -> IO ()) -> IO ()
tailOpLog pipe f = bracket acquire release (run . loop)
  where
    acquire = run . find $ (select [] opLogColl) { options = [TailableCursor, AwaitData, NoCursorTimeout]  }
    release x = do
      infoM "mongodb" "Closing opLog cursor..."
      run $ closeCursor x
    loop cr = do
      xs <- nextBatch cr
      liftIO $ do
        debugM "mongodb" (concat ["nextBatch.length=", show $ length xs])
        f xs
      loop cr
    run = access pipe master localDb

mainService :: IO ()
mainService = do
  infoM "main" "Starting..."
  bracket (connect (host "127.0.0.1")) close $ \pipe -> tailOpLog pipe print