d765444 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Remove lifted-base dependency

d765444Harendra Kumar8 years ago

src/Streamly/Core.hs+10−36

compare with master

unifiedsplit

@@ -56,11 +56,6 @@ module Streamly.Core

56 , zipWith

57 , zipAsyncWith

59− -- XXX move to Streams.hs

60− -- * Transformers

61− , withLocal

62− , withCatchError

63−

64 -- * Concurrent Stream Vars (SVars)

59 -- * Concurrent Stream Vars (SVars)

65 , SVar

60 , SVar

66 , SVarStyle (..)

61 , SVarStyle (..)

@@ -73,15 +68,12 @@ where

73import Control.Concurrent (ThreadId, myThreadId, threadDelay)

68import Control.Concurrent (ThreadId, myThreadId, threadDelay)

74import Control.Concurrent.MVar (MVar, newEmptyMVar, tryTakeMVar,

69import Control.Concurrent.MVar (MVar, newEmptyMVar, tryTakeMVar,

75 tryPutMVar, takeMVar, putMVar)

70 tryPutMVar, takeMVar, putMVar)

76−import Control.Exception (SomeException (..))

71+import Control.Exception (SomeException (..), catch, mask)

77−import qualified Control.Exception.Lifted as EL

78import Control.Monad (when)

72import Control.Monad (when)

79import Control.Monad.Catch (MonadThrow, throwM)

73import Control.Monad.Catch (MonadThrow, throwM)

80−import Control.Monad.Error.Class (MonadError(..))

81import Control.Monad.IO.Class (MonadIO(..))

74import Control.Monad.IO.Class (MonadIO(..))

82−import Control.Monad.Reader.Class (MonadReader(..))

83import Control.Monad.Trans.Class (MonadTrans (lift))

75import Control.Monad.Trans.Class (MonadTrans (lift))

84−import Control.Monad.Trans.Control (MonadBaseControl, liftBaseWith)

76+import Control.Monad.Trans.Control (MonadBaseControl, control)

85import Data.Atomics (casIORef, readForCAS, peekTicket

77import Data.Atomics (casIORef, readForCAS, peekTicket

86 ,atomicModifyIORefCAS_)

78 ,atomicModifyIORefCAS_)

