30a6e32 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Fix Monoid and other instances

30a6e32Harendra Kumar8 years ago

benchmark/Main.hs+7−3

compare with master

unifiedsplit

@@ -95,6 +95,10 @@ main = do

95map :: Monad m => (a -> Int) -> a -> m Int

96map f x = return $ f x

98+guard' :: (A.IsStream t, Applicative (t m)) => Bool -> t m ()

99+guard' True = pure ()

100+guard' False = A.nil

101+

98{-# INLINABLE filter #-}

102{-# INLINABLE filter #-}

99filter :: (Monad m, Alternative m) => (a -> Bool) -> a -> m a

103filter :: (Monad m, Alternative m) => (a -> Bool) -> a -> m a

100filter cond x = guard (not $ cond x) >> return x

104filter cond x = guard (not $ cond x) >> return x

@@ -102,12 +106,12 @@ filter cond x = guard (not $ cond x) >> return x

102amap :: Monad (s IO) => (Int -> Int) -> Int -> s IO Int

106amap :: Monad (s IO) => (Int -> Int) -> Int -> s IO Int

103amap = Main.map

107amap = Main.map

104

108

105−afilter :: (Alternative (s IO), Monad (s IO)) => (Int -> Bool) -> Int -> s IO Int

109+afilter :: (A.IsStream s, Monad (s IO)) => (Int -> Bool) -> Int -> s IO Int

106−afilter = Main.filter

110+afilter cond x = guard' (not $ cond x) >> return x

107

111

108{-# INLINE streamly_basic #-}

112{-# INLINE streamly_basic #-}

109streamly_basic

113streamly_basic

110− :: (Alternative (t IO), Monad (t IO), A.IsStream t)

114+ :: (Monad (t IO), A.IsStream t)

111 => (forall a. t IO a -> IO [a])

115 => (forall a. t IO a -> IO [a])

112 -> (t IO Int -> t IO Int -> t IO Int)

116 -> (t IO Int -> t IO Int -> t IO Int)

113 -> IO Int

117 -> IO Int

examples/loops.hs+5−4

@@ -1,5 +1,6 @@

1import Streamly

2import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))

3+import Streamly.Prelude (nil)

4main = do

5main = do

5 liftIO $ hSetBuffering stdout LineBuffering

6 liftIO $ hSetBuffering stdout LineBuffering

@@ -49,7 +50,7 @@ main = do

49 loopTail :: Int -> SerialT IO Int

50 loopTail :: Int -> SerialT IO Int

50 loopTail x = do

51 loopTail x = do

51 liftIO $ putStrLn "LoopTail..."

52 liftIO $ putStrLn "LoopTail..."

52− return x <> (if x < 3 then loopTail (x + 1) else empty)

53+ return x <> (if x < 3 then loopTail (x + 1) else nil)

54 -- Loops and then generates a value. The consumer can run only after the

55 -- Loops and then generates a value. The consumer can run only after the

55 -- loop has finished. An infinite generator will not let the consumer run

56 -- loop has finished. An infinite generator will not let the consumer run

@@ -57,7 +58,7 @@ main = do

57 loopHead :: Int -> SerialT IO Int

58 loopHead :: Int -> SerialT IO Int

58 loopHead x = do

59 loopHead x = do

59 liftIO $ putStrLn "LoopHead..."

60 liftIO $ putStrLn "LoopHead..."

60− (if x < 3 then loopHead (x + 1) else empty) <> return x

61+ (if x < 3 then loopHead (x + 1) else nil) <> return x

62-------------------------------------------------------------------------------

63-------------------------------------------------------------------------------

63-- Concurrent (multi-threaded) adaptive demand-based stream generator loops

64-- Concurrent (multi-threaded) adaptive demand-based stream generator loops

@@ -71,12 +72,12 @@ main = do

71 loopTailA :: Int -> SerialT IO Int

72 loopTailA :: Int -> SerialT IO Int

72 loopTailA x = do

73 loopTailA x = do

73 liftIO $ putStrLn "LoopTailA..."

74 liftIO $ putStrLn "LoopTailA..."

74− return x `coparallel` (if x < 3 then loopTailA (x + 1) else empty)

75+ return x `coparallel` (if x < 3 then loopTailA (x + 1) else nil)

76 loopHeadA :: Int -> SerialT IO Int

77 loopHeadA :: Int -> SerialT IO Int

77 loopHeadA x = do

78 loopHeadA x = do

78 liftIO $ putStrLn "LoopHeadA..."

79 liftIO $ putStrLn "LoopHeadA..."

79− (if x < 3 then loopHeadA (x + 1) else empty) `coparallel` return x

80+ (if x < 3 then loopHeadA (x + 1) else nil) `coparallel` return x

81-------------------------------------------------------------------------------

82-------------------------------------------------------------------------------

82-- Parallel (fairly scheduled, multi-threaded) stream generator loops

83-- Parallel (fairly scheduled, multi-threaded) stream generator loops

src/Streamly/Core.hs+21−66

@@ -39,6 +39,10 @@ module Streamly.Core

39 -- * Alternative

40 , alt

42+ -- * Transformers

43+ , withLocal

44+ , withCatchError

45+

42 -- * Concurrent Stream Vars (SVars)

46 -- * Concurrent Stream Vars (SVars)

43 , SVar

47 , SVar

44 , SVarSched (..)

48 , SVarSched (..)

@@ -53,20 +57,17 @@ module Streamly.Core

53 )

57 )

54where

58where

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

57import Control.Concurrent (ThreadId, forkIO,

60import Control.Concurrent (ThreadId, forkIO,

58 myThreadId, threadDelay)

61 myThreadId, threadDelay)

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

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

60 tryPutMVar, takeMVar)

63 tryPutMVar, takeMVar)

61import Control.Exception (SomeException (..))

64import Control.Exception (SomeException (..))

62import qualified Control.Exception.Lifted as EL

65import qualified Control.Exception.Lifted as EL

63−import Control.Monad (MonadPlus(..), mzero, when)

66+import Control.Monad (when)

64−import Control.Monad.Base (MonadBase (..), liftBaseDefault)

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

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

66import Control.Monad.Error.Class (MonadError(..))

68import Control.Monad.Error.Class (MonadError(..))

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

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

68import Control.Monad.Reader.Class (MonadReader(..))

70import Control.Monad.Reader.Class (MonadReader(..))

69−import Control.Monad.State.Class (MonadState(..))

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

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

71import Control.Monad.Trans.Control (MonadBaseControl, liftBaseWith)

72import Control.Monad.Trans.Control (MonadBaseControl, liftBaseWith)

72import Data.Atomics (atomicModifyIORefCAS,

73import Data.Atomics (atomicModifyIORefCAS,

@@ -184,15 +185,6 @@ cons a r = Stream $ \_ _ _ yld -> yld a r

184repeat :: a -> Stream m a

185repeat :: a -> Stream m a

185repeat a = let x = cons a x in x

186repeat a = let x = cons a x in x

186

187

187−------------------------------------------------------------------------------

188−-- Composing streams

189−------------------------------------------------------------------------------

190−

191−-- Streams can be composed sequentially or in parallel; in product style

192−-- compositions (monadic bind multiplies streams in a ListT fashion) or in sum

193−-- style compositions like 'Semigroup', 'Monoid', 'Alternative' or variants of

194−-- these.

195−

196------------------------------------------------------------------------------

188------------------------------------------------------------------------------

197-- Semigroup

189-- Semigroup

198------------------------------------------------------------------------------

190------------------------------------------------------------------------------

@@ -582,29 +574,15 @@ parallel :: MonadParallel m => Stream m a -> Stream m a -> Stream m a

582parallel = joinStreamVar2 (SVarStyle Disjunction FIFO)

574parallel = joinStreamVar2 (SVarStyle Disjunction FIFO)

583

575

584-------------------------------------------------------------------------------

576-------------------------------------------------------------------------------

585−-- Instances (only used for deriving newtype instances)

577+-- Functor instace is the same for all types

586-------------------------------------------------------------------------------

578-------------------------------------------------------------------------------

587

579

588−-- Stream type is not exposed, these instances are only for deriving instances

589−-- for the newtype wrappers based on Stream.

590−

591−-- Dummy Instances, defined to enable the definition of other instances that

592−-- require a Monad constraint. Must be defined by the newtypes.

593−

594instance Monad m => Functor (Stream m) where

580instance Monad m => Functor (Stream m) where

595 fmap f m = Stream $ \_ stp sng yld ->

581 fmap f m = Stream $ \_ stp sng yld ->

596 let single = sng . f

582 let single = sng . f

597 yield a r = yld (f a) (fmap f r)

583 yield a r = yld (f a) (fmap f r)

598 in (runStream m) Nothing stp single yield

584 in (runStream m) Nothing stp single yield

599

585

600−instance Monad m => Applicative (Stream m) where

601− pure = undefined

602− (<*>) = undefined

603−

604−instance Monad m => Monad (Stream m) where

605− return = pure

606− (>>=) = undefined

607−

608------------------------------------------------------------------------------

586------------------------------------------------------------------------------

609-- Alternative & MonadPlus

587-- Alternative & MonadPlus

610------------------------------------------------------------------------------

588------------------------------------------------------------------------------

@@ -614,50 +592,27 @@ alt m1 m2 = Stream $ \_ stp sng yld ->

614 let stop = runStream m2 Nothing stp sng yld

592 let stop = runStream m2 Nothing stp sng yld

615 in runStream m1 Nothing stop sng yld

593 in runStream m1 Nothing stop sng yld

616

594

617−instance MonadParallel m => Alternative (Stream m) where

618− empty = nil

619− (<|>) = alt

620−

621−instance MonadParallel m => MonadPlus (Stream m) where

622− mzero = nil

623− mplus = (<|>)

624−

625-------------------------------------------------------------------------------

595-------------------------------------------------------------------------------

626−-- Transformer

596+-- Transformers

627-------------------------------------------------------------------------------

597-------------------------------------------------------------------------------

628

598

629instance MonadTrans Stream where

599instance MonadTrans Stream where

630 lift mx = Stream $ \_ _ single _ -> mx >>= single

600 lift mx = Stream $ \_ _ single _ -> mx >>= single

631

601

632−instance (MonadBase b m, Monad m) => MonadBase b (Stream m) where

602+withLocal :: MonadReader r m => (r -> r) -> Stream m a -> Stream m a

633− liftBase = liftBaseDefault

603+withLocal f m =

634−

635−------------------------------------------------------------------------------

636−-- Standard transformer instances

637−------------------------------------------------------------------------------

638−

639−instance MonadIO m => MonadIO (Stream m) where

640− liftIO = lift . liftIO

641−

642−instance MonadThrow m => MonadThrow (Stream m) where

643− throwM = lift . throwM

644−

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

646−instance MonadError e m => MonadError e (Stream m) where

647− throwError = lift . throwError

648− catchError m h = Stream $ \svr stp sng yld ->

649− let handle r = r `catchError` \e -> (runStream (h e)) svr stp sng yld

650− yield a r = yld a (catchError r h)

651− in handle $ (runStream m) svr stp sng yield

652−

653−instance MonadReader r m => MonadReader r (Stream m) where

654− ask = lift ask

655− local f m = Stream $ \svr stp sng yld ->

604+ Stream $ \svr stp sng yld ->

656 let single = local f . sng

605 let single = local f . sng

657− yield a r = local f $ yld a (local f r)

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

658 in (runStream m) svr (local f stp) single yield

607 in (runStream m) svr (local f stp) single yield

659

608

660−instance MonadState s m => MonadState s (Stream m) where

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

661− get = lift get

610+withCatchError

662− put x = lift (put x)

611+ :: MonadError e m

663− state k = lift (state k)

612+ => Stream m a -> (e -> Stream m a) -> Stream m a

613+withCatchError m h =

614+ Stream $ \svr stp sng yld ->

615+ let run x = runStream x svr stp sng yield

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

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

618+ in handle $ run m

src/Streamly/Streams.hs+129−320

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE ConstraintKinds #-}

2{-# LANGUAGE ConstraintKinds #-}

2{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE FlexibleInstances #-}

4{-# LANGUAGE FlexibleInstances #-}

@@ -102,15 +103,15 @@ module Streamly.Streams

102 )

103 )

103where

104where

104

105

105−import Control.Applicative (Alternative (..), liftA2)

106+import Control.Applicative (liftA2)

106−import Control.Monad (MonadPlus(..), ap)

107+import Control.Monad (ap)

107−import Control.Monad.Base (MonadBase (..))

108+import Control.Monad.Base (MonadBase (..), liftBaseDefault)

108−import Control.Monad.Catch (MonadThrow)

109+import Control.Monad.Catch (MonadThrow, throwM)

109import Control.Monad.Error.Class (MonadError(..))

110import Control.Monad.Error.Class (MonadError(..))

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

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

111import Control.Monad.Reader.Class (MonadReader(..))

112import Control.Monad.Reader.Class (MonadReader(..))

112import Control.Monad.State.Class (MonadState(..))

113import Control.Monad.State.Class (MonadState(..))

113−import Control.Monad.Trans.Class (MonadTrans)

114+import Control.Monad.Trans.Class (MonadTrans (lift))

114import Data.Semigroup (Semigroup(..))

115import Data.Semigroup (Semigroup(..))

115import Prelude hiding (zipWith)

116import Prelude hiding (zipWith)

116import Streamly.Core ( MonadParallel, Stream(Stream)

117import Streamly.Core ( MonadParallel, Stream(Stream)

@@ -266,6 +267,85 @@ async m = do

266 sv <- S.newStreamVar1 (SVarStyle Disjunction LIFO) (toStream m)

267 sv <- S.newStreamVar1 (SVarStyle Disjunction LIFO) (toStream m)

267 return $ fromSVar sv

268 return $ fromSVar sv

268

269

270+------------------------------------------------------------------------------

271+-- CPP macros for common instances

272+------------------------------------------------------------------------------

273+

274+-- XXX use template haskell instead and include Monoid and IsStream instances

275+-- as well.

276+

277+#define MONADPARALLEL , MonadParallel m

278+

279+#define MONAD_APPLICATIVE_INSTANCE(STREAM,CONSTRAINT) \

280+instance (Monad m CONSTRAINT) => Applicative (STREAM m) where { \

281+ pure = STREAM . singleton; \

282+ (<*>) = ap }

283+

284+#define MONAD_COMMON_INSTANCES(STREAM,CONSTRAINT) \

285+instance (MonadBase b m, Monad m CONSTRAINT) => MonadBase b (STREAM m) where {\

286+ liftBase = liftBaseDefault }; \

287+ \

288+instance (MonadIO m CONSTRAINT) => MonadIO (STREAM m) where { \

289+ liftIO = lift . liftIO }; \

290+ \

291+instance (MonadThrow m CONSTRAINT) => MonadThrow (STREAM m) where { \

292+ throwM = lift . throwM }; \

293+ \

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

295+ throwError = lift . throwError; \

296+ catchError m h = \

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

298+ \

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

300+ ask = lift ask; \

301+ local f m = fromStream $ S.withLocal f (toStream m) }; \

302+ \

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

304+ get = lift get; \

305+ put x = lift (put x); \

306+ state k = lift (state k) }

307+

308+#define NUMERIC_COMMON_INSTANCES(STREAM,CONSTRAINT) \

309+instance (Monad m, Num a CONSTRAINT) => Num (STREAM m a) where { \

310+ fromInteger n = pure (fromInteger n); \

311+ \

312+ negate = fmap negate; \

313+ abs = fmap abs; \

314+ signum = fmap signum; \

315+ \

316+ (+) = liftA2 (+); \

317+ (*) = liftA2 (*); \

318+ (-) = liftA2 (-) }; \

319+ \

320+instance (Monad m, Fractional a CONSTRAINT) => Fractional (STREAM m a) where {\

321+ fromRational n = pure (fromRational n); \

322+ \

323+ recip = fmap recip; \

324+ \

325+ (/) = liftA2 (/) }; \

326+ \

327+instance (Monad m, Floating a CONSTRAINT) => Floating (STREAM m a) where { \

328+ pi = pure pi; \

329+ \

330+ exp = fmap exp; \

331+ sqrt = fmap sqrt; \

332+ log = fmap log; \

333+ sin = fmap sin; \

334+ tan = fmap tan; \

335+ cos = fmap cos; \

336+ asin = fmap asin; \

337+ atan = fmap atan; \

338+ acos = fmap acos; \

339+ sinh = fmap sinh; \

340+ tanh = fmap tanh; \

341+ cosh = fmap cosh; \

342+ asinh = fmap asinh; \

343+ atanh = fmap atanh; \

344+ acosh = fmap acosh; \

345+ \

346+ (**) = liftA2 (**); \

347+ logBase = liftA2 logBase }

348+

269------------------------------------------------------------------------------

349------------------------------------------------------------------------------

270-- SerialT

350-- SerialT

271------------------------------------------------------------------------------

351------------------------------------------------------------------------------

@@ -321,14 +401,7 @@ async m = do

321-- streams as it explores only one stream at a time.

401-- streams as it explores only one stream at a time.

322--

402--

323newtype SerialT m a = SerialT {getSerialT :: Stream m a}

403newtype SerialT m a = SerialT {getSerialT :: Stream m a}

324− deriving (Functor, Semigroup, Monoid, MonadTrans, MonadIO, MonadThrow)

404+ deriving (Semigroup, Monoid, Functor, MonadTrans)

325−

326−deriving instance MonadParallel m => Alternative (SerialT m)

327−deriving instance MonadParallel m => MonadPlus (SerialT m)

328−deriving instance (MonadBase b m, Monad m) => MonadBase b (SerialT m)

329−deriving instance MonadError e m => MonadError e (SerialT m)

330−deriving instance MonadReader r m => MonadReader r (SerialT m)

331−deriving instance MonadState s m => MonadState s (SerialT m)

332

405

333instance IsStream SerialT where

406instance IsStream SerialT where

334 toStream = getSerialT

407 toStream = getSerialT

@@ -338,11 +411,6 @@ instance IsStream SerialT where

338{-# Deprecated StreamT "Please use SerialT instead." #-}

411{-# Deprecated StreamT "Please use SerialT instead." #-}

339type StreamT = SerialT

412type StreamT = SerialT

340

413

341−-- XXX The Functor/Applicative/Num instances for all the types are exactly the

342−-- same, how can we reduce this boilerplate (use TH)? We cannot derive them

343−-- from a single base type because they depend on the Monad instance which is

344−-- different for each type.

345−

346------------------------------------------------------------------------------

414------------------------------------------------------------------------------

347-- Semigroup

415-- Semigroup

348------------------------------------------------------------------------------

416------------------------------------------------------------------------------

@@ -367,56 +435,12 @@ instance Monad m => Monad (SerialT m) where

367 in m Nothing stp single yield

435 in m Nothing stp single yield

368

436

369------------------------------------------------------------------------------

437------------------------------------------------------------------------------

370−-- Applicative

438+-- Other instances

371−------------------------------------------------------------------------------

372−

373−instance Monad m => Applicative (SerialT m) where

374− pure = SerialT . singleton

375− (<*>) = ap

376−

377−------------------------------------------------------------------------------

378−-- Num

379------------------------------------------------------------------------------

439------------------------------------------------------------------------------

380

440

381−instance (Monad m, Num a) => Num (SerialT m a) where

441+MONAD_APPLICATIVE_INSTANCE(SerialT,)

382− fromInteger n = pure (fromInteger n)

442+MONAD_COMMON_INSTANCES(SerialT,)

383−

443+NUMERIC_COMMON_INSTANCES(SerialT,)

384− negate = fmap negate

385− abs = fmap abs

386− signum = fmap signum

387−

388− (+) = liftA2 (+)

389− (*) = liftA2 (*)

390− (-) = liftA2 (-)

391−

392−instance (Monad m, Fractional a) => Fractional (SerialT m a) where

393− fromRational n = pure (fromRational n)

394−

395− recip = fmap recip

396−

397− (/) = liftA2 (/)

398−

399−instance (Monad m, Floating a) => Floating (SerialT m a) where

400− pi = pure pi

401−

402− exp = fmap exp

403− sqrt = fmap sqrt

404− log = fmap log

405− sin = fmap sin

406− tan = fmap tan

407− cos = fmap cos

408− asin = fmap asin

409− atan = fmap atan

410− acos = fmap acos

411− sinh = fmap sinh

412− tanh = fmap tanh

413− cosh = fmap cosh

414− asinh = fmap asinh

415− atanh = fmap atanh

416− acosh = fmap acosh

417−

418− (**) = liftA2 (**)

419− logBase = liftA2 logBase

420

444

421------------------------------------------------------------------------------

445------------------------------------------------------------------------------

422-- CoserialT

446-- CoserialT

@@ -453,14 +477,7 @@ instance (Monad m, Floating a) => Floating (SerialT m a) where

453-- streams as it needs to retain state for each unfinished stream.

477-- streams as it needs to retain state for each unfinished stream.

454--

478--

455newtype CoserialT m a = CoserialT {getCoserialT :: Stream m a}

479newtype CoserialT m a = CoserialT {getCoserialT :: Stream m a}

456− deriving (Functor, Monoid, MonadTrans, MonadIO, MonadThrow)

480+ deriving (Functor, MonadTrans)

457−

458−deriving instance MonadParallel m => Alternative (CoserialT m)

459−deriving instance MonadParallel m => MonadPlus (CoserialT m)

460−deriving instance (MonadBase b m, Monad m) => MonadBase b (CoserialT m)

461−deriving instance MonadError e m => MonadError e (CoserialT m)

462−deriving instance MonadReader r m => MonadReader r (CoserialT m)

463−deriving instance MonadState s m => MonadState s (CoserialT m)

464

481

465{-# DEPRECATED InterleavedT "Please use 'CoserialT' instead." #-}

482{-# DEPRECATED InterleavedT "Please use 'CoserialT' instead." #-}

466type InterleavedT = CoserialT

483type InterleavedT = CoserialT

@@ -490,6 +507,14 @@ infixr 5 <=>

490(<=>) :: IsStream t => t m a -> t m a -> t m a

507(<=>) :: IsStream t => t m a -> t m a -> t m a

491(<=>) = coserial

508(<=>) = coserial

492

509

510+------------------------------------------------------------------------------

511+-- Monoid

512+------------------------------------------------------------------------------

513+

514+instance Monoid (CoserialT m a) where

515+ mempty = nil

516+ mappend = (<>)

517+

493------------------------------------------------------------------------------

518------------------------------------------------------------------------------

494-- Monad

519-- Monad

495------------------------------------------------------------------------------

520------------------------------------------------------------------------------

@@ -503,56 +528,12 @@ instance Monad m => Monad (CoserialT m) where

503 in m Nothing stp single yield

528 in m Nothing stp single yield

504

529

505------------------------------------------------------------------------------

530------------------------------------------------------------------------------

506−-- Applicative

531+-- Other instances

507------------------------------------------------------------------------------

532------------------------------------------------------------------------------

508

533

509−instance Monad m => Applicative (CoserialT m) where

534+MONAD_APPLICATIVE_INSTANCE(CoserialT,)

510− pure = CoserialT . singleton

535+MONAD_COMMON_INSTANCES(CoserialT,)

511− (<*>) = ap

536+NUMERIC_COMMON_INSTANCES(CoserialT,)

512−

513−------------------------------------------------------------------------------

514−-- Num

515−------------------------------------------------------------------------------

516−

517−instance (Monad m, Num a) => Num (CoserialT m a) where

518− fromInteger n = pure (fromInteger n)

519−

520− negate = fmap negate

521− abs = fmap abs

522− signum = fmap signum

523−

524− (+) = liftA2 (+)

525− (*) = liftA2 (*)

526− (-) = liftA2 (-)

527−

528−instance (Monad m, Fractional a) => Fractional (CoserialT m a) where

529− fromRational n = pure (fromRational n)

530−

531− recip = fmap recip

532−

533− (/) = liftA2 (/)

534−

535−instance (Monad m, Floating a) => Floating (CoserialT m a) where

536− pi = pure pi

537−

538− exp = fmap exp

539− sqrt = fmap sqrt

540− log = fmap log

541− sin = fmap sin

542− tan = fmap tan

543− cos = fmap cos

544− asin = fmap asin

545− atan = fmap atan

546− acos = fmap acos

547− sinh = fmap sinh

548− tanh = fmap tanh

549− cosh = fmap cosh

550− asinh = fmap asinh

551− atanh = fmap atanh

552− acosh = fmap acosh

553−

554− (**) = liftA2 (**)

555− logBase = liftA2 logBase

556

537

557------------------------------------------------------------------------------

538------------------------------------------------------------------------------

558-- CoparallelT

539-- CoparallelT

@@ -600,16 +581,6 @@ instance (Monad m, Floating a) => Floating (CoserialT m a) where

600newtype CoparallelT m a = CoparallelT {getCoparallelT :: Stream m a}

581newtype CoparallelT m a = CoparallelT {getCoparallelT :: Stream m a}

601 deriving (Functor, MonadTrans)

582 deriving (Functor, MonadTrans)

602

583

603−deriving instance MonadParallel m => Monoid (CoparallelT m a)

604−deriving instance MonadParallel m => Alternative (CoparallelT m)

605−deriving instance MonadParallel m => MonadPlus (CoparallelT m)

606−deriving instance MonadParallel m => MonadIO (CoparallelT m)

607−deriving instance MonadParallel m => MonadThrow (CoparallelT m)

608−deriving instance (MonadBase b m, MonadParallel m) => MonadBase b (CoparallelT m)

609−deriving instance (MonadError e m, MonadParallel m) => MonadError e (CoparallelT m)

610−deriving instance (MonadReader r m, MonadParallel m) => MonadReader r (CoparallelT m)

611−deriving instance (MonadState s m, MonadParallel m) => MonadState s (CoparallelT m)

612−

613{-# DEPRECATED AsyncT "Please use 'CoparallelT' instead." #-}

584{-# DEPRECATED AsyncT "Please use 'CoparallelT' instead." #-}

614type AsyncT = CoparallelT

585type AsyncT = CoparallelT

615

586

@@ -637,6 +608,14 @@ instance MonadParallel m => Semigroup (CoparallelT m a) where

637(<|) :: (IsStream t, MonadParallel m) => t m a -> t m a -> t m a

608(<|) :: (IsStream t, MonadParallel m) => t m a -> t m a -> t m a

638(<|) = coparallel

609(<|) = coparallel

639

610

611+------------------------------------------------------------------------------

612+-- Monoid

613+------------------------------------------------------------------------------

614+

615+instance MonadParallel m => Monoid (CoparallelT m a) where

616+ mempty = nil

617+ mappend = (<>)

618+

640------------------------------------------------------------------------------

619------------------------------------------------------------------------------

641-- Monad

620-- Monad

642------------------------------------------------------------------------------

621------------------------------------------------------------------------------

@@ -662,56 +641,12 @@ instance MonadParallel m => Monad (CoparallelT m) where

662 where par = S.joinStreamVar2 (SVarStyle Conjunction LIFO)

641 where par = S.joinStreamVar2 (SVarStyle Conjunction LIFO)

663

642

664------------------------------------------------------------------------------

643------------------------------------------------------------------------------

665−-- Applicative

644+-- Other instances

666------------------------------------------------------------------------------

645------------------------------------------------------------------------------

667

646

668−instance MonadParallel m => Applicative (CoparallelT m) where

647+MONAD_APPLICATIVE_INSTANCE(CoparallelT,MONADPARALLEL)

669− pure = CoparallelT . singleton

648+MONAD_COMMON_INSTANCES(CoparallelT, MONADPARALLEL)

670− (<*>) = ap

649+NUMERIC_COMMON_INSTANCES(CoparallelT, MONADPARALLEL)

671−

672−------------------------------------------------------------------------------

673−-- Num

674−------------------------------------------------------------------------------

675−

676−instance (MonadParallel m, Num a) => Num (CoparallelT m a) where

677− fromInteger n = pure (fromInteger n)

678−

679− negate = fmap negate

680− abs = fmap abs

681− signum = fmap signum

682−

683− (+) = liftA2 (+)

684− (*) = liftA2 (*)

685− (-) = liftA2 (-)

686−

687−instance (MonadParallel m, Fractional a) => Fractional (CoparallelT m a) where

688− fromRational n = pure (fromRational n)

689−

690− recip = fmap recip

691−

692− (/) = liftA2 (/)

693−

694−instance (MonadParallel m, Floating a) => Floating (CoparallelT m a) where

695− pi = pure pi

696−

697− exp = fmap exp

698− sqrt = fmap sqrt

699− log = fmap log

700− sin = fmap sin

701− tan = fmap tan

702− cos = fmap cos

703− asin = fmap asin

704− atan = fmap atan

705− acos = fmap acos

706− sinh = fmap sinh

707− tanh = fmap tanh

708− cosh = fmap cosh

709− asinh = fmap asinh

710− atanh = fmap atanh

711− acosh = fmap acosh

712−

713− (**) = liftA2 (**)

714− logBase = liftA2 logBase

715

650

716------------------------------------------------------------------------------

651------------------------------------------------------------------------------

717-- ParallelT

652-- ParallelT

@@ -757,16 +692,6 @@ instance (MonadParallel m, Floating a) => Floating (CoparallelT m a) where

757newtype ParallelT m a = ParallelT {getParallelT :: Stream m a}

692newtype ParallelT m a = ParallelT {getParallelT :: Stream m a}

758 deriving (Functor, MonadTrans)

693 deriving (Functor, MonadTrans)

759

694

760−deriving instance MonadParallel m => Monoid (ParallelT m a)

761−deriving instance MonadParallel m => Alternative (ParallelT m)

762−deriving instance MonadParallel m => MonadPlus (ParallelT m)

763−deriving instance MonadParallel m => MonadIO (ParallelT m)

764−deriving instance MonadParallel m => MonadThrow (ParallelT m)

765−deriving instance (MonadBase b m, MonadParallel m) => MonadBase b (ParallelT m)

766−deriving instance (MonadError e m, MonadParallel m) => MonadError e (ParallelT m)

767−deriving instance (MonadReader r m, MonadParallel m) => MonadReader r (ParallelT m)

768−deriving instance (MonadState s m, MonadParallel m) => MonadState s (ParallelT m)

769−

770instance IsStream ParallelT where

695instance IsStream ParallelT where

771 toStream = getParallelT

696 toStream = getParallelT

772 fromStream = ParallelT

697 fromStream = ParallelT

@@ -784,6 +709,14 @@ parallel m1 m2 = fromStream $ S.parallel (toStream m1) (toStream m2)

784instance MonadParallel m => Semigroup (ParallelT m a) where

709instance MonadParallel m => Semigroup (ParallelT m a) where

785 (<>) = parallel

710 (<>) = parallel

786

711

712+------------------------------------------------------------------------------

713+-- Monoid

714+------------------------------------------------------------------------------

715+

716+instance MonadParallel m => Monoid (ParallelT m a) where

717+ mempty = nil

718+ mappend = (<>)

719+

787------------------------------------------------------------------------------

720------------------------------------------------------------------------------

788-- Monad

721-- Monad

789------------------------------------------------------------------------------

722------------------------------------------------------------------------------

@@ -794,56 +727,12 @@ instance MonadParallel m => Monad (ParallelT m) where

794 where par = S.joinStreamVar2 (SVarStyle Conjunction FIFO)

727 where par = S.joinStreamVar2 (SVarStyle Conjunction FIFO)

795

728

796------------------------------------------------------------------------------

729------------------------------------------------------------------------------

797−-- Applicative

730+-- Other instances

798------------------------------------------------------------------------------

731------------------------------------------------------------------------------

799

732

800−instance MonadParallel m => Applicative (ParallelT m) where

733+MONAD_APPLICATIVE_INSTANCE(ParallelT,MONADPARALLEL)

801− pure = ParallelT . singleton

734+MONAD_COMMON_INSTANCES(ParallelT, MONADPARALLEL)

802− (<*>) = ap

735+NUMERIC_COMMON_INSTANCES(ParallelT, MONADPARALLEL)

803−

804−------------------------------------------------------------------------------

805−-- Num

806−------------------------------------------------------------------------------

807−

808−instance (MonadParallel m, Num a) => Num (ParallelT m a) where

809− fromInteger n = pure (fromInteger n)

810−

811− negate = fmap negate

812− abs = fmap abs

813− signum = fmap signum

814−

815− (+) = liftA2 (+)

816− (*) = liftA2 (*)

817− (-) = liftA2 (-)

818−

819−instance (MonadParallel m, Fractional a) => Fractional (ParallelT m a) where

820− fromRational n = pure (fromRational n)

821−

822− recip = fmap recip

823−

824− (/) = liftA2 (/)

825−

826−instance (MonadParallel m, Floating a) => Floating (ParallelT m a) where

827− pi = pure pi

828−

829− exp = fmap exp

830− sqrt = fmap sqrt

831− log = fmap log

832− sin = fmap sin

833− tan = fmap tan

834− cos = fmap cos

835− asin = fmap asin

836− atan = fmap atan

837− acos = fmap acos

838− sinh = fmap sinh

839− tanh = fmap tanh

840− cosh = fmap cosh

841− asinh = fmap asinh

842− atanh = fmap atanh

843− acosh = fmap acosh

844−

845− (**) = liftA2 (**)

846− logBase = liftA2 logBase

847

736

848------------------------------------------------------------------------------

737------------------------------------------------------------------------------

849-- Serially Zipping Streams

738-- Serially Zipping Streams

@@ -886,8 +775,6 @@ newtype ZipSerial m a = ZipSerial {getZipSerial :: Stream m a}

886-- | Same as ZipSerial.

775-- | Same as ZipSerial.

887type ZipStream = ZipSerial

776type ZipStream = ZipSerial

888

777

889−deriving instance MonadParallel m => Alternative (ZipSerial m)

890−

891instance Monad m => Applicative (ZipSerial m) where

778instance Monad m => Applicative (ZipSerial m) where

892 pure = ZipSerial . S.repeat

779 pure = ZipSerial . S.repeat

893 (<*>) = zipWith id

780 (<*>) = zipWith id

@@ -896,45 +783,7 @@ instance IsStream ZipSerial where

896 toStream = getZipSerial

783 toStream = getZipSerial

897 fromStream = ZipSerial

784 fromStream = ZipSerial

898

785

899−instance (Monad m, Num a) => Num (ZipSerial m a) where

786+NUMERIC_COMMON_INSTANCES(ZipSerial,)

900− fromInteger n = pure (fromInteger n)

901−

902− negate = fmap negate

903− abs = fmap abs

904− signum = fmap signum

905−

906− (+) = liftA2 (+)

907− (*) = liftA2 (*)

908− (-) = liftA2 (-)

909−

910−instance (Monad m, Fractional a) => Fractional (ZipSerial m a) where

911− fromRational n = pure (fromRational n)

912−

913− recip = fmap recip

914−

915− (/) = liftA2 (/)

916−

917−instance (Monad m, Floating a) => Floating (ZipSerial m a) where

918− pi = pure pi

919−

920− exp = fmap exp

921− sqrt = fmap sqrt

922− log = fmap log

923− sin = fmap sin

924− tan = fmap tan

925− cos = fmap cos

926− asin = fmap asin

927− atan = fmap atan

928− acos = fmap acos

929− sinh = fmap sinh

930− tanh = fmap tanh

931− cosh = fmap cosh

932− asinh = fmap asinh

933− atanh = fmap atanh

934− acosh = fmap acosh

935−

936− (**) = liftA2 (**)

937− logBase = liftA2 logBase

938

787

939------------------------------------------------------------------------------

788------------------------------------------------------------------------------

940-- Parallely Zipping Streams

789-- Parallely Zipping Streams

@@ -976,8 +825,6 @@ newtype ZipParallel m a = ZipParallel {getZipParallel :: Stream m a}

976{-# DEPRECATED ZipAsync "Please use ZipParallel instead." #-}

825{-# DEPRECATED ZipAsync "Please use ZipParallel instead." #-}

977type ZipAsync = ZipParallel

826type ZipAsync = ZipParallel

978

827

979−deriving instance MonadParallel m => Alternative (ZipParallel m)

980−

981instance MonadParallel m => Applicative (ZipParallel m) where

828instance MonadParallel m => Applicative (ZipParallel m) where

982 pure = ZipParallel . S.repeat

829 pure = ZipParallel . S.repeat

983 (<*>) = zipParallelWith id

830 (<*>) = zipParallelWith id

@@ -986,45 +833,7 @@ instance IsStream ZipParallel where

986 toStream = getZipParallel

833 toStream = getZipParallel

987 fromStream = ZipParallel

834 fromStream = ZipParallel

988

835

989−instance (MonadParallel m, Num a) => Num (ZipParallel m a) where

836+NUMERIC_COMMON_INSTANCES(ZipParallel,MONADPARALLEL)

990− fromInteger n = pure (fromInteger n)

991−

992− negate = fmap negate

993− abs = fmap abs

994− signum = fmap signum

995−

996− (+) = liftA2 (+)

997− (*) = liftA2 (*)

998− (-) = liftA2 (-)

999−

1000−instance (MonadParallel m, Fractional a) => Fractional (ZipParallel m a) where

1001− fromRational n = pure (fromRational n)

1002−

1003− recip = fmap recip

1004−

1005− (/) = liftA2 (/)

1006−

1007−instance (MonadParallel m, Floating a) => Floating (ZipParallel m a) where

1008− pi = pure pi

1009−

1010− exp = fmap exp

1011− sqrt = fmap sqrt

1012− log = fmap log

1013− sin = fmap sin

1014− tan = fmap tan

1015− cos = fmap cos

1016− asin = fmap asin

1017− atan = fmap atan

1018− acos = fmap acos

1019− sinh = fmap sinh

1020− tanh = fmap tanh

1021− cosh = fmap cosh

1022− asinh = fmap asinh

1023− atanh = fmap atanh

1024− acosh = fmap acosh

1025−

1026− (**) = liftA2 (**)

1027− logBase = liftA2 logBase

1028

837

1029-------------------------------------------------------------------------------

838-------------------------------------------------------------------------------

1030-- Type adapting combinators

839-- Type adapting combinators

stack.yaml+2−2

@@ -25,5 +25,5 @@ flags: {}

25extra-package-dbs: []

26rebuild-ghc-options: true

27# For mac ports installed SDL library on Mac OS X

28−#extra-include-dirs:

28+extra-include-dirs:

29−#- /opt/local/include

29+- /opt/local/include

test/Main.hs+37−22

@@ -40,10 +40,10 @@ main = hspec $ do

40 describe "Empty" $ do

41 it "Monoid - mempty" $

42 (toListSerial mempty) `shouldReturn` ([] :: [Int])

43− it "Alternative - empty" $

43+ -- it "Alternative - empty" $

44− (toListSerial empty) `shouldReturn` ([] :: [Int])

44+ -- (toListSerial empty) `shouldReturn` ([] :: [Int])

45− it "MonadPlus - mzero" $

45+ -- it "MonadPlus - mzero" $

46− (toListSerial mzero) `shouldReturn` ([] :: [Int])

46+ -- (toListSerial mzero) `shouldReturn` ([] :: [Int])

48 ---------------------------------------------------------------------------

49 -- Functor

@@ -84,7 +84,26 @@ main = hspec $ do

84 `shouldReturn` ([(1,2),(1,3)] :: [(Int, Int)])

86 ---------------------------------------------------------------------------

87+ -- Semigroup/Monoidal Composition strict ordering checks

88+ ---------------------------------------------------------------------------

89+

90+ -- test both (<>) and mappend to make sure we are using correct instance

91+ -- for Monoid that is using the right version of semigroup. Instance

92+ -- deriving can cause us to pick wrong instances sometimes.

93+

94+ describe "Serial interleaved (<>) ordering check" $ interleaveCheck coserially (<>)

95+ describe "Serial interleaved mappend ordering check" $ interleaveCheck coserially mappend

96+

97+ describe "Parallel interleaved (<>) ordering check" $ interleaveCheck parallely (<>)

98+ describe "Parallel interleaved mappend ordering check" $ interleaveCheck parallely mappend

99+

100+ describe "Coparallel (<>) time order check" $ parallelCheck coparallely (<>)

101+ describe "Coparallel mappend time order check" $ parallelCheck coparallely mappend

102+ describe "Parallel (<>) time order check" $ parallelCheck parallely (<>)

103+ describe "Parallel mappend time order check" $ parallelCheck parallely mappend

104+

105+ ---------------------------------------------------------------------------

87− -- Monoidal Compositions

106+ -- Monoidal Compositions, multiset equality checks

88 ---------------------------------------------------------------------------

107 ---------------------------------------------------------------------------

108

90 describe "Serial Composition" $ compose serially mempty id

109 describe "Serial Composition" $ compose serially mempty id

@@ -94,14 +113,6 @@ main = hspec $ do

94 describe "Semigroup Composition for ZipSerial" $ compose zipSerially mempty id

113 describe "Semigroup Composition for ZipSerial" $ compose zipSerially mempty id

95 describe "Semigroup Composition for ZipAsync" $ compose zipParallely mempty id

114 describe "Semigroup Composition for ZipAsync" $ compose zipParallely mempty id

96 -- XXX need to check alternative compositions as well

115 -- XXX need to check alternative compositions as well

97− ---------------------------------------------------------------------------

98− -- Monoidal Composition ordering checks

99− ---------------------------------------------------------------------------

100−

101− describe "Serial interleaved ordering check" $ interleaveCheck coserially

102− describe "Parallel interleaved ordering check" $ interleaveCheck parallely

103− describe "Left biased parallel time order check" $ parallelCheck coparallely

104− describe "Fair parallel time order check" $ parallelCheck parallely

105

116

106 ---------------------------------------------------------------------------

117 ---------------------------------------------------------------------------

107 -- TBD Monoidal composition combinations

118 -- TBD Monoidal composition combinations

@@ -374,22 +385,26 @@ nestTwoParallelNum =

374timed :: MonadIO (t IO) => Int -> t IO Int

385timed :: MonadIO (t IO) => Int -> t IO Int

375timed x = liftIO (threadDelay (x * 100000)) >> return x

386timed x = liftIO (threadDelay (x * 100000)) >> return x

376

387

377−interleaveCheck :: (IsStream t, Semigroup (t IO Int))

388+interleaveCheck :: IsStream t

378− => (t IO Int -> SerialT IO Int) -> Spec

389+ => (t IO Int -> SerialT IO Int)

390+ -> (t IO Int -> t IO Int -> t IO Int)

391+ -> Spec

379−interleaveCheck t =

392+interleaveCheck t f =

380 it "Interleave four" $

393 it "Interleave four" $

381− (A.toList . t) ((singleton 0 <> singleton 1) <> (singleton 100 <> singleton 101))

394+ (A.toList . t) ((singleton 0 `f` singleton 1) `f` (singleton 100 `f` singleton 101))

382 `shouldReturn` ([0, 100, 1, 101])

395 `shouldReturn` ([0, 100, 1, 101])

383

396

384−parallelCheck :: (Semigroup (t IO Int), MonadIO (t IO))

397+parallelCheck :: MonadIO (t IO)

385− => (t IO Int -> SerialT IO Int) -> Spec

398+ => (t IO Int -> SerialT IO Int)

399+ -> (t IO Int -> t IO Int -> t IO Int)

400+ -> Spec

386−parallelCheck t = do

401+parallelCheck t f = do

387 it "Parallel ordering left associated" $

402 it "Parallel ordering left associated" $

388− (A.toList . t) (((event 4 <> event 3) <> event 2) <> event 1)

403+ (A.toList . t) (((event 4 `f` event 3) `f` event 2) `f` event 1)

389 `shouldReturn` ([1..4])

404 `shouldReturn` ([1..4])

390

405

391 it "Parallel ordering right associated" $

406 it "Parallel ordering right associated" $

392− (A.toList . t) (event 4 <> (event 3 <> (event 2 <> event 1)))

407+ (A.toList . t) (event 4 `f` (event 3 `f` (event 2 `f` event 1)))

393 `shouldReturn` ([1..4])

408 `shouldReturn` ([1..4])

394

409

395 where event n = (liftIO $ threadDelay (n * 100000)) >> (return n)

410 where event n = (liftIO $ threadDelay (n * 100000)) >> (return n)