on aa94fd4 help sign in
1 file changed+28
since splitsnapshots
unifiedsplit
src/Reflex/Dynamic.hs+28
src/Reflex/Dynamic.hs+28
@@ -31,6 +31,9 @@ module Reflex.Dynamic ( Dynamic -- Abstract so we can preserve the law that the
3131 , Demux
3232 , demux
3333 , getDemuxed
34+ , MultiDemux
35+ , multiDemux
36+ , getMultiDemuxed
3437 -- Things that probably aren't very useful:
3538 , HList (..)
3639 , FHList (..)
@@ -52,6 +55,8 @@ import Data.Traversable (mapM, forM)
5255import Data.Align
5356import Data.Map (Map)
5457import qualified Data.Map as Map
58+import Data.Set (Set)
59+import qualified Data.Set as Set
5560import Data.Dependent.Map (DMap)
5661import qualified Data.Dependent.Map as DMap
5762import Data.Dependent.Sum (DSum (..))
@@ -391,6 +396,29 @@ getDemuxed d k = do
391396 let b = pull $ join $ sample bb
392397 return $ Dynamic b e
393398
399+--------------------------------------------------------------------------------
400+-- MultiDemux
401+--------------------------------------------------------------------------------
402+
403+data MultiDemux t k
404+ = MultiDemux { multiDemuxValue :: Behavior t (Set k)
405+ , multiDemuxSelector :: EventSelector t (Const2 k Bool)
406+ }
407+
408+-- | Demultiplex an input value to a 'Demux' with many outputs. At any given time, whichever output is indicated by the given 'Dynamic' will be 'True'.
409+multiDemux :: (Reflex t, Ord k) => Dynamic t (Set k) -> MultiDemux t k
410+multiDemux k = MultiDemux (current k) $ fan $ attachWith (\ks0 ks1 -> DMap.union (DMap.fromList $ map (\k0 -> Const2 k0 :=> False) $ Set.toList $ ks0 `Set.difference` ks1) (DMap.fromList $ map (\k1 -> Const2 k1 :=> True) $ Set.toList $ ks1 `Set.difference` ks0)) (current k) (updated k)
411+
412+--TODO: The pattern of using hold (sample b0) can be reused in various places as a safe way of building certain kinds of Dynamics; see if we can factor this out
413+-- | Select a particular output of the 'Demux'; this is equivalent to (but much faster than)
414+-- mapping over the original 'Dynamic' and checking whether it is equal to the given key.
415+getMultiDemuxed :: (Reflex t, MonadHold t m, Ord k) => MultiDemux t k -> k -> m (Dynamic t Bool)
416+getMultiDemuxed d k = do
417+ let e = select (multiDemuxSelector d) (Const2 k)
418+ bb <- hold (liftM (k `Set.member`) $ sample $ multiDemuxValue d) $ fmap return e
419+ let b = pull $ join $ sample bb
420+ return $ Dynamic b e
421+
394422--------------------------------------------------------------------------------
395423-- collectDyn
396424--------------------------------------------------------------------------------