diff --git a/purescript/switcheroo/src/Main.purs b/purescript/switcheroo/src/Main.purs index fabbb83..c47010b 100644 --- a/purescript/switcheroo/src/Main.purs +++ b/purescript/switcheroo/src/Main.purs @@ -8,7 +8,7 @@ import Data.Identity (Identity(..)) import Effect (Effect) import Effect.Console (log) import Safe.Coerce (coerce) -import Swictheroo.Stream (Finished, Producer, constantProducer, runConsumeM_) +import Swictheroo.Stream (ConsumeM, Producer, constantProducer, runConsumeM_, unitProducer) import Swictheroo.Stream as Stream type Producers m = @@ -17,7 +17,7 @@ type Producers m = , ping :: Producer m Boolean } -program :: forall m. Monad m => Producers m -> Finished m String Unit +program :: forall m. Monad m => Producers m -> ConsumeM m Unit Unit String program producers = Ix.do Stream.replace producers.download a <- Stream.pull @@ -28,7 +28,9 @@ program producers = Ix.do Stream.replace producers.ping c <- Stream.pull - Stream.terminate $ Array.fold + Stream.replace unitProducer + + pure $ Array.fold [ "Download: " , show a , ", Report: " @@ -104,7 +106,7 @@ Note that in an actual production codebase we would receive allow mocking and to not tie ourselves to a specific monad. -} -{- One could thing about this approach is +{- One cool thing about this approach is that simple state can be kept without the need for StateT! (because we can simply pass around values) -} diff --git a/purescript/switcheroo/src/Stream.purs b/purescript/switcheroo/src/Stream.purs index 708161a..4b117a9 100644 --- a/purescript/switcheroo/src/Stream.purs +++ b/purescript/switcheroo/src/Stream.purs @@ -6,60 +6,60 @@ import Control.Alt (class Alt) import Control.Alternative (class Plus, (<|>)) import Control.Applicative.Indexed (class IxApplicative, class IxApply, class IxFunctor) import Control.Bind.Indexed (class IxBind) -import Control.Monad.Indexed (class IxMonad, iap) +import Control.Monad.Indexed (class IxMonad, iap, iapply, ibind, imap, ipure) import Control.Parallel (parOneOf, parSequence_) +import Data.Bifunctor (bimap) import Data.Either (Either(..)) +import Data.Lazy (Lazy) +import Data.Lazy as Lazy import Data.Maybe (Maybe(..)) +import Data.Profunctor.Strong (first) import Data.Tuple.Nested (type (/\), (/\)) import Effect.Aff (Aff, never) -- | A producer can: -- | - Produce values -- | - Destroy itself --- | --- | A producer does this by reacting to input events --- | in order to satisfy continuations. newtype Producer m a = - Producer (forall c. Monad m => ProducerEvent m c a -> m c) - -data ProducerEvent m c a - -- | Producers advance to a new version once they produce a value. - -- | This allows pure producers to exist. For example, a pure producer - -- | could hold an array of events, return the first one, and then create - -- | a new producer from the tail of the array - = Produce (a -> Producer m a -> c) - | Destroy c + Producer + { destroy :: m Unit + -- | Producers advance to a new version once they produce a value. + -- | This allows pure producers to exist. For example, a pure producer + -- | could hold an array of events, return the first one, and then create + -- | a new producer from the tail of the array + , produce :: m (Lazy (a /\ Producer m a)) + } produce :: forall m i. Monad m => Producer m i -> m (i /\ Producer m i) -produce (Producer producer) = producer (Produce (/\)) +produce (Producer producer) = producer.produce <#> Lazy.force destroyProducer :: forall m i. Monad m => Producer m i -> m Unit -destroyProducer (Producer producer) = producer (Destroy unit) +destroyProducer (Producer producer) = producer.destroy -constantProducer :: forall m a. Monad m => a -> Producer m a -constantProducer value = Producer case _ of - Destroy c -> pure c - Produce next -> pure (next value (constantProducer value)) +constantProducer :: forall m a. Monad m => a -> Producer m a +constantProducer value = Producer + { destroy: pure unit + , produce: pure $ Lazy.defer \_ -> value /\ (constantProducer value) + } -unitProducer :: forall m. Monad m => Producer m Unit +unitProducer :: forall m. Monad m => Producer m Unit unitProducer = constantProducer unit filterMapProducer :: forall a b m. Monad m => (a -> Maybe b) -> Producer m a -> Producer m b -filterMapProducer f producer = Producer case _ of - Destroy c -> destroyProducer producer $> c - Produce next -> loop producer - where - -- Keeps producing values until one matches the given predicate! - loop producer = do - value /\ producer' <- produce producer - case f value of - Nothing -> loop producer' - Just updated -> pure (next updated (filterMapProducer f producer')) - +filterMapProducer f producer = Producer + { destroy: destroyProducer producer + , produce: loop producer + } + where + -- Keeps producing values until one matches the given predicate! + loop producer = do + value /\ producer' <- produce producer + case f value of + Nothing -> loop producer' + Just updated -> pure $ Lazy.defer \_ -> updated /\ (filterMapProducer f producer') -- | Type parameter explanation: -- | - m = underlying monad --- | - t = type we want to end on -- | - i = what the producer present when -- | the computation *starts* needs to produce -- | - o = what the producer present when @@ -67,126 +67,101 @@ filterMapProducer f producer = Producer case _ of -- | - a = result of the computation -- | -- | This monad encapsulates the followin 3 operations: --- | - Basic continuations (we have a type we want to terminate on) -- | - Consuming values from a producer -- | - Cancelling + replacing the current producer with a different one. -newtype ConsumeM m t i o a = ConsumeM - ( forall c - . { producer :: Producer m i - , continue :: Producer m o -> a -> m c - , terminate :: t -> m c - } - -> m c +newtype ConsumeM m i o a = ConsumeM + ( Producer m i -> m (a /\ Producer m o) ) --- | A ConsumeM computation that has finshed running -type Finished m t i = ConsumeM m t i Void Void +pull :: forall m i. Monad m => ConsumeM m i i i +pull = ConsumeM produce -pull :: forall m t i. Monad m => ConsumeM m t i i i -pull = ConsumeM \inputs -> do - i /\ producer' <- produce inputs.producer - inputs.continue producer' i +replace :: forall m i o. Monad m => Producer m o -> ConsumeM m i o Unit +replace producer' = ConsumeM \producer -> do + destroyProducer producer + pure (unit /\ producer') -replace :: forall m t i o. Monad m => Producer m o -> ConsumeM m t i o Unit -replace producer' = ConsumeM \inputs -> do - destroyProducer inputs.producer - inputs.continue producer' unit - -terminate :: forall m t i. Monad m => t -> Finished m t i -terminate result = ConsumeM \inputs -> do - destroyProducer inputs.producer - inputs.terminate result - -lift :: forall m t i a. Monad m => m a -> ConsumeM m t i i a -lift computation = ConsumeM \inputs -> do +lift :: forall m i a. Monad m => m a -> ConsumeM m i i a +lift computation = ConsumeM \producer -> do result <- computation - inputs.continue inputs.producer result + pure (result /\ producer) -producer :: forall m t i. Monad m => ConsumeM m t i i (Producer m i) -producer = ConsumeM \inputs -> inputs.continue inputs.producer inputs.producer +producer :: forall m i. Monad m => ConsumeM m i i (Producer m i) +producer = ConsumeM \p -> pure (p /\ p) -mapSource :: forall m t i o. Monad m => (Producer m i -> Producer m o) -> ConsumeM m t i o Unit -mapSource f = ConsumeM \inputs -> do - let new = f inputs.producer - inputs.continue new unit +mapSource :: forall m i o. Monad m => (Producer m i -> Producer m o) -> ConsumeM m i o Unit +mapSource f = ConsumeM \producer -> do + pure (unit /\ f producer) -runConsumeM :: forall m i t. Monad m => Producer m i -> Finished m t i -> m t -runConsumeM producer (ConsumeM run) = run - { producer - , terminate: pure - , continue: \producer value -> absurd value -- not eta-reduced for clarity - } +runConsumeM :: forall m i o a. Monad m => Producer m i -> ConsumeM m i o a -> m a +runConsumeM producer (ConsumeM run) = do + result /\ producer' <- run producer + destroyProducer producer' + pure result -runConsumeM_ :: forall m t. Monad m => Finished m t Unit -> m t +runConsumeM_ :: forall m a o. Monad m => ConsumeM m Unit o a -> m a runConsumeM_ = runConsumeM unitProducer ---------- Typeclass instances -instance Monad m => Functor (Producer m) where - map f (Producer producer) = Producer case _ of - Destroy c -> producer (Destroy c) - Produce next -> producer $ Produce \a p -> next (f a) (map f p) +instance Functor m => Functor (Producer m) where + map f (Producer producer) = Producer + { destroy: producer.destroy + , produce: producer.produce <#> map (bimap f (map f)) + } -instance Monad m => IxFunctor (ConsumeM m t) where +instance Functor m => IxFunctor (ConsumeM m) where imap f (ConsumeM consumer) = ConsumeM - \inputs -> consumer - { producer: inputs.producer - , terminate: inputs.terminate - , continue: \producer a -> inputs.continue producer (f a) - } + \producer -> consumer producer <#> first f -instance Monad m => IxApply (ConsumeM m t) where +instance Functor m => Functor (ConsumeM m i i) where + map = imap + +instance Monad m => IxApply (ConsumeM m) where iapply = iap -instance Monad m => IxApplicative (ConsumeM m t) where - ipure a = ConsumeM \inputs -> inputs.continue inputs.producer a +instance Monad m => Apply (ConsumeM m i i) where + apply = iapply -instance Monad m => IxBind (ConsumeM m t) where +instance Monad m => IxApplicative (ConsumeM m) where + ipure a = ConsumeM \p -> pure (a /\ p) + +instance Monad m => Applicative (ConsumeM m i i) where + pure = ipure + +instance Monad m => IxBind (ConsumeM m) where ibind (ConsumeM consumer) f = ConsumeM - \inputs -> do - consumerResult <- consumer - { producer: inputs.producer - , terminate: \result -> pure (Left result) - , continue: \a b -> pure (Right (a /\ b)) - } + \producer -> do + result /\ producer' <- consumer producer + let (ConsumeM consumer') = f result + consumer' producer' - case consumerResult of - -- Terminated - Left final -> inputs.terminate final +instance Monad m => Bind (ConsumeM m i i) where + bind = ibind - -- Kept going - Right (producer' /\ result) -> do - let (ConsumeM consumer') = f result - - consumer' - { producer: producer' - , continue: inputs.continue - , terminate: inputs.terminate - } - -instance Monad m => IxMonad (ConsumeM m t) +instance Monad m => IxMonad (ConsumeM m) +instance Monad m => Monad (ConsumeM m i i) ---------- Merge producers type AffProducer = Producer Aff instance Alt AffProducer where - alt first second = Producer case _ of - Produce continue -> ado - result <- parOneOf - [ produce first <#> Left - , produce second <#> Right - ] - in - case result of - Left (result /\ first') -> continue result (first' <|> second) - Right (result /\ second') -> continue result (first <|> second') - - Destroy continue -> ado - parSequence_ - [ destroyProducer first - , destroyProducer second - ] - in continue + alt first second = Producer + { destroy: + parSequence_ + [ destroyProducer first + , destroyProducer second + ] + , produce: ado + result <- parOneOf + [ produce first <#> Left + , produce second <#> Right + ] + in + pure case result of + Left (result /\ first') -> result /\ (first' <|> second) + Right (result /\ second') -> result /\ (first <|> second') + } instance Plus AffProducer where - empty = Producer \_ -> never + empty = Producer { destroy: pure unit, produce: never }