87import Data.Concurrent.Queue.MichaelScott (LinkedQueue, newQ, pushL,

79import Data.Concurrent.Queue.MichaelScott (LinkedQueue, newQ, pushL,

@@ -395,14 +387,14 @@ rawForkIO action = IO $ \ s ->

395{-# INLINE doFork #-}

387{-# INLINE doFork #-}

396doFork :: MonadBaseControl IO m

388doFork :: MonadBaseControl IO m

397 => m ()

389 => m ()

398− -> (SomeException -> m ())

390+ -> (SomeException -> IO ())

399 -> m ThreadId

391 -> m ThreadId

400doFork action exHandler =

392doFork action exHandler =

401− EL.mask $ \restore ->

393+ control $ \runInIO ->

402− liftBaseWith $ \runInIO -> rawForkIO $ do

394+ mask $ \restore -> do

403− _ <- runInIO $ EL.catch (restore action) exHandler

395+ tid <- rawForkIO $ catch (restore $ void $ runInIO action)

404− -- XXX restore state here?

396+ exHandler

405− return ()

397+ runInIO (return tid)

406

398

407-- XXX exception safety of all atomic/MVar operations

399-- XXX exception safety of all atomic/MVar operations

408

400

@@ -808,8 +800,8 @@ allThreadsDone :: MonadIO m => SVar m a -> m Bool

808allThreadsDone sv = liftIO $ S.null <$> readIORef (runningThreads sv)

800allThreadsDone sv = liftIO $ S.null <$> readIORef (runningThreads sv)

809

801

810{-# NOINLINE handleChildException #-}

802{-# NOINLINE handleChildException #-}

811−handleChildException :: MonadIO m => SVar m a -> SomeException -> m ()

803+handleChildException :: SVar m a -> SomeException -> IO ()

812−handleChildException sv e = liftIO $ do

804+handleChildException sv e = do

813 tid <- myThreadId

805 tid <- myThreadId

814 send sv (ChildStop tid (Just e))

806 send sv (ChildStop tid (Just e))

815

807

@@ -1335,21 +1327,3 @@ zipAsyncWith f m1 m2 = Stream $ \_ stp sng yld -> do

1335

1327

1336instance MonadTrans Stream where

1328instance MonadTrans Stream where

1337 lift = once

1329 lift = once

1338−

1339−withLocal :: MonadReader r m => (r -> r) -> Stream m a -> Stream m a

1340−withLocal f m =

1341− Stream $ \svr stp sng yld ->

1342− let single = local f . sng

1343− yield a r = local f $ yld a (withLocal f r)

1344− in (runStream m) svr (local f stp) single yield

1345−

1346−-- XXX handle and test cross thread state transfer

1347−withCatchError

1348− :: MonadError e m

1349− => Stream m a -> (e -> Stream m a) -> Stream m a

1350−withCatchError m h =

1351− Stream $ \svr stp sng yld ->

1352− let run x = runStream x svr stp sng yield

1353− handle r = r `catchError` \e -> run $ h e

1354− yield a r = yld a (withCatchError r h)

1355− in handle $ run m

src/Streamly/Streams.hs+22−2

@@ -404,6 +404,26 @@ x |> f = f <| x

404-- XXX use template haskell instead and include Monoid and IsStream instances

405-- as well.

406

407+withLocal :: MonadReader r m => (r -> r) -> S.Stream m a -> S.Stream m a

408+withLocal f m =

409+ S.Stream $ \svr stp sng yld ->

410+ let single = local f . sng

411+ yield a r = local f $ yld a (withLocal f r)

412+ in (S.runStream m) svr (local f stp) single yield

413+

414+{-

415+-- XXX handle and test cross thread state transfer

416+withCatchError

417+ :: MonadError e m

418+ => S.Stream m a -> (e -> S.Stream m a) -> S.Stream m a

419+withCatchError m h =

420+ S.Stream $ \svr stp sng yld ->

421+ let run x = S.runStream x svr stp sng yield

422+ handle r = r `catchError` \e -> run $ h e

423+ yield a r = yld a (withCatchError r h)

424+ in handle $ run m

425+-}

426+

407#define MONADPARALLEL , MonadAsync m

427#define MONADPARALLEL , MonadAsync m

408

428

409#define MONAD_APPLICATIVE_INSTANCE(STREAM,CONSTRAINT) \

429#define MONAD_APPLICATIVE_INSTANCE(STREAM,CONSTRAINT) \

@@ -425,12 +445,12 @@ instance (MonadThrow m CONSTRAINT) => MonadThrow (STREAM m) where { \

425instance (MonadError e m CONSTRAINT) => MonadError e (STREAM m) where { \

445instance (MonadError e m CONSTRAINT) => MonadError e (STREAM m) where { \

426 throwError = lift . throwError; \

446 throwError = lift . throwError; \

427 catchError m h = \

447 catchError m h = \

428− fromStream $ S.withCatchError (toStream m) (\e -> toStream $ h e) }; \

448+ fromStream $ withCatchError (toStream m) (\e -> toStream $ h e) }; \

429-} \

449-} \

430 \

450 \

431instance (MonadReader r m CONSTRAINT) => MonadReader r (STREAM m) where { \

451instance (MonadReader r m CONSTRAINT) => MonadReader r (STREAM m) where { \

432 ask = lift ask; \

452 ask = lift ask; \

433− local f m = fromStream $ S.withLocal f (toStream m) }; \

453+ local f m = fromStream $ withLocal f (toStream m) }; \

434 \

454 \

435instance (MonadState s m CONSTRAINT) => MonadState s (STREAM m) where { \

455instance (MonadState s m CONSTRAINT) => MonadState s (STREAM m) where { \

436 get = lift get; \

456 get = lift get; \

streamly.cabal+3−2

@@ -118,14 +118,15 @@ library

118 -Wnoncanonical-monadfail-instances

119

120 build-depends: base >= 4.8 && < 5

121− , atomic-primops >= 0.8 && < 0.9

122 , containers >= 0.5 && < 0.6

121 , containers >= 0.5 && < 0.6

123 , heaps >= 0.3 && < 0.4

122 , heaps >= 0.3 && < 0.4

123+

124+ -- concurrency

125+ , atomic-primops >= 0.8 && < 0.9

124 , lockfree-queue >= 0.2.3 && < 0.3

126 , lockfree-queue >= 0.2.3 && < 0.3

125

127

126 -- transfomers

128 -- transfomers

127 , exceptions >= 0.8 && < 0.11

129 , exceptions >= 0.8 && < 0.11

128− , lifted-base >= 0.2 && < 0.3

129 , monad-control >= 1.0 && < 2

130 , monad-control >= 1.0 && < 2

130 , mtl >= 2.2 && < 3

131 , mtl >= 2.2 && < 3

131 , transformers >= 0.4 && < 0.6

132 , transformers >= 0.4 && < 0.6