leveldb-haskell 0.3.1 → 0.4.0

raw patch · 12 files changed

+873/−124 lines, 12 filesdep +QuickCheckdep +directorydep +exceptionsdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, directory, exceptions, mtl, tasty, tasty-quickcheck, temporary

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG +8/−0
• Readme.md +8/−0
• examples/comparator.hs +7/−7
• examples/features.hs +11/−12
• leveldb-haskell.cabal +29/−4
• src/Data/Stream/Monadic.hs +661/−0
• src/Database/LevelDB.hs +2/−2
• src/Database/LevelDB/Base.hs +3/−4
• src/Database/LevelDB/Iterator.hs +3/−54
• src/Database/LevelDB/MonadResource.hs +0/−41
• src/Database/LevelDB/Streaming.hs +133/−0
• test/Main.hs +8/−0

@@ -1,3 +1,11 @@+[0.4.0]:++* New streaming interface (experimental)++[0.3.1]:++* Deprecate `mapIter`, `iterItems`, `iterKeys`, `iterValues`+ [0.3.0]:  * ResourceT is no longer compulsory

@@ -5,6 +5,14 @@  ## History +Version 0.4.0:++* New streaming interface (experimental)++Version 0.3.1:++* Deprecate `mapIter`, `iterItems`, `iterKeys`, `iterValues`+ Version 0.3.0:  * ResourceT is no longer compulsory

@@ -4,10 +4,10 @@  module Main where -import Control.Monad.IO.Class (liftIO)-import Data.Default--import Database.LevelDB+import           Control.Monad.IO.Class     (liftIO)+import           Data.Default+import           Database.LevelDB+import qualified Database.LevelDB.Streaming as S   customComparator :: Comparator@@ -24,8 +24,8 @@     put db def "yyy" ""     put db def "xxx" "" -    withIterator db def $ \iter -> do-        iterFirst iter-        iterItems iter >>= liftIO . print+    withIterator db def $ \iter -> liftIO $+            S.toList (S.entrySlice iter S.AllKeys S.Asc)+        >>= print      return ()

@@ -4,14 +4,14 @@ -- module Main where -import Control.Monad-import Control.Monad.IO.Class       (liftIO)-import Control.Monad.Trans.Resource (release)-import Data.ByteString.Char8 hiding (take)-import Data.Default-import Prelude               hiding (putStrLn)--import Database.LevelDB+import           Control.Monad+import           Control.Monad.IO.Class       (liftIO)+import           Control.Monad.Trans.Resource (release)+import           Data.ByteString.Char8        hiding (take)+import           Data.Default+import           Database.LevelDB+import qualified Database.LevelDB.Streaming   as S+import           Prelude                      hiding (putStrLn)   main :: IO ()@@ -59,10 +59,9 @@     return ()    where--    dumpEntries iter = do-        iterFirst iter-        iterItems iter >>= liftIO . print+    dumpEntries iter = liftIO $+            S.toList (S.entrySlice iter S.AllKeys S.Asc)+        >>= print      printProperty l p = liftIO $ do         putStrLn l

@@ -1,5 +1,5 @@ name:                leveldb-haskell-version:             0.3.1+version:             0.4.0 synopsis:            Haskell bindings to LevelDB homepage:            http://github.com/kim/leveldb-haskell bug-reports:         http://github.com/kim/leveldb-haskell/issues@@ -45,13 +45,16 @@                   , Database.LevelDB.Internal                   , Database.LevelDB.Iterator                   , Database.LevelDB.MonadResource+                  , Database.LevelDB.Streaming                   , Database.LevelDB.Types+                  , Data.Stream.Monadic    default-language: Haskell2010    build-depends:    base >= 3 && < 5                   , bytestring                   , data-default+                  , exceptions == 0.6.*                   , filepath                   , resourcet > 0.3.2                   , transformers@@ -73,7 +76,7 @@                   , data-default                   , leveldb-haskell -  ghc-options:      -Wall -Werror -O -rtsopts+  ghc-options:      -Wall -O -rtsopts   ghc-prof-options: -prof -auto-all    hs-source-dirs:   examples@@ -115,7 +118,7 @@                   , data-default                   , leveldb-haskell -  ghc-options:      -Wall -Werror -O -rtsopts+  ghc-options:      -Wall -O -rtsopts   ghc-prof-options: -prof -auto-all    hs-source-dirs:   examples@@ -136,7 +139,7 @@                   , data-default                   , leveldb-haskell -  ghc-options:      -Wall -Werror -O -rtsopts+  ghc-options:      -Wall -O -rtsopts   ghc-prof-options: -prof -auto-all    hs-source-dirs:   examples@@ -145,3 +148,25 @@     buildable:      True   else     buildable:      False++test-suite leveldb-properties+  type:             exitcode-stdio-1.0+  main-is:          Main.hs+  hs-source-dirs:   test++  default-language: Haskell2010++  build-depends:    base+                  , bytestring+                  , data-default+                  , directory+                  , exceptions       == 0.6.*+                  , mtl+                  , leveldb-haskell+                  , QuickCheck       == 2.7.*+                  , tasty            == 0.10.*+                  , tasty-quickcheck == 0.8.*+                  , temporary+                  , transformers++  ghc-options:      -Wall -O -rtsopts -threaded -with-rtsopts=-N

@@ -0,0 +1,661 @@+{-# LANGUAGE BangPatterns              #-}+{-# LANGUAGE ExistentialQuantification #-}++-- |+-- Module      : Data.Stream.Monadic+-- Copyright   : (c) 2014 Kim Altintop+-- License     : BSD3+-- Maintainer  : kim.altintop@gmail.com+-- Stability   : experimental+-- Portability : non-portable+--+-- (Mostly mechanical) adaptation of the+-- <http://hackage.haskell.org/package/stream-fusion/docs/Data-Stream.html Data.Stream>+-- module from the+-- <http://hackage.haskell.org/package/stream-fusion stream-fusion> package to a+-- monadic 'Stream' datatype similar to the one+-- <https://www.fpcomplete.com/blog/2014/08/conduit-stream-fusion proposed> by+-- Michael Snoyman for the <http://hackage.haskell.org/package/conduit conduit>+-- package.+--+-- The intention here is to provide a high-level, "Data.List"-like interface to+-- "Database.LevelDB.Iterator"s with predictable space and time complexity (see+-- "Database.LevelDB.Streaming"), and without introducing a dependency eg. on+-- one of the streaming libraries (all relevant datatypes are fully exported,+-- though, so it should be straightforward to write wrappers for your favourite+-- streaming library).+--+-- Fusion and inlining rules and strictness annotations have been put in place+-- faithfully, and may need further profiling. Also, some functions (from+-- "Data.List") have been omitted as either no obvious solution exists (notably+-- @mapM@), they didn't seem too useful in the given context (eg. @lookup@), or+-- I was just too lazy. Missing functions may be added upon+-- <https://github.com/kim/leveldb-haskell/pulls request>.++module Data.Stream.Monadic+    ( Step   (..)+    , Stream (..)++    -- * Conversion with lists+    , toList+    , fromList++    -- * Basic functions+    , append+    , cons+    , snoc+    , head+    , last+    , tail+    , init+    , null+    , length++    -- * Transformations+    , map+    -- , mapM+    , intersperse++    -- * Folds+    , foldl+    , foldl'+    -- , foldl1+    -- , foldl1'+    , foldr+    -- , foldr1+    , foldMap+    , foldM+    , foldM_++    -- * Special folds+    -- , concat+    , concatMap+    -- , and+    -- , or+    -- , any+    -- , all+    -- , sum+    -- , product+    -- , maximum+    -- , minimum++    -- , scanl+    -- , scanl1++    -- * Infinite streams+    , iterate+    , repeat+    , replicate+    , cycle++    -- * Unfolding+    , unfoldr+    , unfoldrM++    -- , isPrefixOf++    -- * Searching streams+    -- , elem+    -- , lookup++    -- , find+    , filter++    -- , index+    -- , findIndex+    -- , elemIndex+    -- , elemIndices+    -- , findIndices++    -- * Substreams+    , take+    , drop+    -- , splitAt+    , takeWhile+    , dropWhile++    -- * Zipping and unzipping+    , zip+    -- , zip3+    -- , zip4+    , zipWith+    -- , zipWith3+    -- , zipWith4+    , unzip++    -- , insertBy+    -- , maximumBy+    -- , minimumBy++    -- , genericLength+    -- , genericTake+    -- , genericDrop+    -- , genericIndex+    -- , genericSplitAt++    -- , enumFromToInt+    -- , enumFromToChar+    -- , enumDeltaInteger+    )+where++import Control.Applicative+import Data.Monoid++import Prelude (Bool (..), Either (..), Eq (..), Functor (..), Int, Maybe (..),+                Monad (..), Num (..), Ord (..), error, otherwise, ($), (&&),+                (.), (=<<))+++data Step   a  s+   = Yield  a !s+   | Skip  !s+   | Done++data Stream m a = forall s. Stream (s -> m (Step a s)) (m s)++instance Monad m => Functor (Stream m) where+    fmap = map+++toList :: (Functor m, Monad m) => Stream m a -> m [a]+toList (Stream next s0) = unfold =<< s0+  where+    unfold !s = do+        step <- next s+        case step of+            Done       -> return []+            Skip    s' -> unfold s'+            Yield x s' -> (x :) <$> unfold s'++fromList :: Monad m => [a] -> Stream m a+fromList xs = Stream next (return xs)+  where+    {-# INLINE next #-}+    next []      = return Done+    next (x:xs') = return $ Yield x xs'++{-# RULES+    "Stream fromList/toList fusion" forall s.+        fmap fromList (toList s) = return s+  #-}++append :: (Functor m, Monad m) => Stream m a -> Stream m a -> Stream m a+append (Stream next0 s0) (Stream next1 s1) = Stream next (Left <$> s0)+  where+    {-# INLINE next #-}+    next (Left s) = do+        step <- next0 s+        case step of+            Done       -> Skip . Right <$> s1+            Skip    s' -> return $ Skip    (Left s')+            Yield x s' -> return $ Yield x (Left s')++    next (Right s) = do+        step <- next1 s+        return $ case step of+            Done       -> Done+            Skip    s' -> Skip    (Right s')+            Yield x s' -> Yield x (Right s')+{-# INLINE [0] append #-}++cons :: (Functor m, Monad m) => a -> Stream m a -> Stream m a+cons w (Stream next0 s0) = Stream next ((,) S2 <$> s0)+  where+    {-# INLINE next #-}+    next (S2, s) = return $ Yield w (S1, s)+    next (S1, s) = do+        step <- next0 s+        return $ case step of+            Done       -> Done+            Skip    s' -> Skip    (S1, s')+            Yield x s' -> Yield x (S1, s')+{-# INLINE [0] cons #-}++snoc :: (Functor m, Monad m) => Stream m a -> a -> Stream m a+snoc (Stream next0 s0) y = Stream next (Just <$> s0)+  where+    {-# INLINE next #-}+    next Nothing  = return Done+    next (Just s) = do+        step <- next0 s+        return $ case step of+            Done       -> Yield y Nothing+            Skip    s' -> Skip    (Just s')+            Yield x s' -> Yield x (Just s')+{-# INLINE [0] snoc #-}++-- | Unlike 'Data.List.head', this function does not diverge if the 'Stream is+-- empty. Instead, 'Nothing' is returned.+head :: Monad m => Stream m a -> m (Maybe a)+head (Stream next s0) = loop =<< s0+  where+    loop !s = do+        step <- next s+        case step of+            Yield x _  -> return $ Just x+            Skip    s' -> loop s'+            Done       -> return Nothing+{-# INLINE [0] head #-}++-- | Unlike 'Data.List.last', this function does not diverge if the 'Stream' is+-- empty. Instead, 'Nothing' is returned.+last :: Monad m => Stream m a -> m (Maybe a)+last (Stream next s0) = loop =<< s0+  where+    loop !s = do+        step <- next s+        case step of+            Done       -> return Nothing+            Skip    s' -> loop s'+            Yield x s' -> loop' x s'+    loop' x !s = do+        step <- next s+        case step of+            Done        -> return $ Just x+            Skip     s' -> loop' x s'+            Yield x' s' -> loop' x' s'+{-# INLINE [0] last #-}++data Switch = S1 | S2++-- | Unlike 'Data.List.tail', this function does not diverge if the 'Stream' is+-- empty. Instead, it is the identity in this case.+tail :: (Functor m, Monad m) => Stream m a -> Stream m a+tail (Stream next0 s0) = Stream next ((,) S1 <$> s0)+  where+    {-# INLINE next #-}+    next (S1, s) = do+        step <- next0 s+        return $ case step of+            Done       -> Done+            Skip    s' -> Skip (S1, s')+            Yield _ s' -> Skip (S2, s')++    next (S2, s) = do+        step <- next0 s+        return $ case step of+            Done       -> Done+            Skip    s' -> Skip (S2, s')+            Yield x s' -> Yield x (S2, s')+{-# INLINE [0] tail #-}++-- | Unlike 'Data.List.init', this function does not diverge if the 'Stream' is+-- empty. Instead, it is the identity in this case.+init :: (Functor m, Monad m) => Stream m a -> Stream m a+init (Stream next0 s0) = Stream next ((,) Nothing <$> s0)+  where+    {-# INLINE next #-}+    next (Nothing, s) = do+        step <- next0 s+        return $ case step of+            Done       -> Done+            Skip    s' -> Skip (Nothing, s')+            Yield x s' -> Skip (Just x , s')++    next (Just x, s) = do+        step <- next0 s+        return $ case step of+            Done        -> Done+            Skip     s' -> Skip    (Just x , s')+            Yield x' s' -> Yield x (Just x', s')+{-# INLINE [0] init #-}++null :: Monad m => Stream m a -> m Bool+null (Stream next s0) = loop =<< s0+  where+    loop !s = do+        step <- next s+        case step of+            Done       -> return True+            Yield _ _  -> return False+            Skip    s' -> loop s'+{-# INLINE [0] null #-}++length :: Monad m => Stream m a -> m Int+length (Stream next s0) = loop 0 =<< s0+  where+    loop !z !s = do+        step <- next s+        case step of+            Done       -> return z+            Skip    s' -> loop   z    s'+            Yield _ s' -> loop  (z+1) s'+{-# INLINE [0] length #-}++filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+filter p (Stream next0 s0) = Stream next s0+  where+    {-# INLINE next #-}+    next !s = do+        step <- next0 s+        return $ case step of+            Done                   -> Done+            Skip    s'             -> Skip    s'+            Yield x s' | p x       -> Yield x s'+                       | otherwise -> Skip    s'+{-# INLINE [0] filter #-}+{-# RULES+    "Stream filter/filter fusion" forall p q s.+        filter p (filter q s) = filter (\x -> q x && p x) s+  #-}++map :: Monad m => (a -> b) -> Stream m a -> Stream m b+map f (Stream next0 s0) = Stream next s0+  where+    {-# INLINE next #-}+    next !s = do+        step <- next0 s+        return $ case step of+            Done       -> Done+            Skip    s' -> Skip        s'+            Yield x s' -> Yield (f x) s'+{-# INLINE [0] map #-}+{-# RULES+    "Stream map/map fusion" forall f g s.+        map f (map g s) = map (\x -> f (g x)) s+  #-}++-- 'mapM' is tricky:+--+-- > mapM :: (Monad m, Monad n) => (a -> n b) -> Stream m a -> n (Stream n b)+--+-- we would need a constraint which specifies how to lift any monad /m/ into+-- some monad /n/ (or specialise /m/ to 'IO').+--+-- alternatively, we may define:+--+-- > mapM :: Monad m => (a -> m b) -> Stream m a -> m (Stream m b)+--+-- or rather:+--+-- > mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b+--+-- not sure how useful this would be.+++intersperse :: (Functor m, Monad m) => a -> Stream m a -> Stream m a+intersperse sep (Stream next0 s0) = Stream next ((,,) Nothing S1 <$> s0)+  where+    {-# INLINE next #-}+    next (Nothing, S1, s) = do+        step <- next0 s+        return $ case step of+            Done       -> Done+            Skip    s' -> Skip (Nothing, S1, s')+            Yield x s' -> Skip (Just x , S1, s')++    next (Just x, S1, s)  = return $ Yield x (Nothing, S2, s)++    next (Nothing, S2, s) = do+        step <- next0 s+        return $ case step of+            Done       -> Done+            Skip    s' -> Skip      (Nothing, S2, s')+            Yield x s' -> Yield sep (Just x , S1, s')++    next (Just _, S2, _)  = error "Data.Stream.Monadic.intersperse: impossible"+{-# INLINE [0] intersperse #-}++foldMap :: (Monoid m, Functor n, Monad n) => (a -> m) -> Stream n a -> n m+foldMap f (Stream next s0) = loop mempty =<< s0+  where+    loop z !s = do+        step <- next s+        case step of+            Done       -> return z+            Skip    s' -> loop z s'+            Yield x s' -> loop (z <> f x) s'+{-# INLINE [0] foldMap #-}++-- | Left-associative fold.+--+-- Note that the /direction/ of the traversal is not defined here.+foldl :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b+foldl f z0 (Stream next s0) = loop z0 =<< s0+  where+    loop z !s = do+        step <- next s+        case step of+            Done       -> return z+            Skip    s' -> loop z s'+            Yield x s' -> loop (f z x) s'+{-# INLINE [0] foldl #-}++-- | Left-associative fold with strict accumulator.+--+-- Note that the /direction/ of the traversal is not defined here.+foldl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b+foldl' f z0 (Stream next s0) = loop z0 =<< s0+  where+    loop !z !s = do+        step <- next s+        case step of+            Done       -> return z+            Skip    s' -> loop z s'+            Yield x s' -> loop (f z x) s'+{-# INLINE [0] foldl' #-}++-- | Right-associative fold.+--+-- Note that the /direction/ of the traversal is not defined here.+foldr :: (Functor m, Monad m) => (a -> b -> b) -> b -> Stream m a -> m b+foldr f z (Stream next s0) = loop =<< s0+  where+    loop !s = do+        step <- next s+        case step of+            Done       -> return z+            Skip    s' -> loop s'+            Yield x s' -> f x <$> loop s'+{-# INLINE [0] foldr #-}++foldM :: Monad m => (b -> a -> m b) -> b -> Stream m a -> m b+foldM f z0 (Stream next s0) = loop z0 =<< s0+  where+    loop z !s = do+        step <- next s+        case step of+            Done       -> return z+            Skip    s' -> loop z s'+            Yield x s' -> f z x >>= (`loop` s')+{-# INLINE [0] foldM #-}++foldM_ :: Monad m => (b -> a -> m b) -> b -> Stream m a -> m ()+foldM_ f z0 (Stream next s0) = loop z0 =<< s0+  where+    loop z !s = do+        step <- next s+        case step of+            Done       -> return ()+            Skip    s' -> loop z s'+            Yield x s' -> f z x >>= (`loop` s')+{-# INLINE [0] foldM_ #-}++concatMap :: (Functor m, Monad m) => (a -> Stream m b) -> Stream m a -> Stream m b+concatMap f (Stream next0 s0) = Stream next ((,) Nothing <$> s0)+  where+    {-# INLINE next #-}+    next (Nothing, s) = do+        step <- next0 s+        return $ case step of+            Done       -> Done+            Skip    s' -> Skip (Nothing   , s')+            Yield x s' -> Skip (Just (f x), s')++    next (Just (Stream g t), s) = do+        step <- g =<< t+        return $ case step of+            Done       -> Skip    (Nothing                    , s)+            Skip    t' -> Skip    (Just (Stream g (return t')), s)+            Yield x t' -> Yield x (Just (Stream g (return t')), s)+{-# INLINE [0] concatMap #-}++iterate :: Monad m => (a -> a) -> a -> Stream m a+iterate f x0 = Stream next (return x0)+  where+    {-# INLINE next #-}+    next x = return $ Yield x (f x)+{-# INLINE [0] iterate #-}++repeat :: Monad m => a -> Stream m a+repeat x = Stream next (return ())+  where+    {-# INLINE next #-}+    next _ = return $ Yield x ()+{-# INLINE [0] repeat #-}+{-# RULES+    "map/repeat" forall f x. map f (repeat x) = repeat (f x)+  #-}++replicate :: Monad m => Int -> a -> Stream m a+replicate n x = Stream next (return n)+  where+    {-# INLINE next #-}+    next !i | i <= 0    = return Done+            | otherwise = return $ Yield x (i-1)+{-# INLINE [0] replicate #-}+{-# RULES+    "map/replicate" forall f n x. map f (replicate n x) = replicate n (f x)+  #-}++-- | Unlike 'Data.List.cycle', this function does not diverge if the 'Stream' is+-- empty. Instead, it is the identity in this case.+cycle :: (Functor m, Monad m) => Stream m a -> Stream m a+cycle (Stream next0 s0) = Stream next ((,) S1 <$> s0)+  where+    {-# INLINE next #-}+    next (S1, s) = do+        step <- next0 s+        return $ case step of+            Done       -> Done -- error?+            Skip    s' -> Skip    (S1, s')+            Yield x s' -> Yield x (S2, s')++    next (S2, s) = do+        step <- next0 s+        case step of+            Done       -> Skip . ((,) S2) <$> s0+            Skip    s' -> return $ Skip    (S2, s')+            Yield x s' -> return $ Yield x (S2, s')+{-# INLINE [0] cycle #-}++unfoldr :: Monad m => (b -> Maybe (a, b)) -> b -> Stream m a+unfoldr f s0 = Stream next (return s0)+  where+    {-# INLINE next #-}+    next s = return $ case f s of+        Nothing      -> Done+        Just (w, s') -> Yield w s'+{-# INLINE [0] unfoldr #-}++-- | Build a stream from a monadic seed (or state function).+unfoldrM :: (Functor m, Monad m) => (b -> Maybe (a, m b)) -> m b -> Stream m a+unfoldrM f s0 = Stream next s0+  where+    {-# INLINE next #-}+    next s = case f s of+        Nothing      -> return Done+        Just (w, s') -> Yield w <$> s'+{-# INLINE [0] unfoldrM #-}++take :: (Functor m, Monad m) => Int -> Stream m a -> Stream m a+take n0 (Stream next0 s0) = Stream next ((,) n0 <$> s0)+  where+    {-# INLINE next #-}+    next (!n, s)+      | n <= 0    = return Done+      | otherwise = do+          step <- next0 s+          return $ case step of+              Done       -> Done+              Skip    s' -> Skip    (n  , s')+              Yield x s' -> Yield x (n-1, s')+{-# INLINE [0] take #-}++drop :: (Functor m, Monad m) => Int -> Stream m a -> Stream m a+drop n0 (Stream next0 s0) = Stream next ((,) (Just (max 0 n0)) <$> s0)+  where+    {-# INLINE next #-}+    next (Just !n, s)+      | n == 0    = return $ Skip (Nothing, s)+      | otherwise = do+          step <- next0 s+          return $ case step of+              Done       -> Done+              Skip    s' -> Skip (Just  n   , s')+              Yield _ s' -> Skip (Just (n-1), s')+    next (Nothing, s) = do+        step <- next0 s+        return $ case step of+            Done       -> Done+            Skip    s' -> Skip    (Nothing, s')+            Yield x s' -> Yield x (Nothing, s')+{-# INLINE [0] drop #-}++takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+takeWhile p (Stream next0 s0) = Stream next s0+  where+    {-# INLINE next #-}+    next !s = do+        step <- next0 s+        return $ case step of+            Done                   -> Done+            Skip    s'             -> Skip    s'+            Yield x s' | p x       -> Yield x s'+                       | otherwise -> Done+{-# INLINE [0] takeWhile #-}++dropWhile :: (Functor m, Monad m) => (a -> Bool) -> Stream m a -> Stream m a+dropWhile p (Stream next0 s0) = Stream next ((,) S1 <$> s0)+  where+    {-# INLINE next #-}+    next (S1, s) = do+        step <- next0 s+        return $ case step of+            Done                   -> Done+            Skip    s'             -> Skip    (S1, s')+            Yield x s' | p x       -> Skip    (S1, s')+                       | otherwise -> Yield x (S2, s')+    next (S2, s) = do+        step <- next0 s+        return $ case step of+            Done       -> Done+            Skip    s' -> Skip    (S2, s')+            Yield x s' -> Yield x (S2, s')+{-# INLINE [0] dropWhile #-}++zip :: (Functor m, Applicative m, Monad m)+    => Stream m a+    -> Stream m b+    -> Stream m (a, b)+zip = zipWith (,)+{-# INLINE zip #-}++zipWith :: (Functor m, Applicative m, Monad m)+        => (a -> b -> c)+        -> Stream m a+        -> Stream m b+        -> Stream m c+zipWith f (Stream nexta sa0) (Stream nextb sb0) =+    Stream next ((,,) Nothing <$> sa0 <*> sb0)+  where+    {-# INLINE next #-}+    next (Nothing, sa, sb) = do+        step <- nexta sa+        return $ case step of+            Done        -> Done+            Skip    sa' -> Skip (Nothing, sa', sb)+            Yield a sa' -> Skip (Just a , sa', sb)++    next (Just a, sa', sb) = do+        step <- nextb sb+        return $ case step of+            Done        -> Done+            Skip    sb' -> Skip          (Just a, sa', sb')+            Yield b sb' -> Yield (f a b) (Nothing, sa', sb')+{-# INLINE [0] zipWith #-}++unzip :: (Functor m, Monad m) => Stream m (a, b) -> m ([a], [b])+unzip = foldr (\(a,b) ~(as, bs) -> (a:as, b:bs)) ([], [])+{-# INLINE unzip #-}

@@ -11,6 +11,6 @@ -- The API closely follows the C-API of LevelDB. -- For more information, see: <http://leveldb.googlecode.com> -module Database.LevelDB (module R) where+module Database.LevelDB (module Database.LevelDB.MonadResource) where -import Database.LevelDB.MonadResource as R+import Database.LevelDB.MonadResource

@@ -59,8 +59,8 @@ where  import           Control.Applicative      ((<$>))-import           Control.Exception        (bracket, bracketOnError, finally) import           Control.Monad            (liftM)+import           Control.Monad.Catch import           Control.Monad.IO.Class   (MonadIO (liftIO)) import           Data.ByteString          (ByteString) import           Data.ByteString.Internal (ByteString (..))@@ -98,9 +98,8 @@   -- | Run an action with a 'Snapshot' of the database.-withSnapshot :: MonadIO m => DB -> (Snapshot -> IO a) -> m a-withSnapshot db act = liftIO $-    bracket (createSnapshot db) (releaseSnapshot db) act+withSnapshot :: (MonadMask m, MonadIO m) => DB -> (Snapshot -> m a) -> m a+withSnapshot db = bracket (createSnapshot db) (releaseSnapshot db)  -- | Create a snapshot of the database. --

@@ -15,28 +15,23 @@     , iterEntry     , iterFirst     , iterGetError-    , iterItems     , iterKey-    , iterKeys     , iterLast     , iterNext     , iterPrev     , iterSeek     , iterValid     , iterValue-    , iterValues-    , mapIter     , releaseIter     , withIter     ) where  import           Control.Applicative       ((<$>), (<*>))-import           Control.Exception         (bracket, finally, onException) import           Control.Monad             (when)+import           Control.Monad.Catch import           Control.Monad.IO.Class    (MonadIO (liftIO)) import           Data.ByteString           (ByteString)-import           Data.Maybe                (catMaybes) import           Foreign import           Foreign.C.Error           (throwErrnoIfNull) import           Foreign.C.String          (CString, peekCString)@@ -82,8 +77,8 @@     c_leveldb_iter_destroy iter_ptr `finally` freeCReadOpts opts  -- | Run an action with an 'Iterator'-withIter :: MonadIO m => DB -> ReadOptions -> (Iterator -> IO a) -> m a-withIter db opts = liftIO . bracket (createIter db opts) releaseIter+withIter :: (MonadMask m, MonadIO m) => DB -> ReadOptions -> (Iterator -> m a) -> m a+withIter db opts = bracket (createIter db opts) releaseIter  -- | An iterator is either positioned at a key/value pair, or not valid. This -- function returns /true/ iff the iterator is valid.@@ -164,52 +159,6 @@             else do                 err <- peekCString erra                 return . Just . BC.pack $ err---- | Map a function over an iterator, advancing the iterator forward and--- returning the value. The iterator should be put in the right position prior--- to calling the function.------ Note that this function accumulates the result strictly, ie. it reads all--- values into memory until the iterator is exhausted. This is most likely not--- what you want for large ranges. You may consider using conduits instead, for--- an example see: <https://gist.github.com/adc8ec348f03483446a5>-mapIter :: MonadIO m => (Iterator -> m a) -> Iterator -> m [a]-mapIter f iter@(Iterator iter_ptr _) = go []-  where-    go acc = do-        valid <- liftIO $ c_leveldb_iter_valid iter_ptr-        if valid == 0-            then return acc-            else do-                val <- f iter-                ()  <- liftIO $ c_leveldb_iter_next iter_ptr-                go (val : acc)-{-# DEPRECATED mapIter "will be removed in the next release" #-}---- | Return a list of key and value tuples from an iterator. The iterator--- should be put in the right position prior to calling this with the iterator.------ See strictness remarks on 'mapIter'.-iterItems :: (Functor m, MonadIO m) => Iterator -> m [(ByteString, ByteString)]-iterItems iter = catMaybes <$> mapIter iterEntry iter-{-# DEPRECATED iterItems "will be removed in the next release" #-}---- | Return a list of key from an iterator. The iterator should be put--- in the right position prior to calling this with the iterator.------ See strictness remarks on 'mapIter'-iterKeys :: (Functor m, MonadIO m) => Iterator -> m [ByteString]-iterKeys iter = catMaybes <$> mapIter iterKey iter-{-# DEPRECATED iterKeys "will be removed in the next release" #-}---- | Return a list of values from an iterator. The iterator should be put--- in the right position prior to calling this with the iterator.------ See strictness remarks on 'mapIter'-iterValues :: (Functor m, MonadIO m) => Iterator -> m [ByteString]-iterValues iter = catMaybes <$> mapIter iterValue iter-{-# DEPRECATED iterValues "will be removed in the next release" #-}-  -- -- Internal

