Skip to content

Commit 2e7235a

Browse files
functorafunctora
committed
wip
1 parent 51de66e commit 2e7235a

File tree

6 files changed

+139
-37
lines changed

6 files changed

+139
-37
lines changed

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

Lines changed: 15 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -68,11 +68,13 @@ data Action
6868

6969
data St f = St
7070
{ stAssets :: [Asset f],
71-
stPaymentMoney :: Money f,
71+
stAssetCurrency :: Currency f,
72+
stExchangeRate :: Field Rational f,
73+
stExchangeRateAt :: UTCTime,
74+
stMerchantCurrency :: Currency f,
7275
stMerchantTele :: Field Unicode f,
7376
stMerchantFeePercent :: Field Rational f,
7477
stOnlineOrOffline :: OnlineOrOffline,
75-
stDefAssetCurrency :: Currency f,
7678
stFavName :: Field Unicode f,
7779
stPreview :: Field Unicode f,
7880
stScreen :: Screen
@@ -95,20 +97,24 @@ deriving via GenericType (St Identity) instance Binary (St Identity)
9597

9698
newSt :: (MonadIO m) => m (St Unique)
9799
newSt = do
100+
assetCur <- newCurrency cny
101+
rate <- newRatioField 1
102+
ct <- getCurrentTime
103+
merchantCur <- newCurrency rub
104+
tele <- newTextField "Functora"
98105
fee <- newRatioField 2
99-
paymentMoney <- newMoney 0 rub
100-
defAssetCur <- newCurrency cny
101106
fav <- newTextField mempty
102107
pre <- newTextField "Delivery Calculator"
103-
tele <- newTextField "Functora"
104108
pure
105109
St
106110
{ stAssets = mempty,
107-
stPaymentMoney = paymentMoney,
111+
stAssetCurrency = assetCur,
112+
stExchangeRate = rate,
113+
stExchangeRateAt = ct,
114+
stMerchantCurrency = merchantCur,
108115
stMerchantTele = tele,
109116
stMerchantFeePercent = fee,
110117
stOnlineOrOffline = Online,
111-
stDefAssetCurrency = defAssetCur,
112118
stFavName = fav,
113119
stPreview = pre & #fieldType .~ FieldTypeTitle,
114120
stScreen = Main
@@ -117,8 +123,8 @@ newSt = do
117123
data Asset f = Asset
118124
{ assetLink :: Field URI f,
119125
assetPhoto :: Field URI f,
120-
assetPrice :: Money f,
121-
assetQty :: Field Natural f
126+
assetPrice :: Field Rational f,
127+
assetQty :: Field Rational f
122128
}
123129
deriving stock (Generic)
124130

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

Lines changed: 62 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@ import qualified Functora.Miso.Widgets.BrowserLink as BrowserLink
1212
import qualified Functora.Miso.Widgets.Currency as Currency
1313
import qualified Functora.Miso.Widgets.Field as Field
1414
import qualified Functora.Miso.Widgets.Grid as Grid
15+
import qualified Functora.Money as Money
1516
import qualified Material.Button as Button
1617
import qualified Material.Dialog as Dialog
1718
import qualified Material.IconButton as IconButton
@@ -121,27 +122,37 @@ menu st =
121122
Currency.Args
122123
{ Currency.argsModel = st,
123124
Currency.argsOptic =
124-
#modelState . #stDefAssetCurrency,
125+
#modelState . #stAssetCurrency,
125126
Currency.argsAction =
126127
PushUpdate . Instant,
127128
Currency.argsCurrencies =
128129
#modelCurrencies
129130
}
130-
Currency.Opts
131-
{ Currency.optsExtraOnClick = (& #modelLoading .~ True)
131+
Currency.defOpts
132+
{ Currency.optsExtraOnClick =
133+
(& #modelLoading .~ True),
134+
Currency.optsButtonViewer =
135+
mappend "Marketplace - "
136+
. Money.inspectCurrencyCode
137+
. Money.currencyInfoCode
132138
},
133139
Currency.selectCurrency
134140
Currency.Args
135141
{ Currency.argsModel = st,
136142
Currency.argsOptic =
137-
#modelState . #stPaymentMoney . #moneyCurrency,
143+
#modelState . #stMerchantCurrency,
138144
Currency.argsAction =
139145
PushUpdate . Instant,
140146
Currency.argsCurrencies =
141147
#modelCurrencies
142148
}
143-
Currency.Opts
144-
{ Currency.optsExtraOnClick = (& #modelLoading .~ True)
149+
Currency.defOpts
150+
{ Currency.optsExtraOnClick =
151+
(& #modelLoading .~ True),
152+
Currency.optsButtonViewer =
153+
mappend "Merchant - "
154+
. Money.inspectCurrencyCode
155+
. Money.currencyInfoCode
145156
},
146157
let item :| items = enumerateNE @OnlineOrOffline
147158
in Grid.mediumCell
@@ -180,6 +191,51 @@ menu st =
180191
)
181192
items
182193
],
194+
Grid.mediumCell
195+
[ Field.ratioField
196+
Field.Args
197+
{ Field.argsModel = st,
198+
Field.argsOptic =
199+
#modelState . #stExchangeRate,
200+
Field.argsAction =
201+
PushUpdate . Instant
202+
}
203+
( let disabled =
204+
st
205+
^. #modelState
206+
. #stOnlineOrOffline
207+
== Online
208+
in Field.defOpts @Model @Action
209+
& #optsDisabled
210+
.~ disabled
211+
& #optsPlaceholder
212+
.~ ( "1 "
213+
<> toUpper
214+
( Money.inspectCurrencyCode
215+
$ st
216+
^. #modelState
217+
. #stAssetCurrency
218+
. #currencyOutput
219+
. #currencyInfoCode
220+
)
221+
<> " \8776 X "
222+
<> toUpper
223+
( Money.inspectCurrencyCode
224+
$ st
225+
^. #modelState
226+
. #stMerchantCurrency
227+
. #currencyOutput
228+
. #currencyInfoCode
229+
)
230+
)
231+
& #optsFilledOrOutlined
232+
.~ Outlined
233+
& ( if disabled
234+
then #optsTrailingWidget .~ Nothing
235+
else id
236+
)
237+
)
238+
],
183239
Grid.mediumCell
184240
[ Field.ratioField
185241
Field.Args

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

Lines changed: 53 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -301,39 +301,76 @@ syncInputs st = do
301301
pure txt
302302

303303
evalModel :: (MonadThrow m, MonadUnliftIO m) => Model -> m Model
304-
evalModel raw = do
305-
let oof = raw ^. #modelState . #stOnlineOrOffline
304+
evalModel prev = do
305+
let oof = prev ^. #modelState . #stOnlineOrOffline
306306
new <-
307307
case oof of
308308
Online ->
309309
Syb.everywhereM
310310
( Syb.mkM $ \cur ->
311-
Rates.withMarket (raw ^. #modelWebOpts) (raw ^. #modelMarket)
311+
Rates.withMarket (prev ^. #modelWebOpts) (prev ^. #modelMarket)
312312
. fmap (fromRight cur)
313313
. Rates.tryMarket
314-
. Rates.getCurrencyInfo (raw ^. #modelWebOpts)
314+
. Rates.getCurrencyInfo (prev ^. #modelWebOpts)
315315
$ Money.currencyInfoCode cur
316316
)
317-
( raw ^. #modelState
317+
( prev ^. #modelState
318318
)
319319
Offline ->
320-
pure $ raw ^. #modelState
320+
pure $ prev ^. #modelState
321321
curs <-
322322
case oof of
323323
Online ->
324-
Rates.withMarket (raw ^. #modelWebOpts) (raw ^. #modelMarket)
325-
. fmap (fromRight $ raw ^. #modelCurrencies)
324+
Rates.withMarket (prev ^. #modelWebOpts) (prev ^. #modelMarket)
325+
. fmap (fromRight $ prev ^. #modelCurrencies)
326326
. Rates.tryMarket
327327
. fmap (^. #currenciesList)
328-
$ Rates.getCurrencies (raw ^. #modelWebOpts)
328+
$ Rates.getCurrencies (prev ^. #modelWebOpts)
329329
Offline ->
330-
pure $ raw ^. #modelCurrencies
331-
pure
332-
$ raw
333-
& #modelState
334-
.~ new
335-
& #modelCurrencies
336-
.~ curs
330+
pure $ prev ^. #modelCurrencies
331+
let next =
332+
prev
333+
& #modelState
334+
.~ new
335+
& #modelCurrencies
336+
.~ curs
337+
case oof of
338+
Offline -> pure next
339+
Online ->
340+
Rates.withMarket (next ^. #modelWebOpts) (next ^. #modelMarket) $ do
341+
let base =
342+
Money.Funds
343+
1
344+
$ next
345+
^. #modelState
346+
. #stAssetCurrency
347+
. #currencyOutput
348+
. #currencyInfoCode
349+
quote <-
350+
Rates.getQuote (next ^. #modelWebOpts) base
351+
$ next
352+
^. #modelState
353+
. #stMerchantCurrency
354+
. #currencyOutput
355+
. #currencyInfoCode
356+
let rate =
357+
unTagged
358+
$ quote
359+
^. #quoteMoneyAmount
360+
pure
361+
$ next
362+
& #modelState
363+
. #stExchangeRate
364+
. #fieldInput
365+
. #uniqueValue
366+
.~ inspectRatioDef rate
367+
& #modelState
368+
. #stExchangeRate
369+
. #fieldOutput
370+
.~ rate
371+
& #modelState
372+
. #stExchangeRateAt
373+
.~ (quote ^. #quoteCreatedAt)
337374

338375
syncUri :: URI -> JSM ()
339376
syncUri uri = do

‎ghcjs/miso-widgets/src/Functora/Miso/Widgets/Assets.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -143,7 +143,7 @@ assetEditor
143143
Currency.argsAction = action,
144144
Currency.argsCurrencies = currencies
145145
}
146-
Currency.Opts
146+
Currency.defOpts
147147
{ Currency.optsExtraOnClick = extraOnClick
148148
}
149149
]

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

Lines changed: 7 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -28,15 +28,17 @@ data Args model action = Args
2828
}
2929
deriving stock (Generic)
3030

31-
newtype Opts model = Opts
32-
{ optsExtraOnClick :: model -> model
31+
data Opts model = Opts
32+
{ optsExtraOnClick :: model -> model,
33+
optsButtonViewer :: CurrencyInfo -> Unicode
3334
}
3435
deriving stock (Generic)
3536

3637
defOpts :: Opts model
3738
defOpts =
3839
Opts
39-
{ optsExtraOnClick = id
40+
{ optsExtraOnClick = id,
41+
optsButtonViewer = inspectCurrencyInfo
4042
}
4143

4244
selectCurrency :: Args model action -> Opts model -> View action
@@ -57,7 +59,8 @@ selectCurrency
5759
]
5860
$ Button.config
5961
)
60-
. inspectCurrencyInfo
62+
. ( optsButtonViewer opts
63+
)
6164
$ fromMaybe
6265
(CurrencyInfo (CurrencyCode "XXX") mempty)
6366
(st ^? cloneTraversal optic . #currencyOutput)

‎ghcjs/miso-widgets/src/Functora/Miso/Widgets/PaymentMethods.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -144,7 +144,7 @@ paymentMethodEditor
144144
Currency.argsAction = action,
145145
Currency.argsCurrencies = currencies
146146
}
147-
Currency.Opts
147+
Currency.defOpts
148148
{ Currency.optsExtraOnClick = extraOnClick
149149
}
150150
]

0 commit comments

Comments
 (0)