@@ -34,6 +34,8 @@ module Reflex.Dynamic
3434 , attachPromptlyDynWith
3535 , attachPromptlyDynWithMaybe
3636 , maybeDyn
37+ , eitherDyn
38+ , factorDyn
3739 , scanDyn
3840 , scanDynMaybe
3941 , holdUniqDyn
@@ -87,6 +89,7 @@ module Reflex.Dynamic
8789 , uniqDynBy
8890 ) where
8991
92+import Data.Functor.Compose
9093import Data.Functor.Misc
9194import Reflex.Class
9295
@@ -282,15 +285,41 @@ attachPromptlyDynWithMaybe f d e =
282285-- existing inner 'Dynamic' will become constant, and will not change when the
283286-- outer constructor changes back to 'Nothing'.
284287maybeDyn :: 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
286− ma <- sample $ current d
287− let inner :: forall m'. (MonadFix m', MonadHold t m') => a -> m' (Dynamic t a)
288− inner a = holdDyn a . fmapMaybe id =<< takeWhileE isJust (updated d)
289− mInner0 :: Maybe (Dynamic t a) <- mapM inner ma
290− rec result <- holdDyn mInner0 $ flip push (updated d) $ \new -> do
291− old <- sample $ current d
292− if isJust old == isJust new then return Nothing else Just <$> mapM inner new
293− return result
288+maybeDyn = fmap (fmap unpack) . eitherDyn . fmap pack
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
305+ let inner :: forall m' a. (MonadFix m', MonadHold t m') => k a -> v a -> m' (Dynamic t (v a))
306+ inner k v0 = holdDyn v0 . fmapMaybe id =<< takeWhileE isJust newVal
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
314+ update = flip push (updated d) $ \(newKey :=> newVal) -> do
315+ (oldKey :=> _) <- sample $ current d
316+ case newKey `geq` oldKey of
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
294323
295324--------------------------------------------------------------------------------
296325-- Demux