mirror of
https://github.com/composewell/streamly.git
synced 2024-09-11 11:37:22 +03:00
Implement ZipStream using Data.Stream (#1811)
This commit is contained in:
parent
6925dd06a1
commit
b8a17190a8
@ -70,7 +70,7 @@ import GHC.Exts (IsList(..), IsString(..))
|
||||
import Data.Semigroup (Semigroup(..))
|
||||
#endif
|
||||
import Streamly.Internal.Data.Stream.Type (Stream)
|
||||
import Streamly.Internal.Data.Stream.Zip (ZipSerialM(..))
|
||||
import Streamly.Internal.Data.Stream.Zip (ZipStream(..))
|
||||
|
||||
import qualified Streamly.Internal.Data.Stream.StreamK.Type as K
|
||||
import qualified Streamly.Internal.Data.Stream.Type as Stream
|
||||
@ -94,20 +94,12 @@ newtype List a = List { toStream :: Stream Identity a }
|
||||
deriving
|
||||
( Show, Read, Eq, Ord, NFData , NFData1
|
||||
, Semigroup, Monoid, Functor, Foldable
|
||||
, Applicative, Traversable, Monad)
|
||||
, Applicative, Traversable, Monad, IsList)
|
||||
|
||||
instance (a ~ Char) => IsString (List a) where
|
||||
{-# INLINE fromString #-}
|
||||
fromString = List . fromList
|
||||
|
||||
-- GHC versions 8.0 and below cannot derive IsList
|
||||
instance IsList (List a) where
|
||||
type (Item (List a)) = a
|
||||
{-# INLINE fromList #-}
|
||||
fromList = List . fromList
|
||||
{-# INLINE toList #-}
|
||||
toList = toList . toStream
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Patterns
|
||||
------------------------------------------------------------------------------
|
||||
@ -153,33 +145,25 @@ pattern Cons x xs <-
|
||||
-- and no 'Monad' instance.
|
||||
--
|
||||
-- @since 0.6.0
|
||||
newtype ZipList a = ZipList { toZipSerial :: ZipSerialM Identity a }
|
||||
newtype ZipList a = ZipList { toZipStream :: ZipStream Identity a }
|
||||
deriving
|
||||
( Show, Read, Eq, Ord, NFData , NFData1
|
||||
, Semigroup, Monoid, Functor, Foldable
|
||||
, Applicative, Traversable
|
||||
, Applicative, Traversable, IsList
|
||||
)
|
||||
|
||||
instance (a ~ Char) => IsString (ZipList a) where
|
||||
{-# INLINE fromString #-}
|
||||
fromString = ZipList . fromList
|
||||
|
||||
-- GHC versions 8.0 and below cannot derive IsList
|
||||
instance IsList (ZipList a) where
|
||||
type (Item (ZipList a)) = a
|
||||
{-# INLINE fromList #-}
|
||||
fromList = ZipList . fromList
|
||||
{-# INLINE toList #-}
|
||||
toList = toList . toZipSerial
|
||||
|
||||
-- | Convert a 'ZipList' to a regular 'List'
|
||||
--
|
||||
-- @since 0.6.0
|
||||
fromZipList :: ZipList a -> List a
|
||||
fromZipList (ZipList zs) = List $ Stream.fromStreamK $ getZipSerialM zs
|
||||
fromZipList (ZipList zs) = List $ getZipStream zs
|
||||
|
||||
-- | Convert a regular 'List' to a 'ZipList'
|
||||
--
|
||||
-- @since 0.6.0
|
||||
toZipList :: List a -> ZipList a
|
||||
toZipList = ZipList . ZipSerialM . Stream.toStreamK . toStream
|
||||
toZipList = ZipList . ZipStream . toStream
|
||||
|
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
-- |
|
||||
@ -11,54 +12,41 @@
|
||||
--
|
||||
-- To run examples in this module:
|
||||
--
|
||||
-- >>> import qualified Streamly.Prelude as Stream
|
||||
-- >>> import qualified Streamly.Data.Fold as Fold
|
||||
-- >>> import qualified Streamly.Data.Stream as Stream
|
||||
-- >>> import qualified Streamly.Internal.Data.Stream.Zip as Stream
|
||||
--
|
||||
module Streamly.Internal.Data.Stream.Zip
|
||||
(
|
||||
ZipSerialM (..)
|
||||
ZipStream (..)
|
||||
, ZipSerialM
|
||||
, ZipSerial
|
||||
, consMZip
|
||||
, zipWithK
|
||||
, zipWithMK
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Applicative (liftA2)
|
||||
import Control.DeepSeq (NFData(..), NFData1(..))
|
||||
import Data.Foldable (Foldable(foldl'), fold)
|
||||
import Data.Functor.Identity (Identity(..), runIdentity)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Semigroup (Endo(..))
|
||||
#if __GLASGOW_HASKELL__ < 808
|
||||
import Data.Semigroup (Semigroup(..))
|
||||
#endif
|
||||
import GHC.Exts (IsList(..), IsString(..), oneShot)
|
||||
import Data.Functor.Identity (Identity(..))
|
||||
import GHC.Exts (IsList(..), IsString(..))
|
||||
import Streamly.Internal.Data.Stream.Type (Stream, toStreamD, fromStreamD)
|
||||
import Text.Read
|
||||
( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec
|
||||
, readListPrecDefault)
|
||||
import Streamly.Internal.BaseCompat ((#.))
|
||||
import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)
|
||||
import Streamly.Internal.Data.Stream.StreamK.Type (Stream)
|
||||
|
||||
import qualified Streamly.Internal.Data.Stream.Common as P
|
||||
(cmpBy, eqBy, foldl', foldr, fromList, toList)
|
||||
import qualified Streamly.Internal.Data.Stream.StreamK.Type as K
|
||||
import qualified Streamly.Internal.Data.Stream as Stream
|
||||
import qualified Streamly.Internal.Data.Stream.StreamD as D
|
||||
import qualified Streamly.Internal.Data.Stream.Serial as Serial
|
||||
import qualified Streamly.Internal.Data.Stream.Type as Stream
|
||||
|
||||
import Prelude hiding (map, repeat, zipWith)
|
||||
|
||||
#include "Instances.hs"
|
||||
|
||||
-- $setup
|
||||
-- >>> import qualified Streamly.Prelude as Stream
|
||||
-- >>> import qualified Streamly.Data.Fold as Fold
|
||||
-- >>> import qualified Streamly.Data.Stream as Stream
|
||||
-- >>> import qualified Streamly.Internal.Data.Stream.Zip as Stream
|
||||
|
||||
{-# INLINE zipWithMK #-}
|
||||
zipWithMK :: Monad m =>
|
||||
(a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c
|
||||
zipWithMK f m1 m2 =
|
||||
D.toStreamK $ D.zipWithM f (D.fromStreamK m1) (D.fromStreamK m2)
|
||||
fromStreamD $ D.zipWithM f (toStreamD m1) (toStreamD m2)
|
||||
|
||||
{-# INLINE zipWithK #-}
|
||||
zipWithK :: Monad m
|
||||
@ -69,26 +57,48 @@ zipWithK f = zipWithMK (\a b -> return (f a b))
|
||||
-- Serially Zipping Streams
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- | For 'ZipSerialM' streams:
|
||||
-- | For 'ZipStream':
|
||||
--
|
||||
-- @
|
||||
-- (<>) = 'Streamly.Prelude.serial'
|
||||
-- (<*>) = 'Streamly.Prelude.serial.zipWith' id
|
||||
-- (<>) = 'Streamly.Data.Stream.append'
|
||||
-- (<*>) = 'Streamly.Data.Stream.zipWith' id
|
||||
-- @
|
||||
--
|
||||
-- Applicative evaluates the streams being zipped serially:
|
||||
--
|
||||
-- >>> s1 = Stream.fromFoldable [1, 2]
|
||||
-- >>> s2 = Stream.fromFoldable [3, 4]
|
||||
-- >>> s3 = Stream.fromFoldable [5, 6]
|
||||
-- >>> Stream.toList $ Stream.fromZipSerial $ (,,) <$> s1 <*> s2 <*> s3
|
||||
-- >>> s1 = Stream.ZipStream $ Stream.fromFoldable [1, 2]
|
||||
-- >>> s2 = Stream.ZipStream $ Stream.fromFoldable [3, 4]
|
||||
-- >>> s3 = Stream.ZipStream $ Stream.fromFoldable [5, 6]
|
||||
-- >>> s = (,,) <$> s1 <*> s2 <*> s3
|
||||
-- >>> Stream.fold Fold.toList (Stream.getZipStream s)
|
||||
-- [(1,3,5),(2,4,6)]
|
||||
--
|
||||
-- /Since: 0.2.0 ("Streamly")/
|
||||
--
|
||||
-- @since 0.8.0
|
||||
newtype ZipSerialM m a = ZipSerialM {getZipSerialM :: Stream m a}
|
||||
deriving (Semigroup, Monoid)
|
||||
newtype ZipStream m a = ZipStream {getZipStream :: Stream m a}
|
||||
deriving (Functor, Semigroup, Monoid)
|
||||
|
||||
deriving instance NFData a => NFData (ZipStream Identity a)
|
||||
deriving instance NFData1 (ZipStream Identity)
|
||||
deriving instance IsList (ZipStream Identity a)
|
||||
deriving instance (a ~ Char) => IsString (ZipStream Identity a)
|
||||
deriving instance Eq a => Eq (ZipStream Identity a)
|
||||
deriving instance Ord a => Ord (ZipStream Identity a)
|
||||
deriving instance (Foldable m, Monad m) => Foldable (ZipStream m)
|
||||
deriving instance Traversable (ZipStream Identity)
|
||||
|
||||
instance Show a => Show (ZipStream Identity a) where
|
||||
showsPrec p dl = showParen (p > 10) $
|
||||
showString "fromList " . shows (toList dl)
|
||||
|
||||
instance Read a => Read (ZipStream Identity a) where
|
||||
readPrec = parens $ prec 10 $ do
|
||||
Ident "fromList" <- lexP
|
||||
fromList <$> readPrec
|
||||
readListPrec = readListPrecDefault
|
||||
|
||||
type ZipSerialM = ZipStream
|
||||
|
||||
-- | An IO stream whose applicative instance zips streams serially.
|
||||
--
|
||||
@ -97,21 +107,8 @@ newtype ZipSerialM m a = ZipSerialM {getZipSerialM :: Stream m a}
|
||||
-- @since 0.8.0
|
||||
type ZipSerial = ZipSerialM IO
|
||||
|
||||
consMZip :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a
|
||||
consMZip m (ZipSerialM r) = ZipSerialM $ K.consM m r
|
||||
|
||||
LIST_INSTANCES(ZipSerialM)
|
||||
NFDATA1_INSTANCE(ZipSerialM)
|
||||
|
||||
instance Monad m => Functor (ZipSerialM m) where
|
||||
{-# INLINE fmap #-}
|
||||
fmap f (ZipSerialM m) = ZipSerialM $ Stream.toStreamK $ fmap f (Stream.fromStreamK m)
|
||||
|
||||
instance Monad m => Applicative (ZipSerialM m) where
|
||||
pure = ZipSerialM . Stream.toStreamK . Serial.repeat
|
||||
instance Monad m => Applicative (ZipStream m) where
|
||||
pure = ZipStream . Stream.repeat
|
||||
|
||||
{-# INLINE (<*>) #-}
|
||||
ZipSerialM m1 <*> ZipSerialM m2 = ZipSerialM $ zipWithK id m1 m2
|
||||
|
||||
FOLDABLE_INSTANCE(ZipSerialM)
|
||||
TRAVERSABLE_INSTANCE(ZipSerialM)
|
||||
ZipStream m1 <*> ZipStream m2 = ZipStream $ zipWithK id m1 m2
|
||||
|
@ -317,8 +317,6 @@ library
|
||||
, Streamly.Internal.Data.Stream.Reduce
|
||||
, Streamly.Internal.Data.Stream.Top
|
||||
, Streamly.Internal.Data.Stream
|
||||
, Streamly.Internal.Data.Stream.Serial
|
||||
, Streamly.Internal.Data.Stream.WSerial
|
||||
, Streamly.Internal.Data.Stream.Zip
|
||||
, Streamly.Internal.Data.List
|
||||
|
||||
|
@ -139,7 +139,7 @@ instance (Foldable m, Monad m) => Foldable (STREAM m) where { \
|
||||
\
|
||||
{-# INLINE maximum #-}; \
|
||||
maximum = \
|
||||
fromMaybe (errorWithoutStackTrace $ "maximum: empty stream") \
|
||||
fromMaybe (errorWithoutStackTrace "maximum: empty stream") \
|
||||
. toMaybe \
|
||||
. foldl' getMax Nothing' where { \
|
||||
getMax Nothing' x = Just' x; \
|
||||
@ -147,7 +147,7 @@ instance (Foldable m, Monad m) => Foldable (STREAM m) where { \
|
||||
\
|
||||
{-# INLINE minimum #-}; \
|
||||
minimum = \
|
||||
fromMaybe (errorWithoutStackTrace $ "minimum: empty stream") \
|
||||
fromMaybe (errorWithoutStackTrace "minimum: empty stream") \
|
||||
. toMaybe \
|
||||
. foldl' getMin Nothing' where { \
|
||||
getMin Nothing' x = Just' x; \
|
||||
|
@ -107,7 +107,7 @@ import Streamly.Internal.Data.Stream.Async
|
||||
(AsyncT(..), Async, WAsyncT(..), WAsync)
|
||||
import Streamly.Internal.Data.Stream.Ahead (AheadT(..), Ahead)
|
||||
import Streamly.Internal.Data.Stream.Parallel (ParallelT(..), Parallel)
|
||||
import Streamly.Internal.Data.Stream.Zip (ZipSerialM(..), ZipSerial)
|
||||
import Streamly.Internal.Data.Stream.Zip (ZipSerialM, ZipSerial)
|
||||
import Streamly.Internal.Data.Stream.ZipAsync (ZipAsyncM(..), ZipAsync)
|
||||
import Streamly.Internal.Data.SVar.Type (State, adaptState)
|
||||
|
||||
@ -567,6 +567,10 @@ instance IsStream ParallelT where
|
||||
-- Zip
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
consMZip :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a
|
||||
consMZip m (Zip.ZipStream r) =
|
||||
Zip.ZipStream $ Stream.fromStreamK $ K.consM m (Stream.toStreamK r)
|
||||
|
||||
-- | Fix the type of a polymorphic stream as 'ZipSerialM'.
|
||||
--
|
||||
-- /Since: 0.2.0 ("Streamly")/
|
||||
@ -575,18 +579,18 @@ instance IsStream ParallelT where
|
||||
fromZipSerial :: IsStream t => ZipSerialM m a -> t m a
|
||||
fromZipSerial = adapt
|
||||
instance IsStream ZipSerialM where
|
||||
toStream = getZipSerialM
|
||||
fromStream = ZipSerialM
|
||||
toStream = Stream.toStreamK . Zip.getZipStream
|
||||
fromStream = Zip.ZipStream . Stream.fromStreamK
|
||||
|
||||
{-# INLINE consM #-}
|
||||
{-# SPECIALIZE consM :: IO a -> ZipSerialM IO a -> ZipSerialM IO a #-}
|
||||
consM :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a
|
||||
consM = Zip.consMZip
|
||||
consM = consMZip
|
||||
|
||||
{-# INLINE (|:) #-}
|
||||
{-# SPECIALIZE (|:) :: IO a -> ZipSerialM IO a -> ZipSerialM IO a #-}
|
||||
(|:) :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a
|
||||
(|:) = Zip.consMZip
|
||||
(|:) = consMZip
|
||||
|
||||
-- | Fix the type of a polymorphic stream as 'ZipAsyncM'.
|
||||
--
|
||||
|
@ -188,7 +188,6 @@ extra-source-files:
|
||||
|
||||
core/src/Streamly/Internal/Data/Parser.hs
|
||||
core/src/Streamly/Internal/Data/Pipe.hs
|
||||
core/src/Streamly/Internal/Data/Stream/Serial.hs
|
||||
core/src/Streamly/Internal/Data/Stream.hs
|
||||
core/src/Streamly/Internal/Data/Stream/Bottom.hs
|
||||
core/src/Streamly/Internal/Data/Stream/Eliminate.hs
|
||||
@ -201,7 +200,6 @@ extra-source-files:
|
||||
core/src/Streamly/Internal/Data/Stream/Top.hs
|
||||
core/src/Streamly/Internal/Data/Stream/Transform.hs
|
||||
core/src/Streamly/Internal/Data/Stream/Type.hs
|
||||
core/src/Streamly/Internal/Data/Stream/WSerial.hs
|
||||
core/src/Streamly/Internal/Data/Stream/Zip.hs
|
||||
core/src/Streamly/Internal/Data/List.hs
|
||||
core/src/Streamly/Internal/Data/Array.hs
|
||||
@ -443,6 +441,8 @@ library
|
||||
, Streamly.Internal.Data.Stream.SVar.Generate
|
||||
, Streamly.Internal.Data.Stream.SVar.Eliminate
|
||||
|
||||
, Streamly.Internal.Data.Stream.Serial
|
||||
, Streamly.Internal.Data.Stream.WSerial
|
||||
, Streamly.Internal.Data.Stream.Async
|
||||
, Streamly.Internal.Data.Stream.Parallel
|
||||
, Streamly.Internal.Data.Stream.Ahead
|
||||
@ -599,7 +599,6 @@ library
|
||||
, Streamly.Internal.Data.Stream.Lift
|
||||
, Streamly.Internal.Data.Stream.Top
|
||||
, Streamly.Internal.Data.Stream
|
||||
, Streamly.Internal.Data.Stream.Serial
|
||||
, Streamly.Internal.Data.Stream.Zip
|
||||
, Streamly.Internal.Data.List
|
||||
|
||||
|
@ -196,10 +196,10 @@ main = hspec $
|
||||
|
||||
it "Show instance" $ do
|
||||
show ([1..3] :: ZipList Int) `shouldBe`
|
||||
"ZipList {toZipSerial = fromList [1,2,3]}"
|
||||
"ZipList {toZipStream = fromList [1,2,3]}"
|
||||
|
||||
it "Read instance" $ do
|
||||
(read "ZipList {toZipSerial = fromList [1,2,3]}" :: ZipList Int)
|
||||
(read "ZipList {toZipStream = fromList [1,2,3]}" :: ZipList Int)
|
||||
`shouldBe` [1..3]
|
||||
|
||||
it "Eq instance" $ do
|
||||
|
Loading…
Reference in New Issue
Block a user