1{-# LANGUAGE BangPatterns #-}
3{-# LANGUAGE ConstraintKinds #-}
4{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE InstanceSigs #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE PatternSynonyms #-}
9{-# LANGUAGE ViewPatterns #-}
10{-# LANGUAGE RankNTypes #-}
11{-# LANGUAGE UndecidableInstances #-} -- XXX
14-- Module : Streamly.Streams.StreamKType
15-- Copyright : (c) 2017 Harendra Kumar
18-- Maintainer : harendra.kumar@gmail.com
19-- Stability : experimental
23-- Continuation passing style (CPS) stream implementation. The symbol 'K' below
24-- denotes a function as well as a Kontinuation.
26module Streamly.Streams.StreamKType
28 -- * A class for streams
54 , Streaming -- deprecated
58import Control.Monad (void)
59import Control.Monad.IO.Class (MonadIO(liftIO))
60import Control.Monad.Trans.Class (MonadTrans(lift))
61import Data.Semigroup (Semigroup(..))
62import Prelude hiding (map)
66------------------------------------------------------------------------------
68------------------------------------------------------------------------------
70-- | The type @Stream m a@ represents a monadic stream of values of type 'a'
71-- constructed using actions in monad 'm'. It uses stop, singleton and yield
72-- continuations equivalent to the following direct style type:
75-- data Stream m a = Stop | Singleton a | Yield a (Stream m a)
78-- To facilitate parallel composition we maintain a local state in an 'SVar'
79-- that is shared across and is used for synchronization of the streams being
82-- The singleton case can be expressed in terms of stop and yield but we have
83-- it as a separate case to optimize composition operations for streams with
84-- single element. We build singleton streams in the implementation of 'pure'
85-- for Applicative and Monad, and in 'lift' for MonadTrans.
87-- XXX remove the Stream type parameter from State as it is always constant.
88-- We can remove it from SVar as well
92 State Stream m a -- state
94 -> (a -> m r) -- singleton
95 -> (a -> Stream m a -> m r) -- yield
99------------------------------------------------------------------------------
100-- Types that can behave as a Stream
101------------------------------------------------------------------------------
106-- XXX Use a different SVar based on the stream type. But we need to make sure
107-- that we do not lose performance due to polymorphism.
109-- | Class of types that can represent a stream of elements of some type 'a' in
113class IsStream t where
114 toStream :: t m a -> Stream m a
115 fromStream :: Stream m a -> t m a
116 -- | Constructs a stream by adding a monadic action at the head of an
117 -- existing stream. For example:
120 -- > toList $ getLine \`consM` getLine \`consM` nil
126 -- /Concurrent (do not use 'parallely' to construct infinite streams)/
129 consM :: MonadAsync m => m a -> t m a -> t m a
130 -- | Operator equivalent of 'consM'. We can read it as "@parallel colon@"
131 -- to remember that @|@ comes before ':'.
134 -- > toList $ getLine |: getLine |: nil
141 -- let delay = threadDelay 1000000 >> print 1
142 -- runStream $ serially $ delay |: delay |: delay |: nil
143 -- runStream $ parallely $ delay |: delay |: delay |: nil
146 -- /Concurrent (do not use 'parallely' to construct infinite streams)/
149 (|:) :: MonadAsync m => m a -> t m a -> t m a
150 -- We can define (|:) just as 'consM' but it is defined explicitly for each
151 -- type because we want to use SPECIALIZE pragma on the definition.
153-- | Same as 'IsStream'.
156{-# DEPRECATED Streaming "Please use IsStream instead." #-}
157type Streaming = IsStream
159-------------------------------------------------------------------------------
160-- Type adapting combinators
161-------------------------------------------------------------------------------
163-- XXX Move/reset the State here by reconstructing the stream with cleared
164-- state. Can we make sure we do not do that when t1 = t2? If we do this then
165-- we do not need to do that explicitly using svarStyle. It would act as
166-- unShare when the stream type is the same.
168-- | Adapt any specific stream type to any other specific stream type.
171adapt :: (IsStream t1, IsStream t2) => t1 m a -> t2 m a
172adapt = fromStream . toStream
174------------------------------------------------------------------------------
176------------------------------------------------------------------------------
178-- XXX The State is always parameterized by "Stream" which means State is not
179-- different for different stream types. So we have to manually make sure that
180-- when converting from one stream to another we migrate the state correctly.
181-- This can be fixed if we use a different SVar type for different streams.
182-- Currently we always use "SVar Stream" and therefore a different State type
183-- parameterized by that stream.
185-- XXX change the order of arguments to match the standard fold function
186-- convention i.e. st yield single stop.
188-- | Build a stream from an 'SVar', a stop continuation, a singleton stream
189-- continuation and a yield continuation.
191 => (forall r. State Stream m a
194 -> (a -> t m a -> m r)
197mkStream k = fromStream $ MkStream $ \st stp sng yld ->
198 let yieldk a r = yld a (toStream r)
199 in k st stp sng yieldk
201-- | A terminal function that has no continuation to follow.
202type StopK m = forall r. m r -> m r
204-- | A monadic continuation, it is a function that yields a value of type "a"
205-- and calls the argument (a -> m r) as a continuation with that value. We can
206-- also think of it as a callback with a handler (a -> m r). Category
207-- theorists call it a codensity type, a special type of right kan extension.
208type YieldK m a = forall r. (a -> m r) -> m r
210_wrapM :: Monad m => m a -> YieldK m a
211_wrapM m = \k -> m >>= k
213-- | Make an empty stream from a stop function.
214fromStopK :: IsStream t => StopK m -> t m a
215fromStopK k = mkStream $ \_ stp _ _ -> k stp
217-- | Make a singleton stream from a yield function.
218fromYieldK :: IsStream t => YieldK m a -> t m a
219fromYieldK k = mkStream $ \_ _ sng _ -> k sng
221-- | Add a yield function at the head of the stream.
222consK :: IsStream t => YieldK m a -> t m a -> t m a
223consK k r = mkStream $ \_ _ _ yld -> k (\x -> yld x r)
225-- XXX Build a stream from a repeating callback function.
227------------------------------------------------------------------------------
229------------------------------------------------------------------------------
231-- | Fold a stream by providing an SVar, a stop continuation, a singleton
232-- continuation and a yield continuation. The stream would share the current
233-- SVar passed via the State.
234{-# INLINE foldStreamShared #-}
240 -> (a -> t m a -> m r)
243foldStreamShared st stp sng yld m =
244 let yieldk a x = yld a (fromStream x)
245 MkStream k = toStream m
246 in k st stp sng yieldk
248-- | Fold a stream by providing a State, stop continuation, a singleton
249-- continuation and a yield continuation. The stream will not use the SVar
251{-# INLINE foldStream #-}
257 -> (a -> t m a -> m r)
260foldStream st stp sng yld m =
261 let yieldk a x = yld a (fromStream x)
262 MkStream k = toStream m
263 in k (adaptState st) stp sng yieldk
265-- Run the stream using a run function associated with the SVar that runs the
266-- streams with a captured snapshot of the monadic state.
267{-# INLINE foldStreamSVar #-}
269 :: (IsStream t, MonadIO m)
271 -> State Stream m a -- state
273 -> (a -> m r) -- singleton
274 -> (a -> t m a -> m r) -- yield
277foldStreamSVar sv st stp sng yld m =
278 let mrun = runInIO $ svarMrun sv
279 in void $ liftIO $ mrun $ foldStreamShared st stp sng yld m
281-------------------------------------------------------------------------------
283-------------------------------------------------------------------------------
285{-# INLINE consMSerial #-}
286consMSerial :: (IsStream t, Monad m) => m a -> t m a -> t m a
287consMSerial m r = mkStream $ \_ _ _ yld -> m >>= \a -> yld a r
289-------------------------------------------------------------------------------
291-------------------------------------------------------------------------------
293instance IsStream Stream where
298 {-# SPECIALIZE consM :: IO a -> Stream IO a -> Stream IO a #-}
299 consM :: Monad m => m a -> Stream m a -> Stream m a
303 {-# SPECIALIZE (|:) :: IO a -> Stream IO a -> Stream IO a #-}
304 (|:) :: Monad m => m a -> Stream m a -> Stream m a
307------------------------------------------------------------------------------
309------------------------------------------------------------------------------
311-- | Polymorphic version of the 'Semigroup' operation '<>' of 'SerialT'.
312-- Appends two streams sequentially, yielding all elements from the first
313-- stream, and then all elements from the second stream.
317serial :: IsStream t => t m a -> t m a -> t m a
320 go m = mkStream $ \st stp sng yld ->
321 let stop = foldStream st stp sng yld m2
323 yieldk a r = yld a (go r)
324 in foldStream st stop single yieldk m
326instance Semigroup (Stream m a) where
329------------------------------------------------------------------------------
331------------------------------------------------------------------------------
341nil :: IsStream t => t m a
342nil = mkStream $ \_ stp _ _ -> stp
344instance Monoid (Stream m a) where
348-------------------------------------------------------------------------------
350-------------------------------------------------------------------------------
354map :: (IsStream t, Monad m) => (a -> b) -> t m a -> t m b
355map f m = mkStream $ \st stp sng yld ->
357 yieldk a r = yld (f a) (map f r)
358 in foldStream (adaptState st) stp single yieldk m
360instance Monad m => Functor (Stream m) where
363-------------------------------------------------------------------------------
365-------------------------------------------------------------------------------
368yieldM :: (Monad m, IsStream t) => m a -> t m a
369yieldM m = fromStream $ mkStream $ \_ _ single _ -> m >>= single
371instance MonadTrans Stream where
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list