Skip to content

Commit 4ca33c6

Browse files
functorafunctora
committed
miso sink refactoring wip
1 parent d231409 commit 4ca33c6

File tree

9 files changed

+148
-241
lines changed

9 files changed

+148
-241
lines changed

‎ghcjs/delivery-calculator/src/App/Types.hs‎

Lines changed: 9 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@ module App.Types
1919
unShareUri,
2020
stUri,
2121
setScreenAction,
22-
pushActionQueue,
22+
emitter,
2323
icon,
2424
vsn,
2525
usd,
@@ -62,7 +62,8 @@ import qualified Text.Regex as Re
6262
import qualified Text.URI as URI
6363

6464
data Model = Model
65-
{ modelMenu :: OpenedOrClosed,
65+
{ modelSink :: MVar (Action -> IO ()),
66+
modelMenu :: OpenedOrClosed,
6667
modelLinks :: OpenedOrClosed,
6768
modelPlaceOrder :: OpenedOrClosed,
6869
modelRemoveOrder :: OpenedOrClosed,
@@ -71,8 +72,6 @@ data Model = Model
7172
modelState :: St Unique,
7273
modelUriViewer :: [FieldPair DynamicField Unique],
7374
modelDonateViewer :: [FieldPair DynamicField Unique],
74-
modelProducerQueue :: TChan (InstantOrDelayed (Update Model)),
75-
modelConsumerQueue :: TChan (InstantOrDelayed (Update Model)),
7675
modelCurrencies :: NonEmpty CurrencyInfo,
7776
modelWebOpts :: Web.Opts,
7877
modelMarket :: MVar Rates.Market
@@ -83,8 +82,8 @@ data Action
8382
= Noop
8483
| InitUpdate (Maybe (St Unique))
8584
| SyncInputs
86-
| ChanUpdate (Model -> Model)
87-
| PushUpdate (InstantOrDelayed (Update Model))
85+
| EvalUpdate (Model -> Model)
86+
| PushUpdate (Update Model)
8887

8988
data St f = St
9089
{ stAssets :: [Asset f],
@@ -491,19 +490,12 @@ setScreenPure sc =
491490
setScreenAction :: Screen -> Action
492491
setScreenAction =
493492
PushUpdate
494-
. Instant
495493
. setScreenPure
496494

497-
pushActionQueue ::
498-
( MonadIO m
499-
) =>
500-
Model ->
501-
InstantOrDelayed (Update Model) ->
502-
m ()
503-
pushActionQueue st =
504-
liftIO
505-
. atomically
506-
. writeTChan (st ^. #modelProducerQueue)
495+
emitter :: (MonadIO m) => Model -> Update Model -> m ()
496+
emitter st updater = do
497+
sink <- readMVar $ modelSink st
498+
liftIO . sink $ PushUpdate updater
507499

508500
icon :: Icon.Icon -> View action
509501
icon = Icon.icon @Icon.Fa

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

Lines changed: 5 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,6 @@ assetViewer st idx =
2727
button_
2828
[ onClick
2929
. PushUpdate
30-
. Instant
3130
. PureUpdate
3231
$ cloneTraversal modalOptic
3332
.~ Opened
@@ -65,7 +64,7 @@ assetViewer st idx =
6564
Dialog.Args
6665
{ Dialog.argsModel = st,
6766
Dialog.argsOptic = modalOptic,
68-
Dialog.argsAction = PushUpdate . Instant,
67+
Dialog.argsAction = PushUpdate,
6968
Dialog.argsContent =
7069
failures False
7170
<> FieldPairs.fieldPairsEditor args fieldPairsOpts
@@ -78,9 +77,10 @@ assetViewer st idx =
7877
FieldPairs.argsOptic =
7978
#modelState . #stAssets . ix idx . #assetFieldPairs,
8079
FieldPairs.argsAction =
81-
PushUpdate . Instant,
82-
FieldPairs.argsEmitter =
83-
pushActionQueue st . Instant
80+
PushUpdate,
81+
FieldPairs.argsEmitter = \updater -> do
82+
sink <- readMVar $ modelSink st
83+
liftIO . sink $ PushUpdate updater
8484
}
8585
title =
8686
"Item #" <> inspect (idx + 1)
@@ -91,11 +91,9 @@ assetViewer st idx =
9191
. #assetModalState
9292
removeAction =
9393
PushUpdate
94-
. Instant
9594
$ Jsm.removeAt (#modelState . #stAssets) idx
9695
saveAction =
9796
PushUpdate
98-
. Instant
9997
$ PureUpdate saveUpdate
10098
saveUpdate =
10199
( #modelState
@@ -146,7 +144,6 @@ fieldPairsOpts =
146144
modal =
147145
Field.ActionWidget Icon.IconShopping mempty
148146
. PushUpdate
149-
. Instant
150147
. PureUpdate
151148
$ #modelMarketLinks
152149
.~ Opened

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

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -69,17 +69,17 @@ screenWidget st@Model {modelState = St {stScreen = QrCode sc}} =
6969
Field.Args
7070
{ Field.argsModel = st,
7171
Field.argsOptic = #modelState . #stPreview,
72-
Field.argsAction = PushUpdate . Instant,
73-
Field.argsEmitter = pushActionQueue st . Instant
72+
Field.argsAction = PushUpdate,
73+
Field.argsEmitter = emitter st
7474
}
7575
)
7676
<> FieldPairs.fieldPairsViewer
7777
FieldPairs.defOpts
7878
FieldPairs.Args
7979
{ FieldPairs.argsModel = st,
8080
FieldPairs.argsOptic = #modelUriViewer,
81-
FieldPairs.argsAction = PushUpdate . Instant,
82-
FieldPairs.argsEmitter = pushActionQueue st . Instant
81+
FieldPairs.argsAction = PushUpdate,
82+
FieldPairs.argsEmitter = emitter st
8383
}
8484
<> [ button_
8585
[ onClick . setScreenAction $ unQrCode sc
@@ -93,8 +93,8 @@ screenWidget st@Model {modelState = St {stScreen = Donate}} =
9393
FieldPairs.Args
9494
{ FieldPairs.argsModel = st,
9595
FieldPairs.argsOptic = #modelDonateViewer,
96-
FieldPairs.argsAction = PushUpdate . Instant,
97-
FieldPairs.argsEmitter = pushActionQueue st . Instant
96+
FieldPairs.argsAction = PushUpdate,
97+
FieldPairs.argsEmitter = emitter st
9898
}
9999
<> [ button_
100100
[ onClick $ setScreenAction Main
@@ -128,7 +128,7 @@ screenWidget st@Model {modelState = St {stScreen = Main}} =
128128
]
129129
)
130130
$ ( button_
131-
[ onClick . PushUpdate . Instant . ImpureUpdate $ do
131+
[ onClick . PushUpdate . ImpureUpdate $ do
132132
asset <- newAsset
133133
pure
134134
$ #modelState
@@ -154,8 +154,8 @@ totalViewer st =
154154
FieldPairs.Args
155155
{ FieldPairs.argsModel = st,
156156
FieldPairs.argsOptic = constTraversal total,
157-
FieldPairs.argsAction = PushUpdate . Instant,
158-
FieldPairs.argsEmitter = pushActionQueue st . Instant
157+
FieldPairs.argsAction = PushUpdate,
158+
FieldPairs.argsEmitter = emitter st
159159
}
160160
where
161161
total = newTotal $ modelState st
@@ -170,7 +170,7 @@ tosWidget =
170170
BrowserLink.Args
171171
{ BrowserLink.argsLink = functoraLink,
172172
BrowserLink.argsLabel = "Functora",
173-
BrowserLink.argsAction = PushUpdate . Instant
173+
BrowserLink.argsAction = PushUpdate
174174
},
175175
Miso.text ". All rights reserved. ",
176176
Miso.text "By continuing to use this software, you agree to the ",

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

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,7 @@ marketLinks st =
1717
Dialog.Args
1818
{ Dialog.argsModel = st,
1919
Dialog.argsOptic = #modelMarketLinks,
20-
Dialog.argsAction = PushUpdate . Instant,
20+
Dialog.argsAction = PushUpdate,
2121
Dialog.argsContent =
2222
[ button_ [onClick $ openBrowser alibabaLink] [text "1688"],
2323
button_ [onClick $ openBrowser alibabaLink] [text "Alibaba"],
@@ -30,7 +30,6 @@ marketLinks st =
3030
where
3131
openBrowser link =
3232
PushUpdate
33-
. Instant
3433
$ PureAndEffectUpdate
3534
(#modelMarketLinks .~ Closed)
3635
(Jsm.openBrowserPage link)

0 commit comments

Comments
 (0)