Skip to content

Instantly share code, notes, and snippets.

@maralorn
Created May 23, 2020 02:22
Show Gist options
  • Save maralorn/c1e7d2481d6fd91562994e01bbe21af8 to your computer and use it in GitHub Desktop.
Save maralorn/c1e7d2481d6fd91562994e01bbe21af8 to your computer and use it in GitHub Desktop.
A try at efficient reflex list widgets
( 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment