Skip to content

Instantly share code, notes, and snippets.

@aloiscochard
Created January 18, 2015 11:35
Show Gist options
  • Save aloiscochard/1338d462f12a7480dd42 to your computer and use it in GitHub Desktop.
Save aloiscochard/1338d462f12a7480dd42 to your computer and use it in GitHub Desktop.
Tailing MongoDB OpLog in Haskell
{-# 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment