{-# 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
import Control.Monad.Fix
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 Map k v
m0 Event t (Map k (Maybe v))
m' 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 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'
  (DMap (Const2 k a) Identity
a0, 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, Eq v)
  => 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 Dynamic t (Map k v)
vals 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 Map k a
olds 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 a
_    -> Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing
          These a
_ a
_ -> Maybe (Maybe a)
forall a. Maybe a
Nothing
          That 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 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
=<< Dynamic t v -> m (Dynamic t v)
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn (Dynamic t v -> m (Dynamic t v))
-> m (Dynamic t v) -> m (Dynamic t v)
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 Map k v
initialVals Event t (Map k (Maybe v))
valsChanged 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 Maybe a
patch p
_ = 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
        Maybe a
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 a
_  -> 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 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, Eq v)
  => 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 Dynamic t (Map k v)
vals 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,
 Eq v) =>
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, Eq v)
  => 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' Dynamic t (Map k v)
vals 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,
 Eq v) =>
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, Eq v)
  => 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 Dynamic t k
selection Dynamic t (Map k v)
vals 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,
 Eq v) =>
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 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, Eq v)
  => 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_ Dynamic t k
selection Dynamic t (Map k v)
vals 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,
 Eq v) =>
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, Eq v)
  => 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 Dynamic t (Map k v)
dm 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,
 Eq v) =>
Dynamic t (Map k v)
-> (k -> Dynamic t v -> m a) -> m (Dynamic t (Map k a))
listWithKey Dynamic t (Map k v)
dm (\k
_ 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, Eq v)
  => 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 Dynamic t [v]
xs 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,
 Eq v) =>
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 [(Int
1 :: Int) ..])
    Dynamic t [v]
xs