on develop help sign in
A few more sortableList example improvements
commit776e2fabfb5f4cee1177560fbbc4bcd23367b66c authorRyan Trinkle <ryan.trinkle@gmail.com> dateFri 10 Feb 2017, 00:47 (10 years ago) parent903b0d2
1 file changed+15−15
examples/sortableList.hs+15−15
examples/sortableList.hs+15−15
@@ -23,8 +23,8 @@ import System.Random
2323
2424main :: IO ()
2525main = mainWidget $ do
26− let f k (a, b, c) = el "tr" $ do
27− mapM_ (el "td" . text . T.pack . show) [k, a, b, c]
26+ let f _ (a, b, c) = el "tr" $ do
27+ mapM_ (el "td" . text . T.pack . show) [a, b, c]
2828 _ <- el "td" $ inputElement def
2929 return ()
3030 let numKeys = 1000 :: Int
@@ -33,15 +33,15 @@ main = mainWidget $ do
3333 values = zip3 (randoms (mkStdGen 0)) (randoms (mkStdGen 1)) (randoms (mkStdGen 2))
3434 testMap = Map.fromList $ zip keys values
3535 resortButtons = el "div" $ leftmost <$> sequence
36− [ (comparing (view _1) <$) <$> button "1 ASC"
37− , (flip (comparing (view _1)) <$) <$> button "1 DESC"
38− , (comparing (view _2) <$) <$> button "2 ASC"
39− , (flip (comparing (view _2)) <$) <$> button "2 DESC"
40− , (comparing (view _3) <$) <$> button "3 ASC"
41− , (flip (comparing (view _3)) <$) <$> button "3 DESC"
36+ [ (comparing (view _1) <$) <$> button "A ASC"
37+ , (flip (comparing (view _1)) <$) <$> button "A DESC"
38+ , (comparing (view _2) <$) <$> button "B ASC"
39+ , (flip (comparing (view _2)) <$) <$> button "B DESC"
40+ , (comparing (view _3) <$) <$> button "C ASC"
41+ , (flip (comparing (view _3)) <$) <$> button "C DESC"
4242 ]
4343 el "h1" $ text "Improved list sorting"
44− el "p" $ text $ "This app shows a table of " <> T.pack (show numKeys) <> " items, and allows you to re-sort by columns a, b, and c, which are full of pseudorandom numbers."
44+ el "p" $ text $ "This app shows a table of " <> T.pack (show numKeys) <> " rows, and allows you to re-sort by columns a, b, and c, which are full of pseudorandom numbers. Each row also includes an element with internal state (a textbox) to demonstrate that the state is preserved, only when using the new way."
4545 el "h3" $ text "Re-sort the list the OLD way (by redrawing everything)"
4646 resortSlow <- resortButtons
4747 displayRedrawTime resortSlow
@@ -51,7 +51,6 @@ main = mainWidget $ do
5151 el "hr" blank
5252 el "table" $ do
5353 el "tr" $ do
54− el "th" $ text "Key"
5554 el "th" $ text "A"
5655 el "th" $ text "B"
5756 el "th" $ text "C"
@@ -76,13 +75,14 @@ mapMapWithAdjustWithMove f m0 m' = do
7675
7776simpleSortableList :: forall t m k v. (MonadHold t m, MonadFix m, MonadAdjust t m, Ord k) => (k -> v -> m ()) -> Map k v -> Event t (v -> v -> Ordering) -> Event t (v -> v -> Ordering) -> m ()
7877simpleSortableList f m0 resortFunc resortSlowFunc = do
79− rec let resortPatch = attachWith (flip patchThatSortsMapWith) (currentIncremental m) resortFunc
78+ rec let resortPatchFast = attachWith (flip patchThatSortsMapWith) (currentIncremental m) resortFunc
8079 redrawPatch :: Map k v -> (v -> v -> Ordering) -> PatchMapWithMove k v
8180 redrawPatch d cmp = unsafePatchMapWithMove $ fmap (MapEdit_Insert False) $ Map.fromList $ zip (Map.keys d) (sortBy cmp $ Map.elems d)
8281 resortPatchSlow = attachWith redrawPatch (currentIncremental m) resortSlowFunc
82+ resortPatch = leftmost
83+ [ resortPatchFast
84+ , resortPatchSlow
85+ ]
8386 m <- holdIncremental m0 resortPatch
84− _ <- mapMapWithAdjustWithMove f m0 $ leftmost
85− [ resortPatch
86− , resortPatchSlow
87− ]
87+ _ <- mapMapWithAdjustWithMove f m0 resortPatch
8888 return ()