9b4272e · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Change "handle" to produce a stream on exception

9b4272eHarendra Kumar7 years ago

src/Streamly/Benchmark/FileIO/Stream.hs+2−2

compare with master

unifiedsplit

@@ -245,8 +245,8 @@ inspect $ hasNoTypeClasses 'catFinally

245{-# INLINE catHandle #-}

246catHandle :: Handle -> Handle -> IO ()

247catHandle devNull inh =

248− let readEx = IUF.handle (\(_e :: SomeException) -> hClose inh >> return 10)

248+ let handler = \(_e :: SomeException) -> hClose inh >> return 10

249− FH.read

249+ readEx = IUF.handle (IUF.singleton handler) FH.read

250 in S.fold (FH.write devNull) $ S.unfold readEx inh

251

252#ifdef INSPECTION

src/Streamly/Data/String.hs+2−2

@@ -269,11 +269,11 @@ words = foldWords A.write

269-- | Unfold a stream to character streams using the supplied 'Unfold'

270-- and concat the results suffixing a newline character @\\n@ to each stream.

271--

272−-- > unfoldLines = S.intercalateSuffix UF.singleton '\n'

272+-- > unfoldLines = S.intercalateSuffix UF.identity '\n'

273--

274{-# INLINE unfoldLines #-}

275unfoldLines :: (MonadIO m, IsStream t) => Unfold m a Char -> t m a -> t m Char

276−unfoldLines unf = S.intercalateSuffix UF.singleton '\n' unf

276+unfoldLines unf = S.intercalateSuffix UF.identity '\n' unf

277

278-- | Flattens the stream of @Array Char@, after appending a terminating

279-- newline to each string.

src/Streamly/Internal/Data/Unfold.hs+170−33

@@ -6,6 +6,7 @@

6{-# LANGUAGE RankNTypes #-}

7{-# LANGUAGE RecordWildCards #-}

8{-# LANGUAGE ScopedTypeVariables #-}

9+{-# LANGUAGE TupleSections #-}

10#include "inline.hs"

11#include "inline.hs"

@@ -59,10 +60,13 @@ module Streamly.Internal.Data.Unfold

59 Unfold

60 Unfold

61 -- * Operations on Input

62 -- * Operations on Input

63+ , lmap

62 , close

64 , close

63 , first

65 , first

64 , second

66 , second

65− , lmap

67+ , discardFirst

68+ , discardSecond

69+ , swap

66 -- coapply

70 -- coapply

67 -- comonad

71 -- comonad

@@ -74,9 +78,14 @@ module Streamly.Internal.Data.Unfold

74 , fromStream

78 , fromStream

75 , fromStream1

79 , fromStream1

76 , fromStream2

80 , fromStream2

81+ , nilM

82+ , consM

83+ , effect

77 , singleton

84 , singleton

85+ , identity

78 , replicateM

86 , replicateM

79 , fromList

87 , fromList

88+ , fromListM

80 , enumerateFromStepIntegral

89 , enumerateFromStepIntegral

81 , enumerateFromToIntegral

90 , enumerateFromToIntegral

82 , enumerateFromIntegral

91 , enumerateFromIntegral

@@ -121,6 +130,7 @@ import Streamly.Internal.Data.SVar (defState)

121import Control.Monad.Catch (MonadCatch)

130import Control.Monad.Catch (MonadCatch)

122

131

123import qualified Control.Monad.Catch as MC

132import qualified Control.Monad.Catch as MC

133+import qualified Data.Tuple as Tuple

124import qualified Streamly.Streams.StreamK as K

134import qualified Streamly.Streams.StreamK as K

125import qualified Streamly.Streams.StreamD as D

135import qualified Streamly.Streams.StreamD as D

126

136

@@ -128,13 +138,17 @@ import qualified Streamly.Streams.StreamD as D

128-- Input operations

138-- Input operations

129-------------------------------------------------------------------------------

139-------------------------------------------------------------------------------

130

140

141+{-# INLINE_NORMAL lmap #-}

142+lmap :: (a -> c) -> Unfold m c b -> Unfold m a b

143+lmap f (Unfold ustep uinject) = Unfold ustep (uinject . f)

144+

131-- | Supply the seed to an unfold closing the input end of the unfold.

145-- | Supply the seed to an unfold closing the input end of the unfold.

132--

146--

133-- /Internal/

147-- /Internal/

134--

148--

135{-# INLINE_NORMAL close #-}

149{-# INLINE_NORMAL close #-}

136close :: Unfold m a b -> a -> Unfold m Void b

150close :: Unfold m a b -> a -> Unfold m Void b

137−close (Unfold ustep uinject) a = Unfold ustep (const $ uinject a)

151+close unf a = lmap (const a) unf

138

152

139-- XXX rename to closeFst/closeSnd

153-- XXX rename to closeFst/closeSnd

140--

154--

@@ -146,7 +160,7 @@ close (Unfold ustep uinject) a = Unfold ustep (const $ uinject a)

146--

160--

147{-# INLINE_NORMAL first #-}

161{-# INLINE_NORMAL first #-}

148first :: Unfold m (a, b) c -> a -> Unfold m b c

162first :: Unfold m (a, b) c -> a -> Unfold m b c

149−first (Unfold ustep uinject) a = Unfold ustep (\b -> uinject (a, b))

163+first unf a = lmap (a, ) unf

150

164

151-- | Supply the second component of the tuple to an unfold that accepts a tuple

165-- | Supply the second component of the tuple to an unfold that accepts a tuple

152-- as a seed resulting in a fold that accepts the first component of the tuple

166-- as a seed resulting in a fold that accepts the first component of the tuple

@@ -156,11 +170,19 @@ first (Unfold ustep uinject) a = Unfold ustep (\b -> uinject (a, b))

156--

170--

157{-# INLINE_NORMAL second #-}

171{-# INLINE_NORMAL second #-}

158second :: Unfold m (a, b) c -> b -> Unfold m a c

172second :: Unfold m (a, b) c -> b -> Unfold m a c

159−second (Unfold ustep uinject) b = Unfold ustep (\a -> uinject (a, b))

173+second unf b = lmap (, b) unf

160

174

161−{-# INLINE_NORMAL lmap #-}

175+{-# INLINE_NORMAL discardFirst #-}

176+discardFirst :: Unfold m a b -> Unfold m (c, a) b

177+discardFirst = lmap snd

178+

179+{-# INLINE_NORMAL discardSecond #-}

162−lmap :: (a -> c) -> Unfold m c b -> Unfold m a b

180+discardSecond :: Unfold m a b -> Unfold m (a, c) b

163−lmap f (Unfold ustep uinject) = Unfold ustep (\x -> uinject $ f x)

181+discardSecond = lmap fst

182+

183+{-# INLINE_NORMAL swap #-}

184+swap :: Unfold m (a, c) b -> Unfold m (c, a) b

185+swap = lmap Tuple.swap

164

186

165-------------------------------------------------------------------------------

187-------------------------------------------------------------------------------

166-- Output operations

188-- Output operations

@@ -241,20 +263,68 @@ fromStream2 f = Unfold streamStep (\(a, b) -> return $ D.toStreamD $ f a b)

241-- Unfolds

263-- Unfolds

242-------------------------------------------------------------------------------

264-------------------------------------------------------------------------------

243

265

244−-- | Identity unfold. Generates a singleton stream with the seed as the only

266+-- | Lift a monadic function into an unfold generating a nil stream with a side

245−-- element in the stream.

267+-- effect.

246--

268--

247−-- > singleton = replicateM 1

269+{-# INLINE nilM #-}

270+nilM :: Monad m => (a -> m c) -> Unfold m a b

271+nilM f = Unfold step return

272+ where

273+ {-# INLINE_LATE step #-}

274+ step x = f x >> return Stop

275+

276+-- | Prepend a monadic single element generator function to an 'Unfold'.

277+--

278+-- /Internal/

279+{-# INLINE_NORMAL consM #-}

280+consM :: Monad m => (a -> m b) -> Unfold m a b -> Unfold m a b

281+consM action unf = Unfold step inject

282+

283+ where

284+

285+ inject = return . Left

286+

287+ {-# INLINE_LATE step #-}

288+ step (Left a) = do

289+ action a >>= \r -> return $ Yield r (Right (D.unfold unf a))

290+ step (Right (UnStream step1 st)) = do

291+ res <- step1 defState st

292+ case res of

293+ Yield x s -> return $ Yield x (Right (Stream step1 s))

294+ Skip s -> return $ Skip (Right (Stream step1 s))

295+ Stop -> return Stop

296+

297+-- | Lift a monadic effect into an unfold generating a singleton stream.

298+--

299+{-# INLINE effect #-}

300+effect :: Monad m => m b -> Unfold m Void b

301+effect eff = Unfold step inject

302+ where

303+ inject _ = return True

304+ {-# INLINE_LATE step #-}

305+ step True = eff >>= \r -> return $ Yield r False

306+ step False = return Stop

307+

308+-- | Lift a monadic function into an unfold generating a singleton stream.

248--

309--

249{-# INLINE singleton #-}

310{-# INLINE singleton #-}

250−singleton :: Monad m => Unfold m a a

311+singleton :: Monad m => (a -> m b) -> Unfold m a b

251−singleton = Unfold step inject

312+singleton f = Unfold step inject

252 where

313 where

253 inject x = return $ Just x

314 inject x = return $ Just x

254 {-# INLINE_LATE step #-}

315 {-# INLINE_LATE step #-}

255− step (Just x) = return $ Yield x Nothing

316+ step (Just x) = f x >>= \r -> return $ Yield r Nothing

256 step Nothing = return Stop

317 step Nothing = return Stop

257

318

319+-- | Identity unfold. Generates a singleton stream with the seed as the only

320+-- element in the stream.

321+--

322+-- > identity = singleton return

323+--

324+{-# INLINE identity #-}

325+identity :: Monad m => Unfold m a a

326+identity = singleton return

327+

258-- | Generates a stream replicating the seed @n@ times.

328-- | Generates a stream replicating the seed @n@ times.

259--

329--

260{-# INLINE replicateM #-}

330{-# INLINE replicateM #-}

@@ -278,6 +348,16 @@ fromList = Unfold step inject

278 step (x:xs) = return $ Yield x xs

348 step (x:xs) = return $ Yield x xs

279 step [] = return Stop

349 step [] = return Stop

280

350

351+-- | Convert a list of monadic values to a 'Stream'

352+{-# INLINE_LATE fromListM #-}

353+fromListM :: Monad m => Unfold m [m a] a

354+fromListM = Unfold step inject

355+ where

356+ inject x = return x

357+ {-# INLINE_LATE step #-}

358+ step (x:xs) = x >>= \r -> return $ Yield r xs

359+ step [] = return Stop

360+

281-------------------------------------------------------------------------------

361-------------------------------------------------------------------------------

282-- Filtering

362-- Filtering

283-------------------------------------------------------------------------------

363-------------------------------------------------------------------------------

@@ -444,7 +524,7 @@ concatMapM f (Unfold step1 inject1) = Unfold step inject

444 Skip s -> return $ Skip (ConcatMapOuter s)

524 Skip s -> return $ Skip (ConcatMapOuter s)

445 Stop -> return Stop

525 Stop -> return Stop

446

526

447− step (ConcatMapInner ost (Stream istep ist)) = do

527+ step (ConcatMapInner ost (UnStream istep ist)) = do

448 r <- istep defState ist

528 r <- istep defState ist

449 return $ case r of

529 return $ case r of

450 Yield x s -> Yield x (ConcatMapInner ost (Stream istep s))

530 Yield x s -> Yield x (ConcatMapInner ost (Stream istep s))

@@ -455,6 +535,54 @@ concatMapM f (Unfold step1 inject1) = Unfold step inject

455-- Exceptions

535-- Exceptions

456------------------------------------------------------------------------------

536------------------------------------------------------------------------------

457

537

538+-- MBD: If we add an (Unfold m e b) argument to it we can encompass "handle" as

539+-- well under this.

540+{-# INLINE_NORMAL gbracket #-}

541+gbracket

542+ :: Monad m

543+ => (a -> m c)

544+ -> (forall s. m s -> m (Either e s))

545+ -> (c -> m d)

546+ -> Unfold m (c, e) b

547+ -> Unfold m c b

548+ -> Unfold m a b

549+gbracket bef exc aft (Unfold estep einject) (Unfold step1 inject1) =

550+ Unfold step inject

551+

552+ where

553+

554+ inject x = do

555+ r <- bef x

556+ s <- inject1 r

557+ return $ Right (s, r)

558+

559+ {-# INLINE_LATE step #-}

560+ step (Right (st, v)) = do

561+ res <- exc $ step1 st

562+ case res of

563+ Right r -> case r of

564+ Yield x s -> return $ Yield x (Right (s, v))

565+ Skip s -> return $ Skip (Right (s, v))

566+ Stop -> aft v >> return Stop

567+ Left e -> do

568+ r <- einject (v, e)

569+ return $ Skip (Left r)

570+ step (Left st) = do

571+ res <- estep st

572+ case res of

573+ Yield x s -> return $ Yield x (Left s)

574+ Skip s -> return $ Skip (Left s)

575+ Stop -> return Stop

576+

577+-- The custom implementation of "before" is slightly faster (5-7%) than

578+-- "_before". This is just to document and make sure that we can always use

579+-- gbracket to implement before. The same applies to other combinators as well.

580+--

581+{-# INLINE_NORMAL _before #-}

582+_before :: Monad m => (a -> m c) -> Unfold m a b -> Unfold m a b

583+_before action unf = gbracket (\x -> action x >> return x) (fmap Right)

584+ (\_ -> return ()) undefined unf

585+

458-- | Run a side effect before the unfold yields its first element.

586-- | Run a side effect before the unfold yields its first element.

459--

587--

460-- /Internal/

588-- /Internal/

@@ -477,6 +605,10 @@ before action (Unfold step1 inject1) = Unfold step inject

477 Skip s -> return $ Skip s

605 Skip s -> return $ Skip s

478 Stop -> return Stop

606 Stop -> return Stop

479

607

608+{-# INLINE_NORMAL _after #-}

609+_after :: Monad m => (a -> m c) -> Unfold m a b -> Unfold m a b

610+_after aft = gbracket return (fmap Right) aft undefined

611+

480-- | Run a side effect whenever the unfold stops normally.

612-- | Run a side effect whenever the unfold stops normally.

481--

613--

482-- /Internal/

614-- /Internal/

@@ -498,6 +630,13 @@ after action (Unfold step1 inject1) = Unfold step inject

498 Skip s -> return $ Skip (s, v)

630 Skip s -> return $ Skip (s, v)

499 Stop -> action v >> return Stop

631 Stop -> action v >> return Stop

500

632

633+{-# INLINE_NORMAL _onException #-}

634+_onException :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b

635+_onException action unf =

636+ gbracket return MC.try

637+ (\_ -> return ())

638+ (nilM (\(a, (_ :: MC.SomeException)) -> action a)) unf

639+

501-- | Run a side effect whenever the unfold aborts due to an exception.

640-- | Run a side effect whenever the unfold aborts due to an exception.

502--

641--

503-- /Internal/

642-- /Internal/

@@ -519,6 +658,12 @@ onException action (Unfold step1 inject1) = Unfold step inject

519 Skip s -> return $ Skip (s, v)

658 Skip s -> return $ Skip (s, v)

520 Stop -> return Stop

659 Stop -> return Stop

521

660

661+{-# INLINE_NORMAL _finally #-}

662+_finally :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b

663+_finally action unf =

664+ gbracket return MC.try action

665+ (nilM (\(a, (_ :: MC.SomeException)) -> action a)) unf

666+

522-- | Run a side effect whenever the unfold stops normally or aborts due to an

667-- | Run a side effect whenever the unfold stops normally or aborts due to an

523-- exception.

668-- exception.

524--

669--

@@ -541,6 +686,12 @@ finally action (Unfold step1 inject1) = Unfold step inject

541 Skip s -> return $ Skip (s, v)

686 Skip s -> return $ Skip (s, v)

542 Stop -> action v >> return Stop

687 Stop -> action v >> return Stop

543

688

689+{-# INLINE_NORMAL _bracket #-}

690+_bracket :: MonadCatch m

691+ => (a -> m c) -> (c -> m d) -> Unfold m c b -> Unfold m a b

692+_bracket bef aft unf =

693+ gbracket bef MC.try aft (nilM (\(a, (_ :: MC.SomeException)) -> aft a)) unf

694+

544-- | @bracket before after between@ runs the @before@ action and then unfolds

695-- | @bracket before after between@ runs the @before@ action and then unfolds

545-- its output using the @between@ unfold. When the @between@ unfold is done or

696-- its output using the @between@ unfold. When the @between@ unfold is done or

546-- if an exception occurs then the @after@ action is run with the output of

697-- if an exception occurs then the @after@ action is run with the output of

@@ -567,26 +718,12 @@ bracket bef aft (Unfold step1 inject1) = Unfold step inject

567 Skip s -> return $ Skip (s, v)

718 Skip s -> return $ Skip (s, v)

568 Stop -> aft v >> return Stop

719 Stop -> aft v >> return Stop

569

720

570−-- | When unfolding an unfold if an exception occurs, unfold aborts

721+-- | When unfolding if an exception occurs, unfold the exception using the

571−-- and the specified exception handler is run with the exception as argument.

722+-- exception unfold.

572--

723--

573-- /Internal/

724-- /Internal/

574{-# INLINE_NORMAL handle #-}

725{-# INLINE_NORMAL handle #-}

575handle :: (MonadCatch m, Exception e)

726handle :: (MonadCatch m, Exception e)

576− => (e -> m b) -> Unfold m a b -> Unfold m a b

727+ => Unfold m e b -> Unfold m a b -> Unfold m a b

577−handle f (Unfold step1 inject1) = Unfold step inject

728+handle exc unf =

578−

729+ gbracket return MC.try (\_ -> return ()) (discardFirst exc) unf

579− where

580−

581− inject x = inject1 x >>= return . Just

582−

583− {-# INLINE_LATE step #-}

584− step (Just st) = do

585− res <- MC.try $ step1 st

586− case res of

587− Left e -> f e >>= \x -> return (Yield x Nothing)

588− Right r -> case r of

589− Yield x s -> return $ Yield x (Just s)

590− Skip s -> return $ Skip (Just s)

591− Stop -> return Stop

592− step Nothing = return Stop

src/Streamly/Internal/Memory/ArrayStream.hs+1−1

@@ -99,7 +99,7 @@ intercalateSuffix arr = S.intercalateSuffix A.read arr A.read

99interposeSuffix :: (MonadIO m, IsStream t, Storable a)

100 => a -> t m (Array a) -> t m a

101-- interposeSuffix x = D.fromStreamD . A.unlines x . D.toStreamD

102−interposeSuffix x = S.intercalateSuffix UF.singleton x A.read

102+interposeSuffix x = S.intercalateSuffix UF.identity x A.read

103

104-- | Split a stream of arrays on a given separator byte, dropping the separator

105-- and coalescing all the arrays between two separators into a single array.