@@ -60,10 +60,6 @@     , iterKey     , iterValue     , iterGetError-    , mapIter-    , iterItems-    , iterKeys-    , iterValues      -- * Re-exports     , MonadResource (..)@@ -244,43 +240,6 @@ -- Note that this captures somewhat severe errors such as a corrupted database. iterGetError :: MonadResource m => Iterator -> m (Maybe ByteString) iterGetError = Base.iterGetError----- | Map a function over an iterator, advancing the iterator forward and--- returning the value. The iterator should be put in the right position prior--- to calling the function.------ Note that this function accumulates the result strictly, ie. it reads all--- values into memory until the iterator is exhausted. This is most likely not--- what you want for large ranges. You may consider using conduits instead, for--- an example see: <https://gist.github.com/adc8ec348f03483446a5>-mapIter :: MonadResource m => (Iterator -> m a) -> Iterator -> m [a]-mapIter = Base.mapIter-{-# DEPRECATED mapIter "will be removed in the next release" #-}---- | Return a list of key and value tuples from an iterator. The iterator--- should be put in the right position prior to calling this with the iterator.------ See strictness remarks on 'mapIter'.-iterItems :: MonadResource m => Iterator -> m [(ByteString, ByteString)]-iterItems = Base.iterItems-{-# DEPRECATED iterItems "will be removed in the next release" #-}---- | Return a list of key from an iterator. The iterator should be put--- in the right position prior to calling this with the iterator.------ See strictness remarks on 'mapIter'-iterKeys :: MonadResource m => Iterator -> m [ByteString]-iterKeys = Base.iterKeys-{-# DEPRECATED iterKeys "will be removed in the next release" #-}---- | Return a list of values from an iterator. The iterator should be put--- in the right position prior to calling this with the iterator.------ See strictness remarks on 'mapIter'-iterValues :: MonadResource m => Iterator -> m [ByteString]-iterValues = Base.iterValues-{-# DEPRECATED iterValues "will be removed in the next release" #-}   -- | Return the runtime version of the underlying LevelDB library as a (major,

@@ -0,0 +1,133 @@+{-# LANGUAGE BangPatterns #-}++-- |+-- Module      : Database.LevelDB.Streaming+-- Copyright   : (c) 2014 Kim Altintop+-- License     : BSD3+-- Maintainer  : kim.altintop@gmail.com+-- Stability   : experimental+-- Portability : non-portable+--+-- High-level, "Data.List"-like, streaming interface to+-- "Database.LevelDB.Iterator".+--+-- This module contains types and functions to construct 'Stream's from+-- 'Database.LevelDB.Iterator.Iterator's, and re-exports the functions operating+-- on 'Stream's from "Data.Stream.Monadic".+--+-- __Note__ that most of the functions from the latter module are+-- (intentionally) conflicting with the "Prelude", it is thus recommended to+-- import this module qualified:+--+-- > import Database.LevelDB -- or Database.LevelDB.Base+-- > import qualified Database.LevelDB.Streaming as S++module Database.LevelDB.Streaming+    ( Slice     (..)+    , KeyRange  (..)+    , Direction (..)+    , Key+    , Value+    , Entry++    -- * Constructing streams+    , keySlice+    , entrySlice++    -- * Re-exports+    , module Data.Stream.Monadic+    )+where++import Control.Applicative+import Control.Monad.IO.Class+import Data.ByteString        (ByteString)+import Data.Stream.Monadic+import Database.LevelDB.Base++import Prelude hiding (drop, filter, foldl, map, mapM, mapM_, take)+++data Slice = Slice !Iterator (Maybe KeyRange) !Direction++data KeyRange+    = KeyRange { start :: !ByteString+               , end   :: ByteString -> Ordering+               }+    | AllKeys++data Direction = Asc | Desc+    deriving Show++type Key   = ByteString+type Value = ByteString+type Entry = (Key, Value)+++-- | Create a 'Stream' which yields only the keys of the given 'KeyRange' (in+-- the given 'Direction').+--+-- Since traversing the 'Stream' mutates the state of the underlying 'Iterator',+-- it is obviously __unsafe__ to share the latter (between threads, or when+-- 'Data.Stream.Monadic.zip'ping). Hence, it is __highly__ recommended to create+-- a new 'Iterator' for each 'Stream'.+keySlice :: (Applicative m, MonadIO m)+         => Iterator+         -> KeyRange+         -> Direction+         -> Stream m Key+keySlice i (KeyRange s e) d = Stream next (iterSeek i s >> pure i)+  where+    next it = do+        key <- iterKey it+        case key of+            Nothing -> pure Done+            Just k  -> case d of+                Asc  | e k < GT  -> Yield k <$> (iterNext it >> pure it)+                     | otherwise -> pure Done+                Desc | e k > EQ  -> Yield k <$> (iterPrev it >> pure it)+                     | otherwise -> pure Done++keySlice i AllKeys Asc = Stream next (iterFirst i >> pure i)+  where+    next it = iterKey it+          >>= maybe (pure Done) (\ k -> Yield k <$> (iterNext it >> pure it))++keySlice i AllKeys Desc = Stream next (iterLast i >> pure i)+  where+    next it = iterKey it+          >>= maybe (pure Done) (\ k -> Yield k <$> (iterPrev it >> pure it))++-- | Create a 'Stream' which yields key/value pairs of the given 'KeyRange' (in+-- the given 'Direction').+--+-- Since traversing the 'Stream' mutates the state of the underlying 'Iterator',+-- it is obviously __unsafe__ to share the latter (between threads, or when+-- 'Data.Stream.Monadic.zip'ping). Hence, it is __highly__ recommended to create+-- a new 'Iterator' for each 'Stream'.+entrySlice :: (Applicative m, MonadIO m)+           => Iterator+           -> KeyRange+           -> Direction+           -> Stream m Entry+entrySlice i (KeyRange s e) d = Stream next (iterSeek i s >> pure i)+  where+    next it = do+        entry <- iterEntry it+        case entry of+            Nothing       -> pure Done+            Just x@(!k,_) -> case d of+                Asc  | e k < GT  -> Yield x <$> (iterNext it >> pure it)+                     | otherwise -> pure Done+                Desc | e k > EQ  -> Yield x <$> (iterPrev it >> pure it)+                     | otherwise -> pure Done++entrySlice i AllKeys Asc = Stream next (iterFirst i >> pure i)+  where+    next it = iterEntry it+          >>= maybe (pure Done) (\ x -> Yield x <$> (iterNext it >> pure it))++entrySlice i AllKeys Desc = Stream next (iterLast i >> pure i)+  where+    next it = iterEntry it+          >>= maybe (pure Done) (\ x -> Yield x <$> (iterPrev it >> pure it))

@@ -0,0 +1,8 @@+module Main (main) where++import qualified Test.Streaming as Streaming+import           Test.Tasty+++main :: IO ()+main = defaultMain $ testGroup "Tests" [ Streaming.tests ]