@@ -3,7 +3,6 @@
3{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE GADTs #-}
5{-# LANGUAGE GADTs #-}
6−{-# LANGUAGE LambdaCase #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
6{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE OverloadedStrings #-}
7{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE RankNTypes #-}
8{-# LANGUAGE RankNTypes #-}
@@ -12,7 +11,6 @@
12{-# LANGUAGE TypeFamilies #-}
11{-# LANGUAGE TypeFamilies #-}
13module Reflex.Dom.Widget.Basic
12module Reflex.Dom.Widget.Basic
14 ( partitionMapBySetLT
13 ( partitionMapBySetLT
16 , ChildResult (..)
14 , ChildResult (..)
18 -- * Displaying Values
16 -- * Displaying Values
@@ -24,21 +22,6 @@ module Reflex.Dom.Widget.Basic
24 , widgetHold
22 , widgetHold
25 , untilReady
23 , untilReady
27− -- * Working with Maps
31− , mapPartitionEithers
34− -- * Widgets on Collections
37− , listWithKeyShallowDiff
39− , selectViewListWithKey
40− , selectViewListWithKey_
42 -- * Creating DOM Elements
25 -- * Creating DOM Elements
@@ -56,10 +39,6 @@ module Reflex.Dom.Widget.Basic
56 , dynamicAttributesToModifyAttributes
39 , dynamicAttributesToModifyAttributes
57 , dynamicAttributesToModifyAttributesWithInitial
40 , dynamicAttributesToModifyAttributesWithInitial
63 -- * Specific DOM Elements
42 -- * Specific DOM Elements
64 , Link (..)
43 , Link (..)
65 , linkClass
44 , linkClass
@@ -83,6 +62,7 @@ module Reflex.Dom.Widget.Basic
85import Reflex.Class
64import Reflex.Class
65+import Reflex.Collection
86import Reflex.Dom.Builder.Class
66import Reflex.Dom.Builder.Class
87import Reflex.Dom.Class
67import Reflex.Dom.Class
88import Reflex.Dynamic
68import Reflex.Dynamic
@@ -95,9 +75,9 @@ import Data.Align
95import Data.Default
75import Data.Default
96import Data.Either
76import Data.Either
97import Data.Foldable
77import Data.Foldable
98−import Data.Functor.Misc
99import Data.Map (Map)
78import Data.Map (Map)
100import qualified Data.Map as Map
79import qualified Data.Map as Map
101import Data.Maybe
81import Data.Maybe
102import Data.Set (Set)
82import Data.Set (Set)
103import qualified Data.Set as Set
83import qualified Data.Set as Set
@@ -129,13 +109,6 @@ partitionMapBySetLT s m0 = Map.fromDistinctAscList $ go (Set.toAscList s) m0
130newtype ChildResult t k a = ChildResult { unChildResult :: (a, Event t (Map k (Maybe (ChildResult t k a)))) }
110newtype ChildResult t k a = ChildResult { unChildResult :: (a, Event t (Map k (Maybe (ChildResult t k a)))) }
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
139text :: DomBuilder t m => Text -> m ()
112text :: DomBuilder t m => Text -> m ()
140text t = void $ textNode $ def & textNodeConfig_initialContents .~ t
113text t = void $ textNode $ def & textNodeConfig_initialContents .~ t
@@ -182,107 +155,6 @@ untilReady a b = do
182 postBuild <- getPostBuild
155 postBuild <- getPostBuild
183 runWithReplace a $ b <$ postBuild
156 runWithReplace a $ b <$ postBuild
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
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
195− | old == new -> Nothing
196− | otherwise -> Just $ Just new
197− That new -> Just $ Just new
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
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"
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
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
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
238− listHoldWithKey Map.empty changeVals $ \k v ->
239− mkChild k =<< holdDyn v (select childValChangedSelector $ Const2 k)
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
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
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
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
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
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
286-- | Create a DOM element
158-- | Create a DOM element
287-- > el "div" (text "Hello World")
159-- > el "div" (text "Hello World")
288-- <div>Hello World</div>
160-- <div>Hello World</div>
@@ -380,15 +252,6 @@ dynamicAttributesToModifyAttributesWithInitial attrs0 d = do
380-- Copied and pasted from Reflex.Widget.Class
252-- Copied and pasted from Reflex.Widget.Class
381--------------------------------------------------------------------------------
253--------------------------------------------------------------------------------
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)
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
393schedulePostBuild x = performEvent_ . (x <$) =<< getPostBuild
256schedulePostBuild x = performEvent_ . (x <$) =<< getPostBuild