Add missing Scanl tests

Author: harendra-kumar

test/Streamly/Test/Data/Scanl/Combinators.hs

@@ -12,8 +12,10 @@ module Streamly.Test.Data.Scanl.Combinators (main) where
 import Data.Int (Int64)
 import Data.Semigroup (Sum(..))
 import qualified Streamly.Internal.Data.MutArray as MArray
+import qualified Streamly.Internal.Data.Pipe as Pipe
 import qualified Streamly.Internal.Data.Scanl as F
 import qualified Streamly.Internal.Data.Stream as Stream
+import qualified Streamly.Internal.Data.Unfold as Unfold
 
 import qualified Prelude
 import Prelude hiding (maximum, minimum, product, sum, mconcat, foldMap, maybe)
@@ -26,13 +28,165 @@ import Test.QuickCheck (Gen, Property, choose, forAll, listOf1)
 
 #include "Streamly/Test/Data/Scanl/CommonCombinators.hs"
 
+-------------------------------------------------------------------------------
+-- Scanl-only tests (these combinators are not exported by the Fold module, or
+-- their scan output cannot be shared via the common 'check' harness).
+-------------------------------------------------------------------------------
+
+-- 'compose' scans the input through the left scan and feeds each of its outputs
+-- (including the initial extract) to the right scan.
+composeS :: Expectation
+composeS =
+    check (F.compose F.sum F.toList) ([1, 2, 3] :: [Int])
+        [[0], [0, 1], [0, 1, 3], [0, 1, 3, 6]]
+
+-- 'composeMany' restarts the left scan with a fresh state each time it
+-- terminates. Here the left scan (take 2 sum) emits a running sum of every two
+-- inputs which the right scan (sum) accumulates.
+composeManyS :: Expectation
+composeManyS =
+    check (F.composeMany (F.take 2 F.sum) F.sum) ([1, 2, 3, 4, 5] :: [Int])
+        [0, 1, 4, 7, 14, 19]
+
+-- 'with' adapts a stateful combinator (here 'indexed') so that the supplied
+-- predicate also sees the state (the index). This keeps elements at even
+-- indices.
+withS :: Expectation
+withS =
+    check (F.with F.indexed F.filter (even . fst) F.toList) "abcde"
+        ["", "a", "a", "ac", "ac", "ace"]
+
+pipeS :: Expectation
+pipeS =
+    check (F.pipe (Pipe.map (* 2)) F.sum) ([1, 2, 3] :: [Int]) [0, 2, 6, 12]
+
+topByS :: Expectation
+topByS =
+    check (F.rmapM MArray.toList (F.topBy compare 3)) ([5, 1, 4, 2, 3] :: [Int])
+        [[], [5], [5, 1], [5, 4, 1], [5, 4, 2], [5, 4, 3]]
+
+bottomByS :: Expectation
+bottomByS =
+    check (F.rmapM MArray.toList (F.bottomBy compare 3)) ([5, 1, 4, 2, 3] :: [Int])
+        [[], [5], [1, 5], [1, 4, 5], [1, 2, 4], [1, 2, 3]]
+
+indexingWithS :: Expectation
+indexingWithS =
+    check (F.indexingWith 0 (+ 2)) "abc"
+        [Nothing, Just (0, 'a'), Just (2, 'b'), Just (4, 'c')]
+
+indexingS :: Expectation
+indexingS =
+    check F.indexing "abc"
+        [Nothing, Just (0, 'a'), Just (1, 'b'), Just (2, 'c')]
+
+indexingRevS :: Expectation
+indexingRevS =
+    check (F.indexingRev 5) "abc"
+        [Nothing, Just (5, 'a'), Just (4, 'b'), Just (3, 'c')]
+
+takingEndByUS :: Expectation
+takingEndByUS =
+    check (F.takingEndBy_ (== 3)) ([1, 2, 3, 4, 5] :: [Int])
+        [Nothing, Just 1, Just 2, Nothing]
+
+mapMaybeMS :: Expectation
+mapMaybeMS =
+    check
+        (F.mapMaybeM (\x -> return (if even x then Just x else Nothing)) F.toList)
+        ([1, 2, 3, 4] :: [Int])
+        [[], [], [2], [2], [2, 4]]
+
+-- An Unfold that streams the elements of an input list.
+unfoldList :: Monad m => Unfold.Unfold m [a] a
+unfoldList =
+    Unfold.unfoldrM
+        (\xs -> return (case xs of { [] -> Nothing; (y:ys) -> Just (y, ys) }))
+
+unfoldEachS :: Expectation
+unfoldEachS =
+    check (F.unfoldEach unfoldList F.toList) ([[1, 2], [3], [4, 5]] :: [[Int]])
+        [[], [1, 2], [1, 2, 3], [1, 2, 3, 4, 5]]
+
+unfoldManyS :: Expectation
+unfoldManyS =
+    check (F.unfoldMany unfoldList F.toList) ([[1, 2], [3], [4, 5]] :: [[Int]])
+        [[], [1, 2], [1, 2, 3], [1, 2, 3, 4, 5]]
+
+-- 'defaultSalt' is the default salt used by 'rollingHash'. It is part of the
+-- output contract, so the test duplicates the constant rather than importing it.
+defaultSaltS :: Expectation
+defaultSaltS = F.defaultSalt `shouldBe` (-2578643520546668380 :: Int64)
+
+teeS :: Expectation
+teeS =
+    check (F.tee F.sum F.length) ([1, 2, 3] :: [Int])
+        [(0, 0), (1, 1), (3, 2), (6, 3)]
+
+-- Unlike the Fold 'partition' which returns the tuple of both branch results, a
+-- Scanl emits a single interleaved value per input: the just-updated branch.
+partitionByS :: Expectation
+partitionByS =
+    check
+        (F.partitionBy (\x -> if odd x then Left x else Right x) F.length F.length)
+        ([1, 2, 3, 4, 5] :: [Int])
+        [0, 1, 1, 2, 2, 3]
+
+partitionByMS :: Expectation
+partitionByMS =
+    check
+        (F.partitionByM
+            (\x -> return (if odd x then Left x else Right x)) F.length F.length)
+        ([1, 2, 3, 4, 5] :: [Int])
+        [0, 1, 1, 2, 2, 3]
+
+partitionS :: Expectation
+partitionS =
+    check (F.partition F.toList F.toList)
+        ([Left 1, Right 2, Left 3, Right 4] :: [Either Int Int])
+        [[], [1], [2], [1, 3], [2, 4]]
+
+-------------------------------------------------------------------------------
+-- Deprecated combinators (aliases for compose / composeMany)
+-------------------------------------------------------------------------------
+
+scanlS :: Expectation
+scanlS =
+    check (F.scanl F.sum F.toList) ([1, 2, 3] :: [Int])
+        [[0], [0, 1], [0, 1, 3], [0, 1, 3, 6]]
+
+scanlManyS :: Expectation
+scanlManyS =
+    check (F.scanlMany (F.take 2 F.sum) F.sum) ([1, 2, 3, 4, 5] :: [Int])
+        [0, 1, 4, 7, 14, 19]
+
 moduleName :: String
 moduleName = "Data.Scanl.Combinators"
 
 main :: IO ()
 main = hspec $
