ff35f64 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add Num, Floating, Fractional instances for zip types

ff35f64Harendra Kumar9 years ago

src/Asyncly/Prelude.hs+91−8

compare with master

unifiedsplit

@@ -35,7 +35,7 @@ module Asyncly.Prelude

35 )

36where

38−import Control.Applicative (Alternative (..))

38+import Control.Applicative (Alternative (..), liftA2)

39import Data.Semigroup (Semigroup(..), cycle1)

40import Prelude hiding (drop, take, zipWith)

41import Asyncly.AsyncT

@@ -91,11 +91,11 @@ drop n m = AsyncT $ \ctx stp yld -> do

91 else (runAsyncT m) ctx stp yield

93------------------------------------------------------------------------------

94−-- Zipping Streams

94+-- Serially Zipping Streams

95------------------------------------------------------------------------------

97-- | Zip two AsyncT streams serially using a monadic zipping function.

98−zipWithM :: MonadAsync m =>

98+zipWithM :: Monad m =>

99 (a -> b -> AsyncT m c) -> AsyncT m a -> AsyncT m b -> AsyncT m c

100zipWithM f m1 m2 = AsyncT $ \_ stp yld -> do

101 let merge a ra =

@@ -103,19 +103,18 @@ zipWithM f m1 m2 = AsyncT $ \_ stp yld -> do

103 yield2 b (Just rb) =

104 (runAsyncT ((f a b) <> (zipWithM f ra rb))) Nothing stp yld

105 in (runAsyncT m2) Nothing stp yield2

106− let yield1 a Nothing = merge a empty

106+ let yield1 a Nothing = merge a mempty

107 yield1 a (Just ra) = merge a ra

108 (runAsyncT m1) Nothing stp yield1

109

110-- | Zip two AsyncT streams serially using a pure zipping function.

111−zipWith :: MonadAsync m

112− => (a -> b -> c) -> AsyncT m a -> AsyncT m b -> AsyncT m c

111+zipWith :: Monad m => (a -> b -> c) -> AsyncT m a -> AsyncT m b -> AsyncT m c

113zipWith f m1 m2 = AsyncT $ \_ stp yld -> do

112zipWith f m1 m2 = AsyncT $ \_ stp yld -> do

114 let merge a ra =

113 let merge a ra =

115 let yield2 b Nothing = yld (f a b) Nothing

114 let yield2 b Nothing = yld (f a b) Nothing

116 yield2 b (Just rb) = yld (f a b) (Just (zipWith f ra rb))

115 yield2 b (Just rb) = yld (f a b) (Just (zipWith f ra rb))

117 in (runAsyncT m2) Nothing stp yield2

116 in (runAsyncT m2) Nothing stp yield2

118− let yield1 a Nothing = merge a empty

117+ let yield1 a Nothing = merge a mempty

119 yield1 a (Just ra) = merge a ra

118 yield1 a (Just ra) = merge a ra

120 (runAsyncT m1) Nothing stp yield1

119 (runAsyncT m1) Nothing stp yield1

121

120

@@ -127,10 +126,54 @@ zipWith f m1 m2 = AsyncT $ \_ stp yld -> do

127newtype ZipSerial m a = ZipSerial {getZipSerial :: AsyncT m a}

126newtype ZipSerial m a = ZipSerial {getZipSerial :: AsyncT m a}

128 deriving (Functor)

127 deriving (Functor)

129

128

130−instance MonadAsync m => Applicative (ZipSerial m) where

129+instance Monad m => Applicative (ZipSerial m) where

131 pure a = ZipSerial $ cycle1 (pure a)

130 pure a = ZipSerial $ cycle1 (pure a)

132 (ZipSerial xs) <*> (ZipSerial ys) = ZipSerial (zipWith id xs ys)

131 (ZipSerial xs) <*> (ZipSerial ys) = ZipSerial (zipWith id xs ys)

133

132

133+instance (Monad m, Num a) => Num (ZipSerial m a) where

134+ fromInteger n = pure (fromInteger n)

135+

136+ negate = fmap negate

137+ abs = fmap abs

138+ signum = fmap signum

139+

140+ (+) = liftA2 (+)

141+ (*) = liftA2 (*)

142+ (-) = liftA2 (-)

143+

144+instance (Monad m, Fractional a) => Fractional (ZipSerial m a) where

145+ fromRational n = pure (fromRational n)

146+

147+ recip = fmap recip

148+

149+ (/) = liftA2 (/)

150+

151+instance (Monad m, Floating a) => Floating (ZipSerial m a) where

152+ pi = pure pi

153+

154+ exp = fmap exp

155+ sqrt = fmap sqrt

156+ log = fmap log

157+ sin = fmap sin

158+ tan = fmap tan

159+ cos = fmap cos

160+ asin = fmap asin

161+ atan = fmap atan

162+ acos = fmap acos

163+ sinh = fmap sinh

164+ tanh = fmap tanh

165+ cosh = fmap cosh

166+ asinh = fmap asinh

167+ atanh = fmap atanh

168+ acosh = fmap acosh

169+

170+ (**) = liftA2 (**)

171+ logBase = liftA2 logBase

172+

173+------------------------------------------------------------------------------

174+-- Asyncly Zipping Streams

175+------------------------------------------------------------------------------

176+

134-- | Zip two AsyncT streams asyncly (i.e. both the streams are generated

177-- | Zip two AsyncT streams asyncly (i.e. both the streams are generated

135-- concurrently) using a monadic zipping function.

178-- concurrently) using a monadic zipping function.

136zipAsyncWithM :: MonadAsync m

179zipAsyncWithM :: MonadAsync m

@@ -160,3 +203,43 @@ newtype ZipAsync m a = ZipAsync {getZipAsync :: AsyncT m a}

160instance MonadAsync m => Applicative (ZipAsync m) where

203instance MonadAsync m => Applicative (ZipAsync m) where

161 pure a = ZipAsync $ cycle1 (pure a)

204 pure a = ZipAsync $ cycle1 (pure a)

162 (ZipAsync xs) <*> (ZipAsync ys) = ZipAsync (zipAsyncWith id xs ys)

205 (ZipAsync xs) <*> (ZipAsync ys) = ZipAsync (zipAsyncWith id xs ys)

206+

207+instance (MonadAsync m, Num a) => Num (ZipAsync m a) where

208+ fromInteger n = pure (fromInteger n)

209+

210+ negate = fmap negate

211+ abs = fmap abs

212+ signum = fmap signum

213+

214+ (+) = liftA2 (+)

215+ (*) = liftA2 (*)

216+ (-) = liftA2 (-)

217+

218+instance (MonadAsync m, Fractional a) => Fractional (ZipAsync m a) where

219+ fromRational n = pure (fromRational n)

220+

221+ recip = fmap recip

222+

223+ (/) = liftA2 (/)

224+

225+instance (MonadAsync m, Floating a) => Floating (ZipAsync m a) where

226+ pi = pure pi

227+

228+ exp = fmap exp

229+ sqrt = fmap sqrt

230+ log = fmap log

231+ sin = fmap sin

232+ tan = fmap tan

233+ cos = fmap cos

234+ asin = fmap asin

235+ atan = fmap atan

236+ acos = fmap acos

237+ sinh = fmap sinh

238+ tanh = fmap tanh

239+ cosh = fmap cosh

240+ asinh = fmap asinh

241+ atanh = fmap atanh

242+ acosh = fmap acosh

243+

244+ (**) = liftA2 (**)

245+ logBase = liftA2 logBase