@@ -3,7 +3,6 @@
33{-# LANGUAGE FlexibleContexts #-}
44{-# LANGUAGE FlexibleInstances #-}
55{-# LANGUAGE GADTs #-}
6−{-# LANGUAGE LambdaCase #-}
76{-# LANGUAGE MultiParamTypeClasses #-}
87{-# LANGUAGE OverloadedStrings #-}
98{-# LANGUAGE RankNTypes #-}
@@ -12,7 +11,6 @@
1211{-# LANGUAGE TypeFamilies #-}
1312module Reflex.Dom.Widget.Basic
1413 ( partitionMapBySetLT
15− , listHoldWithKey
1614 , ChildResult (..)
1715
1816 -- * Displaying Values
@@ -24,21 +22,6 @@ module Reflex.Dom.Widget.Basic
2422 , widgetHold
2523 , untilReady
2624
27− -- * Working with Maps
28− , diffMapNoEq
29− , diffMap
30− , applyMap
31− , mapPartitionEithers
32− , applyMapKeysSet
33−
34− -- * Widgets on Collections
35− , listWithKey
36− , listWithKey'
37− , listWithKeyShallowDiff
38− , listViewWithKey
39− , selectViewListWithKey
40− , selectViewListWithKey_
41−
4225 -- * Creating DOM Elements
4326 , el
4427 , elAttr
@@ -56,10 +39,6 @@ module Reflex.Dom.Widget.Basic
5639 , dynamicAttributesToModifyAttributes
5740 , dynamicAttributesToModifyAttributesWithInitial
5841
59− -- * List Utils
60− , list
61− , simpleList
62−
6342 -- * Specific DOM Elements
6443 , Link (..)
6544 , linkClass
@@ -83,6 +62,7 @@ module Reflex.Dom.Widget.Basic
8362 ) where
8463
8564import Reflex.Class
65+import Reflex.Collection
8666import Reflex.Dom.Builder.Class
8767import Reflex.Dom.Class
8868import Reflex.Dynamic
@@ -95,9 +75,9 @@ import Data.Align
9575import Data.Default
9676import Data.Either
9777import Data.Foldable
98−import Data.Functor.Misc
9978import Data.Map (Map)
10079import qualified Data.Map as Map
80+import Data.Map.Misc
10181import Data.Maybe
10282import Data.Set (Set)
10383import qualified Data.Set as Set
@@ -129,13 +109,6 @@ partitionMapBySetLT s m0 = Map.fromDistinctAscList $ go (Set.toAscList s) m0
129109
130110newtype ChildResult t k a = ChildResult { unChildResult :: (a, Event t (Map k (Maybe (ChildResult t k a)))) }
131111
132−listHoldWithKey :: forall t m k v a. (Ord k, DomBuilder t m, MonadHold t m) => Map k v -> Event t (Map k (Maybe v)) -> (k -> v -> m a) -> m (Dynamic t (Map k a))
133−listHoldWithKey m0 m' f = do
134− let dm0 = mapWithFunctorToDMap $ Map.mapWithKey f m0
135− dm' = fmap (PatchDMap . mapWithFunctorToDMap . Map.mapWithKey (\k v -> ComposeMaybe $ fmap (f k) v)) m'
136− (a0, a') <- sequenceDMapWithAdjust dm0 dm'
137− fmap dmapToMap . incrementalToDynamic <$> holdIncremental a0 a' --TODO: Move the dmapToMap to the righthand side so it doesn't get fully redone every time
138−
139112text :: DomBuilder t m => Text -> m ()
140113text t = void $ textNode $ def & textNodeConfig_initialContents .~ t
141114
@@ -182,107 +155,6 @@ untilReady a b = do
182155 postBuild <- getPostBuild
183156 runWithReplace a $ b <$ postBuild
184157
185−diffMapNoEq :: (Ord k) => Map k v -> Map k v -> Map k (Maybe v)
186−diffMapNoEq olds news = flip Map.mapMaybe (align olds news) $ \case
187− This _ -> Just Nothing
188− These _ new -> Just $ Just new
189− That new -> Just $ Just new
190−
191−diffMap :: (Ord k, Eq v) => Map k v -> Map k v -> Map k (Maybe v)
192−diffMap olds news = flip Map.mapMaybe (align olds news) $ \case
193− This _ -> Just Nothing
194− These old new
195− | old == new -> Nothing
196− | otherwise -> Just $ Just new
197− That new -> Just $ Just new
198−
199−applyMap :: Ord k => Map k (Maybe v) -> Map k v -> Map k v
200−applyMap patch old = insertions `Map.union` (old `Map.difference` deletions)
201− where (deletions, insertions) = mapPartitionEithers $ maybeToEither <$> patch
202− maybeToEither = \case
203− Nothing -> Left ()
204− Just r -> Right r
205−
206−mapPartitionEithers :: Map k (Either a b) -> (Map k a, Map k b)
207−mapPartitionEithers m = (fromLeft <$> ls, fromRight <$> rs)
208− where (ls, rs) = Map.partition isLeft m
209− fromLeft (Left l) = l
210− fromLeft _ = error "mapPartitionEithers: fromLeft received a Right value; this should be impossible"
211− fromRight (Right r) = r
212− fromRight _ = error "mapPartitionEithers: fromRight received a Left value; this should be impossible"
213−
214−-- | Apply a map patch to a set
215−-- > applyMapKeysSet patch (Map.keysSet m) == Map.keysSet (applyMap patch m)
216−applyMapKeysSet :: Ord k => Map k (Maybe v) -> Set k -> Set k
217−applyMapKeysSet patch old = Map.keysSet insertions `Set.union` (old `Set.difference` Map.keysSet deletions)
218− where (insertions, deletions) = Map.partition isJust patch
219−
220−--TODO: Something better than Dynamic t (Map k v) - we want something where the Events carry diffs, not the whole value
221−listWithKey :: forall t k v m a. (Ord k, DomBuilder 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))
222−listWithKey vals mkChild = do
223− postBuild <- getPostBuild
224− let childValChangedSelector = fanMap $ updated vals
225− -- We keep track of changes to children values in the mkChild function we pass to listHoldWithKey
226− -- The other changes we need to keep track of are child insertions and deletions. diffOnlyKeyChanges
227− -- keeps track of insertions and deletions but ignores value changes, since they're already accounted for.
228− diffOnlyKeyChanges olds news = flip Map.mapMaybe (align olds news) $ \case
229− This _ -> Just Nothing
230− These _ _ -> Nothing
231− That new -> Just $ Just new
232− rec sentVals :: Dynamic t (Map k v) <- foldDyn applyMap Map.empty changeVals
233− let changeVals :: Event t (Map k (Maybe v))
234− changeVals = attachWith diffOnlyKeyChanges (current sentVals) $ leftmost
235− [ updated vals
236− , tag (current vals) postBuild --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
237− ]
238− listHoldWithKey Map.empty changeVals $ \k v ->
239− mkChild k =<< holdDyn v (select childValChangedSelector $ Const2 k)
240−
241−{-# DEPRECATED listWithKey' "listWithKey' has been renamed to listWithKeyShallowDiff; also, its behavior has changed to fix a bug where children were always rebuilt (never updated)" #-}
242−listWithKey' :: (Ord k, DomBuilder 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))
243−listWithKey' = listWithKeyShallowDiff
244−
245−-- | 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.
246−listWithKeyShallowDiff :: (Ord k, DomBuilder 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))
247−listWithKeyShallowDiff initialVals valsChanged mkChild = do
248− let childValChangedSelector = fanMap $ fmap (Map.mapMaybe id) valsChanged
249− sentVals <- foldDyn applyMap Map.empty $ fmap (fmap void) valsChanged
250− let relevantPatch patch _ = case patch of
251− Nothing -> Just Nothing -- Even if we let a Nothing through when the element doesn't already exist, this doesn't cause a problem because it is ignored
252− Just _ -> Nothing -- We don't want to let spurious re-creations of items through
253− listHoldWithKey initialVals (attachWith (flip (Map.differenceWith relevantPatch)) (current sentVals) valsChanged) $ \k v ->
254− mkChild k v $ select childValChangedSelector $ Const2 k
255−
256−--TODO: Something better than Dynamic t (Map k v) - we want something where the Events carry diffs, not the whole value
257−-- | Create a dynamically-changing set of Event-valued widgets.
258−-- 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'.
259−listViewWithKey :: (Ord k, DomBuilder 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))
260−listViewWithKey vals mkChild = switch . fmap mergeMap <$> listViewWithKey' vals mkChild
261−
262−listViewWithKey' :: (Ord k, DomBuilder 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))
263−listViewWithKey' vals mkChild = current <$> listWithKey vals mkChild
264−
265−-- | Create a dynamically-changing set of widgets, one of which is selected at any time.
266−selectViewListWithKey :: forall t m k v a. (DomBuilder t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)
267− => Dynamic t k -- ^ Current selection key
268− -> Dynamic t (Map k v) -- ^ Dynamic key/value map
269− -> (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
270− -> m (Event t (k, a)) -- ^ Event that fires when any child's return Event fires. Contains key of an arbitrary firing widget.
271−selectViewListWithKey selection vals mkChild = do
272− let selectionDemux = demux selection -- For good performance, this value must be shared across all children
273− selectChild <- listWithKey vals $ \k v -> do
274− let selected = demuxed selectionDemux k
275− selectSelf <- mkChild k v selected
276− return $ fmap ((,) k) selectSelf
277− return $ switchPromptlyDyn $ leftmost . Map.elems <$> selectChild
278−
279−selectViewListWithKey_ :: forall t m k v a. (DomBuilder t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)
280− => Dynamic t k -- ^ Current selection key
281− -> Dynamic t (Map k v) -- ^ Dynamic key/value map
282− -> (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
283− -> m (Event t k) -- ^ Event that fires when any child's return Event fires. Contains key of an arbitrary firing widget.
284−selectViewListWithKey_ selection vals mkChild = fmap fst <$> selectViewListWithKey selection vals mkChild
285−
286158-- | Create a DOM element
287159-- > el "div" (text "Hello World")
288160-- <div>Hello World</div>
@@ -380,15 +252,6 @@ dynamicAttributesToModifyAttributesWithInitial attrs0 d = do
380252-- Copied and pasted from Reflex.Widget.Class
381253--------------------------------------------------------------------------------
382254
383−-- | Create a dynamically-changing set of widgets from a Dynamic key/value map.
384−-- Unlike the 'withKey' variants, the child widgets are insensitive to which key they're associated with.
385−list :: (Ord k, DomBuilder 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))
386−list dm mkChild = listWithKey dm (\_ dv -> mkChild dv)
387−
388−-- | Create a dynamically-changing set of widgets from a Dynamic list.
389−simpleList :: (DomBuilder t m, MonadHold t m, PostBuild t m, MonadFix m) => Dynamic t [v] -> (Dynamic t v -> m a) -> m (Dynamic t [a])
390−simpleList xs mkChild = fmap (fmap (map snd . Map.toList)) $ flip list mkChild $ fmap (Map.fromList . zip [(1::Int)..]) xs
391−
392255{-
393256schedulePostBuild x = performEvent_ . (x <$) =<< getPostBuild
394257