leveldb-haskell 0.5.1 → 0.6

raw patch · 5 files changed

+1273/−93 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +5/−0
• leveldb-haskell.cabal +3/−1
• src/Data/Stream/Monadic.hs +625/−90
• src/Database/LevelDB/Streaming.hs +2/−2
• test/Test/Streaming.hs +638/−0

@@ -1,3 +1,8 @@+[0.6.0]:++* Slices include the end element (justifies version bump)+* Large parts of the Data.API implemented. This is now completely overdone+ [0.5.0]:  * Remove `close` from public API

@@ -1,5 +1,5 @@ name:                leveldb-haskell-version:             0.5.1+version:             0.6 synopsis:            Haskell bindings to LevelDB homepage:            http://github.com/kim/leveldb-haskell bug-reports:         http://github.com/kim/leveldb-haskell/issues@@ -153,6 +153,8 @@   type:             exitcode-stdio-1.0   main-is:          Main.hs   hs-source-dirs:   test++  other-modules:    Test.Streaming    default-language: Haskell2010 

@@ -27,10 +27,8 @@ -- -- 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>.+-- "Data.List") have been omitted for various reasons. Missing functions may be+-- added upon <https://github.com/kim/leveldb-haskell/pulls request>.  module Data.Stream.Monadic     ( Step   (..)@@ -49,12 +47,15 @@     , tail     , init     , null-    , length+    , length -- finitary      -- * Transformations     , map-    -- , mapM+    , mapM+    , mapM_+    , reverse     , intersperse+    , intercalate      -- * Folds     , foldl@@ -68,85 +69,145 @@     , foldM_      -- * Special folds-    -- , concat+    , concat     , concatMap-    -- , and-    -- , or-    -- , any-    -- , all-    -- , sum-    -- , product-    -- , maximum-    -- , minimum+    , and+    , or+    , any+    , all+    , sum+    , product+    --, maximum -- non-empty+    --, minimum -- non-empty -    -- , scanl+    -- * Building streams+    -- ** Scans+    , scanl     -- , scanl1+    -- , scanr+    -- , scanr1 -    -- * Infinite streams+    -- Accumulating maps+    -- , mapAccumL+    -- , mapAccumR++    -- ** Infinite streams     , iterate     , repeat     , replicate     , cycle -    -- * Unfolding+    -- ** Unfolding     , unfoldr     , unfoldrM -    -- , isPrefixOf+    -- * Substreams+    -- ** Extracting substreams+    , take+    , drop+    , splitAt+    , takeWhile+    , dropWhile+    , span+    , break+    -- , group+    -- , inits+    -- , tails +    -- ** Predicates+    , isPrefixOf+    , isSuffixOf+    -- , isInfixOf -- would need 'tails'+     -- * Searching streams-    -- , elem-    -- , lookup+    -- ** Searching by equality+    , elem+    , notElem+    , lookup -    -- , find+    -- ** Searching with a predicate+    , find     , filter+    -- , partition +    -- Indexing streams+    --   does not make too much sense     -- , index     -- , findIndex     -- , elemIndex     -- , elemIndices     -- , findIndices -    -- * Substreams-    , take-    , drop-    -- , splitAt-    , takeWhile-    , dropWhile-     -- * Zipping and unzipping     , zip-    -- , zip3-    -- , zip4+    , zip3+    , zip4     , zipWith-    -- , zipWith3-    -- , zipWith4+    , zipWith3+    , zipWith4     , unzip+    , unzip3+    , unzip4 -    -- , insertBy+    -- * Special streams+    --   strings - not applicable+    -- , lines+    -- , words+    -- , unlines+    -- , unwords++    -- ** \"Set\" operations+    -- , nub+    , delete+    -- , \\+    -- , union+    -- , intersect++    -- , sort+    , insert++    -- * Generalized functions++    --   User-supplied equality, replacing an Eq context+    -- , nubBy+    , deleteBy+    -- , deleteFirstsBy+    -- , unionBy+    -- , intersectBy+    -- , groupBy++    -- ** User-supplied comparison, replacing an Ord context+    -- , sortBy+    , insertBy     -- , maximumBy     -- , minimumBy -    -- , genericLength-    -- , genericTake-    -- , genericDrop+    -- * The \"generic\" operations+    , genericLength+    , genericTake+    , genericDrop+    , genericSplitAt     -- , genericIndex-    -- , genericSplitAt+    , genericReplicate -    -- , enumFromToInt-    -- , enumFromToChar-    -- , enumDeltaInteger+    , enumFromToInt+    , enumFromToChar+    , enumDeltaInteger     ) where  import Control.Applicative+import Control.Monad       (Monad (..), void, (=<<), (>=>))+import Data.Char           (Char, chr, ord) import Data.Monoid -import Prelude (Bool (..), Either (..), Eq (..), Functor (..), Int, Maybe (..),-                Monad (..), Num (..), Ord (..), error, otherwise, ($), (&&),-                (.), (=<<))+import Debug.Trace +import Prelude (Bool (..), Either (..), Eq (..), Functor (..), Int, Integer,+                Integral (..), Maybe (..), Num (..), Ord (..), Ordering (..),+                error, flip, not, otherwise, undefined, ($), (&&), (.), (||)) + data Step   a  s    = Yield  a !s    | Skip  !s@@ -167,6 +228,7 @@             Done       -> return []             Skip    s' -> unfold s'             Yield x s' -> (x :) <$> unfold s'+{-# INLINE [0] toList #-}  fromList :: Monad m => [a] -> Stream m a fromList xs = Stream next (return xs)@@ -174,10 +236,10 @@     {-# INLINE next #-}     next []      = return Done     next (x:xs') = return $ Yield x xs'-+{-# INLINE [0] fromList #-} {-# RULES-    "Stream fromList/toList fusion" forall s.-        fmap fromList (toList s) = return s+"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@@ -323,6 +385,37 @@             Yield _ s' -> loop  (z+1) s' {-# INLINE [0] length #-} +elem :: (Eq a, Monad m) => a -> Stream m a -> m Bool+elem x (Stream next s0) = loop =<< s0+  where+    loop !s = do+        step <- next s+        case step of+            Done                   -> return False+            Skip    s'             -> loop s'+            Yield y s' | y == x    -> return True+                       | otherwise -> loop s'+{-# INLINE [0] elem #-}++notElem :: (Eq a, Monad m) => a -> Stream m a -> m Bool+notElem x s = elem x s >>= return . not++lookup :: (Eq a, Monad m) => a -> Stream m (a, b) -> m (Maybe b)+lookup key (Stream next s0) = loop =<< s0+  where+    loop !s = do+        step <- next s+        case step of+            Done                        -> return Nothing+            Skip s'                     -> loop s'+            Yield (x, y) s' | key == x  -> return $ Just y+                            | otherwise -> loop s'+{-# INLINE [0] lookup #-}++find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a)+find p = head . filter p+{-# INLINE [0] find #-}+ filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a filter p (Stream next0 s0) = Stream next s0   where@@ -336,8 +429,8 @@                        | 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+"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@@ -352,28 +445,50 @@             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+"Stream map/map fusion" forall f g s.+    map f (map g s) = map (f . g) 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.+mapM :: (Functor m, Monad m) => (a -> m b) -> Stream m a -> Stream m b+mapM f (Stream next0 s0) = Stream next s0+  where+    {-# INLINE next #-}+    next !s = do+        step <- next0 s+        case step of+            Done       -> return Done+            Skip    s' -> return $ Skip s'+            Yield x s' -> (`Yield` s') <$> f x+{-# INLINE [0] mapM #-}+{-# RULES+"Stream mapM/mapM fusion" forall f g s.+    mapM f (mapM g s) = mapM (g >=> f) s +"Stream map/mapM fusion" forall f g s.+    map f (mapM g s)  = mapM (fmap f . g) s +"Stream mapM/map fusion" forall f g s.+    mapM f (map g s)  = mapM (f . g) s+  #-}++mapM_ :: (Functor m, Monad m) => (a -> m b) -> Stream m a -> Stream m ()+mapM_ f s = Stream go (return ())+  where+    {-# INLINE go #-}+    go _ = foldM_ (\ _ -> void . f) () s >> return Done+{-# INLINE [0] mapM_ #-}+{-# RULES+"Stream mapM_/mapM fusion" forall f g s.+    mapM_ f (mapM g s) = mapM_ (g >=> f) s++"Stream mapM_/map fusion" forall f g s.+    mapM_ f (map g s)  = mapM_ (f . g) s+  #-}++reverse :: (Functor m, Monad m) => Stream m a -> m (Stream m a)+reverse = foldl' (flip cons) (fromList [])+{-# INLINE reverse #-}+ intersperse :: (Functor m, Monad m) => a -> Stream m a -> Stream m a intersperse sep (Stream next0 s0) = Stream next ((,,) Nothing S1 <$> s0)   where@@ -397,6 +512,15 @@     next (Just _, S2, _)  = error "Data.Stream.Monadic.intersperse: impossible" {-# INLINE [0] intersperse #-} +intercalate :: (Functor m, Monad m) => Stream m a -> Stream m [a] -> Stream m a+intercalate sep s = first s `append` rest s+  where+    first = concat                            . take 1+    rest  = concatMap (append sep . fromList) . drop 1+{-# INLINE intercalate #-}++--transpose :: Monad m => Stream m [a] -> Stream m [a]+ foldMap :: (Monoid m, Functor n, Monad n) => (a -> m) -> Stream n a -> n m foldMap f (Stream next s0) = loop mempty =<< s0   where@@ -407,10 +531,14 @@             Skip    s' -> loop z s'             Yield x s' -> loop (z <> f x) s' {-# INLINE [0] foldMap #-}+{-# RULES+"Stream foldMap/map fusion" forall f g s.+    foldMap f (map g s)  = foldMap (f . g) s --- | Left-associative fold.------ Note that the /direction/ of the traversal is not defined here.+"Stream foldMap/mapM fusion" forall f g s.+    foldMap f (mapM g s) = foldM (\ z' -> fmap ((z' <>) . f) . g) mempty s+  #-}+ foldl :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b foldl f z0 (Stream next s0) = loop z0 =<< s0   where@@ -421,10 +549,14 @@             Skip    s' -> loop z s'             Yield x s' -> loop (f z x) s' {-# INLINE [0] foldl #-}+{-# RULES+"Stream foldl/map fusion" forall f g z s.+    foldl f z (map g s)  = foldl (\ z' -> f z' . g) z s --- | Left-associative fold with strict accumulator.------ Note that the /direction/ of the traversal is not defined here.+"Stream foldl/mapM fusion" forall f g z s.+    foldl f z (mapM g s) = foldM (\ z' -> fmap (f z') . g) z s+  #-}+ foldl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b foldl' f z0 (Stream next s0) = loop z0 =<< s0   where@@ -435,10 +567,14 @@             Skip    s' -> loop z s'             Yield x s' -> loop (f z x) s' {-# INLINE [0] foldl' #-}+{-# RULES+"Stream foldl'/map fusion" forall f g z s.+    foldl' f z (map g s)  = foldl' (\ z' -> f z' . g) z s --- | Right-associative fold.------ Note that the /direction/ of the traversal is not defined here.+"Stream foldl'/mapM fusion" forall f g z s.+    foldl' f z (mapM g s) = foldM  (\ z' -> fmap (f z') . g) z s+  #-}+ foldr :: (Functor m, Monad m) => (a -> b -> b) -> b -> Stream m a -> m b foldr f z (Stream next s0) = loop =<< s0   where@@ -449,7 +585,14 @@             Skip    s' -> loop s'             Yield x s' -> f x <$> loop s' {-# INLINE [0] foldr #-}+{-# RULES+"Stream foldr/map fusion" forall f g z s.+    foldr f z (map g s)  = foldr (f . g) z s +"Stream foldr/mapM fusion" forall f g z s.+    foldr f z (mapM g s) = foldM (\ z' -> fmap (`f` z') . g) z s+  #-}+ foldM :: Monad m => (b -> a -> m b) -> b -> Stream m a -> m b foldM f z0 (Stream next s0) = loop z0 =<< s0   where@@ -460,18 +603,22 @@             Skip    s' -> loop z s'             Yield x s' -> f z x >>= (`loop` s') {-# INLINE [0] foldM #-}+{-# RULES+"Stream foldM/map fusion" forall f g z s.+    foldM f z (map g s)  = foldM (\ z' -> f z' . g) z s +"Stream foldM/mapM fusion" forall f g z s.+    foldM f z (mapM g s) = foldM (\ z' -> g >=> f z') z s+  #-}+ 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_ #-}+foldM_ f z s = foldM f z s >> return ()+{-# INLINE foldM_ #-} +concat :: (Functor m, Monad m) => Stream m [a] -> Stream m a+concat = concatMap fromList+{-# INLINE concat #-}+ 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@@ -490,7 +637,80 @@             Skip    t' -> Skip    (Just (Stream g (return t')), s)             Yield x t' -> Yield x (Just (Stream g (return t')), s) {-# INLINE [0] concatMap #-}+{-# RULES+"Stream concatMap/map fusion" forall f g s.+    concatMap f (map g s) = concatMap (f . g) s+  #-} +and :: (Functor m, Monad m) => Stream m Bool -> m Bool+and = foldr (&&) True+{-# INLINE and #-}++or :: (Functor m, Monad m) => Stream m Bool -> m Bool+or = foldr (||) False+{-# INLINE or #-}++any :: Monad m => (a -> Bool) -> Stream m a -> m Bool+any p (Stream next s0) = loop =<< s0+  where+    loop !s = do+        step <- next s+        case step of+            Done                   -> return False+            Skip    s'             -> loop s'+            Yield x s' | p x       -> return True+                       | otherwise -> loop s'+{-# INLINE [0] any #-}++all :: Monad m => (a -> Bool) -> Stream m a -> m Bool+all p (Stream next s0) = loop =<< s0+  where+    loop !s = do+        step <- next s+        case step of+            Done                   -> return True+            Skip    s'             -> loop s'+            Yield x s' | p x       -> loop s'+                       | otherwise -> return False+{-# INLINE [0] all #-}++sum :: (Num a, Monad m) => Stream m a -> m a+sum (Stream next s0) = loop 0 =<< s0+  where+    loop !a !s = do+        step <- next s+        case step of+            Done       -> return a+            Skip    s' -> loop   a      s'+            Yield x s' -> loop  (a + x) s'+{-# INLINE [0] sum #-}++product :: (Num a, Monad m) => Stream m a -> m a+product (Stream next s0) = loop 1 =<< s0+  where+    loop !a !s = do+        step <- next s+        case step of+            Done       -> return a+            Skip    s' -> loop   a      s'+            Yield x s' -> loop  (a * x) s'+{-# INLINE [0] product #-}++scanl :: (Functor m, Monad m) => (b -> a -> b) -> b -> Stream m a -> Stream m b+scanl f z0 = go . (`snoc` undefined)+  where+    {-# INLINE go #-}+    go (Stream step s0) = Stream (next step) ((,) z0 <$> s0)++    {-# INLINE next #-}+    next step (z, s) = do+        step' <- step s+        return $ case step' of+            Done       -> Done+            Skip    s' -> Skip    (z    , s')+            Yield x s' -> Yield z (f z x, s')+{-# INLINE [0] scanl #-}+ iterate :: Monad m => (a -> a) -> a -> Stream m a iterate f x0 = Stream next (return x0)   where@@ -505,7 +725,8 @@     next _ = return $ Yield x () {-# INLINE [0] repeat #-} {-# RULES-    "map/repeat" forall f x. map f (repeat x) = repeat (f x)+"map/repeat" forall f x.+    map f (repeat x) = repeat (f x)   #-}  replicate :: Monad m => Int -> a -> Stream m a@@ -516,7 +737,8 @@             | 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)+"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@@ -535,7 +757,7 @@     next (S2, s) = do         step <- next0 s         case step of-            Done       -> Skip . ((,) S2) <$> s0+            Done       -> Skip . (,) S2 <$> s0             Skip    s' -> return $ Skip    (S2, s')             Yield x s' -> return $ Yield x (S2, s') {-# INLINE [0] cycle #-}@@ -551,7 +773,7 @@  -- | 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+unfoldrM f = Stream next   where     {-# INLINE next #-}     next s = case f s of@@ -559,6 +781,41 @@         Just (w, s') -> Yield w <$> s' {-# INLINE [0] unfoldrM #-} +isPrefixOf :: (Eq a, Monad m) => Stream m a -> Stream m a -> m Bool+isPrefixOf (Stream nexta sa0) (Stream nextb sb0) = do+    sa0' <- sa0+    sb0' <- sb0+    loop sa0' sb0' Nothing+  where+    loop !sa !sb Nothing = do+        stepa <- nexta sa+        case stepa of+            Done        -> return True+            Skip    sa' -> loop sa' sb Nothing+            Yield x sa' -> loop sa' sb (Just x)++    loop !sa !sb (Just x) = do+        stepb <- nextb sb+        case stepb of+            Done                    -> return False+            Skip    sb'             -> loop sa sb' (Just x)+            Yield y sb' | x == y    -> loop sa sb' Nothing+                        | otherwise -> return False+{-# INLINE [0] isPrefixOf #-}++-- | Note that this is:+--+-- > isSuffixOf a b = reverse a `isPrefixOf` reverse b+--+-- It might be more efficient to construct the 'Stream's in reverse order and+-- use 'isPrefixOf' directly, as 'reverse' is /O(n)/ and requires a finite+-- stream argument.+isSuffixOf :: (Eq a, Functor m, Monad m) => Stream m a -> Stream m a -> m Bool+isSuffixOf sa sb = do+    ra <- reverse sa+    rb <- reverse sb+    ra `isPrefixOf` rb+ take :: (Functor m, Monad m) => Int -> Stream m a -> Stream m a take n0 (Stream next0 s0) = Stream next ((,) n0 <$> s0)   where@@ -593,6 +850,18 @@             Yield x s' -> Yield x (Nothing, s') {-# INLINE [0] drop #-} +-- |+--+-- > splitAt n s = (take n s, drop n s)+--+-- Note that the resulting 'Streams' share their state, so do not interleave+-- traversals.+splitAt :: (Functor m, Monad m) => Int -> Stream m a -> (Stream m a, Stream m a)+-- not the most efficient solution, but allows the stream argument to be+-- infinite+splitAt n s = (take n s, drop n s)+{-# INLINE splitAt #-}+ takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a takeWhile p (Stream next0 s0) = Stream next s0   where@@ -625,6 +894,14 @@             Yield x s' -> Yield x (S2, s') {-# INLINE [0] dropWhile #-} +span :: (Functor m, Monad m) => (a -> Bool) -> Stream m a -> (Stream m a, Stream m a)+span p s = (takeWhile p s, dropWhile p s)+{-# INLINE span #-}++break :: (Functor m, Monad m) => (a -> Bool) -> Stream m a -> (Stream m a, Stream m a)+break p = span (not . p)+{-# INLINE break #-}+ zip :: (Functor m, Applicative m, Monad m)     => Stream m a     -> Stream m b@@ -632,6 +909,23 @@ zip = zipWith (,) {-# INLINE zip #-} +zip3 :: (Functor m, Applicative m, Monad m)+     => Stream m a+     -> Stream m b+     -> Stream m c+     -> Stream m (a, b, c)+zip3 = zipWith3 (,,)+{-# INLINE zip3 #-}++zip4 :: (Functor m, Applicative m, Monad m)+     => Stream m a+     -> Stream m b+     -> Stream m c+     -> Stream m d+     -> Stream m (a, b, c, d)+zip4 = zipWith4 (,,,)+{-# INLINE zip4 #-}+ zipWith :: (Functor m, Applicative m, Monad m)         => (a -> b -> c)         -> Stream m a@@ -656,6 +950,247 @@             Yield b sb' -> Yield (f a b) (Nothing, sa', sb') {-# INLINE [0] zipWith #-} +zipWith3 :: (Functor m, Applicative m , Monad m)+         => (a -> b -> c -> d)+         -> Stream m a+         -> Stream m b+         -> Stream m c+         -> Stream m d+zipWith3 f (Stream nexta sa0)+           (Stream nextb sb0)+           (Stream nextc sc0)+    = Stream next ((,,,) Nothing <$> sa0 <*> sb0 <*> sc0)+  where+    {-# INLINE next #-}+    next (Nothing, sa, sb, sc) = do+        step <- nexta sa+        return $ case step of+            Done        -> Done+            Skip    sa' -> Skip (Nothing          , sa', sb, sc)+            Yield a sa' -> Skip (Just (a, Nothing), sa', sb, sc)++    next (Just (a, Nothing), sa', sb, sc) = do+        step <- nextb sb+        return $ case step of+            Done        -> Done+            Skip    sb' -> Skip (Just (a, Nothing), sa', sb', sc)+            Yield b sb' -> Skip (Just (a, Just b ), sa', sb', sc)++    next (Just (a, Just b), sa', sb', sc) = do+        step <- nextc sc+        return $ case step of+            Done        -> Done+            Skip    sc' -> Skip            (Just (a, Just b), sa', sb', sc')+            Yield c sc' -> Yield (f a b c) (Nothing         , sa', sb', sc')+{-# INLINE [0] zipWith3 #-}++zipWith4 :: (Functor m, Applicative m , Monad m)+         => (a -> b -> c -> d -> e)+         -> Stream m a+         -> Stream m b+         -> Stream m c+         -> Stream m d+         -> Stream m e+zipWith4 f (Stream nexta sa0)+           (Stream nextb sb0)+           (Stream nextc sc0)+           (Stream nextd sd0)+    = Stream next ((,,,,) Nothing <$> sa0 <*> sb0 <*> sc0 <*> sd0)+  where+    {-# INLINE next #-}+    next (Nothing, sa, sb, sc, sd) = do+        step <- nexta sa+        return $ case step of+            Done        -> Done+            Skip    sa' -> Skip (Nothing          , sa', sb, sc, sd)+            Yield a sa' -> Skip (Just (a, Nothing), sa', sb, sc, sd)++    next (Just (a, Nothing), sa', sb, sc, sd) = do+        step <- nextb sb+        return $ case step of+            Done        -> Done+            Skip sb'    -> Skip (Just (a, Nothing)          , sa', sb', sc, sd)+            Yield b sb' -> Skip (Just (a, Just (b, Nothing)), sa', sb', sc, sd)++    next (Just (a, Just (b, Nothing)), sa', sb', sc, sd) = do+        step <- nextc sc+        return $ case step of+            Done        -> Done+            Skip    sc' -> Skip (Just (a, Just (b, Nothing)), sa', sb', sc', sd)+            Yield c sc' -> Skip (Just (a, Just (b, Just c)) , sa', sb', sc', sd)++    next (Just (a, Just (b, Just c)), sa', sb', sc', sd) = do+        step <- nextd sd+        return $ case step of+            Done        -> Done+            Skip    sd' -> Skip              (Just (a, Just (b, Just c)), sa', sb', sc', sd')+            Yield d sd' -> Yield (f a b c d) (Nothing                   , sa', sb', sc', sd')+{-# INLINE [0] zipWith4 #-}+ unzip :: (Functor m, Monad m) => Stream m (a, b) -> m ([a], [b])-unzip = foldr (\(a,b) ~(as, bs) -> (a:as, b:bs)) ([], [])+unzip = foldr (\ (a,b) ~(as,bs) -> (a:as, b:bs)) ([],[]) {-# INLINE unzip #-}++unzip3 :: (Functor m, Monad m) => Stream m (a, b, c) -> m ([a], [b], [c])+unzip3 = foldr (\ (a,b,c) ~(as,bs,cs) -> (a:as, b:bs, c:cs)) ([],[],[])+{-# INLINE unzip3 #-}++unzip4 :: (Functor m, Monad m) => Stream m (a, b, c, d) -> m ([a], [b], [c], [d])+unzip4 = foldr (\ (a,b,c,d) ~(as,bs,cs,ds) -> (a:as, b:bs, c:cs, d:ds)) ([],[],[],[])+{-# INLINE unzip4 #-}++delete :: (Eq a, Functor m, Monad m) => a -> Stream m a -> Stream m a+delete = deleteBy (==)+{-# INLINE delete #-}++insert :: (Ord a, Functor m, Monad m) => a -> Stream m a -> Stream m a+insert = insertBy compare+{-# INLINE insert #-}++deleteBy :: (Functor m, Monad m)+         => (a -> a -> Bool)+         -> a+         -> Stream m a+         -> Stream m a+deleteBy eq a (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' | a `eq` x  -> Skip    (S2, s')+                       | otherwise -> Yield x (S1, 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] deleteBy #-}++insertBy :: (Functor m, Monad m)+         => (a -> a -> Ordering)+         -> a+         -> Stream m a+         -> Stream m a+insertBy cmp x (Stream next0 s0) = Stream next ((,,) S2 Nothing <$> s0)+  where+    {-# INLINE next #-}+    next (S2, Nothing, s) = do+        step <- next0 s+        return $ case step of+            Done                       -> Yield x (S1, Nothing, s ) -- a snoc+            Skip    s'                 -> Skip    (S2, Nothing, s')+            Yield y s' | GT == cmp x y -> Yield y (S2, Nothing, s')+                       | otherwise     -> Yield x (S1, Just y , s ) -- insert++    next (S2, Just _, _) = error "Data.Stream.Monadic.insertBy: impossible"++    next (S1, Just y, s) = return $ Yield y (S1, Nothing, s)++    next (S1, Nothing, s) = do+        step <- next0 s+        return $ case step of+            Done       -> Done+            Skip    s' -> Skip    (S1, Nothing, s')+            Yield y s' -> Yield y (S1, Nothing, s')+{-# INLINE [0] insertBy #-}++-- not sure why this is defined recursively (unlike 'length')+genericLength :: (Num i, Functor m, Monad m) => Stream m a -> m i+genericLength (Stream next s0) = loop =<< s0+  where+    loop !s = do+        step <- next s+        case step of+            Done       -> return 0+            Skip    s' -> loop s'+            Yield _ s' -> (1 +) <$> loop s'+{-# INLINE [0] genericLength #-}++genericTake :: (Integral i, Functor m, Monad m) => i -> Stream m a -> Stream m a+genericTake n0 (Stream next0 s0) = Stream next ((,) n0 <$> s0)+  where+    {-# INLINE next #-}+    next (0, _)  = return Done+    next (n, s)  = do+        step <- next0 s+        return $ case step of+            Done          -> Done+            Skip    s'    -> Skip    (n  , s')+            Yield x s'+              | n > 0     -> Yield x (n-1, s')+              | otherwise -> error "List.genericTake: negative argument"+{-# INLINE [0] genericTake #-}++genericDrop :: (Integral i, Functor m, Monad m) => i -> Stream m a -> Stream m a+genericDrop n0 (Stream next0 s0) = Stream next ((,) (Just n0) <$> s0)+  where+    {-# INLINE next #-}+    next (Just 0, s) = return $ Skip (Nothing, s)+    next (Just n, s) = do+        step <- next0 s+        return $ case step of+            Done                    -> Done+            Skip    s'              -> Skip (Just n    , s')+            Yield _ s' | n > 0      -> Skip (Just (n-1), s')+                       | otherwise  -> error "List.genericDrop: negative argument"++    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] genericDrop #-}++genericSplitAt :: (Integral i, Functor m, Monad m)+               => i+               -> Stream m a+               -> (Stream m a, Stream m a)+genericSplitAt i s = (genericTake i s, genericDrop i s)+{-# INLINE genericSplitAt #-}++genericReplicate :: (Integral i, Functor m, Monad m) => i -> a -> Stream m a+genericReplicate n = genericTake n . repeat+{-# INLINE [0] genericReplicate #-}+{-# RULES+"genericReplicate -> replicate/Int"+    genericReplicate = replicate :: Monad m => Int -> a -> Stream m a+  #-}++-- TODO: is it possible to define rules which would rewrite @fromList [n..m]@ to+-- one of the below?++-- | Like @fromList ([n..m] :: [Int])@ but avoids allocating a list+enumFromToInt :: Monad m => Int -> Int -> Stream m Int+enumFromToInt x y = trace "enumFromToInt" $ Stream next (return x)+  where+    {-# INLINE next #-}+    next !n+      | n > y     = return Done+      | otherwise = return $ Yield n (n+1)+{-# INLINE [0] enumFromToInt #-}++-- | Like @fromList ([n,n+d..] :: [Integer])@ but avoids allocating a list+enumDeltaInteger :: Monad m => Integer -> Integer -> Stream m Integer+enumDeltaInteger a d = trace "enumDeltaInteger" $ Stream next (return a)+  where+    {-# INLINE next #-}+    next !x = return $ Yield x (x+d)+{-# INLINE [0] enumDeltaInteger #-}++-- | Like @fromList ([n..m] :: [Char])@ but avoids allocating a list+enumFromToChar :: Monad m => Char -> Char -> Stream m Char+enumFromToChar x y = Stream next (return (ord x))+  where+    m = ord y++    {-# INLINE next #-}+    next !n+      | n > m     = return Done+      | otherwise = return $ Yield (chr n) (n+1)+{-# INLINE [0] enumFromToChar #-}

