Skip to content

Commit 6fabc94

Browse files
functorafunctora
committed
wip
1 parent 4d94675 commit 6fabc94

File tree

4 files changed

+70
-78
lines changed

4 files changed

+70
-78
lines changed

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

Lines changed: 33 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,7 @@ module App.Types
1111
newFieldPair,
1212
newFieldPairId,
1313
newTotal,
14+
inspectExchangeRate,
1415
Screen (..),
1516
isQrCode,
1617
unQrCode,
@@ -208,7 +209,7 @@ newFieldPairId key val = do
208209
. #fieldOptsQrState
209210
.~ Nothing
210211

211-
newTotal :: Model -> [FieldPair DynamicField Identity]
212+
newTotal :: St Unique -> [FieldPair DynamicField Identity]
212213
newTotal st =
213214
if base == 0
214215
then mempty
@@ -219,6 +220,9 @@ newTotal st =
219220
newFieldPairId ("Subtotal " <> quoteCur)
220221
. DynamicFieldText
221222
$ inspectRatioDef quote,
223+
newFieldPairId ("Exchange rate")
224+
. DynamicFieldText
225+
$ inspectExchangeRate st,
222226
FieldPair (newTextFieldId "Fee %")
223227
$ uniqueToIdentity fee
224228
& #fieldOpts
@@ -231,8 +235,8 @@ newTotal st =
231235
$ fee
232236
]
233237
where
234-
fee = st ^. #modelState . #stMerchantFeePercent
235-
rate = st ^. #modelState . #stExchangeRate . #fieldOutput
238+
fee = st ^. #stMerchantFeePercent
239+
rate = st ^. #stExchangeRate . #fieldOutput
236240
base =
237241
foldl
238242
( \acc fps ->
@@ -243,31 +247,48 @@ newTotal st =
243247
else acc
244248
)
245249
0
246-
( st
247-
^.. #modelState
248-
. #stAssets
249-
. each
250-
. #assetFieldPairs
250+
( st ^.. #stAssets . each . #assetFieldPairs
251251
)
252252
quote =
253253
rate * base
254254
baseCur =
255255
st
256-
^. #modelState
257-
. #stAssetCurrency
256+
^. #stAssetCurrency
258257
. #currencyOutput
259258
. #currencyInfoCode
260259
. to Money.inspectCurrencyCode
261260
. to toUpper
262261
quoteCur =
263262
st
264-
^. #modelState
265-
. #stMerchantCurrency
263+
^. #stMerchantCurrency
266264
. #currencyOutput
267265
. #currencyInfoCode
268266
. to Money.inspectCurrencyCode
269267
. to toUpper
270268

269+
inspectExchangeRate :: St f -> Unicode
270+
inspectExchangeRate st =
271+
"1 "
272+
<> toUpper
273+
( Money.inspectCurrencyCode
274+
$ st
275+
^. #stAssetCurrency
276+
. #currencyOutput
277+
. #currencyInfoCode
278+
)
279+
<> " \8776 "
280+
<> inspectRatioDef
281+
( st ^. #stExchangeRate . #fieldOutput
282+
)
283+
<> " "
284+
<> toUpper
285+
( Money.inspectCurrencyCode
286+
$ st
287+
^. #stMerchantCurrency
288+
. #currencyOutput
289+
. #currencyInfoCode
290+
)
291+
271292
foldField :: Rational -> Field DynamicField f -> Rational
272293
foldField acc Field {fieldType = typ, fieldOutput = out} =
273294
case out of

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -163,7 +163,7 @@ totalViewer st =
163163
FieldPairs.argsEmitter = pushActionQueue st . Instant
164164
}
165165
where
166-
total = newTotal st
166+
total = newTotal $ modelState st
167167

168168
tosWidget :: View Action
169169
tosWidget =

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

Lines changed: 6 additions & 62 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,6 @@ where
77

88
import qualified App.Jsm as Jsm
99
import App.Types
10-
import qualified App.Widgets.Fav as Fav
1110
import qualified App.Xlsx as Xlsx
1211
import qualified Data.ByteString.Lazy as BL
1312
import qualified Functora.Miso.Jsm as Jsm
@@ -19,7 +18,6 @@ import qualified Functora.Miso.Widgets.Field as Field
1918
import qualified Functora.Miso.Widgets.Icon as Icon
2019
import qualified Functora.Miso.Widgets.Select as Select
2120
import qualified Functora.Miso.Widgets.Switch as Switch
22-
import qualified Functora.Money as Money
2321
import qualified Text.URI as URI
2422

