purescript(switcheroo): Simplified types

Signed-off-by: prescientmoon <git@moonythm.dev>

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)
 -}

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)
+  Producer
-
+    { destroy :: m Unit
-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)
+    , produce :: m (Lazy (a /\ Producer m a))
-  | Destroy c
+    }
 
 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
+constantProducer value = Producer
-  Destroy c -> pure c
+  { destroy: pure unit
-  Produce next -> pure (next value (constantProducer value))
+  , produce: pure $ Lazy.defer \_ -> value /\ (constantProducer value)
+  }
 
 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
+filterMapProducer f producer = Producer
-  Destroy c -> destroyProducer producer $> c
+  { destroy: destroyProducer producer
-  Produce next -> loop 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 (next updated  (filterMapProducer f 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
+newtype ConsumeM m i o a = ConsumeM
-  ( forall c
+  ( Producer m i -> m (a /\ Producer m o)
-     . { producer :: Producer m i
-       , continue :: Producer m o -> a -> m c
-       , terminate :: t -> m c
-       }
-    -> m c
   )
 
--- | A ConsumeM computation that has finshed running
+pull :: forall m i. Monad m => ConsumeM m i i i
-type Finished m t i = ConsumeM m t i Void Void
+pull = ConsumeM produce
 
-pull :: forall m t i. Monad m => ConsumeM m t i i i
+replace :: forall m i o. Monad m => Producer m o -> ConsumeM m i o Unit
-pull = ConsumeM \inputs -> do
+replace producer' = ConsumeM \producer -> do
-  i /\ producer' <- produce inputs.producer
+  destroyProducer producer
-  inputs.continue producer' i
+  pure (unit /\ producer')
 
-replace :: forall m t i o. Monad m => Producer m o -> ConsumeM m t i o Unit
+lift :: forall m i a. Monad m => m a -> ConsumeM m i i a
-replace producer' = ConsumeM \inputs -> do
+lift computation = ConsumeM \producer -> 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
   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 :: forall m i. Monad m => ConsumeM m i i (Producer m i)
-producer = ConsumeM \inputs -> inputs.continue inputs.producer inputs.producer
+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 :: forall m i o. Monad m => (Producer m i -> Producer m o) -> ConsumeM m i o Unit
-mapSource f = ConsumeM \inputs -> do 
+mapSource f = ConsumeM \producer -> do
-  let new = f inputs.producer
+  pure (unit /\ f producer)
-  inputs.continue new unit
 
-runConsumeM :: forall m i t. Monad m => Producer m i -> Finished m t i -> m t
+runConsumeM :: forall m i o a. Monad m => Producer m i -> ConsumeM m i o a -> m a
-runConsumeM producer (ConsumeM run) = run
+runConsumeM producer (ConsumeM run) = do
-  { producer
+  result /\ producer' <- run producer
-  , terminate: pure
+  destroyProducer producer'
-  , continue: \producer value -> absurd value -- not eta-reduced for clarity
+  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
+instance Functor m => Functor (Producer m) where
-  map f (Producer producer) = Producer case _ of
+  map f (Producer producer) = Producer
-    Destroy c -> producer (Destroy c)
+    { destroy: producer.destroy
-    Produce next -> producer $ Produce \a p -> next (f a) (map f p)
+    , produce: producer.produce <#> map (bimap f (map f))
-
-instance Monad m => IxFunctor (ConsumeM m t) where
-  imap f (ConsumeM consumer) = ConsumeM
-    \inputs -> consumer
-      { producer: inputs.producer
-      , terminate: inputs.terminate
-      , continue: \producer a -> inputs.continue producer (f a)
     }
 
-instance Monad m => IxApply (ConsumeM m t) where
+instance Functor m => IxFunctor (ConsumeM m) where
+  imap f (ConsumeM consumer) = ConsumeM
+    \producer -> consumer producer <#> first f
+
+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
+instance Monad m => Apply (ConsumeM m i i) where
-  ipure a = ConsumeM \inputs -> inputs.continue inputs.producer a
+  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
+    \producer -> do
-      consumerResult <- consumer
+      result /\ producer' <- consumer producer
-        { producer: inputs.producer
-        , terminate: \result -> pure (Left result)
-        , continue: \a b -> pure (Right (a /\ b))
-        }
-
-      case consumerResult of
-        -- Terminated
-        Left final -> inputs.terminate final
-
-        -- Kept going
-        Right (producer' /\ result) -> do
       let (ConsumeM consumer') = f result
+      consumer' producer'
 
-          consumer'
+instance Monad m => Bind (ConsumeM m i i) where
-            { producer: producer'
+  bind = ibind
-            , 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
+  alt first second = Producer
-    Produce continue -> ado
+    { destroy:
+        parSequence_
+          [ destroyProducer first
+          , destroyProducer second
+          ]
+    , produce: ado
         result <- parOneOf
           [ produce first <#> Left
           , produce second <#> Right
           ]
         in
-        case result of
+          pure case result of
-          Left (result /\ first') -> continue result (first' <|> second)
+            Left (result /\ first') -> result /\ (first' <|> second)
-          Right (result /\ second') -> continue result (first <|> second')
+            Right (result /\ second') -> result /\ (first <|> second')
-
+    }
-    Destroy continue -> ado
-      parSequence_
-        [ destroyProducer first
-        , destroyProducer second
-        ]
-      in continue
 
 instance Plus AffProducer where
-  empty = Producer \_ -> never
+  empty = Producer { destroy: pure unit, produce: never }