@@ -31,6 +31,9 @@ module Reflex.Dynamic ( Dynamic -- Abstract so we can preserve the law that the
33 , getDemuxed
33 , getDemuxed
34 -- Things that probably aren't very useful:
37 -- Things that probably aren't very useful:
35 , HList (..)
38 , HList (..)
36 , FHList (..)
39 , FHList (..)
@@ -52,6 +55,8 @@ import Data.Traversable (mapM, forM)
52import Data.Align
55import Data.Align
53import Data.Map (Map)
56import Data.Map (Map)
54import qualified Data.Map as Map
57import qualified Data.Map as Map
59+import qualified Data.Set as Set
55import Data.Dependent.Map (DMap)
60import Data.Dependent.Map (DMap)
56import qualified Data.Dependent.Map as DMap
61import qualified Data.Dependent.Map as DMap
57import Data.Dependent.Sum (DSum (..))
62import Data.Dependent.Sum (DSum (..))
@@ -391,6 +396,29 @@ getDemuxed d k = do
391 let b = pull $ join $ sample bb
396 let b = pull $ join $ sample bb
392 return $ Dynamic b e
397 return $ Dynamic b e
399+--------------------------------------------------------------------------------
401+--------------------------------------------------------------------------------
404+ = MultiDemux { multiDemuxValue :: Behavior t (Set k)
405+ , multiDemuxSelector :: EventSelector t (Const2 k Bool)
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)
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
394--------------------------------------------------------------------------------
422--------------------------------------------------------------------------------
395-- collectDyn
423-- collectDyn
396--------------------------------------------------------------------------------
424--------------------------------------------------------------------------------