LevelDB conduit iteration

conduititer.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Control.Applicative          ((<$>), (<*>))
import Control.Monad.IO.Class       (liftIO)
import Control.Monad.Trans.Resource
import Data.ByteString              (ByteString)
import Data.ByteString.Char8 hiding (take)
import Data.Default

import Database.LevelDB

import qualified Data.Conduit      as C
import qualified Data.Conduit.List as CL

sourceIter :: MonadResource m
           => DB
           -> C.Source m (Maybe (ByteString, ByteString))
sourceIter db = C.PipeM
    (do
        (rk, iter) <- iterOpen' db def
        iterFirst iter
        pull rk iter
    )
    (return ())

    where
        src rk iter = C.PipeM (pull rk iter) (release rk)

        pull rk iter = do
            valid <- iterValid iter
            if not valid
                then return $ C.Done Nothing ()
                else do
                    mkey <- iterKey iter
                    mval <- iterValue iter
                    _    <- iterNext iter
                    let pair  = (,) <$> mkey <*> mval
                        next  = src rk iter
                        close = release rk
                    return $ C.HaveOutput next close pair


main :: IO ()
main = runResourceT $ do
    db <- open "/tmp/levelconduit" def{createIfMissing=True}

    write db def{sync = True} [ Put "a" "one"
                              , Put "b" "two"
                              , Put "c" "three"
                              ]

    xs <- sourceIter db  C.$$ CL.consume
    liftIO . print $ xs