{-# LANGUAGE RecursiveDo #-}
module Reflex.Potato.Helpers
(
dsum_to_dmap
, simultaneous
, assertEvent
, assertEventWith
, fmapMaybeWarn
, fmapMaybeWarnWith
, traceEventSimple
, leftmostWarn
, leftmostAssert
, leftmostWarnWithIndex
, leftmostWarnWithEverything
, alignWarn
, alignAssert
, foldDynMergeWith
, foldDynMerge
, fanDSum
, pushAlwaysDyn
, delayEvent
, sequenceEvents
, stepEvents
, stepEventsAndCollectOutput
, stepEventsAndSequenceCollectOutput
, switchHoldPair
, switchHoldTriple
, waitForSecondAfterFirst
)
where
import Prelude (error)
import Relude hiding (error)
import Reflex
import Control.Monad.Fix
import Data.Align
import qualified Data.Dependent.Map as DM
import qualified Data.Dependent.Sum as DS
import qualified Data.GADT.Compare as DM
import Data.These
simultaneous :: (Reflex t) => Event t a -> Event t b -> Event t (a,b)
simultaneous :: forall t a b. Reflex t => Event t a -> Event t b -> Event t (a, b)
simultaneous Event t a
eva Event t b
evb = forall {k} (t :: k) a b c.
Reflex t =>
(These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
alignEventWithMaybe
(\case
These a
a b
b -> forall a. a -> Maybe a
Just (a
a,b
b)
These a b
_ -> forall a. Maybe a
Nothing)
Event t a
eva
Event t b
evb
dsum_to_dmap :: DM.GCompare k => DS.DSum k f -> DM.DMap k f
dsum_to_dmap :: forall (k :: * -> *) (f :: * -> *).
GCompare k =>
DSum k f -> DMap k f
dsum_to_dmap DSum k f
ds = forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
GCompare k2 =>
[DSum k2 f] -> DMap k2 f
DM.fromList [DSum k f
ds]
assertEvent :: (Reflex t, Show a)
=> String
-> (a -> Bool)
-> Event t a
-> Event t a
assertEvent :: forall t a.
(Reflex t, Show a) =>
String -> (a -> Bool) -> Event t a -> Event t a
assertEvent String
s a -> Bool
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> if Bool -> Bool
not (a -> Bool
p a
x) then forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
s forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show a
x else a
x)
assertEventWith :: (Reflex t)
=> (a -> String)
-> (a -> Bool)
-> Event t a
-> Event t a
assertEventWith :: forall t a.
Reflex t =>
(a -> String) -> (a -> Bool) -> Event t a -> Event t a
assertEventWith a -> String
sf a -> Bool
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> if Bool -> Bool
not (a -> Bool
p a
x) then forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ a -> String
sf a
x else a
x)
fmapMaybeWarn :: (Reflex t, Show a)
=> String
-> (a -> Bool)
-> Event t a
-> Event t a
fmapMaybeWarn :: forall t a.
(Reflex t, Show a) =>
String -> (a -> Bool) -> Event t a -> Event t a
fmapMaybeWarn String
s a -> Bool
p Event t a
ev = Event t a
r where
ev' :: Event t (Bool, a)
ev' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> (a -> Bool
p a
x, a
x)) Event t a
ev
good :: Event t a
good = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (\(Bool
a,a
x) -> if Bool
a then forall a. a -> Maybe a
Just a
x else forall a. Maybe a
Nothing) Event t (Bool, a)
ev'
bad :: Event t a
bad = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (\(Bool
a,a
x) -> if Bool -> Bool
not Bool
a then forall a. a -> Maybe a
Just a
x else forall a. Maybe a
Nothing) Event t (Bool, a)
ev'
r :: Event t a
r = forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t a
good, forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a.
(Reflex t, Show a) =>
String -> Event t a -> Event t a
traceEvent String
s Event t a
bad]
fmapMaybeWarnWith :: (Reflex t)
=> (a -> String)
-> (a -> Bool)
-> Event t a
-> Event t a
fmapMaybeWarnWith :: forall t a.
Reflex t =>
(a -> String) -> (a -> Bool) -> Event t a -> Event t a
fmapMaybeWarnWith a -> String
sf a -> Bool
p Event t a
ev = Event t a
r where
ev' :: Event t (Bool, a)
ev' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> (a -> Bool
p a
x, a
x)) Event t a
ev
good :: Event t a
good = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (\(Bool
a,a
x) -> if Bool
a then forall a. a -> Maybe a
Just a
x else forall a. Maybe a
Nothing) Event t (Bool, a)
ev'
bad :: Event t a
bad = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (\(Bool
a,a
x) -> if Bool -> Bool
not Bool
a then forall a. a -> Maybe a
Just a
x else forall a. Maybe a
Nothing) Event t (Bool, a)
ev'
r :: Event t a
r = forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t a
good, forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a.
Reflex t =>
(a -> String) -> Event t a -> Event t a
traceEventWith a -> String
sf Event t a
bad]
traceEventSimple :: (Reflex t) => String -> Event t a -> Event t a
traceEventSimple :: forall t a. Reflex t => String -> Event t a -> Event t a
traceEventSimple String
s = forall {k} (t :: k) a.
Reflex t =>
(a -> String) -> Event t a -> Event t a
traceEventWith (forall a b. a -> b -> a
const String
s)
leftmostWarn :: (Reflex t) => String -> [Event t a] -> Event t a
leftmostWarn :: forall t a. Reflex t => String -> [Event t a] -> Event t a
leftmostWarn String
label [Event t a]
evs = Event t a
r where
combine :: Event t (NonEmpty a)
combine = forall {k} (t :: k) a.
Reflex t =>
[Event t a] -> Event t (NonEmpty a)
mergeList [Event t a]
evs
nowarn :: Event t a
nowarn =
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (\NonEmpty a
x -> if forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty a
x forall a. Eq a => a -> a -> Bool
== Int
1 then forall a. a -> Maybe a
Just (forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty a
x) else forall a. Maybe a
Nothing) Event t (NonEmpty a)
combine
warn :: Event t a
warn =
forall {k} (t :: k) a.
Reflex t =>
(a -> String) -> Event t a -> Event t a
traceEventWith
(forall a b. a -> b -> a
const (String
"WARNING: multiple " forall a. Semigroup a => a -> a -> a
<> String
label forall a. Semigroup a => a -> a -> a
<> String
" events triggered"))
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (\NonEmpty a
x -> if forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty a
x forall a. Ord a => a -> a -> Bool
> Int
1 then forall a. a -> Maybe a
Just (forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty a
x) else forall a. Maybe a
Nothing)
Event t (NonEmpty a)
combine
r :: Event t a
r = forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t a
nowarn, Event t a
warn]
leftmostAssert :: (Reflex t) => String -> [Event t a] -> Event t a
leftmostAssert :: forall t a. Reflex t => String -> [Event t a] -> Event t a
leftmostAssert String
label [Event t a]
evs = Event t a
r where
combine :: Event t (NonEmpty a)
combine = forall {k} (t :: k) a.
Reflex t =>
[Event t a] -> Event t (NonEmpty a)
mergeList [Event t a]
evs
nowarn :: Event t a
nowarn =
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (\NonEmpty a
x -> if forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty a
x forall a. Eq a => a -> a -> Bool
== Int
1 then forall a. a -> Maybe a
Just (forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty a
x) else forall a. Maybe a
Nothing) Event t (NonEmpty a)
combine
warn :: Event t a
warn =
forall t a.
Reflex t =>
(a -> String) -> (a -> Bool) -> Event t a -> Event t a
assertEventWith (forall a b. a -> b -> a
const (String
"ASSERT: multiple " forall a. Semigroup a => a -> a -> a
<> String
label forall a. Semigroup a => a -> a -> a
<> String
" events triggered")) (forall a b. a -> b -> a
const Bool
False)
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (\NonEmpty a
x -> if forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty a
x forall a. Ord a => a -> a -> Bool
> Int
1 then forall a. a -> Maybe a
Just (forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty a
x) else forall a. Maybe a
Nothing)
Event t (NonEmpty a)
combine
r :: Event t a
r = forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t a
nowarn, Event t a
warn]
leftmostWarnWithIndex :: (Reflex t) => String -> [Event t a] -> Event t a
leftmostWarnWithIndex :: forall t a. Reflex t => String -> [Event t a] -> Event t a
leftmostWarnWithIndex String
label [Event t a]
evs = Event t a
r where
evsWithIndex :: [Event t (Integer, a)]
evsWithIndex = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Integer
i -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer
i,)) [Integer
0..] [Event t a]
evs
combine :: Event t (NonEmpty (Integer, a))
combine = forall {k} (t :: k) a.
Reflex t =>
[Event t a] -> Event t (NonEmpty a)
mergeList [Event t (Integer, a)]
evsWithIndex
nowarn :: Event t (Integer, a)
nowarn =
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (\NonEmpty (Integer, a)
x -> if forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (Integer, a)
x forall a. Eq a => a -> a -> Bool
== Int
1 then forall a. a -> Maybe a
Just (forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty (Integer, a)
x) else forall a. Maybe a
Nothing) Event t (NonEmpty (Integer, a))
combine
warn :: Event t (Integer, a)
warn = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (\NonEmpty (Integer, a)
x -> if forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (Integer, a)
x forall a. Ord a => a -> a -> Bool
> Int
1 then forall a. a -> Maybe a
Just (forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty (Integer, a)
x) else forall a. Maybe a
Nothing)
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a.
Reflex t =>
(a -> String) -> Event t a -> Event t a
traceEventWith (\NonEmpty (Integer, a)
xs -> String
"WARNING: multiple " forall a. Semigroup a => a -> a -> a
<> String
label forall a. Semigroup a => a -> a -> a
<> String
" events triggered: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst NonEmpty (Integer, a)
xs))
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (\NonEmpty (Integer, a)
x -> if forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (Integer, a)
x forall a. Ord a => a -> a -> Bool
> Int
1 then forall a. a -> Maybe a
Just NonEmpty (Integer, a)
x else forall a. Maybe a
Nothing)
Event t (NonEmpty (Integer, a))
combine
r :: Event t a
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t (Integer, a)
nowarn, Event t (Integer, a)
warn]
leftmostWarnWithEverything :: (Reflex t, Show a) => String -> [Event t a] -> Event t a
leftmostWarnWithEverything :: forall t a.
(Reflex t, Show a) =>
String -> [Event t a] -> Event t a
leftmostWarnWithEverything String
label [Event t a]
evs = Event t a
r where
evsWithIndex :: [Event t (Integer, a)]
evsWithIndex = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Integer
i -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer
i,)) [Integer
0..] [Event t a]
evs
combine :: Event t (NonEmpty (Integer, a))
combine = forall {k} (t :: k) a.
Reflex t =>
[Event t a] -> Event t (NonEmpty a)
mergeList [Event t (Integer, a)]
evsWithIndex
nowarn :: Event t (Integer, a)
nowarn =
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (\NonEmpty (Integer, a)
x -> if forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (Integer, a)
x forall a. Eq a => a -> a -> Bool
== Int
1 then forall a. a -> Maybe a
Just (forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty (Integer, a)
x) else forall a. Maybe a
Nothing) Event t (NonEmpty (Integer, a))
combine
warn :: Event t (Integer, a)
warn = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (\NonEmpty (Integer, a)
x -> if forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (Integer, a)
x forall a. Ord a => a -> a -> Bool
> Int
1 then forall a. a -> Maybe a
Just (forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty (Integer, a)
x) else forall a. Maybe a
Nothing)
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a.
Reflex t =>
(a -> String) -> Event t a -> Event t a
traceEventWith (\NonEmpty (Integer, a)
xs -> String
"WARNING: multiple " forall a. Semigroup a => a -> a -> a
<> String
label forall a. Semigroup a => a -> a -> a
<> String
" events triggered: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show NonEmpty (Integer, a)
xs)
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (\NonEmpty (Integer, a)
x -> if forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (Integer, a)
x forall a. Ord a => a -> a -> Bool
> Int
1 then forall a. a -> Maybe a
Just NonEmpty (Integer, a)
x else forall a. Maybe a
Nothing)
Event t (NonEmpty (Integer, a))
combine
r :: Event t a
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t (Integer, a)
nowarn, Event t (Integer, a)
warn]
alignWarn
:: (Reflex t) => String -> Event t a -> Event t b -> Event t (Either a b)
alignWarn :: forall t a b.
Reflex t =>
String -> Event t a -> Event t b -> Event t (Either a b)
alignWarn String
label Event t a
ev1 Event t b
ev2 =
forall t a. Reflex t => String -> [Event t a] -> Event t a
leftmostWarn String
label [forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t a
ev1, forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t b
ev2]
alignAssert :: (Reflex t) => String -> Event t a -> Event t b -> Event t (Either a b)
alignAssert :: forall t a b.
Reflex t =>
String -> Event t a -> Event t b -> Event t (Either a b)
alignAssert String
label = forall {k} (t :: k) a b c.
Reflex t =>
(These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
alignEventWithMaybe These a b -> Maybe (Either a b)
alignfn where
alignfn :: These a b -> Maybe (Either a b)
alignfn (This a
a) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left a
a
alignfn (That b
b) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right b
b
alignfn These a b
_ = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"both events fired when aligning " forall a. Semigroup a => a -> a -> a
<> String
label
foldDynMergeWith
:: (Reflex t, MonadHold t m, MonadFix m)
=> b
-> [Event t (b -> b)]
-> m (Dynamic t b)
foldDynMergeWith :: forall t (m :: * -> *) b.
(Reflex t, MonadHold t m, MonadFix m) =>
b -> [Event t (b -> b)] -> m (Dynamic t b)
foldDynMergeWith b
acc = forall {k} (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn forall a b. (a -> b) -> a -> b
($) b
acc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k) a.
Reflex t =>
(a -> a -> a) -> [Event t a] -> Event t a
mergeWith forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
foldDynMerge
:: (Reflex t, MonadHold t m, MonadFix m)
=> (a -> b -> b)
-> b
-> [Event t a]
-> m (Dynamic t b)
foldDynMerge :: forall t (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> [Event t a] -> m (Dynamic t b)
foldDynMerge a -> b -> b
f b
acc [Event t a]
evs = forall t (m :: * -> *) b.
(Reflex t, MonadHold t m, MonadFix m) =>
b -> [Event t (b -> b)] -> m (Dynamic t b)
foldDynMergeWith b
acc (a -> b -> b
f forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> [Event t a]
evs)
fanDSum
:: forall t k
. (Reflex t, DM.GCompare k)
=> Event t (DS.DSum k Identity)
-> EventSelector t k
fanDSum :: forall t (k :: * -> *).
(Reflex t, GCompare k) =>
Event t (DSum k Identity) -> EventSelector t k
fanDSum Event t (DSum k Identity)
ds = forall {k1} (t :: k1) (k2 :: * -> *).
(Reflex t, GCompare k2) =>
Event t (DMap k2 Identity) -> EventSelector t k2
fan forall a b. (a -> b) -> a -> b
$ forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
GEq k2 =>
[DSum k2 f] -> DMap k2 f
DM.fromAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
: []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t (DSum k Identity)
ds
pushAlwaysDyn
:: (Reflex t, MonadHold t m, MonadFix m)
=> (a -> PushM t b)
-> Dynamic t a
-> m (Dynamic t b)
pushAlwaysDyn :: forall t (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> PushM t b) -> Dynamic t a -> m (Dynamic t b)
pushAlwaysDyn a -> PushM t b
f Dynamic t a
da = do
a
da0 <- forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current forall a b. (a -> b) -> a -> b
$ Dynamic t a
da
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
PushM t a -> Event t a -> m (Dynamic t a)
buildDynamic (a -> PushM t b
f a
da0) forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a b.
Reflex t =>
(a -> PushM t b) -> Event t a -> Event t b
pushAlways a -> PushM t b
f (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t a
da)
selectNext :: [a] -> Maybe a
selectNext :: forall a. [a] -> Maybe a
selectNext [] = forall a. Maybe a
Nothing
selectNext (a
x : [a]
_) = forall a. a -> Maybe a
Just a
x
selectRest :: [a] -> Maybe [a]
selectRest :: forall a. [a] -> Maybe [a]
selectRest [] = forall a. Maybe a
Nothing
selectRest (a
_ : []) = forall a. Maybe a
Nothing
selectRest (a
_ : [a]
xs) = forall a. a -> Maybe a
Just [a]
xs
delayEvent
:: forall t m a
. (Adjustable t m)
=> Event t a
-> m (Event t a)
delayEvent :: forall t (m :: * -> *) a.
Adjustable t m =>
Event t a -> m (Event t a)
delayEvent Event t a
ev = do
(()
_, Event t a
evDelayed) <- forall t (m :: * -> *) a b.
Adjustable t m =>
m a -> Event t (m b) -> m (a, Event t b)
runWithReplace (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => a -> m a
return Event t a
ev)
forall (m :: * -> *) a. Monad m => a -> m a
return Event t a
evDelayed
sequenceEvents
:: forall t m a b
. (Adjustable t m, MonadFix m)
=> Event t a
-> Event t b
-> m (Event t b)
sequenceEvents :: forall t (m :: * -> *) a b.
(Adjustable t m, MonadFix m) =>
Event t a -> Event t b -> m (Event t b)
sequenceEvents Event t a
ev1 Event t b
ev2 = mdo
let makeEv2Delayed :: m (Event t b)
makeEv2Delayed :: m (Event t b)
makeEv2Delayed = do
let
fmapfn :: These a a -> Maybe a
fmapfn = \case
These a
_ a
v2 -> forall a. a -> Maybe a
Just a
v2
These a a
_ -> forall a. Maybe a
Nothing
delayed :: Event t b
delayed = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe forall {a} {a}. These a a -> Maybe a
fmapfn Event t (These a b)
redo
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t b
delayed, forall {k} (t :: k) a b.
Reflex t =>
Event t a -> Event t b -> Event t a
difference Event t b
ev2 Event t a
ev1]
(Event t b
ev2Delayed, Event t (These a b)
redo) <- forall t (m :: * -> *) a b.
Adjustable t m =>
m a -> Event t (m b) -> m (a, Event t b)
runWithReplace
m (Event t b)
makeEv2Delayed
(forall {k} (t :: k) a b c.
Reflex t =>
(These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
alignEventWithMaybe (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return) Event t a
ev1 Event t b
ev2)
forall (m :: * -> *) a. Monad m => a -> m a
return Event t b
ev2Delayed
stepEvents
:: forall t m a
. (Adjustable t m, MonadFix m)
=> Event t [a]
-> m (Event t a)
stepEvents :: forall t (m :: * -> *) a.
(Adjustable t m, MonadFix m) =>
Event t [a] -> m (Event t a)
stepEvents Event t [a]
evin = mdo
let
evin' :: Event t [a]
evin' :: Event t [a]
evin' = forall {k} (t :: k) a.
Reflex t =>
(a -> a -> a) -> [Event t a] -> Event t a
mergeWith (\[a]
rev' [a]
ev' -> [a]
rev' forall a. Semigroup a => a -> a -> a
<> [a]
ev') [Event t [a]
rev, Event t [a]
evin]
next :: Event t a
next = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe forall a. [a] -> Maybe a
selectNext Event t [a]
evin'
rest :: Event t [a]
rest = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe forall a. [a] -> Maybe [a]
selectRest Event t [a]
evin'
(()
_, Event t [a]
rev) <- forall t (m :: * -> *) a b.
Adjustable t m =>
m a -> Event t (m b) -> m (a, Event t b)
runWithReplace (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall (m :: * -> *) a. Monad m => a -> m a
return forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t [a]
rest)
forall (m :: * -> *) a. Monad m => a -> m a
return Event t a
next
stepEventsAndCollectOutput
:: forall t m a b
. (Adjustable t m, MonadHold t m, MonadFix m)
=> Event t [a]
-> Event t b
-> m (Event t a, Event t [b])
stepEventsAndCollectOutput :: forall t (m :: * -> *) a b.
(Adjustable t m, MonadHold t m, MonadFix m) =>
Event t [a] -> Event t b -> m (Event t a, Event t [b])
stepEventsAndCollectOutput Event t [a]
evin Event t b
collectEv = mdo
let
evin' :: Event t [a]
evin' :: Event t [a]
evin' = forall {k} (t :: k) a.
Reflex t =>
(a -> a -> a) -> [Event t a] -> Event t a
mergeWith (\[a]
rev' [a]
ev' -> [a]
rev' forall a. Semigroup a => a -> a -> a
<> [a]
ev') [Event t [a]
rev, Event t [a]
evin]
next :: Event t a
next = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe forall a. [a] -> Maybe a
selectNext Event t [a]
evin'
rest :: Event t [a]
rest = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe forall a. [a] -> Maybe [a]
selectRest Event t [a]
evin'
stop :: Event t ()
stop = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe
(\[a]
x -> if forall a. Maybe a -> Bool
isNothing (forall a. [a] -> Maybe [a]
selectRest [a]
x) then forall a. a -> Maybe a
Just () else forall a. Maybe a
Nothing)
Event t [a]
evin'
collected :: Event t [b]
collected = forall {k} (t :: k) a b.
Reflex t =>
Dynamic t a -> Event t b -> Event t a
tagPromptlyDyn (forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t [b]
collector) Event t ()
stop
foldfn :: These Bool b -> [b] -> [b]
foldfn :: These Bool b -> [b] -> [b]
foldfn (This Bool
True ) [b]
_ = []
foldfn (That b
b ) [b]
bs = b
b forall a. a -> [a] -> [a]
: [b]
bs
foldfn (These Bool
True b
b) [b]
_ = [b
b]
foldfn (These Bool
False b
b) [b]
bs = b
b forall a. a -> [a] -> [a]
: [b]
bs
foldfn These Bool b
_ [b]
bs = [b]
bs
Dynamic t [b]
collector <- forall {k} (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn
These Bool b -> [b] -> [b]
foldfn
[]
(forall {k} (t :: k) a b c.
Reflex t =>
(These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
alignEventWithMaybe forall a. a -> Maybe a
Just (forall {k} (t :: k) b a.
Reflex t =>
Behavior t b -> Event t a -> Event t b
tag (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t Bool
resetState) Event t [a]
evin') Event t b
collectEv)
Dynamic t Bool
resetState <- forall {k} (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn
forall a b. a -> b -> a
const
Bool
True
(forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [forall a b. a -> b -> a
const Bool
True forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t ()
stop, forall a b. a -> b -> a
const Bool
False forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t [a]
evin'])
(()
_, Event t [a]
rev) <- forall t (m :: * -> *) a b.
Adjustable t m =>
m a -> Event t (m b) -> m (a, Event t b)
runWithReplace (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall (m :: * -> *) a. Monad m => a -> m a
return forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t [a]
rest)
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t a
next, Event t [b]
collected)
stepEventsAndSequenceCollectOutput
:: forall t m a b
. (Adjustable t m, MonadHold t m, MonadFix m)
=> Event t [a]
-> Event t b
-> m (Event t a, Event t [b])
stepEventsAndSequenceCollectOutput :: forall t (m :: * -> *) a b.
(Adjustable t m, MonadHold t m, MonadFix m) =>
Event t [a] -> Event t b -> m (Event t a, Event t [b])
stepEventsAndSequenceCollectOutput Event t [a]
evin Event t b
collectEv = mdo
let
evin' :: Event t [a]
evin' :: Event t [a]
evin' = forall {k} (t :: k) a.
Reflex t =>
(a -> a -> a) -> [Event t a] -> Event t a
mergeWith (\[a]
rev' [a]
ev' -> [a]
rev' forall a. Semigroup a => a -> a -> a
<> [a]
ev') [Event t [a]
rev, Event t [a]
evin]
next :: Event t a
next = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe forall a. [a] -> Maybe a
selectNext Event t [a]
evin'
rest :: Event t [a]
rest = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe forall a. [a] -> Maybe [a]
selectRest Event t [a]
evin'
stop :: Event t ()
stop = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe
(\[a]
x -> if forall a. Maybe a -> Bool
isNothing (forall a. [a] -> Maybe [a]
selectRest [a]
x) then forall a. a -> Maybe a
Just () else forall a. Maybe a
Nothing)
Event t [a]
evin'
collected :: Event t [b]
collected = forall {k} (t :: k) b a.
Reflex t =>
Behavior t b -> Event t a -> Event t b
tag (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current (forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t [b]
collector)) Event t ()
stop
foldfn :: These Bool b -> [b] -> [b]
foldfn :: These Bool b -> [b] -> [b]
foldfn (This Bool
True ) [b]
_ = []
foldfn (That b
b ) [b]
bs = b
b forall a. a -> [a] -> [a]
: [b]
bs
foldfn (These Bool
True b
b) [b]
_ = [b
b]
foldfn (These Bool
False b
b) [b]
bs = b
b forall a. a -> [a] -> [a]
: [b]
bs
foldfn These Bool b
_ [b]
bs = [b]
bs
Dynamic t [b]
collector <- forall {k} (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn
These Bool b -> [b] -> [b]
foldfn
[]
(forall {k} (t :: k) a b c.
Reflex t =>
(These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
alignEventWithMaybe forall a. a -> Maybe a
Just (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t Bool
resetState) Event t b
collectEv)
Dynamic t Bool
resetState <- forall {k} (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn
forall a b. a -> b -> a
const
Bool
True
(forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [forall a b. a -> b -> a
const Bool
True forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t ()
stop, forall a b. a -> b -> a
const Bool
False forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t [a]
evin'])
(()
_, Event t [a]
rev) <- forall t (m :: * -> *) a b.
Adjustable t m =>
m a -> Event t (m b) -> m (a, Event t b)
runWithReplace (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall (m :: * -> *) a. Monad m => a -> m a
return forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t [a]
rest)
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t a
next, Event t [b]
collected)
switchHoldPair :: (Reflex t, MonadHold t m) => Event t a -> Event t b -> Event t (Event t a, Event t b) -> m (Event t a, Event t b)
switchHoldPair :: forall t (m :: * -> *) a b.
(Reflex t, MonadHold t m) =>
Event t a
-> Event t b
-> Event t (Event t a, Event t b)
-> m (Event t a, Event t b)
switchHoldPair Event t a
eva Event t b
evb Event t (Event t a, Event t b)
evin = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (t :: k) a b.
Reflex t =>
Event t (These a b) -> (Event t a, Event t b)
fanThese forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m) =>
Event t a -> Event t (Event t a) -> m (Event t a)
switchHold (forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align Event t a
eva Event t b
evb) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align) Event t (Event t a, Event t b)
evin
switchHoldTriple :: forall t m a b c. (Reflex t, MonadHold t m) => Event t a -> Event t b -> Event t c -> Event t (Event t a, Event t b, Event t c) -> m (Event t a, Event t b, Event t c)
switchHoldTriple :: forall t (m :: * -> *) a b c.
(Reflex t, MonadHold t m) =>
Event t a
-> Event t b
-> Event t c
-> Event t (Event t a, Event t b, Event t c)
-> m (Event t a, Event t b, Event t c)
switchHoldTriple Event t a
eva Event t b
evb Event t c
evc Event t (Event t a, Event t b, Event t c)
evin = m (Event t a, Event t b, Event t c)
r where
evinAligned :: Event t (Event t (These a (These b c)))
evinAligned :: Event t (Event t (These a (These b c)))
evinAligned = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Event t a
eva', Event t b
evb', Event t c
evc') -> forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align Event t a
eva' (forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align Event t b
evb' Event t c
evc')) Event t (Event t a, Event t b, Event t c)
evin
evabc :: Event t (These a (These b c))
evabc = forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align Event t a
eva (forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align Event t b
evb Event t c
evc)
switched :: m (Event t (These a (These b c)))
switched :: m (Event t (These a (These b c)))
switched = forall {k} (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m) =>
Event t a -> Event t (Event t a) -> m (Event t a)
switchHold Event t (These a (These b c))
evabc Event t (Event t (These a (These b c)))
evinAligned
fanned1 :: m (Event t a, Event t (These b c))
fanned1 :: m (Event t a, Event t (These b c))
fanned1 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (t :: k) a b.
Reflex t =>
Event t (These a b) -> (Event t a, Event t b)
fanThese m (Event t (These a (These b c)))
switched
fanned2 :: m (Event t a, (Event t b, Event t c))
fanned2 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Event t a
a,Event t (These b c)
bc) -> (Event t a
a, forall {k} (t :: k) a b.
Reflex t =>
Event t (These a b) -> (Event t a, Event t b)
fanThese Event t (These b c)
bc)) m (Event t a, Event t (These b c))
fanned1
r :: m (Event t a, Event t b, Event t c)
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Event t a
a, (Event t b
b,Event t c
c)) -> (Event t a
a,Event t b
b,Event t c
c)) m (Event t a, (Event t b, Event t c))
fanned2
waitForSecondAfterFirst :: (Reflex t, MonadFix m, MonadHold t m) => Event t a -> Event t b -> m (Event t (a, b))
waitForSecondAfterFirst :: forall t (m :: * -> *) a b.
(Reflex t, MonadFix m, MonadHold t m) =>
Event t a -> Event t b -> m (Event t (a, b))
waitForSecondAfterFirst Event t a
eva Event t b
evb = mdo
Dynamic t (Maybe a)
aDyn <- forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t (a, b)
evabsimul forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Maybe a
Nothing, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just Event t a
eva, Event t b
evb forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Maybe a
Nothing]
let
evabsimul :: Event t (a, b)
evabsimul = forall t a b. Reflex t => Event t a -> Event t b -> Event t (a, b)
simultaneous Event t a
eva Event t b
evb
evbaftera :: Event t (a, b)
evbaftera = forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (\(Maybe a
ma,b
b) -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,b
b)) Maybe a
ma) (forall {k} (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach (forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Maybe a)
aDyn) Event t b
evb)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t (a, b)
evabsimul, Event t (a, b)
evbaftera]