-    describe moduleName $
+    describe moduleName $ do
         describe "common" commonCombinatorsSpec
 
         -- Before adding any tests here consider if it can be added to the
         -- common tests above.
+        it "compose" composeS
+        it "composeMany" composeManyS
+        it "with" withS
+        it "pipe" pipeS
+        it "topBy" topByS
+        it "bottomBy" bottomByS
+        it "indexingWith" indexingWithS
+        it "indexing" indexingS
+        it "indexingRev" indexingRevS
+        it "takingEndBy_" takingEndByUS
+        it "mapMaybeM" mapMaybeMS
+        it "unfoldEach" unfoldEachS
+        it "unfoldMany" unfoldManyS
+        it "defaultSalt" defaultSaltS
+        it "tee" teeS
+        it "partitionBy" partitionByS
+        it "partitionByM" partitionByMS
+        it "partition" partitionS
+        it "scanl" scanlS
+        it "scanlMany" scanlManyS

test/Streamly/Test/Data/Scanl/Container.hs

@@ -10,6 +10,7 @@
 module Streamly.Test.Data.Scanl.Container (main) where
 
 import qualified Data.IntSet as IntSet
+import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import qualified Streamly.Internal.Data.Scanl as F
 
@@ -18,13 +19,98 @@ import Test.Hspec
 
 #include "Streamly/Test/Data/Scanl/CommonContainer.hs"
 