2523
menu :: Model -> [View Action]
@@ -66,26 +64,12 @@ menu st =
6664
onClick
6765
. PushUpdate
6866
. Instant
69-
. PureUpdate
70-
$ #modelFav
71-
.~ Opened
72-
]
73-
[ icon Icon.IconFav
74-
],
75-
button_
76-
[ role_ "button",
77-
style_
78-
[ ("min-width", "0")
79-
],
80-
onClick
81-
. PushUpdate
82-
. Instant
83-
. ImpureUpdate
84-
$ do
85-
Jsm.printCurrentPage "delivery-calculator"
86-
pure id
67+
. Jsm.shareText
68+
. from @String @Unicode
69+
. either impureThrow URI.renderStr
70+
$ stUri st
8771
]
88-
[ icon Icon.IconPrint
72+
[ icon Icon.IconShare
8973
],
9074
button_
9175
[ role_ "button",
@@ -100,25 +84,9 @@ menu st =
10084
$ Xlsx.newXlsx doc imgs
10185
]
10286
[ icon Icon.IconDownload
103-
],
104-
button_
105-
[ role_ "button",
106-
style_
107-
[ ("min-width", "0")
108-
],
109-
onClick
110-
. PushUpdate
111-
. Instant
112-
. Jsm.shareText
113-
. from @String @Unicode
114-
. either impureThrow URI.renderStr
115-
$ stUri st
116-
]
117-
[ icon Icon.IconShare
11887
]
11988
]
12089
]
121-
<> Fav.fav st
12290
<> Dialog.dialog
12391
( Dialog.defOpts
12492
& #optsTitleIcon
@@ -185,31 +153,7 @@ menu st =
185153
.~ disabled
186154
& #optsLabel
187155
.~ Just
188-
( "1 "
189-
<> toUpper
190-
( Money.inspectCurrencyCode
191-
$ st
192-
^. #modelState
193-
. #stAssetCurrency
194-
. #currencyOutput
195-
. #currencyInfoCode
196-
)
197-
<> " \8776 "
198-
<> inspectRatioDef
199-
( st
200-
^. #modelState
201-
. #stExchangeRate
202-
. #fieldOutput
203-
)
204-
<> " "
205-
<> toUpper
206-
( Money.inspectCurrencyCode
207-
$ st
208-
^. #modelState
209-
. #stMerchantCurrency
210-
. #currencyOutput
211-
. #currencyInfoCode
212-
)
156+
( inspectExchangeRate $ modelState st
213157
)
214158
& ( if disabled
215159
then #optsTrailingWidget .~ Nothing

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

Lines changed: 30 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,7 @@ newXlsx st imgs = xlsx
3232
.~ newColProps (fmap snd rows)
3333
& addHeader st
3434
& flip (foldl $ addRow imgs) rows
35+
& addFooter st (RowIndex (length rows) + 2)
3536
rows =
3637
zip [2 ..]
3738
$ fmap
@@ -90,7 +91,7 @@ addHeader st sheet =
9091
( \acc (colIdx, colVal) ->
9192
acc
9293
& cellValueAt (1, colIdx)
93-
?~ CellText colVal
94+
?~ CellText (from @Unicode @Text colVal)
9495
)
9596
sheet
9697
$ zip [1 ..] rowVal
@@ -106,6 +107,32 @@ addHeader st sheet =
106107
)
107108
$ stAssets st
108109

110+
addFooter :: St Unique -> RowIndex -> Worksheet -> Worksheet
111+
addFooter st rowOffset sheet =
112+
foldl
113+
( \acc (rowIdx, rowVal) ->
114+
acc
115+
& cellValueAt (rowOffset + rowIdx, 1)
116+
?~ CellText
117+
( from @Unicode @Text
118+
$ rowVal
119+
^. #fieldPairKey
120+
. #fieldInput
121+
. #runIdentity
122+
)
123+
& cellValueAt (rowOffset + rowIdx, 2)
124+
?~ CellText
125+
( from @Unicode @Text
126+
$ rowVal
127+
^. #fieldPairValue
128+
. #fieldInput
129+
. #runIdentity
130+
)
131+
)
132+
sheet
133+
. zip [1 ..]
134+
$ newTotal st
135+
109136
addRow ::
110137
Map Unicode Rfc2397 ->
111138
Worksheet ->
@@ -131,15 +158,15 @@ addCol imgs sheet rowIdx colIdx field =
131158
then
132159
sheet
133160
& cellValueAt (rowIdx, colIdx)
134-
?~ CellText txt
161+
?~ CellText (from @Unicode @Text txt)
135162
else case Map.lookup txt imgs of
136163
--
137164
-- TODO : handle img link
138165
--
139166
Nothing ->
140167
sheet
141168
& cellValueAt (rowIdx, colIdx)
142-
?~ CellText txt
169+
?~ CellText (from @Unicode @Text txt)
143170
Just img ->
144171
sheet
145172
& #wsDrawing

0 commit comments

Comments
 (0)