{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
#ifdef USE_REFLEX_OPTIMIZER
{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
#endif
-- |
-- Module:
--   Reflex.Collection
module Reflex.Collection
  (
  -- * Widgets on Collections
    listHoldWithKey
  , listWithKey
  , listWithKeyShallowDiff
  , listViewWithKey
  , selectViewListWithKey
  , selectViewListWithKey_
  -- * List Utils
  , list
  , simpleList
  ) where

#ifdef MIN_VERSION_semialign
import Prelude hiding (zip, zipWith)
#if MIN_VERSION_semialign(1,1,0)
import Data.Zip (Zip (..))
#endif
#endif

import Control.Monad.Identity
import Data.Align
import Data.Functor.Misc
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Map.Misc
import Data.These

import Reflex.Class
import Reflex.Adjustable.Class
import Reflex.Dynamic
import Reflex.PostBuild.Class

-- | Create a set of widgets based on the provided 'Map'. When the
-- input 'Event' fires, remove widgets for keys with the value 'Nothing'
-- and add/replace widgets for keys with 'Just' values.
listHoldWithKey
  :: forall t m k v a
   . (Ord k, Adjustable t m, MonadHold t m)
  => Map k v
  -> Event t (Map k (Maybe v))
  -> (k -> v -> m a)
  -> m (Dynamic t (Map k a))
listHoldWithKey :: Map k v
-> Event t (Map k (Maybe v))
-> (k -> v -> m a)
-> m (Dynamic t (Map k a))
listHoldWithKey m0 :: Map k v
m0 m' :: Event t (Map k (Maybe v))
m' f :: k -> v -> m a
f = do
  let dm0 :: DMap (Const2 k a) m
dm0 = Map k (m a) -> DMap (Const2 k a) m
forall k1 k2 (f :: k1 -> *) (v :: k1).
Map k2 (f v) -> DMap (Const2 k2 v) f
mapWithFunctorToDMap (Map k (m a) -> DMap (Const2 k a) m)
-> Map k (m a) -> DMap (Const2 k a) m
forall a b. (a -> b) -> a -> b
$ (k -> v -> m a) -> Map k v -> Map k (m a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey k -> v -> m a
f Map k v
m0
      dm' :: Event t (PatchDMap (Const2 k a) m)
dm' = (Map k (Maybe v) -> PatchDMap (Const2 k a) m)
-> Event t (Map k (Maybe v)) -> Event t (PatchDMap (Const2 k a) m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        (DMap (Const2 k a) (ComposeMaybe m) -> PatchDMap (Const2 k a) m
forall k (k1 :: k -> *) (v :: k -> *).
DMap k1 (ComposeMaybe v) -> PatchDMap k1 v
PatchDMap (DMap (Const2 k a) (ComposeMaybe m) -> PatchDMap (Const2 k a) m)
-> (Map k (Maybe v) -> DMap (Const2 k a) (ComposeMaybe m))
-> Map k (Maybe v)
-> PatchDMap (Const2 k a) m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (ComposeMaybe m a) -> DMap (Const2 k a) (ComposeMaybe m)
forall k1 k2 (f :: k1 -> *) (v :: k1).
Map k2 (f v) -> DMap (Const2 k2 v) f
mapWithFunctorToDMap (Map k (ComposeMaybe m a) -> DMap (Const2 k a) (ComposeMaybe m))
-> (Map k (Maybe v) -> Map k (ComposeMaybe m a))
-> Map k (Maybe v)
-> DMap (Const2 k a) (ComposeMaybe m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> Maybe v -> ComposeMaybe m a)
-> Map k (Maybe v) -> Map k (ComposeMaybe m a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey
          (\k :: k
k v :: Maybe v
v -> Maybe (m a) -> ComposeMaybe m a
forall k (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe (Maybe (m a) -> ComposeMaybe m a)
-> Maybe (m a) -> ComposeMaybe m a
forall a b. (a -> b) -> a -> b
$ (v -> m a) -> Maybe v -> Maybe (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k -> v -> m a
f k
k) Maybe v
v)
        )
        Event t (Map k (Maybe v))
m'
  (a0 :: DMap (Const2 k a) Identity
a0, a' :: Event t (PatchDMap (Const2 k a) Identity)
a') <- DMap (Const2 k a) m
-> Event t (PatchDMap (Const2 k a) m)
-> m (DMap (Const2 k a) Identity,
      Event t (PatchDMap (Const2 k a) Identity))
forall (k :: * -> *) t (m :: * -> *).
(GCompare k, Adjustable t m) =>
DMap k m
-> Event t (PatchDMap k m)
-> m (DMap k Identity, Event t (PatchDMap k Identity))
sequenceDMapWithAdjust DMap (Const2 k a) m
dm0 Event t (PatchDMap (Const2 k a) m)
dm'

  --TODO: Move the dmapToMap to the righthand side so it doesn't get
  --fully redone every time
  (DMap (Const2 k a) Identity -> Map k a)
-> Dynamic t (DMap (Const2 k a) Identity) -> Dynamic t (Map k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DMap (Const2 k a) Identity -> Map k a
forall k v. DMap (Const2 k v) Identity -> Map k v
dmapToMap (Dynamic t (DMap (Const2 k a) Identity) -> Dynamic t (Map k a))
-> (Incremental t (PatchDMap (Const2 k a) Identity)
    -> Dynamic t (DMap (Const2 k a) Identity))
-> Incremental t (PatchDMap (Const2 k a) Identity)
-> Dynamic t (Map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Incremental t (PatchDMap (Const2 k a) Identity)
-> Dynamic t (DMap (Const2 k a) Identity)
forall k (t :: k) p.
(Reflex t, Patch p) =>
Incremental t p -> Dynamic t (PatchTarget p)
incrementalToDynamic (Incremental t (PatchDMap (Const2 k a) Identity)
 -> Dynamic t (Map k a))
-> m (Incremental t (PatchDMap (Const2 k a) Identity))
-> m (Dynamic t (Map k a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PatchTarget (PatchDMap (Const2 k a) Identity)
-> Event t (PatchDMap (Const2 k a) Identity)
-> m (Incremental t (PatchDMap (Const2 k a) Identity))
forall k (t :: k) (m :: * -> *) p.
(MonadHold t m, Patch p) =>
PatchTarget p -> Event t p -> m (Incremental t p)
holdIncremental DMap (Const2 k a) Identity
PatchTarget (PatchDMap (Const2 k a) Identity)
a0 Event t (PatchDMap (Const2 k a) Identity)
a'

--TODO: Something better than Dynamic t (Map k v) - we want something
--where the Events carry diffs, not the whole value
listWithKey
  :: forall t k v m a
   . (Ord k, Adjustable t m, PostBuild t m, MonadFix m, MonadHold t m)
  => Dynamic t (Map k v)
  -> (k -> Dynamic t v -> m a)
  -> m (Dynamic t (Map k a))
listWithKey :: Dynamic t (Map k v)
-> (k -> Dynamic t v -> m a) -> m (Dynamic t (Map k a))
listWithKey vals :: Dynamic t (Map k v)
vals mkChild :: k -> Dynamic t v -> m a
mkChild = do
  Event t ()
postBuild <- m (Event t ())
forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild
  let childValChangedSelector :: EventSelector t (Const2 k v)
childValChangedSelector = Event t (Map k v) -> EventSelector t (Const2 k v)
forall k1 (t :: k1) k2 a.
(Reflex t, Ord k2) =>
Event t (Map k2 a) -> EventSelector t (Const2 k2 a)
fanMap (Event t (Map k v) -> EventSelector t (Const2 k v))
-> Event t (Map k v) -> EventSelector t (Const2 k v)
forall a b. (a -> b) -> a -> b
$ Dynamic t (Map k v) -> Event t (Map k v)
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Map k v)
vals

      -- We keep track of changes to children values in the mkChild
      -- function we pass to listHoldWithKey The other changes we need
      -- to keep track of are child insertions and
      -- deletions. diffOnlyKeyChanges keeps track of insertions and
      -- deletions but ignores value changes, since they're already
      -- accounted for.
      diffOnlyKeyChanges :: Map k a -> Map k a -> Map k (Maybe a)
diffOnlyKeyChanges olds :: Map k a
olds news :: Map k a
news =
        ((These a a -> Maybe (Maybe a))
 -> Map k (These a a) -> Map k (Maybe a))
-> Map k (These a a)
-> (These a a -> Maybe (Maybe a))
-> Map k (Maybe a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (These a a -> Maybe (Maybe a))
-> Map k (These a a) -> Map k (Maybe a)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (Map k a -> Map k a -> Map k (These a a)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align Map k a
olds Map k a
news) ((These a a -> Maybe (Maybe a)) -> Map k (Maybe a))
-> (These a a -> Maybe (Maybe a)) -> Map k (Maybe a)
forall a b. (a -> b) -> a -> b
$ \case
          This _    -> Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing
          These _ _ -> Maybe (Maybe a)
forall a. Maybe a
Nothing
          That new :: a
new  -> Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just (Maybe a -> Maybe (Maybe a)) -> Maybe a -> Maybe (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
new
  rec Dynamic t (Map k v)
sentVals :: Dynamic t (Map k v) <- (Map k (Maybe v) -> Map k v -> Map k v)
-> Map k v -> Event t (Map k (Maybe v)) -> m (Dynamic t (Map k v))
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn Map k (Maybe v) -> Map k v -> Map k v
forall k v. Ord k => Map k (Maybe v) -> Map k v -> Map k v
applyMap Map k v
forall k a. Map k a
Map.empty Event t (Map k (Maybe v))
changeVals
      let changeVals :: Event t (Map k (Maybe v))
          changeVals :: Event t (Map k (Maybe v))
changeVals =
            (Map k v -> Map k v -> Map k (Maybe v))
-> Behavior t (Map k v)
-> Event t (Map k v)
-> Event t (Map k (Maybe v))
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Behavior t a -> Event t b -> Event t c
attachWith Map k v -> Map k v -> Map k (Maybe v)
forall k a a. Ord k => Map k a -> Map k a -> Map k (Maybe a)
diffOnlyKeyChanges (Dynamic t (Map k v) -> Behavior t (Map k v)
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Map k v)
sentVals) (Event t (Map k v) -> Event t (Map k (Maybe v)))
-> Event t (Map k v) -> Event t (Map k (Maybe v))
forall a b. (a -> b) -> a -> b
$ [Event t (Map k v)] -> Event t (Map k v)
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
              [ Dynamic t (Map k v) -> Event t (Map k v)
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Map k v)
vals

              -- TODO: This should probably be added to the
              -- attachWith, not to the updated; if we were using
              -- diffMap instead of diffMapNoEq, I think it might not
              -- work
              , Behavior t (Map k v) -> Event t () -> Event t (Map k v)
forall k (t :: k) b a.
Reflex t =>
Behavior t b -> Event t a -> Event t b
tag (Dynamic t (Map k v) -> Behavior t (Map k v)
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Map k v)
vals) Event t ()
postBuild
              ]
  Map k v
-> Event t (Map k (Maybe v))
-> (k -> v -> m a)
-> m (Dynamic t (Map k a))
forall t (m :: * -> *) k v a.
(Ord k, Adjustable t m, MonadHold t m) =>
Map k v
-> Event t (Map k (Maybe v))
-> (k -> v -> m a)
-> m (Dynamic t (Map k a))
listHoldWithKey Map k v
forall k a. Map k a
Map.empty Event t (Map k (Maybe v))
changeVals ((k -> v -> m a) -> m (Dynamic t (Map k a)))
-> (k -> v -> m a) -> m (Dynamic t (Map k a))
forall a b. (a -> b) -> a -> b
$ \k :: k
k v :: v
v ->
    k -> Dynamic t v -> m a
mkChild k
k (Dynamic t v -> m a) -> m (Dynamic t v) -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< v -> Event t v -> m (Dynamic t v)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn v
v (EventSelector t (Const2 k v) -> forall a. Const2 k v a -> Event t a
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
select EventSelector t (Const2 k v)
childValChangedSelector (Const2 k v v -> Event t v) -> Const2 k v v -> Event t v
forall a b. (a -> b) -> a -> b
$ k -> Const2 k v v
forall x a (b :: x). a -> Const2 a b b
Const2 k
k)

-- | Display the given map of items (in key order) using the builder
-- function provided, and update it with the given event.  'Nothing'
-- update entries will delete the corresponding children, and 'Just'
-- entries will create them if they do not exist or send an update
-- event to them if they do.
listWithKeyShallowDiff
  :: (Ord k, Adjustable t m, MonadFix m, MonadHold t m)
  => Map k v
  -> Event t (Map k (Maybe v))
  -> (k -> v -> Event t v -> m a)
  -> m (Dynamic t (Map k a))
listWithKeyShallowDiff :: Map k v
-> Event t (Map k (Maybe v))
-> (k -> v -> Event t v -> m a)
-> m (Dynamic t (Map k a))
listWithKeyShallowDiff initialVals :: Map k v
initialVals valsChanged :: Event t (Map k (Maybe v))
valsChanged mkChild :: k -> v -> Event t v -> m a
mkChild = do
  let childValChangedSelector :: EventSelector t (Const2 k v)
childValChangedSelector = Event t (Map k v) -> EventSelector t (Const2 k v)
forall k1 (t :: k1) k2 a.
(Reflex t, Ord k2) =>
Event t (Map k2 a) -> EventSelector t (Const2 k2 a)
fanMap (Event t (Map k v) -> EventSelector t (Const2 k v))
-> Event t (Map k v) -> EventSelector t (Const2 k v)
forall a b. (a -> b) -> a -> b
$ (Map k (Maybe v) -> Map k v)
-> Event t (Map k (Maybe v)) -> Event t (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe v -> Maybe v) -> Map k (Maybe v) -> Map k v
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Maybe v -> Maybe v
forall a. a -> a
id) Event t (Map k (Maybe v))
valsChanged
  Dynamic t (Map k ())
sentVals <- (Map k (Maybe ()) -> Map k () -> Map k ())
-> Map k ()
-> Event t (Map k (Maybe ()))
-> m (Dynamic t (Map k ()))
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn Map k (Maybe ()) -> Map k () -> Map k ()
forall k v. Ord k => Map k (Maybe v) -> Map k v -> Map k v
applyMap (Map k v -> Map k ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Map k v
initialVals) (Event t (Map k (Maybe ())) -> m (Dynamic t (Map k ())))
-> Event t (Map k (Maybe ())) -> m (Dynamic t (Map k ()))
forall a b. (a -> b) -> a -> b
$ (Map k (Maybe v) -> Map k (Maybe ()))
-> Event t (Map k (Maybe v)) -> Event t (Map k (Maybe ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe v -> Maybe ()) -> Map k (Maybe v) -> Map k (Maybe ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe v -> Maybe ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void) Event t (Map k (Maybe v))
valsChanged
  let relevantPatch :: Maybe a -> p -> Maybe (Maybe a)
relevantPatch patch :: Maybe a
patch _ = case Maybe a
patch of

        -- Even if we let a Nothing through when the element doesn't
        -- already exist, this doesn't cause a problem because it is
        -- ignored
        Nothing -> Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing

        -- We don't want to let spurious re-creations of items through
        Just _  -> Maybe (Maybe a)
forall a. Maybe a
Nothing
  Map k v
-> Event t (Map k (Maybe v))
-> (k -> v -> m a)
-> m (Dynamic t (Map k a))
forall t (m :: * -> *) k v a.
(Ord k, Adjustable t m, MonadHold t m) =>
Map k v
-> Event t (Map k (Maybe v))
-> (k -> v -> m a)
-> m (Dynamic t (Map k a))
listHoldWithKey
      Map k v
initialVals
      ((Map k () -> Map k (Maybe v) -> Map k (Maybe v))
-> Behavior t (Map k ())
-> Event t (Map k (Maybe v))
-> Event t (Map k (Maybe v))
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Behavior t a -> Event t b -> Event t c
attachWith ((Map k (Maybe v) -> Map k () -> Map k (Maybe v))
-> Map k () -> Map k (Maybe v) -> Map k (Maybe v)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Maybe v -> () -> Maybe (Maybe v))
-> Map k (Maybe v) -> Map k () -> Map k (Maybe v)
forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
Map.differenceWith Maybe v -> () -> Maybe (Maybe v)
forall a p a. Maybe a -> p -> Maybe (Maybe a)
relevantPatch))
                  (Dynamic t (Map k ()) -> Behavior t (Map k ())
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Map k ())
sentVals)
                  Event t (Map k (Maybe v))
valsChanged
      )
    ((k -> v -> m a) -> m (Dynamic t (Map k a)))
-> (k -> v -> m a) -> m (Dynamic t (Map k a))
forall a b. (a -> b) -> a -> b
$ \k :: k
k v :: v
v -> k -> v -> Event t v -> m a
mkChild k
k v
v (Event t v -> m a) -> Event t v -> m a
forall a b. (a -> b) -> a -> b
$ EventSelector t (Const2 k v) -> forall a. Const2 k v a -> Event t a
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
select EventSelector t (Const2 k v)
childValChangedSelector (Const2 k v v -> Event t v) -> Const2 k v v -> Event t v
forall a b. (a -> b) -> a -> b
$ k -> Const2 k v v
forall x a (b :: x). a -> Const2 a b b
Const2 k
k

--TODO: Something better than Dynamic t (Map k v) - we want something
--where the Events carry diffs, not the whole value
-- | Create a dynamically-changing set of Event-valued widgets.  This
--   is like 'listWithKey', specialized for widgets returning @/Event t a/@.
--   'listWithKey' would return @/Dynamic t (Map k (Event t a))/@ in
--   this scenario, but 'listViewWithKey' flattens this to
--   @/Event t (Map k a)/@ via 'switch'.
listViewWithKey
  :: (Ord k, Adjustable t m, PostBuild t m, MonadHold t m, MonadFix m)
  => Dynamic t (Map k v)
  -> (k -> Dynamic t v -> m (Event t a))
  -> m (Event t (Map k a))
listViewWithKey :: Dynamic t (Map k v)
-> (k -> Dynamic t v -> m (Event t a)) -> m (Event t (Map k a))
listViewWithKey vals :: Dynamic t (Map k v)
vals mkChild :: k -> Dynamic t v -> m (Event t a)
mkChild =
  Behavior t (Event t (Map k a)) -> Event t (Map k a)
forall k (t :: k) a.
Reflex t =>
Behavior t (Event t a) -> Event t a
switch (Behavior t (Event t (Map k a)) -> Event t (Map k a))
-> (Behavior t (Map k (Event t a))
    -> Behavior t (Event t (Map k a)))
-> Behavior t (Map k (Event t a))
-> Event t (Map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map k (Event t a) -> Event t (Map k a))
-> Behavior t (Map k (Event t a)) -> Behavior t (Event t (Map k a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map k (Event t a) -> Event t (Map k a)
forall k1 (t :: k1) k2 a.
(Reflex t, Ord k2) =>
Map k2 (Event t a) -> Event t (Map k2 a)
mergeMap (Behavior t (Map k (Event t a)) -> Event t (Map k a))
-> m (Behavior t (Map k (Event t a))) -> m (Event t (Map k a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (Map k v)
-> (k -> Dynamic t v -> m (Event t a))
-> m (Behavior t (Map k (Event t a)))
forall k t (m :: * -> *) v a.
(Ord k, Adjustable t m, PostBuild t m, MonadHold t m,
 MonadFix m) =>
Dynamic t (Map k v)
-> (k -> Dynamic t v -> m a) -> m (Behavior t (Map k a))
listViewWithKey' Dynamic t (Map k v)
vals k -> Dynamic t v -> m (Event t a)
mkChild

listViewWithKey'
  :: (Ord k, Adjustable t m, PostBuild t m, MonadHold t m, MonadFix m)
  => Dynamic t (Map k v)
  -> (k -> Dynamic t v -> m a)
  -> m (Behavior t (Map k a))
listViewWithKey' :: Dynamic t (Map k v)
-> (k -> Dynamic t v -> m a) -> m (Behavior t (Map k a))
listViewWithKey' vals :: Dynamic t (Map k v)
vals mkChild :: k -> Dynamic t v -> m a
mkChild = Dynamic t (Map k a) -> Behavior t (Map k a)
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current (Dynamic t (Map k a) -> Behavior t (Map k a))
-> m (Dynamic t (Map k a)) -> m (Behavior t (Map k a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (Map k v)
-> (k -> Dynamic t v -> m a) -> m (Dynamic t (Map k a))
forall t k v (m :: * -> *) a.
(Ord k, Adjustable t m, PostBuild t m, MonadFix m,
 MonadHold t m) =>
Dynamic t (Map k v)
-> (k -> Dynamic t v -> m a) -> m (Dynamic t (Map k a))
listWithKey Dynamic t (Map k v)
vals k -> Dynamic t v -> m a
mkChild

-- | Create a dynamically-changing set of widgets, one of which is
-- selected at any time.
selectViewListWithKey
  :: forall t m k v a
   . (Adjustable t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)
  => Dynamic t k
  -- ^ Current selection key
  -> Dynamic t (Map k v)
  -- ^ Dynamic key/value map
  -> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a))
  -- ^ Function to create a widget for a given key from Dynamic value
  -- and Dynamic Bool indicating if this widget is currently selected
  -> m (Event t (k, a))
  -- ^ Event that fires when any child's return Event fires.  Contains
  -- key of an arbitrary firing widget.
selectViewListWithKey :: Dynamic t k
-> Dynamic t (Map k v)
-> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a))
-> m (Event t (k, a))
selectViewListWithKey selection :: Dynamic t k
selection vals :: Dynamic t (Map k v)
vals mkChild :: k -> Dynamic t v -> Dynamic t Bool -> m (Event t a)
mkChild = do
  -- For good performance, this value must be shared across all children
  let selectionDemux :: Demux t k
selectionDemux = Dynamic t k -> Demux t k
forall k1 (t :: k1) k2.
(Reflex t, Ord k2) =>
Dynamic t k2 -> Demux t k2
demux Dynamic t k
selection
  Dynamic t (Map k (Event t (k, a)))
selectChild <- Dynamic t (Map k v)
-> (k -> Dynamic t v -> m (Event t (k, a)))
-> m (Dynamic t (Map k (Event t (k, a))))
forall t k v (m :: * -> *) a.
(Ord k, Adjustable t m, PostBuild t m, MonadFix m,
 MonadHold t m) =>
Dynamic t (Map k v)
-> (k -> Dynamic t v -> m a) -> m (Dynamic t (Map k a))
listWithKey Dynamic t (Map k v)
vals ((k -> Dynamic t v -> m (Event t (k, a)))
 -> m (Dynamic t (Map k (Event t (k, a)))))
-> (k -> Dynamic t v -> m (Event t (k, a)))
-> m (Dynamic t (Map k (Event t (k, a))))
forall a b. (a -> b) -> a -> b
$ \k :: k
k v :: Dynamic t v
v -> do
    let selected :: Dynamic t Bool
selected = Demux t k -> k -> Dynamic t Bool
forall k1 (t :: k1) k2.
(Reflex t, Eq k2) =>
Demux t k2 -> k2 -> Dynamic t Bool
demuxed Demux t k
selectionDemux k
k
    Event t a
selectSelf <- k -> Dynamic t v -> Dynamic t Bool -> m (Event t a)
mkChild k
k Dynamic t v
v Dynamic t Bool
selected
    Event t (k, a) -> m (Event t (k, a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t (k, a) -> m (Event t (k, a)))
-> Event t (k, a) -> m (Event t (k, a))
forall a b. (a -> b) -> a -> b
$ (a -> (k, a)) -> Event t a -> Event t (k, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) k
k) Event t a
selectSelf
  Event t (k, a) -> m (Event t (k, a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t (k, a) -> m (Event t (k, a)))
-> Event t (k, a) -> m (Event t (k, a))
forall a b. (a -> b) -> a -> b
$ Dynamic t (Event t (k, a)) -> Event t (k, a)
forall k (t :: k) a. Reflex t => Dynamic t (Event t a) -> Event t a
switchPromptlyDyn (Dynamic t (Event t (k, a)) -> Event t (k, a))
-> Dynamic t (Event t (k, a)) -> Event t (k, a)
forall a b. (a -> b) -> a -> b
$ [Event t (k, a)] -> Event t (k, a)
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost ([Event t (k, a)] -> Event t (k, a))
-> (Map k (Event t (k, a)) -> [Event t (k, a)])
-> Map k (Event t (k, a))
-> Event t (k, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (Event t (k, a)) -> [Event t (k, a)]
forall k a. Map k a -> [a]
Map.elems (Map k (Event t (k, a)) -> Event t (k, a))
-> Dynamic t (Map k (Event t (k, a))) -> Dynamic t (Event t (k, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (Map k (Event t (k, a)))
selectChild

-- | Like 'selectViewListWithKey' but discards the value of the list
-- item widget's output 'Event'.
selectViewListWithKey_
  :: forall t m k v a
   . (Adjustable t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)
  => Dynamic t k
  -- ^ Current selection key
  -> Dynamic t (Map k v)
  -- ^ Dynamic key/value map
  -> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a))
  -- ^ Function to create a widget for a given key from Dynamic value
  -- and Dynamic Bool indicating if this widget is currently selected
  -> m (Event t k)
  -- ^ Event that fires when any child's return Event fires.  Contains
  -- key of an arbitrary firing widget.
selectViewListWithKey_ :: Dynamic t k
-> Dynamic t (Map k v)
-> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a))
-> m (Event t k)
selectViewListWithKey_ selection :: Dynamic t k
selection vals :: Dynamic t (Map k v)
vals mkChild :: k -> Dynamic t v -> Dynamic t Bool -> m (Event t a)
mkChild =
  ((k, a) -> k) -> Event t (k, a) -> Event t k
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k, a) -> k
forall a b. (a, b) -> a
fst (Event t (k, a) -> Event t k)
-> m (Event t (k, a)) -> m (Event t k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t k
-> Dynamic t (Map k v)
-> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a))
-> m (Event t (k, a))
forall t (m :: * -> *) k v a.
(Adjustable t m, Ord k, PostBuild t m, MonadHold t m,
 MonadFix m) =>
Dynamic t k
-> Dynamic t (Map k v)
-> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a))
-> m (Event t (k, a))
selectViewListWithKey Dynamic t k
selection Dynamic t (Map k v)
vals k -> Dynamic t v -> Dynamic t Bool -> m (Event t a)
mkChild

-- | Create a dynamically-changing set of widgets from a Dynamic
--   key/value map.  Unlike the 'withKey' variants, the child widgets
--   are insensitive to which key they're associated with.
list
  :: (Ord k, Adjustable t m, MonadHold t m, PostBuild t m, MonadFix m)
  => Dynamic t (Map k v)
  -> (Dynamic t v -> m a)
  -> m (Dynamic t (Map k a))
list :: Dynamic t (Map k v)
-> (Dynamic t v -> m a) -> m (Dynamic t (Map k a))
list dm :: Dynamic t (Map k v)
dm mkChild :: Dynamic t v -> m a
mkChild = Dynamic t (Map k v)
-> (k -> Dynamic t v -> m a) -> m (Dynamic t (Map k a))
forall t k v (m :: * -> *) a.
(Ord k, Adjustable t m, PostBuild t m, MonadFix m,
 MonadHold t m) =>
Dynamic t (Map k v)
-> (k -> Dynamic t v -> m a) -> m (Dynamic t (Map k a))
listWithKey Dynamic t (Map k v)
dm (\_ dv :: Dynamic t v
dv -> Dynamic t v -> m a
mkChild Dynamic t v
dv)

-- | Create a dynamically-changing set of widgets from a Dynamic list.
simpleList
  :: (Adjustable t m, MonadHold t m, PostBuild t m, MonadFix m)
  => Dynamic t [v]
  -> (Dynamic t v -> m a)
  -> m (Dynamic t [a])
simpleList :: Dynamic t [v] -> (Dynamic t v -> m a) -> m (Dynamic t [a])
simpleList xs :: Dynamic t [v]
xs mkChild :: Dynamic t v -> m a
mkChild =
  (Dynamic t (Map Int a) -> Dynamic t [a])
-> m (Dynamic t (Map Int a)) -> m (Dynamic t [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Map Int a -> [a]) -> Dynamic t (Map Int a) -> Dynamic t [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Int, a) -> a) -> [(Int, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Int, a) -> a
forall a b. (a, b) -> b
snd ([(Int, a)] -> [a])
-> (Map Int a -> [(Int, a)]) -> Map Int a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Int a -> [(Int, a)]
forall k a. Map k a -> [(k, a)]
Map.toList)) (m (Dynamic t (Map Int a)) -> m (Dynamic t [a]))
-> m (Dynamic t (Map Int a)) -> m (Dynamic t [a])
forall a b. (a -> b) -> a -> b
$ (Dynamic t (Map Int v)
 -> (Dynamic t v -> m a) -> m (Dynamic t (Map Int a)))
-> (Dynamic t v -> m a)
-> Dynamic t (Map Int v)
-> m (Dynamic t (Map Int a))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Dynamic t (Map Int v)
-> (Dynamic t v -> m a) -> m (Dynamic t (Map Int a))
forall k t (m :: * -> *) v a.
(Ord k, Adjustable t m, MonadHold t m, PostBuild t m,
 MonadFix m) =>
Dynamic t (Map k v)
-> (Dynamic t v -> m a) -> m (Dynamic t (Map k a))
list Dynamic t v -> m a
mkChild (Dynamic t (Map Int v) -> m (Dynamic t (Map Int a)))
-> Dynamic t (Map Int v) -> m (Dynamic t (Map Int a))
forall a b. (a -> b) -> a -> b
$ ([v] -> Map Int v) -> Dynamic t [v] -> Dynamic t (Map Int v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    ([(Int, v)] -> Map Int v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Int, v)] -> Map Int v)
-> ([v] -> [(Int, v)]) -> [v] -> Map Int v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [v] -> [(Int, v)]
forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
zip [(1 :: Int) ..])
    Dynamic t [v]
xs