git.iko.soy/patch
on develop help sign in
Add factorDyn and eitherDyn
3a4cb79Ryan Trinkle
src/Reflex/Dynamic.hs+38−9
compare with develop
unifiedsplit
@@ -34,6 +34,8 @@ module Reflex.Dynamic
34 , attachPromptlyDynWith
34 , attachPromptlyDynWith
35 , attachPromptlyDynWithMaybe
35 , attachPromptlyDynWithMaybe
36 , maybeDyn
36 , maybeDyn
37+ , eitherDyn
38+ , factorDyn
37 , scanDyn
39 , scanDyn
38 , scanDynMaybe
40 , scanDynMaybe
39 , holdUniqDyn
41 , holdUniqDyn
@@ -87,6 +89,7 @@ module Reflex.Dynamic
87 , uniqDynBy
89 , uniqDynBy
88 ) where
90 ) where
89
91
92+import Data.Functor.Compose
90import Data.Functor.Misc
93import Data.Functor.Misc
91import Reflex.Class
94import Reflex.Class
92
95
@@ -282,15 +285,41 @@ attachPromptlyDynWithMaybe f d e =
282-- existing inner 'Dynamic' will become constant, and will not change when the
285-- existing inner 'Dynamic' will become constant, and will not change when the
283-- outer constructor changes back to 'Nothing'.
286-- outer constructor changes back to 'Nothing'.
284maybeDyn :: forall t a m. (Reflex t, MonadFix m, MonadHold t m) => Dynamic t (Maybe a) -> m (Dynamic t (Maybe (Dynamic t a)))
287maybeDyn :: forall t a m. (Reflex t, MonadFix m, MonadHold t m) => Dynamic t (Maybe a) -> m (Dynamic t (Maybe (Dynamic t a)))
285−maybeDyn d = do
288+maybeDyn = fmap (fmap unpack) . eitherDyn . fmap pack
286− ma <- sample $ current d
289+ where pack = \case
290+ Nothing -> Left ()
291+ Just a -> Right a
292+ unpack = \case
293+ Left _ -> Nothing
294+ Right a -> Just a
295+
296+eitherDyn :: forall t a b m. (Reflex t, MonadFix m, MonadHold t m) => Dynamic t (Either a b) -> m (Dynamic t (Either (Dynamic t a) (Dynamic t b)))
297+eitherDyn = fmap (fmap unpack) . factorDyn . fmap eitherToDSum
298+ where unpack :: DSum (EitherTag a b) (Compose (Dynamic t) Identity) -> Either (Dynamic t a) (Dynamic t b)
299+ unpack = \case
300+ LeftTag :=> Compose a -> Left $ coerceDynamic a
301+ RightTag :=> Compose b -> Right $ coerceDynamic b
302+
303+factorDyn :: forall t m k v. (Reflex t, MonadFix m, MonadHold t m, GEq k) => Dynamic t (DSum k v) -> m (Dynamic t (DSum k (Compose (Dynamic t) v)))
304+factorDyn d = do
287− let inner :: forall m'. (MonadFix m', MonadHold t m') => a -> m' (Dynamic t a)
305+ let inner :: forall m' a. (MonadFix m', MonadHold t m') => k a -> v a -> m' (Dynamic t (v a))
288− inner a = holdDyn a . fmapMaybe id =<< takeWhileE isJust (updated d)
306+ inner k v0 = holdDyn v0 . fmapMaybe id =<< takeWhileE isJust newVal
289− mInner0 :: Maybe (Dynamic t a) <- mapM inner ma
307+ where newVal = ffor (updated d) $ \(newK :=> newV) -> case newK `geq` k of
308+ Just Refl -> Just newV
309+ Nothing -> Nothing
310+ getInitial = do
311+ k0 :=> (v0 :: v a) <- sample $ current d
312+ i0 <- inner k0 v0
313+ return $ k0 :=> Compose i0
290− rec result <- holdDyn mInner0 $ flip push (updated d) $ \new -> do
314+ update = flip push (updated d) $ \(newKey :=> newVal) -> do
291− old <- sample $ current d
315+ (oldKey :=> _) <- sample $ current d
292− if isJust old == isJust new then return Nothing else Just <$> mapM inner new
316+ case newKey `geq` oldKey of
293− return result
317+ Just Refl -> return Nothing
318+ Nothing -> do
319+ newInner <- inner newKey newVal
320+ return $ Just $ newKey :=> Compose newInner
321+ o0 <- getInitial --TODO: Figure out how to get this to run inside something like the first argument to buildDynamic
322+ holdDyn o0 update
294
323
295--------------------------------------------------------------------------------
324--------------------------------------------------------------------------------
296-- Demux
325-- Demux