A try at efficient reflex list widgets

ReflexUtils.hs

  ( smartSimpleList
  , smartMapList
  , getCachedDynamic
  )
where

import qualified Reflex                        as R
import qualified Reflex.Dom                    as D
import qualified Data.Patch.MapWithMove        as Patch
import qualified Data.Patch.Map                as Patch
import           Data.Map                       ( lookup
                                                , insert
                                                )

-- | Renders a list of widgets depending on a Dynamic list of inputs. This will
-- call the widget constructor once per value in the list.
-- When the list changes, the widget will move and reuse all values that it can
-- so that it only needs to call the constructor again, when a new value (or a
-- second copy of a same value) appears in the list.
smartSimpleList
  :: (R.Adjustable t m, R.PostBuild t m, Ord v)
  => (v -> m ())
  -> R.Dynamic t [v]
  -> m ()
smartSimpleList widget listElements = do
  postBuild <- R.getPostBuild
  let keyMap       = fromList . (zip [0 :: Int ..]) <$> listElements
      keyMapChange = R.attachWith Patch.patchThatChangesMap
                                  (R.current keyMap)
                                  (R.updated keyMap)
      initialKeyMap =
        Patch.patchMapWithMoveInsertAll <$> R.tag (R.current keyMap) postBuild
      keyMapEvents = keyMapChange <> initialKeyMap
  void $ R.mapMapWithAdjustWithMove (const (widget)) mempty keyMapEvents

-- | Picks up values for the widget from a given function. The function should
-- only update the dynamics when necessary.  The widget will only be invoked
-- once as described in `smartSimpleList`.
smartMapList
  :: forall t m k v
   . (R.Adjustable t m, R.PostBuild t m, D.NotReady t m, Ord k)
  => (k -> Maybe (R.Dynamic t v) -> m ())
  -> (k -> m (R.Dynamic t (Maybe (R.Dynamic t v))))
  -> R.Dynamic t [k]
  -> m ()
smartMapList widget elementGetter listElements = do
  let widget' :: k -> m ()
      widget' key = do
        elementDyn <- elementGetter key
        D.dyn_ $ widget key <$> elementDyn
  smartSimpleList widget' listElements

-- | This function can be used to give memoized access to values in an
-- Incremental map. This will only construct one `Dynamic` per key.  The
-- constructed `Dynamic` does not rely on `holdUniqDyn`. Instead it filters
-- update events and only triggers if the event matches the key.
getCachedDynamic
  :: forall t m k v
   . (R.PostBuild t m, Ord k, MonadFix m, R.MonadHold t m, MonadIO m)
  => R.Incremental t (Patch.PatchMap k v)
  -> m (k -> m (R.Dynamic t (Maybe (R.Dynamic t v))))
getCachedDynamic incremental = do
  ref <- newIORef mempty
  pure $ \key -> do
    let mapMap :: Map k v -> Maybe v
        mapMap = lookup key
        mapPatchMap :: Patch.PatchMap k v -> Identity (Maybe v)
        mapPatchMap = Identity . join . lookup key . Patch.unPatchMap
    newDynamic <-
      R.maybeDyn
      . R.incrementalToDynamic
      . R.unsafeMapIncremental mapMap mapPatchMap
      $ incremental
    let modifyCache cache = case lookup key cache of
          Just val -> (cache, val)
          Nothing  -> (insert key newDynamic cache, newDynamic)
    atomicModifyIORef ref modifyCache