Skip to content

Commit 7e88ef6

Browse files
functorafunctora
committed
wip
1 parent 7ecc168 commit 7e88ef6

File tree

6 files changed

+63
-157
lines changed

6 files changed

+63
-157
lines changed

‎ghcjs/delivery-calculator/src/App/Widgets/Asset.hs‎

Lines changed: 8 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -25,15 +25,10 @@ assetViewer st idx =
2525
[ onClick
2626
. PushUpdate
2727
. Instant
28-
$ PureAndImpureUpdate
29-
( cloneTraversal modalOptic
30-
. #uniqueValue
31-
.~ Opened
32-
)
33-
( do
34-
Dialog.openDialog st modalOptic
35-
pure id
36-
)
28+
. PureUpdate
29+
$ cloneTraversal modalOptic
30+
. #uniqueValue
31+
.~ Opened
3732
]
3833
[ text "settings"
3934
]
@@ -105,12 +100,7 @@ assetViewer st idx =
105100
closeAction =
106101
PushUpdate
107102
. Instant
108-
$ PureAndImpureUpdate
109-
( cloneTraversal modalOptic
110-
. #uniqueValue
111-
.~ Closed
112-
)
113-
( do
114-
Dialog.closeDialog st modalOptic
115-
pure id
116-
)
103+
. PureUpdate
104+
$ cloneTraversal modalOptic
105+
. #uniqueValue
106+
.~ Closed

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

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -134,7 +134,6 @@ favItem st label Fav {favUri = uri} =
134134
--
135135
-- TODO : Implement here pure, less costly equivalent of newModel.
136136
--
137-
Dialog.closeDialog st #modelFav
138137
next <- newModel (st ^. #modelWebOpts) (Just st) uri
139138
pure $ #modelState .~ modelState next
140139
)

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

