diff --git a/.hlint.ignore b/.hlint.ignore index fbf657a4..c2eb28c9 100644 --- a/.hlint.ignore +++ b/.hlint.ignore @@ -9,6 +9,7 @@ test/Streamly/Test/Data/SmallArray.hs test/Streamly/Test/Data/Unfold.hs test/Streamly/Test/FileSystem/Event.hs test/Streamly/Test/Prelude/Concurrent.hs +test/Streamly/Test/Data/Stream/Concurrent.hs test/Streamly/Test/Prelude/Fold.hs test/Streamly/Test/Prelude/Rate.hs test/Streamly/Test/Prelude/Serial.hs diff --git a/targets/Targets.hs b/targets/Targets.hs index 1f0c22d3..e49138de 100644 --- a/targets/Targets.hs +++ b/targets/Targets.hs @@ -207,6 +207,6 @@ targets = , ("Network.Inet.TCP", ["noBench"]) , ("version-bounds", ["noBench"]) - , ("Data.List", ["list_grp", "noBench"]) + , ("Data.List", ["list_grp", "noBench", "testDevOnly"]) , ("Data.List.Base", ["list_grp", "noBench"]) ] diff --git a/test/Streamly/Test/Data/Array/Stream.hs b/test/Streamly/Test/Data/Array/Stream.hs index 62fab33f..65e2f4b9 100644 --- a/test/Streamly/Test/Data/Array/Stream.hs +++ b/test/Streamly/Test/Data/Array/Stream.hs @@ -55,11 +55,12 @@ parseBreak = do monadicIO $ do (ls1, str) <- let input = - chunksOf + Stream.toStreamK + $ chunksOf clen (Array.writeN clen) (Stream.fromList ls) parser = Parser.fromFold (Fold.take tlen Fold.toList) in run $ ArrayStream.parseBreak parser input - ls2 <- run $ Stream.fold Fold.toList (ArrayStream.concat str) + ls2 <- run $ Stream.fold Fold.toList (ArrayStream.concat $ Stream.fromStreamK str) case ls1 of Right x -> listEquals (==) (x ++ ls2) ls Left _ -> assert False diff --git a/test/Streamly/Test/Data/Parser/Chunked.hs b/test/Streamly/Test/Data/Parser/Chunked.hs index 2db70068..4edbfcd2 100644 --- a/test/Streamly/Test/Data/Parser/Chunked.hs +++ b/test/Streamly/Test/Data/Parser/Chunked.hs @@ -686,7 +686,7 @@ some = parse :: (Monad f, Unbox a) => P.ChunkParser a f b -> S.Stream f (A.Array a) -> f (Either ParseError b) -parse parser stream = fmap fst (P.parseBreak parser stream) +parse parser stream = fmap fst (P.parseBreak parser $ S.toStreamK stream) applicative :: Property applicative = diff --git a/test/Streamly/Test/Data/Parser/ParserD.hs b/test/Streamly/Test/Data/Parser/ParserD.hs index 35e49bea..0ec4118b 100644 --- a/test/Streamly/Test/Data/Parser/ParserD.hs +++ b/test/Streamly/Test/Data/Parser/ParserD.hs @@ -13,6 +13,7 @@ import Test.QuickCheck.Monadic (monadicIO, assert, run) import qualified Data.List as List import qualified Prelude +import qualified Streamly.Data.Stream as S import qualified Streamly.Internal.Data.Array as A import qualified Streamly.Internal.Data.Fold as FL import qualified Streamly.Internal.Data.Parser.ParserD as P diff --git a/test/Streamly/Test/Data/Stream/Concurrent.hs b/test/Streamly/Test/Data/Stream/Concurrent.hs index 2bd82e7f..816e57e6 100644 --- a/test/Streamly/Test/Data/Stream/Concurrent.hs +++ b/test/Streamly/Test/Data/Stream/Concurrent.hs @@ -131,10 +131,10 @@ exceptionPropagation f = do (Left (ExampleException "E") :: Either ExampleException [Int]) it "append nested throwM" $ do let nested = - Stream.fromFoldable [1..10] + (Stream.fromList [1..10]) `f` Stream.fromEffect (throwM (ExampleException "E")) - `f` Stream.fromFoldable [1..10] - try (tl (Stream.nil `f` nested `f` Stream.fromFoldable [1..10])) + `f` (Stream.fromList [1..10]) + try (tl (Stream.nil `f` nested `f` (Stream.fromList [1..10]))) `shouldReturn` (Left (ExampleException "E") :: Either ExampleException [Int]) @@ -182,7 +182,7 @@ timeOrdering f = do takeCombined :: Int -> IO () takeCombined n = do - let constr = Stream.fromFoldable + let constr = Stream.fromList let s = Async.parList id [constr ([] :: [Int]), constr ([] :: [Int])] r <- Stream.fold Fold.toList $ Stream.take n s r `shouldBe` [] diff --git a/test/Streamly/Test/FileSystem/Event/Common.hs b/test/Streamly/Test/FileSystem/Event/Common.hs index dbbb62ab..07bc4896 100644 --- a/test/Streamly/Test/FileSystem/Event/Common.hs +++ b/test/Streamly/Test/FileSystem/Event/Common.hs @@ -66,7 +66,8 @@ import System.IO.Temp (withSystemTempDirectory) import qualified Data.List.NonEmpty as NonEmpty import qualified Streamly.Internal.Data.Array as Array -import qualified Streamly.Internal.Data.Stream.IsStream as Stream +import qualified Streamly.Internal.Data.Stream as Stream +import qualified Streamly.Internal.Data.Stream.Concurrent as Stream import qualified Streamly.Unicode.Stream as Unicode #if defined(FILESYSTEM_EVENT_LINUX) @@ -95,7 +96,7 @@ type EventChecker = -> MVar () -- mvar to sync file system ops and the watch -> [(String, Event -> Bool)] -- expected events -> IO () -type EventWatcher = NonEmpty (Array Word8) -> Stream.SerialT IO Event.Event +type EventWatcher = NonEmpty (Array Word8) -> Stream.Stream IO Event.Event eventMatches :: Event -> (String, Event -> Bool) -> Bool eventMatches ev (expectedPath, f) = @@ -193,7 +194,8 @@ driver checker symlinkStyle (desc, pre, ops, expected) = -- with the events occurred after the watch is started. let check = checker root target sync expected fsOps = Stream.fromEffect $ runFSOps root sync - Stream.drain $ Stream.fromEffect check `Stream.parallelFst` fsOps + Stream.drain + $ Stream.parListEagerFst [Stream.fromEffect check, fsOps] runFSOps fp sync = do -- We put the MVar before the event watcher starts to run but that does diff --git a/test/Streamly/Test/Network/Inet/TCP.hs b/test/Streamly/Test/Network/Inet/TCP.hs index b8bcbf70..cdaa6821 100644 --- a/test/Streamly/Test/Network/Inet/TCP.hs +++ b/test/Streamly/Test/Network/Inet/TCP.hs @@ -22,11 +22,12 @@ import Streamly.Internal.Data.Stream (Stream) import Test.QuickCheck (Property) import Test.QuickCheck.Monadic (monadicIO, assert, run) +import qualified Streamly.Data.Fold as Fold +import qualified Streamly.Data.Stream.Prelude as Stream import qualified Streamly.Internal.Data.Unfold as Unfold import qualified Streamly.Internal.Network.Inet.TCP as TCP import qualified Streamly.Internal.Network.Socket as Socket import qualified Streamly.Internal.Unicode.Stream as Unicode -import qualified Streamly.Prelude as Stream import Test.Hspec import Test.Hspec.QuickCheck @@ -73,9 +74,9 @@ server -> IO () server listener port sem handler = do putMVar sem () - Stream.fromSerial (Stream.unfold listener port) - & (Stream.fromAsync . Stream.mapM (Socket.forSocketM handler)) - & Stream.drain + Stream.unfold listener port + & Stream.mapM (Socket.forSocketM handler) + & Stream.fold Fold.drain remoteAddr :: (Word8,Word8,Word8,Word8) remoteAddr = (127, 0, 0, 1) diff --git a/test/Streamly/Test/Network/Socket.hs b/test/Streamly/Test/Network/Socket.hs index 4f600d45..685f1e7a 100644 --- a/test/Streamly/Test/Network/Socket.hs +++ b/test/Streamly/Test/Network/Socket.hs @@ -22,10 +22,11 @@ import Streamly.Internal.Data.Stream (Stream) import Test.QuickCheck (Property) import Test.QuickCheck.Monadic (monadicIO, assert, run) +import qualified Streamly.Data.Fold as Fold +import qualified Streamly.Data.Stream.Prelude as Stream import qualified Streamly.Internal.Network.Inet.TCP as TCP import qualified Streamly.Internal.Network.Socket as Socket import qualified Streamly.Internal.Unicode.Stream as Unicode -import qualified Streamly.Prelude as Stream import Test.Hspec import Test.Hspec.QuickCheck @@ -86,9 +87,9 @@ basePort = 64000 server :: PortNumber -> MVar () -> (Socket -> IO ()) -> IO () server port sem handler = do putMVar sem () - Stream.fromSerial (Stream.unfold TCP.acceptorOnPort port) - & Stream.fromAsync . Stream.mapM (Socket.forSocketM handler) - & Stream.drain + Stream.unfold TCP.acceptorOnPort port + & Stream.mapM (Socket.forSocketM handler) + & Stream.fold Fold.drain remoteAddr :: (Word8,Word8,Word8,Word8) remoteAddr = (127, 0, 0, 1) diff --git a/test/Streamly/Test/Prelude/Serial.hs b/test/Streamly/Test/Prelude/Serial.hs index 7e363002..d4346206 100644 --- a/test/Streamly/Test/Prelude/Serial.hs +++ b/test/Streamly/Test/Prelude/Serial.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-deprecations #-} +{-# Language TypeApplications #-} -- | -- Module : Streamly.Test.Prelude.Serial @@ -48,8 +49,10 @@ import qualified Streamly.Data.Stream.Prelude as S import qualified Streamly.Internal.Data.Fold as FL import qualified Streamly.Internal.Data.Unfold as UF import qualified Streamly.Internal.Data.Stream as IS +import qualified Streamly.Internal.Data.Stream.StreamK as K import qualified Streamly.Data.Array as A import qualified Streamly.Internal.Data.Parser as Parser +import qualified Streamly.Prelude as SP import Streamly.Internal.Data.Time.Units (AbsTime, NanoSecond64(..), toRelTime64, diffAbsTime64) @@ -90,8 +93,8 @@ groupsByRolling :: Monad m => groupsByRolling cmp f m = S.catRights $ S.parseMany (Parser.groupByRolling cmp f) m -drainWhile :: Monad m => (a -> Bool) -> S.Stream m a -> m () -drainWhile p = S.fold FL.drain . S.takeWhile p +drainWhile :: Monad m => (a -> Bool) -> SerialT m a -> m () +drainWhile p m = SP.fold FL.drain $ SP.takeWhile p m drainMapM :: Monad m => (a -> m b) -> S.Stream m a -> m () drainMapM f = S.fold (FL.drainMapM f) @@ -427,12 +430,12 @@ associativityCheck desc t = prop desc assocCheckProp assocCheckProp :: [Int] -> [Int] -> [Int] -> Property assocCheckProp xs ys zs = monadicIO $ do - let xStream = S.fromList xs - yStream = S.fromList ys - zStream = S.fromList zs + let xStream = SP.fromList xs + yStream = SP.fromList ys + zStream = SP.fromList zs infixAssocstream <- - run $ toList $ t $ xStream `serial` yStream `serial` zStream - assocStream <- run $ toList $ t $ xStream <> yStream <> zStream + run $ SP.toList $ t $ xStream `serial` yStream `serial` zStream + assocStream <- run $ SP.toList $ t $ xStream <> yStream <> zStream listEquals (==) infixAssocstream assocStream max_length :: Int @@ -540,7 +543,7 @@ foldIterateM = sortBy :: Property sortBy = forAll (listOf (chooseInt (0, max_length))) $ \lst -> monadicIO $ do let s1 = sort lst - s2 <- toList $ IS.sortBy compare $ S.fromList lst + s2 <- toList $ K.toStream (K.sortBy compare $ K.fromStream $ S.fromList lst) assert $ s1 == s2 moduleName :: String @@ -560,15 +563,15 @@ main = hspec <> [("maxBuffer -1", fromSerial . maxBuffer (-1))] #endif let toListSerial :: SerialT IO a -> IO [a] - toListSerial = toList . fromSerial + toListSerial = SP.toList describe "Runners" $ do -- XXX use an IORef to store and check the side effects it "simple serially" $ - (S.fold FL.drain . fromSerial) + (SP.fold FL.drain . fromSerial) (return (0 :: Int)) `shouldReturn` () it "simple serially with IO" $ - (S.fold FL.drain . fromSerial) + (S.fold FL.drain) (S.fromEffect $ putStrLn "hello") `shouldReturn` () describe "Empty" $ @@ -601,8 +604,8 @@ main = hspec serialOps $ prop "serially unfoldr" . constructWithUnfoldr id serialOps $ prop "serially fromPure" . constructWithFromPure id serialOps $ prop "serially fromEffect" . constructWithFromEffect id - serialOps $ prop "serially cons" . constructWithCons S.cons - serialOps $ prop "serially consM" . constructWithConsM S.consM id + serialOps $ prop "serially cons" . constructWithCons SP.cons + serialOps $ prop "serially consM" . constructWithConsM SP.consM id describe "From Generators" $ do prop "unfold" unfold @@ -610,7 +613,7 @@ main = hspec describe "Simple Operations" $ serialOps simpleOps describe "Functor operations" $ do - serialOps $ functorOps S.fromFoldable "serially" (==) + serialOps $ functorOps (SP.fromFoldable) "serially" (==) serialOps $ functorOps folded "serially folded" (==) describe "Monoid operations" $ do @@ -639,17 +642,17 @@ main = hspec -- The tests using sorted equality are weaker tests -- We need to have stronger unit tests for all those -- XXX applicative with three arguments - serialOps $ applicativeOps S.fromFoldable "serially" (==) + serialOps $ applicativeOps (SP.fromFoldable) "serially" (==) serialOps $ applicativeOps folded "serially folded" (==) - serialOps $ applicativeOps1 S.fromFoldable "serially" (==) - serialOps $ applicativeOps1 S.fromFoldable "serially folded" (==) + serialOps $ applicativeOps1 (SP.fromFoldable) "serially" (==) + serialOps $ applicativeOps1 (SP.fromFoldable) "serially folded" (==) -- XXX add tests for indexed/indexedR describe "Zip operations" $ do -- We test only the serial zip with serial streams and the parallel -- stream, because the rate setting in these streams can slow down -- zipAsync. - serialOps $ prop "zip monadic serially" . zipMonadic S.fromFoldable (==) + serialOps $ prop "zip monadic serially" . zipMonadic (SP.fromFoldable) (==) serialOps $ prop "zip monadic serially folded" . zipMonadic folded (==) -- XXX add merge tests like zip tests @@ -658,15 +661,15 @@ main = hspec -- describe "Merge operations" $ do describe "Monad operations" $ do - serialOps $ prop "serially monad then" . monadThen S.fromFoldable (==) + serialOps $ prop "serially monad then" . monadThen (SP.fromFoldable) (==) serialOps $ prop "serially monad then folded" . monadThen folded (==) - serialOps $ prop "serially monad bind" . monadBind S.fromFoldable (==) + serialOps $ prop "serially monad bind" . monadBind (SP.fromFoldable) (==) serialOps $ prop "serially monad bind folded" . monadBind folded (==) describe "Stream transform and combine operations" $ do - serialOps $ transformCombineOpsCommon S.fromFoldable "serially" (==) + serialOps $ transformCombineOpsCommon (SP.fromFoldable) "serially" (==) serialOps $ transformCombineOpsCommon folded "serially" (==) - serialOps $ transformCombineOpsOrdered S.fromFoldable "serially" (==) + serialOps $ transformCombineOpsOrdered (SP.fromFoldable) "serially" (==) serialOps $ transformCombineOpsOrdered folded "serially" (==) #ifdef DEVBUILD @@ -678,19 +681,19 @@ main = hspec -- Just some basic sanity tests for now let input = [[1,1] :: [Int],[2,2],[3,3],[4,4],[5,5],[6,6],[7,7],[8,8]] mustBe g inp out = - toList (S.mergeMapWith g S.fromList (S.fromList inp)) + toList (K.toStream (K.mergeMapWith g K.fromList (K.fromList inp))) `shouldReturn` out in do it "concatPairsWith serial" - $ mustBe S.append input [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8] + $ mustBe K.append input [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8] it "concatPairsWith wSerial" - $ mustBe S.interleave input [1,5,3,7,2,6,4,8,1,5,3,7,2,6,4,8] + $ mustBe K.interleave input [1,5,3,7,2,6,4,8,1,5,3,7,2,6,4,8] it "concatPairsWith mergeBy sorted" $ mustBe - (S.mergeBy compare) input [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8] + (K.mergeBy compare) input [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8] it "concatPairsWith mergeBy reversed" $ mustBe - (S.mergeBy compare) + (K.mergeBy compare) (reverse input) [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8] prop "sortBy" sortBy @@ -699,9 +702,9 @@ main = hspec groupSplitOps "serially" describe "Stream elimination operations" $ do - serialOps $ eliminationOps S.fromFoldable "serially" + serialOps $ eliminationOps (SP.fromFoldable) "serially" serialOps $ eliminationOps folded "serially folded" - serialOps $ eliminationOpsWord8 S.fromFoldable "serially" + serialOps $ eliminationOpsWord8 (SP.fromFoldable) "serially" serialOps $ eliminationOpsWord8 folded "serially folded" serialOps $ \t -> prop "drainWhile (> 0)" $ \n -> @@ -711,15 +714,15 @@ main = hspec ioRef <- run $ newIORef ([] :: [Int]) run $ drainWhile (> 0) . t $ - S.mapM (\a -> modifyIORef' ioRef (a :) >> return a) $ - S.fromList xs + SP.mapM (\a -> modifyIORef' ioRef (a :) >> return a) $ + SP.fromList xs strm <- run $ readIORef ioRef listEquals (==) (reverse strm) (takeWhile (> 0) xs) -- XXX Add a test where we chain all transformation APIs and make sure that -- the state is being passed through all of them. describe "Stream serial elimination operations" $ do - serialOps $ eliminationOpsOrdered S.fromFoldable "serially" + serialOps $ eliminationOpsOrdered (SP.fromFoldable) "serially" serialOps $ eliminationOpsOrdered folded "serially folded" describe "Tests for S.groupsBy" groupingOps diff --git a/test/Streamly/Test/Unicode/Stream.hs b/test/Streamly/Test/Unicode/Stream.hs index b3a6588a..74fe140e 100644 --- a/test/Streamly/Test/Unicode/Stream.hs +++ b/test/Streamly/Test/Unicode/Stream.hs @@ -19,9 +19,9 @@ import Test.QuickCheck import Test.QuickCheck.Monadic (run, monadicIO, assert) import qualified Streamly.Data.Array as A +import qualified Streamly.Data.Stream as Stream import qualified Streamly.Internal.Data.Stream.Chunked as AS -import qualified Streamly.Prelude as S -import qualified Streamly.Internal.Data.Stream.IsStream as S +import qualified Streamly.Internal.Data.Stream.StreamD as Stream import qualified Streamly.Unicode.Stream as SS import qualified Streamly.Internal.Unicode.Stream as IUS import qualified Streamly.Internal.Unicode.Array as IUA @@ -50,8 +50,8 @@ propDecodeEncodeId' :: Property propDecodeEncodeId' = forAll genUnicode $ \list -> monadicIO $ do - let wrds = SS.encodeUtf8' $ S.fromList list - chrs <- S.toList $ SS.decodeUtf8' wrds + let wrds = SS.encodeUtf8' $ Stream.fromList list + chrs <- run $ Stream.toList $ SS.decodeUtf8' wrds assert (chrs == list) -- XXX need to use invalid characters @@ -59,16 +59,16 @@ propDecodeEncodeId :: Property propDecodeEncodeId = forAll genUnicode $ \list -> monadicIO $ do - let wrds = SS.encodeUtf8 $ S.fromList list - chrs <- S.toList $ SS.decodeUtf8 wrds + let wrds = SS.encodeUtf8 $ Stream.fromList list + chrs <- Stream.toList $ SS.decodeUtf8 wrds assert (chrs == list) propDecodeEncodeIdArrays :: Property propDecodeEncodeIdArrays = forAll genUnicode $ \list -> monadicIO $ do - let wrds = S.arraysOf 8 $ SS.encodeUtf8' $ S.fromList list - chrs <- S.toList $ IUS.decodeUtf8Arrays wrds + let wrds = Stream.arraysOf 8 $ SS.encodeUtf8' $ Stream.fromList list + chrs <- Stream.toList $ IUS.decodeUtf8Arrays wrds assert (chrs == list) unicodeTestData :: [Char] @@ -82,8 +82,10 @@ propASCIIToLatin1 = forAll (choose (1, 1000)) $ \len -> forAll (vectorOf len arbitraryASCIIChar) $ \list -> monadicIO $ do - let wrds = SS.decodeLatin1 $ SS.encodeLatin1 $ S.fromList list - lst <- run $ S.toList wrds + let wrds = SS.decodeLatin1 + $ SS.encodeLatin1 + $ Stream.fromList list + lst <- run $ Stream.toList wrds assert (list == lst) propUnicodeToLatin1 :: Property @@ -92,8 +94,8 @@ propUnicodeToLatin1 = let wrds = SS.decodeLatin1 $ SS.encodeLatin1 - $ S.fromList unicodeTestData - lst <- run $ S.toList wrds + $ Stream.fromList unicodeTestData + lst <- run $ Stream.toList wrds assert (latin1TestData == lst) propUnicodeToLatin1' :: Property @@ -102,28 +104,28 @@ propUnicodeToLatin1' = let wrds = SS.decodeLatin1 $ SS.encodeLatin1' - $ S.fromList unicodeTestData - lst <- run $ S.toList wrds + $ Stream.fromList unicodeTestData + lst <- run $ Stream.toList wrds assert (latin1TestData == lst) testLines :: Property testLines = forAll genUnicode $ \list -> monadicIO $ do - xs <- S.toList - $ S.map A.toList + xs <- Stream.toList + $ fmap A.toList $ IUA.lines - $ S.fromList list + $ Stream.fromList list assert (xs == lines list) testLinesArray :: Property testLinesArray = forAll genWord8 $ \list -> monadicIO $ do - xs <- S.toList - $ S.map A.toList + xs <- Stream.toList + $ fmap A.toList $ AS.splitOnSuffix 10 - $ S.fromPure (A.fromList list) + $ Stream.fromPure (A.fromList list) assert (xs == map (map (fromIntegral . ord)) (lines (map (chr . fromIntegral) list))) @@ -131,20 +133,20 @@ testWords :: Property testWords = forAll genUnicode $ \list -> monadicIO $ do - xs <- S.toList - $ S.map A.toList + xs <- Stream.toList + $ Stream.map A.toList $ IUA.words - $ S.fromList list + $ Stream.fromList list assert (xs == words list) testUnlines :: Property testUnlines = forAll genUnicode $ \list -> monadicIO $ do - xs <- S.toList + xs <- Stream.toList $ IUA.unlines $ IUA.lines - $ S.fromList list + $ Stream.fromList list assert (xs == unlines (lines list)) testUnwords :: Property @@ -152,10 +154,10 @@ testUnwords = forAll genUnicode $ \list -> monadicIO $ do xs <- run - $ S.toList + $ Stream.toList $ IUA.unwords $ IUA.words - $ S.fromList list + $ Stream.fromList list assert (xs == unwords (words list)) moduleName :: String diff --git a/test/streamly-tests.cabal b/test/streamly-tests.cabal index 88ac7ac9..4cf70dd4 100644 --- a/test/streamly-tests.cabal +++ b/test/streamly-tests.cabal @@ -219,6 +219,8 @@ test-suite Data.List type: exitcode-stdio-1.0 main-is: Streamly/Test/Data/List.hs cpp-options: -DUSE_STREAMLY_LIST + if !flag(dev) + buildable: False test-suite Data.List.Base import: test-options