103705f · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Change the signatures of unfold bracket/exception ops

103705fHarendra Kumar7 years ago

src/Streamly/Benchmark/FileIO/Array.hs+3−3

compare with master

unifiedsplit

@@ -135,8 +135,8 @@ inspect $ 'cat `hasNoType` ''Step

135{-# INLINE catBracket #-}

136catBracket :: Handle -> Handle -> IO ()

137catBracket devNull inh =

138− let readEx = IUF.bracket (return ()) (\_ -> hClose inh)

138+ let readEx = IUF.bracket return (\_ -> hClose inh)

139− (\_ -> IUF.first FH.readArraysOf (256*1024))

139+ (IUF.first FH.readArraysOf (256*1024))

140 in IUF.fold readEx (IFH.writeArrays devNull) inh

141

142#ifdef INSPECTION

@@ -161,7 +161,7 @@ inspect $ hasNoTypeClasses 'catBracketStream

161{-# INLINE catOnException #-}

162catOnException :: Handle -> Handle -> IO ()

163catOnException devNull inh =

164− let readEx = IUF.onException (hClose inh)

164+ let readEx = IUF.onException (\_ -> hClose inh)

165 (IUF.first FH.readArraysOf (256*1024))

166 in IUF.fold readEx (IFH.writeArrays devNull) inh

167

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

@@ -190,7 +190,7 @@ inspect $ 'catStreamWrite `hasNoType` ''D.ConcatMapUState

190{-# INLINE catBracket #-}

191catBracket :: Handle -> Handle -> IO ()

192catBracket devNull inh =

193− let readEx = IUF.bracket (return ()) (\_ -> hClose inh) (\_ -> FH.read)

193+ let readEx = IUF.bracket return (\_ -> hClose inh) FH.read

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

195

196#ifdef INSPECTION

@@ -217,7 +217,7 @@ inspect $ hasNoTypeClasses 'catBracketStream

217{-# INLINE catOnException #-}

218catOnException :: Handle -> Handle -> IO ()

219catOnException devNull inh =

220− let readEx = IUF.onException (hClose inh) FH.read

220+ let readEx = IUF.onException (\_ -> hClose inh) FH.read

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

222

223#ifdef INSPECTION

@@ -231,7 +231,7 @@ inspect $ hasNoTypeClasses 'catOnException

231{-# INLINE catFinally #-}

232catFinally :: Handle -> Handle -> IO ()

233catFinally devNull inh =

234− let readEx = IUF.finally (hClose inh) FH.read

234+ let readEx = IUF.finally (\_ -> hClose inh) FH.read

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

236

237#ifdef INSPECTION

src/Streamly/Internal/Data/Unfold.hs+47−38

@@ -417,13 +417,13 @@ concatMapM f (Unfold step1 inject1) = Unfold step inject

417--

418-- /Internal/

419{-# INLINE_NORMAL before #-}

420−before :: Monad m => m c -> Unfold m a b -> Unfold m a b

420+before :: Monad m => (a -> m c) -> Unfold m a b -> Unfold m a b

421before action (Unfold step1 inject1) = Unfold step inject

422

423 where

424

425 inject x = do

426− _ <- action

426+ _ <- action x

427 st <- inject1 x

428 return st

429

@@ -439,34 +439,42 @@ before action (Unfold step1 inject1) = Unfold step inject

439--

440-- /Internal/

441{-# INLINE_NORMAL after #-}

442−after :: Monad m => m c -> Unfold m a b -> Unfold m a b

442+after :: Monad m => (a -> m c) -> Unfold m a b -> Unfold m a b

443−after action (Unfold step1 inject1) = Unfold step inject1

443+after action (Unfold step1 inject1) = Unfold step inject

444

445 where

446

447+ inject x = do

448+ s <- inject1 x

449+ return (s, x)

450+

447 {-# INLINE_LATE step #-}

451 {-# INLINE_LATE step #-}

448− step st = do

452+ step (st, v) = do

449 res <- step1 st

453 res <- step1 st

450 case res of

454 case res of

451− Yield x s -> return $ Yield x s

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

452− Skip s -> return $ Skip s

456+ Skip s -> return $ Skip (s, v)

453− Stop -> action >> return Stop

457+ Stop -> action v >> return Stop

454

458

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

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

456--

460--

457-- /Internal/

461-- /Internal/

458{-# INLINE_NORMAL onException #-}

462{-# INLINE_NORMAL onException #-}

459−onException :: MonadCatch m => m c -> Unfold m a b -> Unfold m a b

463+onException :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b

460−onException action (Unfold step1 inject1) = Unfold step inject1

464+onException action (Unfold step1 inject1) = Unfold step inject

461

465

462 where

466 where

463

467

468+ inject x = do

469+ s <- inject1 x

470+ return (s, x)

471+

464 {-# INLINE_LATE step #-}

472 {-# INLINE_LATE step #-}

465− step st = do

473+ step (st, v) = do

466− res <- step1 st `MC.onException` action

474+ res <- step1 st `MC.onException` action v

467 case res of

475 case res of

468− Yield x s -> return $ Yield x s

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

469− Skip s -> return $ Skip s

477+ Skip s -> return $ Skip (s, v)

470 Stop -> return Stop

478 Stop -> return Stop

471

479

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

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

@@ -474,46 +482,47 @@ onException action (Unfold step1 inject1) = Unfold step inject1

474--

482--

475-- /Internal/

483-- /Internal/

476{-# INLINE_NORMAL finally #-}

484{-# INLINE_NORMAL finally #-}

477−finally :: MonadCatch m => m c -> Unfold m a b -> Unfold m a b

485+finally :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b

478−finally action (Unfold step1 inject1) = Unfold step inject1

486+finally action (Unfold step1 inject1) = Unfold step inject

479

487

480 where

488 where

481

489

490+ inject x = do

491+ s <- inject1 x

492+ return (s, x)

493+

482 {-# INLINE_LATE step #-}

494 {-# INLINE_LATE step #-}

483− step st = do

495+ step (st, v) = do

484− res <- step1 st `MC.onException` action

496+ res <- step1 st `MC.onException` action v

485 case res of

497 case res of

486− Yield x s -> return $ Yield x s

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

487− Skip s -> return $ Skip s

499+ Skip s -> return $ Skip (s, v)

488− Stop -> action >> return Stop

500+ Stop -> action v >> return Stop

489−

501+

490−-- | @bracket before after between@ runs the @before@ action and then runs the

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

491−-- @between@ function using the output of @before@ as its argument. When the

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

492−-- @between@ unfold is done or if an exception occurs while running @between@

493−-- the @after@ action is run with the output of @before@ as argument.

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

505+-- @before@ as argument.

494--

506--

495-- /Internal/

507-- /Internal/

496{-# INLINE_NORMAL bracket #-}

508{-# INLINE_NORMAL bracket #-}

497bracket :: MonadCatch m

509bracket :: MonadCatch m

498− => m c -> (c -> m d) -> (c -> Unfold m a b) -> Unfold m a b

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

499−bracket bef aft bet = Unfold step inject

511+bracket bef aft (Unfold step1 inject1) = Unfold step inject

500

512

501 where

513 where

502

514

503 inject x = do

515 inject x = do

504− r <- bef

516+ r <- bef x

505− go (bet r) r

517+ s <- inject1 r

506− where

507− go (Unfold step2 inject2) r = do

508− st <- inject2 x

509− return (Stream (\_ -> step2) st, r)

518+ return (s, r)

510

519

511 {-# INLINE_LATE step #-}

520 {-# INLINE_LATE step #-}

512− step (UnStream step2 state, v) = do

521+ step (st, v) = do

513− res <- step2 defState state `MC.onException` aft v

522+ res <- step1 st `MC.onException` aft v

514 case res of

523 case res of

515− Yield x s -> return $ Yield x (Stream step2 s, v)

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

516− Skip s -> return $ Skip (Stream step2 s, v)

525+ Skip s -> return $ Skip (s, v)

517 Stop -> aft v >> return Stop

526 Stop -> aft v >> return Stop

518

527

519-- | When unfolding an unfold if an exception occurs, unfold aborts

528-- | When unfolding an unfold if an exception occurs, unfold aborts