Lines changed: 0 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,6 @@ import qualified Functora.Miso.Css as Css
77
import qualified Functora.Miso.Jsm as Jsm
88
import Functora.Miso.Prelude
99
import qualified Functora.Miso.Widgets.BrowserLink as BrowserLink
10-
import qualified Functora.Miso.Widgets.Dialog as Dialog
1110
import qualified Functora.Miso.Widgets.Field as Field
1211
import qualified Functora.Miso.Widgets.FieldPairs as FieldPairs
1312
import qualified Functora.Miso.Widgets.Grid as Grid
@@ -110,14 +109,6 @@ screenWidget st@Model {modelState = St {stScreen = Main}} =
110109
[ Css.fullWidth,
111110
onClick . PushUpdate . Instant . ImpureUpdate $ do
112111
asset <- newAsset
113-
void . spawnLink $ do
114-
--
115-
-- NOTE : not reliable
116-
--
117-
sleepMilliSeconds 100
118-
Dialog.openDialog st
119-
. constTraversal
120-
$ assetModalState asset
121112
pure
122113
$ #modelState
123114
. #stAssets

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

Lines changed: 16 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -35,15 +35,10 @@ menu st =
3535
onClick
3636
. PushUpdate
3737
. Instant
38-
$ PureAndImpureUpdate
39-
( #modelMenu
40-
. #uniqueValue
41-
.~ Opened
42-
)
43-
( do
44-
Dialog.openDialog st #modelMenu
45-
pure id
46-
)
38+
. PureUpdate
39+
$ #modelMenu
40+
. #uniqueValue
41+
.~ Opened
4742
]
4843
[ icon Icon.IconMenu
4944
],
@@ -64,15 +59,10 @@ menu st =
6459
onClick
6560
. PushUpdate
6661
. Instant
67-
$ PureAndImpureUpdate
68-
( #modelFav
69-
. #uniqueValue
70-
.~ Opened
71-
)
72-
( do
73-
Dialog.openDialog st #modelFav
74-
pure id
75-
)
62+
. PureUpdate
63+
$ #modelFav
64+
. #uniqueValue
65+
.~ Opened
7666
]
7767
[ icon Icon.IconFav
7868
],
@@ -292,15 +282,10 @@ menu st =
292282
screen next =
293283
PushUpdate
294284
. Instant
295-
$ PureAndImpureUpdate
296-
( (#modelMenu . #uniqueValue .~ Closed)
297-
. (#modelLoading .~ isQrCode next)
298-
. (#modelState . #stScreen .~ next)
299-
)
300-
( do
301-
Dialog.closeDialog st #modelMenu
302-
pure id
303-
)
285+
. PureUpdate
286+
$ (#modelMenu . #uniqueValue .~ Closed)
287+
. (#modelLoading .~ isQrCode next)
288+
. (#modelState . #stScreen .~ next)
304289
sc =
305290
st ^. #modelState . #stScreen
306291

@@ -407,15 +392,10 @@ linksWidget st =
407392
openWidget =
408393
PushUpdate
409394
. Instant
410-
$ PureAndImpureUpdate
411-
( #modelLinks
412-
. #uniqueValue
413-
.~ Opened
414-
)
415-
( do
416-
Dialog.openDialog st #modelLinks
417-
pure id
418-
)
395+
. PureUpdate
396+
$ #modelLinks
397+
. #uniqueValue
398+
.~ Opened
419399
openBrowser =
420400
PushUpdate
421401
. Instant

‎ghcjs/miso-functora/src/Functora/Miso/Widgets/Currency.hs‎

Lines changed: 34 additions & 46 deletions
Original file line numberDiff line numberDiff line change
@@ -87,28 +87,23 @@ selectCurrency
8787
where
8888
open =
8989
action
90-
$ PureAndImpureUpdate
91-
( \prev ->
92-
prev
93-
& cloneTraversal optic
94-
. #currencyModalState
95-
. #uniqueValue
96-
.~ Opened
97-
& cloneTraversal optic
98-
. #currencyInput
99-
. #fieldInput
100-
. #uniqueValue
101-
.~ mempty
102-
& cloneTraversal optic
103-
. #currencyInput
104-
. #fieldOutput
105-
.~ mempty
106-
& extraOnClick
107-
)
108-
( do
109-
Dialog.openDialog st (cloneTraversal optic . #currencyModalState)
110-
pure id
111-
)
90+
. PureUpdate
91+
$ \prev ->
92+
prev
93+
& cloneTraversal optic
94+
. #currencyModalState
95+
. #uniqueValue
96+
.~ Opened
97+
& cloneTraversal optic
98+
. #currencyInput
99+
. #fieldInput
100+
. #uniqueValue
101+
.~ mempty
102+
& cloneTraversal optic
103+
. #currencyInput
104+
. #fieldOutput
105+
.~ mempty
106+
& extraOnClick
112107

113108
currencyListWidget :: Opts model -> Args model action -> View action
114109
currencyListWidget
@@ -166,7 +161,7 @@ currencyListItemWidget
166161
Opts
167162
{ optsExtraOnClick = extraOnClick
168163
}
169-
args@Args
164+
Args
170165
{ argsOptic = optic,
171166
argsAction = action
172167
}
@@ -175,29 +170,22 @@ currencyListItemWidget
175170
li_
176171
[ onClick
177172
. action
178-
$ PureAndImpureUpdate
179-
( \st ->
180-
st
181-
& cloneTraversal optic
182-
. #currencyModalState
183-
. #uniqueValue
184-
.~ Closed
185-
& cloneTraversal optic
186-
. #currencyInput
187-
. #fieldInput
188-
. #uniqueValue
189-
.~ mempty
190-
& cloneTraversal optic
191-
. #currencyOutput
192-
.~ item
193-
& extraOnClick
194-
)
195-
( do
196-
Dialog.closeDialog
197-
(argsModel args)
198-
(cloneTraversal optic . #currencyModalState)
199-
pure id
200-
)
173+
. PureUpdate
174+
$ \st ->
175+
st
176+
& cloneTraversal optic
177+
. #currencyModalState
178+
. #uniqueValue
179+
.~ Closed
180+
& cloneTraversal optic
181+
. #currencyInput
182+
. #fieldInput
183+
. #uniqueValue
184+
.~ mempty
185+
& cloneTraversal optic
186+
. #currencyOutput
187+
.~ item
188+
& extraOnClick
201189
]
202190
[ ( if current == item
203191
then strong_ mempty

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

Lines changed: 5 additions & 47 deletions
Original file line numberDiff line numberDiff line change
@@ -3,16 +3,13 @@ module Functora.Miso.Widgets.Dialog
33
Opts (..),
44
defOpts,
55
dialog,
6-
openDialog,
7-
closeDialog,
86
)
97
where
108

119
import Functora.Miso.Prelude
1210
import Functora.Miso.Types
1311
import qualified Functora.Miso.Widgets.FixedOverlay as FixedOverlay
1412
import qualified Functora.Miso.Widgets.Icon as Icon
15-
import qualified Language.Javascript.JSaddle as JS
1613

1714
data Args model action = Args
1815
{ argsModel :: model,
@@ -79,7 +76,7 @@ dialog opts args =
7976
defHeaderLeft =
8077
maybeToList
8178
. fmap
82-
( h2_
79+
( h1_
8380
[ style_
8481
[ ("margin", "0"),
8582
("display", "flex"),
@@ -123,7 +120,7 @@ newFlex newTag newAttr lhs rhs =
123120
]
124121
)
125122
$ lhs
126-
<> [ span_
123+
<> [ div_
127124
[ style_
128125
[ ("flex-grow", "1")
129126
]
@@ -135,45 +132,6 @@ newFlex newTag newAttr lhs rhs =
135132
closeDialogAction :: Opts model action -> Args model action -> action
136133
closeDialogAction opts args =
137134
argsAction args
138-
$ PureAndImpureUpdate
139-
( optsExtraOnClose opts
140-
. (cloneTraversal (argsOptic args) . #uniqueValue .~ Closed)
141-
)
142-
( do
143-
closeDialog (argsModel args) (argsOptic args)
144-
pure id
145-
)
146-
147-
openDialog ::
148-
model ->
149-
ATraversal' model (Unique OpenedOrClosed) ->
150-
JSM ()
151-
openDialog st optic =
152-
handleAny consoleLog $ do
153-
el <- getElementById $ getDialogUid st optic
154-
elExist <- ghcjsPure $ JS.isTruthy el
155-
when elExist . void $ el ^. JS.js0 ("showModal" :: Unicode)
156-
157-
closeDialog ::
158-
model ->
159-
ATraversal' model (Unique OpenedOrClosed) ->
160-
JSM ()
161-
closeDialog st optic =
162-
handleAny consoleLog $ do
163-
el <- getElementById $ getDialogUid st optic
164-
elExist <- ghcjsPure $ JS.isTruthy el
165-
when elExist . void $ el ^. JS.js0 ("close" :: Unicode)
166-
167-
getDialogUid ::
168-
model ->
169-
ATraversal' model (Unique OpenedOrClosed) ->
170-
Unicode
171-
getDialogUid st optic =
172-
either impureThrow id
173-
. decodeUtf8Strict
174-
. unTagged
175-
. htmlUid
176-
. fromMaybe nilUid
177-
$ st
178-
^? cloneTraversal optic
179-
. #uniqueUid
135+
. PureUpdate
136+
$ optsExtraOnClose opts
137+
. (cloneTraversal (argsOptic args) . #uniqueValue .~ Closed)

0 commit comments

Comments
 (0)