Skip to content

Commit 2da583b

Browse files
committed
refactoring wip
1 parent 09dda14 commit 2da583b

File tree

16 files changed

+196
-364
lines changed

16 files changed

+196
-364
lines changed

ghcjs/delivery-calculator/default.nix

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -113,7 +113,7 @@ in rec {
113113
--externs ${
114114
pkgs.haskell.packages.ghc865.bitcoin-keys.src
115115
}/js/index.compiled.js \
116-
--externs ${../miso-widgets/js/main.min.js} \
116+
--externs ${../miso-functora/js/main.min.js} \
117117
--externs ${../miso-components/material-components-web.min.js} \
118118
--externs ${../miso-components/material-components-web-elm.min.js} \
119119
--output_wrapper "%output%//# sourceMappingURL=all.js.map" \

ghcjs/delivery-calculator/delivery-calculator.cabal

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -94,7 +94,7 @@ common pkg
9494
, microlens
9595
, miso
9696
, miso-components
97-
, miso-widgets
97+
, miso-functora
9898
, modern-uri
9999
, syb
100100
, xlsx

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,7 @@ pushActionQueue ::
1010
( MonadIO m
1111
) =>
1212
Model ->
13-
InstantOrDelayed (Model -> JSM Model) ->
13+
InstantOrDelayed (Update Model) ->
1414
m ()
1515
pushActionQueue st =
1616
liftIO

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

Lines changed: 7 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -40,9 +40,7 @@ import qualified Data.Version as Version
4040
import Functora.Cfg
4141
import Functora.Miso.Prelude
4242
import Functora.Miso.Types as X hiding
43-
( Asset (..),
44-
newAsset,
45-
newFieldPair,
43+
( newFieldPair,
4644
newFieldPairId,
4745
)
4846
import qualified Functora.Miso.Types as FM
@@ -63,8 +61,8 @@ data Model = Model
6361
modelFavMap :: Map Unicode Fav,
6462
modelUriViewer :: [FieldPair DynamicField Unique],
6563
modelDonateViewer :: [FieldPair DynamicField Unique],
66-
modelProducerQueue :: TChan (InstantOrDelayed (Model -> JSM Model)),
67-
modelConsumerQueue :: TChan (InstantOrDelayed (Model -> JSM Model)),
64+
modelProducerQueue :: TChan (InstantOrDelayed (Update Model)),
65+
modelConsumerQueue :: TChan (InstantOrDelayed (Update Model)),
6866
modelCurrencies :: NonEmpty CurrencyInfo,
6967
modelWebOpts :: Web.Opts,
7068
modelMarket :: MVar Rates.Market
@@ -76,7 +74,7 @@ data Action
7674
| InitUpdate (Maybe (St Unique))
7775
| SyncInputs
7876
| ChanUpdate Model
79-
| PushUpdate (InstantOrDelayed (Model -> JSM Model))
77+
| PushUpdate (InstantOrDelayed (Update Model))
8078

8179
data St f = St
8280
{ stAssets :: [Asset f],
@@ -293,10 +291,10 @@ baseUri =
293291
"https://functora.github.io/apps/delivery-calculator/" <> vsn <> "/index.html"
294292
#endif
295293

296-
setScreenPure :: Screen -> Model -> JSM Model
294+
setScreenPure :: Screen -> Update Model
297295
setScreenPure sc =
298-
pure
299-
. (& #modelFav .~ Closed)
296+
PureUpdate
297+
$ (& #modelFav .~ Closed)
300298
. (& #modelMenu .~ Closed)
301299
. (& #modelLinks .~ Closed)
302300
. (& #modelState . #stScreen .~ sc)

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

Lines changed: 25 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,6 @@ import qualified Functora.Miso.Jsm as Jsm
1010
import Functora.Miso.Prelude
1111
import qualified Functora.Miso.Widgets.FieldPairs as FieldPairs
1212
import qualified Functora.Miso.Widgets.Grid as Grid
13-
import qualified Functora.Miso.Widgets.Header as Header
1413
import qualified Material.Button as Button
1514
import qualified Material.Dialog as Dialog
1615
import qualified Material.IconButton as IconButton
@@ -23,22 +22,25 @@ assetsViewer st = do
2322

2423
assetViewer :: Model -> Int -> [View Action]
2524
assetViewer st idx =
26-
Header.headerViewer
27-
title
28-
[ IconButton.iconButton
29-
( IconButton.config
30-
& IconButton.setAttributes
31-
[ Theme.primary
32-
]
33-
& IconButton.setOnClick
34-
( PushUpdate
35-
. Instant
36-
$ pure
37-
. (cloneTraversal modalOptic .~ Opened)
38-
)
39-
)
40-
"settings"
41-
]
25+
[ h1_
26+
mempty
27+
[ text title,
28+
IconButton.iconButton
29+
( IconButton.config
30+
& IconButton.setAttributes
31+
[ Theme.primary
32+
]
33+
& IconButton.setOnClick
34+
( PushUpdate
35+
. Instant
36+
. PureUpdate
37+
$ cloneTraversal modalOptic
38+
.~ Opened
39+
)
40+
)
41+
"settings"
42+
]
43+
]
4244
<> ( if st ^? cloneTraversal modalOptic /= Just Opened
4345
then mempty
4446
else
@@ -51,7 +53,9 @@ assetViewer st idx =
5153
Nothing
5254
[ Grid.grid
5355
mempty
54-
$ Header.headerViewer title mempty
56+
$ [ h1_ mempty
57+
$ [text title]
58+
]
5559
<> ( FieldPairs.fieldPairsEditor
5660
args
5761
$ FieldPairs.defOpts
@@ -112,5 +116,6 @@ assetViewer st idx =
112116
closeAction =
113117
PushUpdate
114118
. Instant
115-
$ pure
116-
. (& cloneTraversal modalOptic .~ Closed)
119+
. PureUpdate
120+
$ cloneTraversal modalOptic
121+
.~ Closed

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

Lines changed: 37 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,6 @@ fav st =
4242
}
4343
Field.defOpts
4444
{ Field.optsPlaceholder = "Name",
45-
Field.optsFilledOrOutlined = Outlined,
4645
Field.optsOnKeyDownAction = onKeyDownAction,
4746
Field.optsTrailingWidget =
4847
let w =
@@ -78,29 +77,34 @@ fav st =
7877
)
7978
]
8079
where
81-
closeAction = PushUpdate . Instant $ pure . (& #modelFav .~ Closed)
82-
saveAction nextSt = do
83-
ct <- getCurrentTime
84-
uri <- stUri nextSt
85-
let txt = makeFavName st
86-
let nextFav = Fav {favUri = uri, favCreatedAt = ct}
87-
let nextFavName = makeFavName nextSt
88-
Jsm.popupText
89-
$ "Saved"
90-
<> ( if txt == mempty
91-
then mempty
92-
else " "
93-
)
94-
<> txt
95-
<> "!"
96-
pure
97-
$ nextSt
98-
& #modelFavMap
99-
. at nextFavName
100-
%~ (Just . maybe nextFav (& #favUri .~ uri))
101-
deleteAction = PushUpdate . Instant $ \nextSt -> do
80+
closeAction =
81+
PushUpdate
82+
. Instant
83+
. PureUpdate
84+
$ #modelFav
85+
.~ Closed
86+
saveAction =
87+
ImpureUpdate $ do
88+
ct <- getCurrentTime
89+
uri <- stUri st
90+
let txt = makeFavName st
91+
let nextFav = Fav {favUri = uri, favCreatedAt = ct}
92+
let nextFavName = makeFavName st
93+
Jsm.popupText
94+
$ "Saved"
95+
<> ( if txt == mempty
96+
then mempty
97+
else " "
98+
)
99+
<> txt
100+
<> "!"
101+
pure
102+
$ #modelFavMap
103+
. at nextFavName
104+
%~ (Just . maybe nextFav (& #favUri .~ uri))
105+
deleteAction = PushUpdate . Instant . ImpureUpdate $ do
102106
let txt = makeFavName st
103-
let nextFavName = makeFavName nextSt
107+
let nextFavName = makeFavName st
104108
Jsm.popupText
105109
$ "Removed"
106110
<> ( if txt == mempty
@@ -110,8 +114,7 @@ fav st =
110114
<> txt
111115
<> "!"
112116
pure
113-
$ nextSt
114-
& #modelFavMap
117+
$ #modelFavMap
115118
. at nextFavName
116119
.~ Nothing
117120
onKeyDownAction uid code =
@@ -148,16 +151,16 @@ favItem st label Fav {favUri = uri} =
148151
label
149152
]
150153
where
151-
openAction = PushUpdate . Instant $ \nextSt -> do
154+
openAction = PushUpdate . Instant . ImpureUpdate $ do
152155
--
153156
-- TODO : Implement here pure, less costly equivalent of newModel.
154157
--
155158
next <- newModel (st ^. #modelWebOpts) (Just st) uri
156-
pure
157-
$ nextSt
158-
& #modelFav
159-
.~ Closed
160-
& #modelLoading
161-
.~ True
162-
& #modelState
163-
.~ modelState next
159+
pure $ \nextSt ->
160+
nextSt
161+
& #modelFav
162+
.~ Closed
163+
& #modelLoading
164+
.~ True
165+
& #modelState
166+
.~ modelState next

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

Lines changed: 13 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,6 @@ import qualified Functora.Miso.Widgets.BrowserLink as BrowserLink
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
14-
import qualified Functora.Miso.Widgets.Header as Header
1514
import qualified Functora.Money as Money
1615
import Lens.Micro ((^..))
1716
import qualified Material.Button as Button
@@ -60,15 +59,13 @@ screenWidget st@Model {modelState = St {stScreen = QrCode sc}} =
6059
( if unQrCode sc == Donate
6160
then mempty
6261
else
63-
Header.headerWrapper
64-
( Field.fieldViewer
65-
Field.Args
66-
{ Field.argsModel = st,
67-
Field.argsOptic = #modelState . #stPreview,
68-
Field.argsAction = PushUpdate . Instant,
69-
Field.argsEmitter = Misc.pushActionQueue st . Instant
70-
}
71-
)
62+
Field.fieldViewer
63+
Field.Args
64+
{ Field.argsModel = st,
65+
Field.argsOptic = #modelState . #stPreview,
66+
Field.argsAction = PushUpdate . Instant,
67+
Field.argsEmitter = Misc.pushActionQueue st . Instant
68+
}
7269
)
7370
<> [ Grid.bigCell
7471
$ FieldPairs.fieldPairsViewer
@@ -126,9 +123,9 @@ screenWidget st@Model {modelState = St {stScreen = Main}} =
126123
& Button.setIcon (Just "add_box")
127124
& Button.setAttributes [Css.fullWidth]
128125
& Button.setOnClick
129-
( PushUpdate . Instant $ \next -> do
126+
( PushUpdate . Instant . ImpureUpdate $ do
130127
asset <- newAsset
131-
pure $ next & #modelState . #stAssets %~ flip snoc asset
128+
pure $ #modelState . #stAssets %~ flip snoc asset
132129
)
133130
)
134131
"Add item"
@@ -141,7 +138,8 @@ screenWidget st@Model {modelState = St {stScreen = Main}} =
141138
& Button.setOnClick
142139
( PushUpdate
143140
. Instant
144-
$ \next -> flip Jsm.openBrowserPage next =<< stTeleUri next
141+
. either impureThrow Jsm.openBrowserPage
142+
$ stTeleUri st
145143
)
146144
)
147145
"Order via Telegram"
@@ -153,7 +151,8 @@ totalViewer st =
153151
if base == 0
154152
then mempty
155153
else
156-
Header.headerViewer "Total" mempty
154+
[ h1_ mempty [text "Total"]
155+
]
157156
<> FieldPairs.fieldPairsViewer
158157
FieldPairs.Args
159158
{ FieldPairs.argsModel = st,

0 commit comments

Comments
 (0)