{-# LANGUAGE RecursiveDo #-}
module Engine.ReactiveBanana.Course
( Course(..)
, setup
, when
, unless
, whenIdle
, whenActive
, whenFinished
, isIdle
, isActive
, isFinished
) where
import RIO hiding (when, unless)
import Data.Maybe (fromJust)
import Data.These (These(..))
import Reactive.Banana qualified as RB
import Reactive.Banana.Frameworks qualified as RBF
data Course a
= Idle
| Active a
| Finished
deriving (Course a -> Course a -> Bool
(Course a -> Course a -> Bool)
-> (Course a -> Course a -> Bool) -> Eq (Course a)
forall a. Eq a => Course a -> Course a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Course a -> Course a -> Bool
$c/= :: forall a. Eq a => Course a -> Course a -> Bool
== :: Course a -> Course a -> Bool
$c== :: forall a. Eq a => Course a -> Course a -> Bool
Eq, Eq (Course a)
Eq (Course a)
-> (Course a -> Course a -> Ordering)
-> (Course a -> Course a -> Bool)
-> (Course a -> Course a -> Bool)
-> (Course a -> Course a -> Bool)
-> (Course a -> Course a -> Bool)
-> (Course a -> Course a -> Course a)
-> (Course a -> Course a -> Course a)
-> Ord (Course a)
Course a -> Course a -> Bool
Course a -> Course a -> Ordering
Course a -> Course a -> Course a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Course a)
forall a. Ord a => Course a -> Course a -> Bool
forall a. Ord a => Course a -> Course a -> Ordering
forall a. Ord a => Course a -> Course a -> Course a
min :: Course a -> Course a -> Course a
$cmin :: forall a. Ord a => Course a -> Course a -> Course a
max :: Course a -> Course a -> Course a
$cmax :: forall a. Ord a => Course a -> Course a -> Course a
>= :: Course a -> Course a -> Bool
$c>= :: forall a. Ord a => Course a -> Course a -> Bool
> :: Course a -> Course a -> Bool
$c> :: forall a. Ord a => Course a -> Course a -> Bool
<= :: Course a -> Course a -> Bool
$c<= :: forall a. Ord a => Course a -> Course a -> Bool
< :: Course a -> Course a -> Bool
$c< :: forall a. Ord a => Course a -> Course a -> Bool
compare :: Course a -> Course a -> Ordering
$ccompare :: forall a. Ord a => Course a -> Course a -> Ordering
Ord, Int -> Course a -> ShowS
[Course a] -> ShowS
Course a -> String
(Int -> Course a -> ShowS)
-> (Course a -> String) -> ([Course a] -> ShowS) -> Show (Course a)
forall a. Show a => Int -> Course a -> ShowS
forall a. Show a => [Course a] -> ShowS
forall a. Show a => Course a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Course a] -> ShowS
$cshowList :: forall a. Show a => [Course a] -> ShowS
show :: Course a -> String
$cshow :: forall a. Show a => Course a -> String
showsPrec :: Int -> Course a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Course a -> ShowS
Show, (forall a b. (a -> b) -> Course a -> Course b)
-> (forall a b. a -> Course b -> Course a) -> Functor Course
forall a b. a -> Course b -> Course a
forall a b. (a -> b) -> Course a -> Course b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Course b -> Course a
$c<$ :: forall a b. a -> Course b -> Course a
fmap :: forall a b. (a -> b) -> Course a -> Course b
$cfmap :: forall a b. (a -> b) -> Course a -> Course b
Functor)
setup
:: RB.Event a
-> RB.Event (a -> Either final a)
-> RBF.MomentIO (RB.Event a, RB.Event final, RB.Behavior (Course a))
setup :: forall a final.
Event a
-> Event (a -> Either final a)
-> MomentIO (Event a, Event final, Behavior (Course a))
setup Event a
triggerE Event (a -> Either final a)
stepE = mdo
(Event (Maybe final)
e, Behavior (Course a)
b) <- Course a
-> Event (Course a -> (Maybe final, Course a))
-> MomentIO (Event (Maybe final), Behavior (Course a))
forall (m :: * -> *) acc x.
MonadMoment m =>
acc -> Event (acc -> (x, acc)) -> m (Event x, Behavior acc)
RB.mapAccum Course a
forall a. Course a
Idle (Event (Course a -> (Maybe final, Course a))
-> MomentIO (Event (Maybe final), Behavior (Course a)))
-> Event (Course a -> (Maybe final, Course a))
-> MomentIO (Event (Maybe final), Behavior (Course a))
forall a b. (a -> b) -> a -> b
$
(These a (a -> Either final a)
-> Course a -> (Maybe final, Course a))
-> Event (These a (a -> Either final a))
-> Event (Course a -> (Maybe final, Course a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap These a (a -> Either final a)
-> Course a -> (Maybe final, Course a)
forall {a} {a} {a}.
These a (a -> Either a a) -> Course a -> (Maybe a, Course a)
dispatch (Event (These a (a -> Either final a))
-> Event (Course a -> (Maybe final, Course a)))
-> Event (These a (a -> Either final a))
-> Event (Course a -> (Maybe final, Course a))
forall a b. (a -> b) -> a -> b
$
Event a
-> Event (a -> Either final a)
-> Event (These a (a -> Either final a))
forall a b. Event a -> Event b -> Event (These a b)
RB.merge Event a
triggerE (Behavior (Course a)
-> Event (a -> Either final a) -> Event (a -> Either final a)
forall a e. Behavior (Course a) -> Event e -> Event e
whenActive Behavior (Course a)
b Event (a -> Either final a)
stepE)
(Event a
activeE, Handler a
fireActive) <- MomentIO (Event a, Handler a)
forall a. MomentIO (Event a, Handler a)
RBF.newEvent
Event (IO ()) -> MomentIO ()
RBF.reactimate (Event (IO ()) -> MomentIO ()) -> Event (IO ()) -> MomentIO ()
forall a b. (a -> b) -> a -> b
$ (Event (Maybe final)
e Event (Maybe final) -> Behavior (Course a) -> Event (Course a)
forall a b. Event a -> Behavior b -> Event b
RB.@> Behavior (Course a)
b) Event (Course a) -> (Course a -> IO ()) -> Event (IO ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Active a
a ->
Handler a
fireActive a
a
Course a
_ ->
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Event final
finishedE <- Event final -> MomentIO (Event final)
forall (m :: * -> *) a. MonadMoment m => Event a -> m (Event a)
RB.once (Event final -> MomentIO (Event final))
-> Event final -> MomentIO (Event final)
forall a b. (a -> b) -> a -> b
$
(Maybe final -> final) -> Event (Maybe final) -> Event final
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe final -> final
forall a. HasCallStack => Maybe a -> a
fromJust (Event (Maybe final) -> Event final)
-> Event (Maybe final) -> Event final
forall a b. (a -> b) -> a -> b
$ (Maybe final -> Bool) -> Event (Maybe final) -> Event (Maybe final)
forall a. (a -> Bool) -> Event a -> Event a
RB.filterE Maybe final -> Bool
forall a. Maybe a -> Bool
isJust Event (Maybe final)
e
(Event a, Event final, Behavior (Course a))
-> MomentIO (Event a, Event final, Behavior (Course a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event a
activeE, Event final
finishedE, Behavior (Course a)
b)
where
dispatch :: These a (a -> Either a a) -> Course a -> (Maybe a, Course a)
dispatch = \case
This a
initial -> \case
Course a
Idle ->
(Maybe a
forall a. Maybe a
Nothing, a -> Course a
forall a. a -> Course a
Active a
initial)
Active{} ->
String -> (Maybe a, Course a)
forall a. HasCallStack => String -> a
error String
"trigger not filtered when active"
Course a
Finished ->
String -> (Maybe a, Course a)
forall a. HasCallStack => String -> a
error String
"trigger not filtered when finished"
That a -> Either a a
step -> \case
Course a
Idle ->
String -> (Maybe a, Course a)
forall a. HasCallStack => String -> a
error String
"tick not filtered when idle"
Active a
current ->
case a -> Either a a
step a
current of
Left a
done ->
(a -> Maybe a
forall a. a -> Maybe a
Just a
done, Course a
forall a. Course a
Finished)
Right a
next ->
(Maybe a
forall a. Maybe a
Nothing, a -> Course a
forall a. a -> Course a
Active a
next)
Course a
Finished ->
String -> (Maybe a, Course a)
forall a. HasCallStack => String -> a
error String
"tick not filtered when finished"
These{} ->
String -> Course a -> (Maybe a, Course a)
forall a. HasCallStack => String -> a
error String
"tick happened on top of trigger"
when :: (Course a -> Bool) -> RB.Behavior (Course a) -> RB.Event e -> RB.Event e
when :: forall a e.
(Course a -> Bool) -> Behavior (Course a) -> Event e -> Event e
when Course a -> Bool
pred Behavior (Course a)
course =
Behavior (e -> Bool) -> Event e -> Event e
forall a. Behavior (a -> Bool) -> Event a -> Event a
RB.filterApply (Behavior (Course a)
course Behavior (Course a)
-> (Course a -> e -> Bool) -> Behavior (e -> Bool)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Bool -> e -> Bool
forall a b. a -> b -> a
const (Bool -> e -> Bool) -> (Course a -> Bool) -> Course a -> e -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Course a -> Bool
pred)
unless :: (Course a -> Bool) -> RB.Behavior (Course a) -> RB.Event e -> RB.Event e
unless :: forall a e.
(Course a -> Bool) -> Behavior (Course a) -> Event e -> Event e
unless Course a -> Bool
pred Behavior (Course a)
course =
Behavior (e -> Bool) -> Event e -> Event e
forall a. Behavior (a -> Bool) -> Event a -> Event a
RB.filterApply (Behavior (Course a)
course Behavior (Course a)
-> (Course a -> e -> Bool) -> Behavior (e -> Bool)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Bool -> e -> Bool
forall a b. a -> b -> a
const (Bool -> e -> Bool) -> (Course a -> Bool) -> Course a -> e -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (Course a -> Bool) -> Course a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Course a -> Bool
pred)
whenIdle :: RB.Behavior (Course a) -> RB.Event e -> RB.Event e
whenIdle :: forall a e. Behavior (Course a) -> Event e -> Event e
whenIdle = (Course a -> Bool) -> Behavior (Course a) -> Event e -> Event e
forall a e.
(Course a -> Bool) -> Behavior (Course a) -> Event e -> Event e
when Course a -> Bool
forall a. Course a -> Bool
isIdle
whenActive :: RB.Behavior (Course a) -> RB.Event e -> RB.Event e
whenActive :: forall a e. Behavior (Course a) -> Event e -> Event e
whenActive = (Course a -> Bool) -> Behavior (Course a) -> Event e -> Event e
forall a e.
(Course a -> Bool) -> Behavior (Course a) -> Event e -> Event e
when Course a -> Bool
forall a. Course a -> Bool
isActive
whenFinished :: RB.Behavior (Course a) -> RB.Event e -> RB.Event e
whenFinished :: forall a e. Behavior (Course a) -> Event e -> Event e
whenFinished = (Course a -> Bool) -> Behavior (Course a) -> Event e -> Event e
forall a e.
(Course a -> Bool) -> Behavior (Course a) -> Event e -> Event e
when Course a -> Bool
forall a. Course a -> Bool
isFinished
isIdle :: Course a -> Bool
isIdle :: forall a. Course a -> Bool
isIdle = \case
Course a
Idle -> Bool
True
Course a
_ -> Bool
False
isActive :: Course a -> Bool
isActive :: forall a. Course a -> Bool
isActive = \case
Active{} -> Bool
True
Course a
_ -> Bool
False
isFinished :: Course a -> Bool
isFinished :: forall a. Course a -> Bool
isFinished = \case
Course a
Finished -> Bool
True
Course a
_ -> Bool
False