@@ -106,7 +106,7 @@             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)+                Desc | e k > LT  -> Yield k <$> (iterPrev it >> pure it)                      | otherwise -> pure Done  keySlice i AllKeys Asc = Stream next (iterFirst i >> pure i)@@ -135,7 +135,7 @@             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)+                Desc | e k > LT  -> Yield x <$> (iterPrev it >> pure it)                      | otherwise -> pure Done  entrySlice i AllKeys Asc = Stream next (iterFirst i >> pure i)

@@ -0,0 +1,638 @@+{-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE OverloadedStrings #-}++{-# OPTIONS_GHC -fno-warn-orphans            #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++module Test.Streaming (tests) where++import           Control.Applicative        hiding (empty)+import           Control.Monad.Catch+import           Control.Monad.Identity+import           Control.Monad.IO.Class+import qualified Data.ByteString            as BS+import           Data.ByteString.Char8      (ByteString, singleton, unpack)+import           Data.Default+import           Data.Foldable              (foldMap)+import           Data.List+import           Data.Monoid+import           Database.LevelDB.Base+import           Database.LevelDB.Internal  (unsafeClose)+import qualified Database.LevelDB.Streaming as S+import           System.Directory+import           System.IO.Temp+import           Test.QuickCheck+import           Test.QuickCheck.Monadic+import           Test.Tasty+import           Test.Tasty.QuickCheck+++type Prop = Test.Tasty.QuickCheck.Property++data Range' = Range' S.Direction Char Char+    deriving Show++asKeyRange :: Range' -> S.KeyRange+asKeyRange (Range' _ s e) =+    let s' = singleton s+        e' = singleton e+      in S.KeyRange s' (`compare` e')++asList :: Range' -> [ByteString]+asList (Range' _   '{' '}') = []+asList (Range' S.Asc !s !e)+  | s > 'Z'   = []+  | e > 'Z'   = map singleton [s..'Z']+  | otherwise = map singleton [s..e]+asList (Range' S.Desc !s !e)+  | s > 'Z'   = reverse . map singleton $ [e..'Z']+  | e > 'Z'   = []+  | otherwise = reverse . map singleton $ [e..s]++asAssocList :: Range' -> [(ByteString, ByteString)]+asAssocList r = let r' = asList r in zip r' r'++mkKeySlice :: (Applicative m, MonadIO m) => Range' -> Iterator -> S.Stream m S.Key+mkKeySlice r@(Range' d _ _) i = S.keySlice i (asKeyRange r) d++mkEntrySlice :: (Applicative m, MonadIO m) => Range' -> Iterator -> S.Stream m S.Entry+mkEntrySlice r@(Range' d _ _) i = S.entrySlice i (asKeyRange r) d+++instance Arbitrary Range' where+    arbitrary = do+        d <- arbitrary+        oneof [ empty d, nonempty d ]+      where+        nonempty d = do+            s <- elements ['A'..'Z']+            e <- case d of+                S.Asc  -> arbitrary `suchThat` (<= 'Z') `suchThat` (>= s)+                S.Desc -> arbitrary `suchThat` (>= 'A') `suchThat` (<= s)+            return $ Range' d s e++        empty d = return $ Range' d '{' '}'++instance Arbitrary S.Direction where+    arbitrary = elements [ S.Asc, S.Desc ]++instance Arbitrary ByteString where+    arbitrary = BS.pack <$> arbitrary++instance CoArbitrary ByteString where+    coarbitrary = coarbitrary . unpack+++instance Show (a -> b) where+    show = const "<function>"++data Rs = Rs DB FilePath++tests :: TestTree+tests = withResource initDB destroyDB $ \ rs ->+    testGroup "List-like Iterators"+        [ testGroup "conversions"+            [ testProperty "toList . fromList = id" prop_fromList+            ]+        , testGroup "basic functions"+            [ testProperty "head"        (prop_head        rs)+            , testProperty "append"      (prop_append      rs)+            , testProperty "cons"        (prop_cons        rs)+            , testProperty "snoc"        (prop_snoc        rs)+            , testProperty "last"        (prop_last        rs)+            , testProperty "tail"        (prop_tail        rs)+            , testProperty "init"        (prop_init        rs)+            , testProperty "null"        (prop_null        rs)+            , testProperty "length"      (prop_length      rs)+            ]+        , testGroup "transformations"+            [ testProperty "map"         (prop_map         rs)+            , testProperty "mapM"        (prop_mapM        rs)+            , testProperty "reverse"     (prop_reverse     rs)+            , testProperty "intersperse" (prop_intersperse rs)+            , testProperty "intercalate" prop_intercalate+            ]+        , testGroup "searching"+            [ testProperty "elem"        (prop_elem        rs)+            , testProperty "notElem"     (prop_notElem     rs)+            , testProperty "lookup"      (prop_lookup      rs)+            , testProperty "find"        (prop_find        rs)+            , testProperty "filter"      (prop_filter      rs)+            ]+        , testGroup "folds"+            [ testProperty "foldl"       (prop_foldl       rs)+            , testProperty "foldl'"      (prop_foldl'      rs)+            , testProperty "foldr"       (prop_foldr       rs)+            , testProperty "foldMap"     (prop_foldMap     rs)+            , testProperty "foldM"       (prop_foldM       rs)+            ]+        , testGroup "special folds"+            [ testProperty "concat"      prop_concat+            , testProperty "concatMap"   (prop_concatMap   rs)+            , testProperty "and"         prop_and+            , testProperty "or"          prop_or+            , testProperty "any"         prop_any+            , testProperty "all"         prop_all+            , testProperty "sum"         prop_sum+            , testProperty "product"     prop_product+            ]+        , testGroup "scans"+            [ testProperty "scanl"       (prop_scanl       rs)+            , testProperty "last (scanl f z xs) == foldl f z xs" (prop_scanl_last rs)+            ]+        , testGroup "infinite streams"+            [ testProperty "iterate"     prop_iterate+            , testProperty "repeat"      prop_repeat+            , testProperty "replicate"   prop_replicate+            , testProperty "cycle"       prop_cycle+            ]+        , testGroup "unfolding"+            [ testProperty "unfoldr"     prop_unfoldr+            ]+        , testGroup "predicates"+            [ testProperty "isPrefixOf"  (prop_isPrefixOf  rs)+            , testProperty "isSuffixOf"  (prop_isSuffixOf  rs)+            ]+        , testGroup "substreams"+            [ testProperty "take"        (prop_take        rs)+            , testProperty "drop"        (prop_drop        rs)+            , testProperty "splitAt"     (prop_splitAt     rs)+            , testProperty "takeWhile"   (prop_takeWhile   rs)+            , testProperty "dropWhile"   (prop_dropWhile   rs)+            , testProperty "span"        (prop_span        rs)+            , testProperty "break"       (prop_break       rs)+            ]+        , testGroup "zipping and unzipping"+            [ testProperty "zip"         (prop_zip         rs)+            , testProperty "zip3"        (prop_zip3        rs)+            , testProperty "zip4"        (prop_zip4        rs)+            , testProperty "zipWith"     (prop_zipWith     rs)+            , testProperty "zipWith3"    (prop_zipWith3    rs)+            , testProperty "zipWith4"    (prop_zipWith4    rs)+            , testProperty "unzip"       (prop_unzip       rs)+            , testProperty "unzip3"      (prop_unzip3      rs)+            , testProperty "unzip4"      (prop_unzip4      rs)+            ]+        , testGroup "generalized functions"+            [ testProperty "deleteBy"    (prop_deleteBy    rs)+            , testProperty "insertBy"    (prop_insertBy    rs)+            ]+        ]+  where+    initDB = do+        tmp <- getTemporaryDirectory+        dir <- createTempDirectory tmp "leveldb-streaming-tests"+        db  <- open dir defaultOptions { createIfMissing = True }+        write db def+            . map ( \ c -> let c' = singleton c in Put c' c')+            $ ['A'..'Z']+        return $ Rs db dir++    destroyDB (Rs db dir) = unsafeClose db `finally` destroy dir defaultOptions+++with_iter rs f    = liftIO $ rs >>= \ (Rs db _) -> withIter db def f+run_prop  rs !a b = monadicIO $ with_iter rs b >>= assert . (a ==)+++--+-- conversions+--++prop_fromList :: [ByteString] -> Prop+prop_fromList xs = monadic runIdentity+                 . fmap (=== xs) . S.toList . S.fromList+                 $ xs++--+-- basic functions+--++prop_append rs range1 range2 = monadicIO $+        (with_iter rs $ \ i1 -> with_iter rs $ \ i2 -> b i1 i2)+    >>= assert . (a ==)+  where+    a       = asList range1 ++ asList range2+    b i1 i2 = S.toList $ S.append (mkKeySlice range1 i1) (mkKeySlice range2 i2)++prop_cons rs range w = run_prop rs a b+  where+    a = w : asList range+    b = S.toList . S.cons w . mkKeySlice range++prop_snoc rs range y = run_prop rs a b+  where+    a = asList range ++ [y]+    b = S.toList . (`S.snoc` y) . mkKeySlice range++prop_head rs range = run_prop rs a b+  where+    a = case asList range of+            [] -> Nothing+            xs -> Just . head $ xs+    b = S.head . mkKeySlice range++prop_last rs range = run_prop rs a b+  where+    a = case asList range of+            [] -> Nothing+            xs -> Just . last $ xs+    b = S.last . mkKeySlice range++prop_tail rs range = run_prop rs a b+  where+    a = case asList range of+            [] -> []+            xs -> tail xs+    b = S.toList . S.tail . mkKeySlice range++prop_init rs range = run_prop rs a b+  where+    a = case asList range of+            [] -> []+            xs -> init xs+    b = S.toList . S.init . mkKeySlice range++prop_null rs range = run_prop rs a b+  where+    a =   null $ asList     range+    b = S.null . mkKeySlice range++prop_length rs range = run_prop rs a b+  where+    a =   length $ asList     range+    b = S.length . mkKeySlice range+++--+-- transformations+--++prop_map :: IO Rs -> Range' -> (ByteString -> Int) -> Prop+prop_map rs range f = run_prop rs a b+  where+    a =              map f $ asList     range+    b = S.toList . S.map f . mkKeySlice range++prop_mapM rs range = monadicIO . with_iter rs $ liftM2 (===) a . b+  where+    a =              mapM f $ asList range+    b = S.toList . S.mapM f . mkKeySlice range++    f = return . BS.length++prop_reverse rs range = run_prop rs a b+  where+    a =                    reverse $ asList     range+    b = (>>= S.toList) . S.reverse . mkKeySlice range++prop_intersperse rs range x = run_prop rs a b+  where+    a =              intersperse x $ asList     range+    b = S.toList . S.intersperse x . mkKeySlice range++prop_intercalate :: [Int] -> [[Int]] -> Prop+prop_intercalate xs xss = monadic runIdentity $! assert . (a ==) =<< b+  where+    a =              intercalate             xs              xss+    b = S.toList $ S.intercalate (S.fromList xs) (S.fromList xss)++--+-- folds+--++prop_foldl rs range f = run_prop rs a b+  where+    a =   foldl f BS.empty $ asList     range+    b = S.foldl f BS.empty . mkKeySlice range++prop_foldl' rs range f = run_prop rs a b+  where+    a =   foldl' f BS.empty $ asList     range+    b = S.foldl' f BS.empty . mkKeySlice range++prop_foldr rs range f = run_prop rs a b+  where+    a =   foldr f BS.empty $ asList     range+    b = S.foldr f BS.empty . mkKeySlice range++prop_foldMap :: IO Rs -> Range' -> (ByteString -> ByteString) -> Prop+prop_foldMap rs range f = run_prop rs a b+  where+    a =   foldMap f $ asList     range+    b = S.foldMap f . mkKeySlice range++prop_foldM rs range = monadicIO . with_iter rs $ \ i -> do+    a' <- a+    b' <- b i+    return $! a' === b'+  where+    a =   foldM f BS.empty $ asList     range+    b = S.foldM f BS.empty . mkKeySlice range++    f z x = return $ z <> x++-- TODO: foldM_ ?+++--+-- special folds+--++prop_concat :: [[Int]] -> Prop+prop_concat xss = monadic runIdentity $! assert . (a ==) =<< b+  where+    a =              concat                xss+    b = S.toList . S.concat . S.fromList $ xss++prop_concatMap rs range = run_prop rs a b+  where+    a =              concatMap (  replicate 10) $ asList     range+    b = S.toList . S.concatMap (S.replicate 10) . mkKeySlice range++prop_and ts = monadic runIdentity $! assert . (a ==) =<< b+  where+    a =   and                ts+    b = S.and . S.fromList $ ts++prop_or ts = monadic runIdentity $! assert . (a ==) =<< b+  where+    a =   or                ts+    b = S.or . S.fromList $ ts++prop_any :: (Int -> Bool) -> [Int] -> Prop+prop_any p xs = monadic runIdentity $! assert . (a ==) =<< b+  where+    a =   any p                xs+    b = S.any p . S.fromList $ xs++prop_all :: (Int -> Bool) -> [Int] -> Prop+prop_all p xs = monadic runIdentity $! assert . (a ==) =<< b+  where+    a =   all p                xs+    b = S.all p . S.fromList $ xs++prop_sum :: [Int] -> Prop+prop_sum xs = monadic runIdentity $! assert . (a ==) =<< b+  where+    a =   sum                xs+    b = S.sum . S.fromList $ xs++prop_product :: [Int] -> Prop+prop_product xs = monadic runIdentity $! assert . (a ==) =<< b+  where+    a =   product                xs+    b = S.product . S.fromList $ xs++--+-- scans+--++prop_scanl rs f range = run_prop rs a b+  where+    a =              scanl f BS.empty $ asList     range+    b = S.toList . S.scanl f BS.empty . mkKeySlice range++prop_scanl_last rs f range = monadicIO $ do+    (a',b') <- with_iter rs $ \ i -> liftM2 (,) (a i) (b i)+    assert $ a' == Just b'+  where+    a = S.last . S.scanl f BS.empty . mkKeySlice range+    b =          S.foldl f BS.empty . mkKeySlice range++--+-- infinite streams+--++prop_iterate :: (Int -> Int) -> Int -> Prop+prop_iterate f x = monadic runIdentity $! assert . (a ==) =<< b+  where+    a =              take 100 $   iterate f x+    b = S.toList . S.take 100 $ S.iterate f x++prop_repeat :: Int -> Prop+prop_repeat x = monadic runIdentity $! assert . (a ==) =<< b+  where+    a =              take 100 $   repeat x+    b = S.toList . S.take 100 $ S.repeat x++prop_replicate :: Int -> Int -> Prop+prop_replicate n x = monadic runIdentity $! assert . (a ==) =<< b+  where+    a =              replicate n x+    b = S.toList $ S.replicate n x++prop_cycle :: NonNegative Int -> Prop+prop_cycle (NonNegative !n) = monadic runIdentity $! assert . (a ==) =<< b+  where+    a | n == 0    = xs+      | otherwise = take (n*2) . cycle $ xs++    b = S.toList . S.take (n*2) . S.cycle . S.fromList $ xs++    xs :: [Int]+    xs | n == 0    = []+       | otherwise = [0..(n `div` 2)]++--+-- unfolding+--++prop_unfoldr :: (Int -> Maybe (Int, Int)) -> Int -> Prop+prop_unfoldr f z = monadic runIdentity $! assert . (a ==) =<< b+  where+    a =              take 100 $   unfoldr f z+    b = S.toList . S.take 100 $ S.unfoldr f z++--+-- predicates+--++prop_isPrefixOf rs range1 range2 = monadicIO $+        (with_iter rs $ \ i1 -> with_iter rs $ \ i2 -> b i1 i2)+    >>= assert . (a ==)+  where+    a       =     asList range1    `isPrefixOf`   asList     range2+    b i1 i2 = mkKeySlice range1 i1 `S.isPrefixOf` mkKeySlice range2 i2+++prop_isSuffixOf rs range1 range2 = monadicIO $+        (with_iter rs $ \ i1 -> with_iter rs $ \ i2 -> b i1 i2)+    >>= assert . (a ==)+  where+    a       =     asList range1    `isSuffixOf`   asList     range2+    b i1 i2 = mkKeySlice range1 i1 `S.isSuffixOf` mkKeySlice range2 i2++--+-- searching+--++prop_elem rs range x = run_prop rs a b+  where+    a =  x `elem`      asList     range+    b = (x `S.elem`) . mkKeySlice range++prop_notElem rs range x = run_prop rs a b+  where+    a =  x `notElem`      asList     range+    b = (x `S.notElem`) . mkKeySlice range++prop_lookup rs range k = run_prop rs a b+  where+    a =   lookup k $ asAssocList  range+    b = S.lookup k . mkEntrySlice range++prop_find rs range f = run_prop rs a b+  where+    a =   find f $ asList     range+    b = S.find f . mkKeySlice range++prop_filter rs range f = run_prop rs a b+  where+    a =              filter f $ asList     range+    b = S.toList . S.filter f . mkKeySlice range++--+-- substreams+--++prop_take rs range i = run_prop rs a b+  where+    a =              take i $ asList     range+    b = S.toList . S.take i . mkKeySlice range++prop_drop rs range i = run_prop rs a b+  where+    a =              drop i $ asList     range+    b = S.toList . S.drop i . mkKeySlice range++prop_splitAt rs range i = run_prop rs a b+  where+    a =             splitAt i $ asList     range+    b = toLists . S.splitAt i . mkKeySlice range++prop_takeWhile rs range f = run_prop rs a b+  where+    a =              takeWhile f $ asList     range+    b = S.toList . S.takeWhile f . mkKeySlice range++prop_dropWhile rs range f = run_prop rs a b+  where+    a =              dropWhile f $ asList     range+    b = S.toList . S.dropWhile f . mkKeySlice range++prop_span rs range p = run_prop rs a b+  where+    a =             span p $ asList     range+    b = toLists . S.span p . mkKeySlice range++prop_break rs range p = run_prop rs a b+  where+    a =             break p $ asList     range+    b = toLists . S.break p . mkKeySlice range++--+-- zipping and unzipping+--++prop_zip rs range1 range2 = monadicIO $+        (with_iter rs $ \ i1 -> with_iter rs $ \ i2 -> b i1 i2)+    >>= assert . (a ==)+  where+    a       =              zip (asList range1)        (asList range2)+    b i1 i2 = S.toList $ S.zip (mkKeySlice range1 i1) (mkKeySlice range2 i2)++prop_zip3 rs range1 range2 range3 = monadicIO $+        (with_iter rs $ \ i1 -> with_iter rs $ \ i2 -> with_iter rs $ \ i3 -> b i1 i2 i3)+    >>= assert . (a ==)+  where+    a          =              zip3 (asList range1)        (asList range2)        (asList range3)+    b i1 i2 i3 = S.toList $ S.zip3 (mkKeySlice range1 i1) (mkKeySlice range2 i2) (mkKeySlice range3 i3)++prop_zip4 rs range1 range2 range3 range4 = monadicIO $+        (with_iter rs $ \ i1 -> with_iter rs $ \ i2 -> with_iter rs $ \ i3 -> with_iter rs $ \ i4 -> b i1 i2 i3 i4)+    >>= assert . (a ==)+  where+    a             =              zip4 (asList range1)        (asList range2)        (asList range3)        (asList range4)+    b i1 i2 i3 i4 = S.toList $ S.zip4 (mkKeySlice range1 i1) (mkKeySlice range2 i2) (mkKeySlice range3 i3) (mkKeySlice range4 i4)++prop_zipWith :: IO Rs+             -> (ByteString -> ByteString -> (ByteString,ByteString))+             -> Range'+             -> Range'+             -> Prop+prop_zipWith rs f range1 range2 = monadicIO $+        (with_iter rs $ \ i1 -> with_iter rs $ \ i2 -> b i1 i2)+    >>= assert . (a ==)+  where+    a       =              zipWith f (asList range1)        (asList range2)+    b i1 i2 = S.toList $ S.zipWith f (mkKeySlice range1 i1) (mkKeySlice range2 i2)++prop_zipWith3 :: IO Rs+              -> (ByteString -> ByteString -> ByteString -> (ByteString, ByteString,ByteString))+              -> Range'+              -> Range'+              -> Range'+              -> Prop+prop_zipWith3 rs f range1 range2 range3 = monadicIO $+        (with_iter rs $ \ i1 -> with_iter rs $ \ i2 -> with_iter rs $ \ i3 -> b i1 i2 i3)+    >>= assert . (a ==)+  where+    a          =              zipWith3 f (asList range1)        (asList range2)        (asList range3)+    b i1 i2 i3 = S.toList $ S.zipWith3 f (mkKeySlice range1 i1) (mkKeySlice range2 i2) (mkKeySlice range3 i3)++prop_zipWith4 :: IO Rs+              -> (ByteString -> ByteString -> ByteString -> ByteString -> (ByteString, ByteString, ByteString,ByteString))+              -> Range'+              -> Range'+              -> Range'+              -> Range'+              -> Prop+prop_zipWith4 rs f range1 range2 range3 range4 = monadicIO $+        (with_iter rs $ \ i1 -> with_iter rs $ \ i2 -> with_iter rs $ \ i3 -> with_iter rs $ \ i4 -> b i1 i2 i3 i4)+    >>= assert . (a ==)+  where+    a             =              zipWith4 f (asList range1)        (asList range2)        (asList range3)        (asList range4)+    b i1 i2 i3 i4 = S.toList $ S.zipWith4 f (mkKeySlice range1 i1) (mkKeySlice range2 i2) (mkKeySlice range3 i3) (mkKeySlice range4 i4)++prop_unzip rs range1 range2 = monadicIO $+        (with_iter rs $ \ i1 -> with_iter rs $ \ i2 -> b i1 i2)+    >>= assert . (a ==)+  where+    a       =   unzip $   zip (asList range1)        (asList range2)+    b i1 i2 = S.unzip $ S.zip (mkKeySlice range1 i1) (mkKeySlice range2 i2)++prop_unzip3 rs range1 range2 range3 = monadicIO $+        (with_iter rs $ \ i1 -> with_iter rs $ \ i2 -> with_iter rs $ \ i3 -> b i1 i2 i3)+    >>= assert . (a ==)+  where+    a          =   unzip3 $   zip3 (asList range1)        (asList range2)        (asList range3)+    b i1 i2 i3 = S.unzip3 $ S.zip3 (mkKeySlice range1 i1) (mkKeySlice range2 i2) (mkKeySlice range3 i3)++prop_unzip4 rs range1 range2 range3 range4 = monadicIO $+        (with_iter rs $ \ i1 -> with_iter rs $ \ i2 -> with_iter rs $ \ i3 -> with_iter rs $ \ i4 -> b i1 i2 i3 i4)+    >>= assert . (a ==)+  where+    a             =   unzip4 $   zip4 (asList range1)        (asList range2)        (asList range3)        (asList range4)+    b i1 i2 i3 i4 = S.unzip4 $ S.zip4 (mkKeySlice range1 i1) (mkKeySlice range2 i2) (mkKeySlice range3 i3) (mkKeySlice range4 i4)++--+-- generalized+--++prop_deleteBy rs eq x range = run_prop rs a b+  where+    a =              deleteBy eq x $ asList     range+    b = S.toList . S.deleteBy eq x . mkKeySlice range++prop_insertBy rs cmp x range = run_prop rs a b+  where+    a =              insertBy cmp x $ asList     range+    b = S.toList . S.insertBy cmp x . mkKeySlice range++--+-- Helpers+--++toLists :: (Functor m, Monad m) => (S.Stream m a, S.Stream m a) -> m ([a], [a])+toLists (s1,s2) = liftM2 (,) (S.toList s1) (S.toList s2)