Skip to content

Commit 55a97a3

Browse files
functorafunctora
committed
wip
1 parent 06add75 commit 55a97a3

File tree

14 files changed

+230
-136
lines changed

14 files changed

+230
-136
lines changed

‎ghcjs/delivery-calculator/delivery-calculator.cabal‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,6 @@ common pkg
1616
hs-source-dirs: src
1717
js-sources: static/app.js
1818
other-modules:
19-
App.Misc
2019
App.Types
2120
App.Widgets.Asset
2221
App.Widgets.Fav

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

Lines changed: 0 additions & 18 deletions
This file was deleted.

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

Lines changed: 22 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ module App.Types
1818
stTeleUri,
1919
setScreenPure,
2020
setScreenAction,
21+
pushActionQueue,
2122
vsn,
2223
usd,
2324
btc,
@@ -53,9 +54,9 @@ import qualified Paths_delivery_calculator as Paths
5354
import qualified Text.URI as URI
5455

5556
data Model = Model
56-
{ modelFav :: OpenedOrClosed,
57-
modelMenu :: OpenedOrClosed,
58-
modelLinks :: OpenedOrClosed,
57+
{ modelFav :: Unique OpenedOrClosed,
58+
modelMenu :: Unique OpenedOrClosed,
59+
modelLinks :: Unique OpenedOrClosed,
5960
modelLoading :: Bool,
6061
modelState :: St Unique,
6162
modelFavMap :: Map Unicode Fav,
@@ -132,7 +133,7 @@ newSt = do
132133

133134
data Asset f = Asset
134135
{ assetFieldPairs :: [FieldPair DynamicField f],
135-
assetModalState :: OpenedOrClosed
136+
assetModalState :: f OpenedOrClosed
136137
}
137138
deriving stock (Generic)
138139

@@ -162,10 +163,12 @@ newAsset = do
162163
newFieldPair "Price" $ DynamicFieldNumber 10
163164
qty <-
164165
newFieldPair "Quantity" $ DynamicFieldNumber 1
166+
modal <-
167+
newUnique Opened
165168
pure
166169
Asset
167170
{ assetFieldPairs = [link, photo, price, qty],
168-
assetModalState = Opened
171+
assetModalState = modal
169172
}
170173

171174
newFieldPair ::
@@ -294,9 +297,9 @@ baseUri =
294297
setScreenPure :: Screen -> Update Model
295298
setScreenPure sc =
296299
PureUpdate
297-
$ (& #modelFav .~ Closed)
298-
. (& #modelMenu .~ Closed)
299-
. (& #modelLinks .~ Closed)
300+
$ (& #modelFav . #uniqueValue .~ Closed)
301+
. (& #modelMenu . #uniqueValue .~ Closed)
302+
. (& #modelLinks . #uniqueValue .~ Closed)
300303
. (& #modelState . #stScreen .~ sc)
301304

302305
setScreenAction :: Screen -> Action
@@ -305,6 +308,17 @@ setScreenAction =
305308
. Instant
306309
. setScreenPure
307310

311+
pushActionQueue ::
312+
( MonadIO m
313+
) =>
314+
Model ->
315+
InstantOrDelayed (Update Model) ->
316+
m ()
317+
pushActionQueue st =
318+
liftIO
319+
. atomically
320+
. writeTChan (st ^. #modelProducerQueue)
321+
308322
vsn :: Unicode
309323
vsn =
310324
intercalate "."

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

Lines changed: 19 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,6 @@ module App.Widgets.Asset
33
)
44
where
55

6-
import qualified App.Misc as Misc
76
import App.Types
87
import qualified Functora.Miso.Css as Css
98
import qualified Functora.Miso.Jsm as Jsm
@@ -26,9 +25,15 @@ assetViewer st idx =
2625
[ onClick
2726
. PushUpdate
2827
. Instant
29-
. PureUpdate
30-
$ cloneTraversal modalOptic
31-
.~ Opened
28+
$ PureAndImpureUpdate
29+
( cloneTraversal modalOptic
30+
. #uniqueValue
31+
.~ Opened
32+
)
33+
( do
34+
Dialog.openDialog st modalOptic
35+
pure id
36+
)
3237
]
3338
[ text "settings"
3439
]
@@ -91,7 +96,7 @@ assetViewer st idx =
9196
FieldPairs.argsAction =
9297
PushUpdate . Instant,
9398
FieldPairs.argsEmitter =
94-
Misc.pushActionQueue st . Instant
99+
pushActionQueue st . Instant
95100
}
96101
title =
97102
"Item #" <> inspect (idx + 1)
@@ -103,6 +108,12 @@ assetViewer st idx =
103108
closeAction =
104109
PushUpdate
105110
. Instant
106-
. PureUpdate
107-
$ cloneTraversal modalOptic
108-
.~ Closed
111+
$ PureAndImpureUpdate
112+
( cloneTraversal modalOptic
113+
. #uniqueValue
114+
.~ Closed
115+
)
116+
( do
117+
Dialog.closeDialog st modalOptic
118+
pure id
119+
)

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

Lines changed: 16 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,6 @@ module App.Widgets.Fav
33
)
44
where
55

6-
import qualified App.Misc as Misc
76
import App.Types
87
import App.Widgets.Templates
98
import qualified Data.Map as Map
@@ -31,8 +30,7 @@ fav st =
3130
{ Field.argsModel = st,
3231
Field.argsOptic = #modelState . #stFavName,
3332
Field.argsAction = PushUpdate . Instant,
34-
Field.argsEmitter =
35-
Misc.pushActionQueue st . Instant
33+
Field.argsEmitter = pushActionQueue st . Instant
3634
}
3735
Field.defOpts
3836
{ Field.optsPlaceholder = "Name",
@@ -125,16 +123,18 @@ favItem st label Fav {favUri = uri} =
125123
]
126124
]
127125
where
128-
openAction = PushUpdate . Instant . ImpureUpdate $ do
129-
--
130-
-- TODO : Implement here pure, less costly equivalent of newModel.
131-
--
132-
next <- newModel (st ^. #modelWebOpts) (Just st) uri
133-
pure $ \nextSt ->
134-
nextSt
135-
& #modelFav
136-
.~ Closed
137-
& #modelLoading
138-
.~ True
139-
& #modelState
140-
.~ modelState next
126+
openAction =
127+
PushUpdate
128+
. Instant
129+
$ PureAndImpureUpdate
130+
( (#modelLoading .~ True)
131+
. (#modelFav . #uniqueValue .~ Closed)
132+
)
133+
( do
134+
--
135+
-- TODO : Implement here pure, less costly equivalent of newModel.
136+
--
137+
Dialog.closeDialog st #modelFav
138+
next <- newModel (st ^. #modelWebOpts) (Just st) uri
139+
pure $ #modelState .~ modelState next
140+
)

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

Lines changed: 17 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,13 @@
11
module App.Widgets.Main (mainWidget) where
22

3-
import qualified App.Misc as Misc
43
import App.Types
54
import qualified App.Widgets.Asset as Asset
65
import qualified App.Widgets.Menu as Menu
76
import qualified Functora.Miso.Css as Css
87
import qualified Functora.Miso.Jsm as Jsm
98
import Functora.Miso.Prelude
109
import qualified Functora.Miso.Widgets.BrowserLink as BrowserLink
10+
import qualified Functora.Miso.Widgets.Dialog as Dialog
1111
import qualified Functora.Miso.Widgets.Field as Field
1212
import qualified Functora.Miso.Widgets.FieldPairs as FieldPairs
1313
import qualified Functora.Miso.Widgets.Grid as Grid
@@ -53,7 +53,7 @@ screenWidget st@Model {modelState = St {stScreen = QrCode sc}} =
5353
{ Field.argsModel = st,
5454
Field.argsOptic = #modelState . #stPreview,
5555
Field.argsAction = PushUpdate . Instant,
56-
Field.argsEmitter = Misc.pushActionQueue st . Instant
56+
Field.argsEmitter = pushActionQueue st . Instant
5757
}
5858
)
5959
<> [ Grid.bigCell
@@ -62,7 +62,7 @@ screenWidget st@Model {modelState = St {stScreen = QrCode sc}} =
6262
{ FieldPairs.argsModel = st,
6363
FieldPairs.argsOptic = #modelUriViewer,
6464
FieldPairs.argsAction = PushUpdate . Instant,
65-
FieldPairs.argsEmitter = Misc.pushActionQueue st . Instant
65+
FieldPairs.argsEmitter = pushActionQueue st . Instant
6666
}
6767
]
6868
<> [ Grid.bigCell
@@ -80,7 +80,7 @@ screenWidget st@Model {modelState = St {stScreen = Donate}} =
8080
{ FieldPairs.argsModel = st,
8181
FieldPairs.argsOptic = #modelDonateViewer,
8282
FieldPairs.argsAction = PushUpdate . Instant,
83-
FieldPairs.argsEmitter = Misc.pushActionQueue st . Instant
83+
FieldPairs.argsEmitter = pushActionQueue st . Instant
8484
}
8585
<> [ Grid.bigCell
8686
[ button_
@@ -109,7 +109,18 @@ screenWidget st@Model {modelState = St {stScreen = Main}} =
109109
[ Css.fullWidth,
110110
onClick . PushUpdate . Instant . ImpureUpdate $ do
111111
asset <- newAsset
112-
pure $ #modelState . #stAssets %~ flip snoc asset
112+
void . spawnLink $ do
113+
--
114+
-- NOTE : not reliable
115+
--
116+
sleepMilliSeconds 100
117+
Dialog.openDialog st
118+
. constTraversal
119+
$ assetModalState asset
120+
pure
121+
$ #modelState
122+
. #stAssets
123+
%~ flip snoc asset
113124
]
114125
[ text "Add item"
115126
]
@@ -158,7 +169,7 @@ totalViewer st =
158169
$ fee
159170
],
160171
FieldPairs.argsAction = PushUpdate . Instant,
161-
FieldPairs.argsEmitter = Misc.pushActionQueue st . Instant
172+
FieldPairs.argsEmitter = pushActionQueue st . Instant
162173
}
163174
where
164175
fee = st ^. #modelState . #stMerchantFeePercent

0 commit comments

Comments
 (0)