+-------------------------------------------------------------------------------
+-- Scanl-only tests: demultiplexing and classifying.
+-------------------------------------------------------------------------------
+
+-- Each key's inner scan is @take 2 sum@; the demux/classify scan emits
+-- @Just (key, result)@ on the step at which a key's inner scan terminates and
+-- @Nothing@ otherwise.
+
+demuxInput :: [(String, Int)]
+demuxInput = [("A", 1), ("A", 2), ("B", 3)]
+
+demuxExpected :: [Maybe (String, Int)]
+demuxExpected = [Just ("A", 1), Just ("A", 3), Just ("B", 3)]
+
+demuxGetScanl :: String -> IO (Maybe (F.Scanl IO (String, Int) Int))
+demuxGetScanl _ = return (Just (F.take 2 (F.lmap snd F.sum)))
+
+demuxS :: Expectation
+demuxS = checkPostscanl (F.demux fst demuxGetScanl) demuxInput demuxExpected
+
+demuxIOS :: Expectation
+demuxIOS = checkPostscanl (F.demuxIO fst demuxGetScanl) demuxInput demuxExpected
+
+demuxGenericS :: Expectation
+demuxGenericS =
+    checkPostscanl
+        (fmap snd
+            (F.demuxGeneric fst demuxGetScanl
+                :: F.Scanl IO (String, Int)
+                    (IO (Map.Map String Int), Maybe (String, Int))))
+        demuxInput demuxExpected
+
+demuxGenericIOS :: Expectation
+demuxGenericIOS =
+    checkPostscanl
+        (fmap snd
+            (F.demuxGenericIO fst demuxGetScanl
+                :: F.Scanl IO (String, Int)
+                    (IO (Map.Map String Int), Maybe (String, Int))))
+        demuxInput demuxExpected
+
+classifyInput :: [(String, Int)]
+classifyInput = [("ONE", 1), ("TWO", 2), ("ONE", 3), ("TWO", 4), ("ONE", 5)]
+
+classifyExpected :: [Maybe (String, Int)]
+classifyExpected =
+    [Just ("ONE", 1), Just ("TWO", 2), Just ("ONE", 4), Just ("TWO", 6), Nothing]
+
+classifyInner :: F.Scanl IO (String, Int) Int
+classifyInner = F.lmap snd (F.take 2 F.sum)
+
+classifyS :: Expectation
+classifyS =
+    checkPostscanl (F.classify fst classifyInner) classifyInput classifyExpected
+
+classifyIOS :: Expectation
+classifyIOS =
+    checkPostscanl (F.classifyIO fst classifyInner) classifyInput classifyExpected
+
+classifyGenericS :: Expectation
+classifyGenericS =
+    checkPostscanl
+        (fmap snd
+            (F.classifyGeneric fst classifyInner
+                :: F.Scanl IO (String, Int)
+                    (IO (Map.Map String Int), Maybe (String, Int))))
+        classifyInput classifyExpected
+
+classifyGenericIOS :: Expectation
+classifyGenericIOS =
+    checkPostscanl
+        (fmap snd
+            (F.classifyGenericIO fst classifyInner
+                :: F.Scanl IO (String, Int)
+                    (IO (Map.Map String Int), Maybe (String, Int))))
+        classifyInput classifyExpected
+
 moduleName :: String
 moduleName = "Data.Scanl.Container"
 
 main :: IO ()
 main = hspec $
-    describe moduleName $
+    describe moduleName $ do
         describe "common" commonContainerSpec
 
         -- Before adding any tests here consider if it can be added to the
         -- common tests above.
+        it "demux" demuxS
+        it "demuxIO" demuxIOS
+        it "demuxGeneric" demuxGenericS
+        it "demuxGenericIO" demuxGenericIOS
+        it "classify" classifyS
+        it "classifyIO" classifyIOS
+        it "classifyGeneric" classifyGenericS
+        it "classifyGenericIO" classifyGenericIOS