{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Reflex.Bulmex.Event where
import Control.Applicative (empty)
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO)
import Data.Time.Clock (NominalDiffTime)
import Data.Witherable
import Reflex
import qualified Reflex.Dom.Builder.Class as Dom
import qualified Reflex.Dom.Widget.Basic as Dom
eventJoin :: (Reflex t, MonadHold t m) => Event t (Event t a) -> m (Event t a)
eventJoin = switchHold never
noNothing :: (Filterable f, Filterable f) => f (Maybe a) -> f a
noNothing = fmapMaybe id
holdEvent ::
(Dom.DomBuilder t m, MonadHold t m)
=> b
-> Event t a
-> (a -> m b)
-> m (Dynamic t b)
holdEvent val evt fun = Dom.widgetHold (pure val) $ fun <$> evt
holdEvent_ ::
(Dom.DomBuilder t m, MonadHold t m) => Event t a -> (a -> m b) -> m ()
holdEvent_ = fmap void . holdEvent undefined
switchTup ::
(Reflex t) => Dynamic t (Event t b, Event t c) -> (Event t b, Event t c)
switchTup tup = (switchDyn $ fst <$> tup, switchDyn $ snd <$> tup)
holdAfter ::
( PostBuild t m
, Dom.DomBuilder t m
, MonadHold t m
, PerformEvent t m
, TriggerEvent t m
, MonadIO (Performable m)
)
=> b
-> Event t a
-> (a -> Event t a -> m b)
-> m (Dynamic t b)
holdAfter val evt fun = delay 0 evt >>= holdEvent val evt . flip fun
flash ::
(Monoid c, Dom.DomBuilder t m, PerformEvent t m, MonadHold t m, TriggerEvent t m, (MonadIO (Performable m)))
=> Event t b
-> (b -> m c)
-> m (Dynamic t c)
flash = flash' 5 mempty
flash' :: (Dom.DomBuilder t m, PerformEvent t m, MonadHold t m, TriggerEvent t m, (MonadIO (Performable m)))
=> NominalDiffTime
-> c
-> Event t b
-> (b -> m c)
-> m (Dynamic t c)
flash' time defVal event monadFunc = do
delayed <- delay time event
holdEvent defVal (leftmost [pure <$> event, empty <$ delayed]) $
maybe (pure defVal) monadFunc