purescript(switcheroo): Simplified types
Signed-off-by: prescientmoon <git@moonythm.dev>
This commit is contained in:
Matei Adriel
parent
a1f2c01651
commit
ca3cb6ae29
SSH key fingerprint:
SHA256:WFp/cO76nbarETAoQcQXuV+0h7XJsEsOCI0UsyPIy6U
|
|
@ -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)
|
||||
-}
|
||||
|
|
|
|||
|
|
@ -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 value = Producer
|
||||
{ destroy: pure unit
|
||||
, 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
|
||||
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 }
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue