Skip to content

Commit d56bf55

Browse files
committed
trying to improve miso view performance with keyed nodes
1 parent cf78aac commit d56bf55

File tree

7 files changed

+181
-181
lines changed

7 files changed

+181
-181
lines changed

ghcjs/delivery-calculator/src/App/Widgets/Fav.hs

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,10 @@ import qualified Functora.Miso.Widgets.Icon as Icon
1515
fav :: Model -> [View Action]
1616
fav st =
1717
Dialog.dialog
18-
Dialog.defOpts
18+
( Dialog.defOpts
19+
& #optsKeyed
20+
.~ "fav"
21+
)
1922
Dialog.Args
2023
{ Dialog.argsModel = st,
2124
Dialog.argsOptic = #modelFav,

ghcjs/delivery-calculator/src/App/Widgets/Main.hs

Lines changed: 26 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -17,30 +17,34 @@ import Miso hiding (at, view)
1717

1818
mainWidget :: Model -> View Action
1919
mainWidget st =
20-
div_
21-
[ style_
22-
[ ("margin", "0"),
23-
("padding", "0"),
24-
("min-width", "100%"),
25-
("max-width", "100%"),
26-
("min-height", "100vh"),
27-
("display", "flex"),
28-
("flex-direction", "column"),
29-
("justify-content", "space-between"),
30-
("align-items", "center"),
31-
("color", "inherit"),
32-
("background-color", "inherit")
33-
]
34-
]
20+
keyed "main-root"
21+
. div_
22+
[ style_
23+
[ ("margin", "0"),
24+
("padding", "0"),
25+
("min-width", "100%"),
26+
("max-width", "100%"),
27+
("min-height", "100vh"),
28+
("display", "flex"),
29+
("flex-direction", "column"),
30+
("justify-content", "space-between"),
31+
("align-items", "center"),
32+
("color", "inherit"),
33+
("background-color", "inherit")
34+
]
35+
]
3536
$ Menu.menu st
36-
<> [ Flex.flexCol main_ id $ screenWidget st
37+
<> [ keyed "main-content"
38+
. Flex.flexCol main_ id
39+
$ screenWidget st
3740
]
38-
<> [ footer_
39-
[ style_
40-
[ ("text-align", "center"),
41-
("margin-bottom", "1rem")
42-
]
43-
]
41+
<> [ keyed "main-footer"
42+
. footer_
43+
[ style_
44+
[ ("text-align", "center"),
45+
("margin-bottom", "1rem")
46+
]
47+
]
4448
$ tosWidget
4549
: br_ mempty
4650
: Menu.qrButton st

ghcjs/delivery-calculator/src/App/Widgets/Menu.hs

Lines changed: 99 additions & 96 deletions
Original file line numberDiff line numberDiff line change
@@ -22,108 +22,111 @@ import qualified Text.URI as URI
2222

2323
menu :: Model -> [View Action]
2424
menu st =
25-
[ nav_
26-
[ style_
27-
[ ("grid-template-columns", "auto 1fr auto auto auto auto")
28-
]
29-
]
30-
[ button_
31-
[ role_ "button",
32-
style_
33-
[ ("min-width", "0")
34-
],
35-
onClick
36-
. PushUpdate
37-
. Instant
38-
. PureUpdate
39-
$ #modelMenu
40-
.~ Opened
41-
]
42-
[ icon Icon.IconMenu
43-
],
44-
button_
45-
[ role_ "button",
46-
style_
47-
[ ("min-width", "0"),
48-
("justify-self", "start"),
49-
("word-break", "keep-all"),
50-
("overflow-wrap", "normal")
51-
],
52-
onClick . PushUpdate . Instant . ImpureUpdate $ do
53-
doc <- liftIO newSt
54-
pure $ #modelState .~ doc
55-
]
56-
[ text "Delivery Calculator"
57-
],
58-
button_
59-
[ role_ "button",
60-
style_
61-
[ ("min-width", "0")
62-
],
63-
onClick
64-
. PushUpdate
65-
. Instant
66-
. PureUpdate
67-
$ #modelFav
68-
.~ Opened
69-
]
70-
[ icon Icon.IconFav
71-
],
72-
button_
73-
[ role_ "button",
74-
style_
75-
[ ("min-width", "0")
76-
],
77-
onClick
78-
. PushUpdate
79-
. Instant
80-
. ImpureUpdate
81-
$ do
82-
Jsm.printCurrentPage "delivery-calculator"
83-
pure id
84-
]
85-
[ icon Icon.IconPrint
86-
],
87-
button_
88-
[ role_ "button",
89-
style_
90-
[ ("min-width", "0")
91-
],
92-
onClick
93-
. PushUpdate
94-
. Instant
95-
. ImpureUpdate
96-
$ do
97-
Jsm.saveFile
98-
"delivery-calculator.xlsx"
99-
"application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
100-
Xlsx.newXlsx
101-
pure id
102-
]
103-
[ icon Icon.IconDownload
104-
],
105-
button_
106-
[ role_ "button",
107-
style_
108-
[ ("min-width", "0")
109-
],
110-
onClick
111-
. PushUpdate
112-
. Instant
113-
. Jsm.shareText
114-
. from @String @Unicode
115-
. either impureThrow URI.renderStr
116-
$ stUri st
117-
]
118-
[ icon Icon.IconShare
119-
]
120-
]
25+
[ keyed "menu"
26+
$ nav_
27+
[ style_
28+
[ ("grid-template-columns", "auto 1fr auto auto auto auto")
29+
]
30+
]
31+
[ button_
32+
[ role_ "button",
33+
style_
34+
[ ("min-width", "0")
35+
],
36+
onClick
37+
. PushUpdate
38+
. Instant
39+
. PureUpdate
40+
$ #modelMenu
41+
.~ Opened
42+
]
43+
[ icon Icon.IconMenu
44+
],
45+
button_
46+
[ role_ "button",
47+
style_
48+
[ ("min-width", "0"),
49+
("justify-self", "start"),
50+
("word-break", "keep-all"),
51+
("overflow-wrap", "normal")
52+
],
53+
onClick . PushUpdate . Instant . ImpureUpdate $ do
54+
doc <- liftIO newSt
55+
pure $ #modelState .~ doc
56+
]
57+
[ text "Delivery Calculator"
58+
],
59+
button_
60+
[ role_ "button",
61+
style_
62+
[ ("min-width", "0")
63+
],
64+
onClick
65+
. PushUpdate
66+
. Instant
67+
. PureUpdate
68+
$ #modelFav
69+
.~ Opened
70+
]
71+
[ icon Icon.IconFav
72+
],
73+
button_
74+
[ role_ "button",
75+
style_
76+
[ ("min-width", "0")
77+
],
78+
onClick
79+
. PushUpdate
80+
. Instant
81+
. ImpureUpdate
82+
$ do
83+
Jsm.printCurrentPage "delivery-calculator"
84+
pure id
85+
]
86+
[ icon Icon.IconPrint
87+
],
88+
button_
89+
[ role_ "button",
90+
style_
91+
[ ("min-width", "0")
92+
],
93+
onClick
94+
. PushUpdate
95+
. Instant
96+
. ImpureUpdate
97+
$ do
98+
Jsm.saveFile
99+
"delivery-calculator.xlsx"
100+
"application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
101+
Xlsx.newXlsx
102+
pure id
103+
]
104+
[ icon Icon.IconDownload
105+
],
106+
button_
107+
[ role_ "button",
108+
style_
109+
[ ("min-width", "0")
110+
],
111+
onClick
112+
. PushUpdate
113+
. Instant
114+
. Jsm.shareText
115+
. from @String @Unicode
116+
. either impureThrow URI.renderStr
117+
$ stUri st
118+
]
119+
[ icon Icon.IconShare
120+
]
121+
]
121122
]
122123
<> Fav.fav st
123124
<> Dialog.dialog
124125
( Dialog.defOpts
125126
& #optsTitleIcon
126127
.~ Just Icon.IconSettings
128+
& #optsKeyed
129+
.~ ("menu" :: Unicode)
127130
& #optsTitle
128131
.~ Just "Settings"
129132
)

ghcjs/miso-functora/src/Functora/Miso/Types.hs

Lines changed: 4 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -492,24 +492,10 @@ identityToUnique :: (TraversableB f, MonadIO m) => f Identity -> m (f Unique)
492492
identityToUnique =
493493
btraverse $ newUnique . runIdentity
494494

495-
keyed :: Uid -> View action -> View action
496-
keyed uid = \case
497-
Node x0 x1 Nothing x2 x3
498-
| not (nullUid uid) ->
499-
Node
500-
x0
501-
x1
502-
( Just
503-
. Miso.Key
504-
. either impureThrow id
505-
. decodeUtf8Strict
506-
. unTagged
507-
$ htmlUid uid
508-
)
509-
x2
510-
x3
511-
x ->
512-
x
495+
keyed :: Unicode -> View action -> View action
496+
keyed key = \case
497+
Node x0 x1 Nothing x2 x3 -> Node x0 x1 (Just $ Miso.Key key) x2 x3
498+
x -> x
513499

514500
prependViews :: [View action] -> View action -> View action
515501
prependViews xs = \case

ghcjs/miso-functora/src/Functora/Miso/Widgets/Dialog.hs

Lines changed: 24 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ data Opts model action = Opts
2929
optsFooterRight :: [View action] -> [View action],
3030
optsExtraOnClose :: model -> model,
3131
optsFlexContent :: Bool,
32+
optsKeyed :: Unicode,
3233
optsIcon :: Icon.Icon -> View action
3334
}
3435
deriving stock (Generic)
@@ -44,6 +45,7 @@ defOpts =
4445
optsFooterRight = id,
4546
optsExtraOnClose = id,
4647
optsFlexContent = True,
48+
optsKeyed = mempty,
4749
optsIcon = Icon.icon @Icon.Fa
4850
}
4951

@@ -56,26 +58,28 @@ dialog opts args =
5658
if not opened
5759
then mempty
5860
else
59-
FixedOverlay.fixedOverlay
60-
[ role_ "button",
61-
onClick $ closeDialogAction opts args
62-
]
63-
. singleton
64-
. nodeHtml "dialog" [boolProp "open" True]
65-
$ Flex.flexLeftRight
66-
header_
67-
id
68-
(optsHeaderLeft opts defHeaderLeft)
69-
(optsHeaderRight opts defHeaderRight)
70-
<> ( if optsFlexContent opts
71-
then [Flex.flexCol form_ id $ argsContent args]
72-
else [form_ mempty $ argsContent args]
73-
)
74-
<> Flex.flexLeftRight
75-
footer_
76-
id
77-
(optsFooterLeft opts mempty)
78-
(optsFooterRight opts defFooterRight)
61+
[ keyed (optsKeyed opts <> "-overlay")
62+
$ FixedOverlay.fixedOverlay
63+
[ role_ "button",
64+
onClick $ closeDialogAction opts args
65+
],
66+
keyed (optsKeyed opts <> "-content")
67+
. nodeHtml "dialog" [boolProp "open" True]
68+
$ Flex.flexLeftRight
69+
header_
70+
id
71+
(optsHeaderLeft opts defHeaderLeft)
72+
(optsHeaderRight opts defHeaderRight)
73+
<> ( if optsFlexContent opts
74+
then [Flex.flexCol form_ id $ argsContent args]
75+
else [form_ mempty $ argsContent args]
76+
)
77+
<> Flex.flexLeftRight
78+
footer_
79+
id
80+
(optsFooterLeft opts mempty)
81+
(optsFooterRight opts defFooterRight)
82+
]
7983
where
8084
opened =
8185
args ^? #argsModel . cloneTraversal (argsOptic args) == Just Opened

0 commit comments

Comments
 (0)