Skip to content

Commit 539f41a

Browse files
functorafunctora
committed
refactor money and tags
1 parent 35ccaa4 commit 539f41a

File tree

22 files changed

+258
-224
lines changed

22 files changed

+258
-224
lines changed

‎pub/bfx/src/Bfx.hs‎

Lines changed: 36 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -68,10 +68,10 @@ marketAveragePrice ::
6868
forall (act :: BuyOrSell) m.
6969
( MonadUnliftIO m,
7070
MonadThrow m,
71-
ToRequestParam (Money (Tags 'Unsigned |+| 'Base |+| act)),
71+
ToRequestParam (Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| act)),
7272
Typeable act
7373
) =>
74-
Money (Tags 'Unsigned |+| 'Base |+| act) ->
74+
Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| act) ->
7575
CurrencyPair ->
7676
m (Money (Tags 'Unsigned |+| 'QuotePerBase |+| act))
7777
marketAveragePrice amt sym =
@@ -119,9 +119,9 @@ spendableExchangeBalance ::
119119
) =>
120120
Env ->
121121
CurrencyCode ->
122-
m (Money (Tags 'Unsigned))
122+
m (Money (Tags 'Unsigned |+| 'MoneyAmount))
123123
spendableExchangeBalance env cc =
124-
maybe (newMoney 0) Wallets.availableBalance
124+
maybe (Tagged 0) Wallets.availableBalance
125125
. Map.lookup Wallets.Exchange
126126
. Map.findWithDefault mempty cc
127127
<$> wallets env
@@ -239,12 +239,13 @@ submitOrder ::
239239
forall (bos :: BuyOrSell) m.
240240
( MonadUnliftIO m,
241241
MonadThrow m,
242-
ToRequestParam (Money (Tags 'Unsigned |+| 'Base |+| bos)),
242+
ToRequestParam (Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos)),
243243
ToRequestParam (Money (Tags 'Unsigned |+| 'QuotePerBase |+| bos)),
244+
Typeable bos,
244245
SingI bos
245246
) =>
246247
Env ->
247-
Money (Tags 'Unsigned |+| 'Base |+| bos) ->
248+
Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos) ->
248249
CurrencyPair ->
249250
Money (Tags 'Unsigned |+| 'QuotePerBase |+| bos) ->
250251
SubmitOrder.Options bos ->
@@ -264,14 +265,14 @@ submitOrderMaker ::
264265
forall (bos :: BuyOrSell) m.
265266
( MonadUnliftIO m,
266267
MonadThrow m,
267-
ToRequestParam (Money (Tags 'Unsigned |+| 'Base |+| bos)),
268+
ToRequestParam (Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos)),
268269
ToRequestParam (Money (Tags 'Unsigned |+| 'QuotePerBase |+| bos)),
269-
MoneyTags (Tags 'Unsigned |+| 'Base |+| bos),
270+
MoneyTags (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos),
270271
MoneyTags (Tags 'Unsigned |+| 'QuotePerBase |+| bos),
271272
HasTag bos (Tags 'Unsigned |+| 'QuotePerBase |+| bos)
272273
) =>
273274
Env ->
274-
Money (Tags 'Unsigned |+| 'Base |+| bos) ->
275+
Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos) ->
275276
CurrencyPair ->
276277
Money (Tags 'Unsigned |+| 'QuotePerBase |+| bos) ->
277278
SubmitOrder.Options bos ->
@@ -289,14 +290,14 @@ submitOrderMakerRec ::
289290
forall (bos :: BuyOrSell) m.
290291
( MonadUnliftIO m,
291292
MonadThrow m,
292-
ToRequestParam (Money (Tags 'Unsigned |+| 'Base |+| bos)),
293+
ToRequestParam (Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos)),
293294
ToRequestParam (Money (Tags 'Unsigned |+| 'QuotePerBase |+| bos)),
294-
MoneyTags (Tags 'Unsigned |+| 'Base |+| bos),
295+
MoneyTags (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos),
295296
MoneyTags (Tags 'Unsigned |+| 'QuotePerBase |+| bos),
296297
HasTag bos (Tags 'Unsigned |+| 'QuotePerBase |+| bos)
297298
) =>
298299
Env ->
299-
Money (Tags 'Unsigned |+| 'Base |+| bos) ->
300+
Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos) ->
300301
CurrencyPair ->
301302
Int ->
302303
Money (Tags 'Unsigned |+| 'QuotePerBase |+| bos) ->
@@ -402,7 +403,7 @@ submitCounterOrder' ::
402403
MonadThrow m
403404
) =>
404405
( Env ->
405-
Money (Tags 'Unsigned |+| 'Base |+| 'Sell) ->
406+
Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| 'Sell) ->
406407
CurrencyPair ->
407408
Money (Tags 'Unsigned |+| 'QuotePerBase |+| 'Sell) ->
408409
SubmitOrder.Options 'Sell ->
@@ -421,17 +422,17 @@ submitCounterOrder' submit env id0 feeB feeQ prof opts = do
421422
SBuy | orderStatus remOrder == Executed -> do
422423
(_, exitAmt, exitRate) <-
423424
Math.newCounterOrder
424-
(tagMoney @'Gross (orderAmount remOrder))
425-
(tagMoney @'Net (orderRate remOrder))
425+
(tag @'Gross (orderAmount remOrder))
426+
(tag @'Net (orderRate remOrder))
426427
feeB
427428
feeQ
428-
(tagMoney @'Quote . tagMoney @'Buy $ tagMoney @'Net prof)
429+
(tag @'Quote . tag @'Buy $ tag @'Net prof)
429430
currentRate <-
430-
marketAveragePrice (unTagMoney @'Net exitAmt)
431+
marketAveragePrice (unTag @'Net exitAmt)
431432
$ orderSymbol remOrder
432433
submit
433434
env
434-
(unTagMoney @'Net exitAmt)
435+
(unTag @'Net exitAmt)
435436
(orderSymbol remOrder)
436437
(max exitRate currentRate)
437438
opts
@@ -444,7 +445,7 @@ dumpIntoQuote' ::
444445
MonadThrow m
445446
) =>
446447
( Env ->
447-
Money (Tags 'Unsigned |+| 'Base |+| 'Sell) ->
448+
Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| 'Sell) ->
448449
CurrencyPair ->
449450
Money (Tags 'Unsigned |+| 'QuotePerBase |+| 'Sell) ->
450451
SubmitOrder.Options 'Sell ->
@@ -456,12 +457,12 @@ dumpIntoQuote' ::
456457
m (Order 'Sell 'Remote)
457458
dumpIntoQuote' submit env sym opts = do
458459
amt <- spendableExchangeBalance env (currencyPairBase sym)
459-
rate <- marketAveragePrice (tagMoney @'Sell $ tagMoney @'Base amt) sym
460+
rate <- marketAveragePrice (tag @'Sell $ tag @'Base amt) sym
460461
catchAny
461-
(submit env (tagMoney @'Sell $ tagMoney @'Base amt) sym rate opts)
462+
(submit env (tag @'Sell $ tag @'Base amt) sym rate opts)
462463
. const
463464
$ do
464-
newAmt <- Math.tweakMoneyPip (tagMoney @'Sell $ tagMoney @'Base amt)
465+
newAmt <- Math.tweakMoneyPip (tag @'Sell $ tag @'Base amt)
465466
submit env newAmt sym rate opts
466467

467468
dumpIntoQuote ::
@@ -492,7 +493,7 @@ netWorth ::
492493
) =>
493494
Env ->
494495
CurrencyCode ->
495-
m (Money (Tags 'Unsigned))
496+
m (Money (Tags 'Unsigned |+| 'MoneyAmount))
496497
netWorth env ccq = do
497498
-- Simplify fees (assume it's alwayus Maker and Crypto2Crypto)
498499
fee <- FeeSummary.makerCrypto2CryptoFee <$> feeSummary env
@@ -501,40 +502,42 @@ netWorth env ccq = do
501502
res <-
502503
foldrM
503504
( \(ccb, bs1) totalAcc -> do
504-
let localAcc :: Money (Tags 'Unsigned) =
505+
let localAcc :: Money (Tags 'Unsigned |+| 'MoneyAmount) =
505506
foldr
506507
( \amt acc ->
507508
Wallets.balance amt `addMoney` acc
508509
)
509-
(newMoney 0)
510+
(Tagged 0)
510511
$ Map.elems bs1
511512
if ccb == ccq
512513
then pure $ totalAcc `addMoney` localAcc
513514
else do
514515
-- In this case we are dealing with Base
515516
-- money, so we need transform from Quote
516517
sym <- currencyPairCon (from ccb) $ Tagged @'Quote ccq
517-
baseMoney :: Money (Tags 'Unsigned |+| 'Base |+| 'Sell) <-
518-
fmap (tagMoney @'Base . tagMoney @'Sell) $ roundMoney localAcc
519-
if baseMoney == newMoney 0
518+
baseMoney ::
519+
Money (Tags 'Unsigned |+| 'Base |+| 'Sell |+| 'MoneyAmount) <-
520+
fmap (tag @'Base . tag @'Sell) $ roundMoney localAcc
521+
if baseMoney == Tagged 0
520522
then pure totalAcc
521523
else do
522524
price :: Money (Tags 'Unsigned |+| 'QuotePerBase |+| 'Sell) <-
523525
marketAveragePrice baseMoney sym
524526
pure
525527
. addMoney totalAcc
526-
. unTagMoney @'Net
527-
. unTagMoney @'Sell
528-
. unTagMoney @'Quote
528+
. unTag @'Net
529+
. unTag @'Sell
530+
. unTag @'Quote
529531
$ deductFee
532+
@(Tags 'Unsigned |+| 'FeeRate |+| 'Maker)
530533
fee
531-
( tagMoney @'Gross
534+
( tag @'Gross
532535
$ exchangeMoney @(Tags 'Unsigned |+| 'Sell)
533536
price
534537
baseMoney
535538
)
536539
)
537-
(newMoney 0)
540+
(Tagged 0)
538541
. filter
539542
( \(cc, _) ->
540543
fromRight

‎pub/bfx/src/Bfx/Class/FromRpc.hs‎

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -86,7 +86,7 @@ instance
8686
(toRational <$> raw ^? nth 0 . _Number)
8787
first (const $ "QuotePerBase is invalid " <> inspect x)
8888
. roundQuotePerBase
89-
. newMoney
89+
. Tagged
9090
$ unsafeFrom @Rational @(Ratio Natural) x
9191

9292
instance FromRpc 'FeeSummary FeeSummary.Response where
@@ -109,7 +109,7 @@ instance FromRpc 'FeeSummary FeeSummary.Response where
109109
Rational ->
110110
Either Text (Money (Tags 'Unsigned |+| 'FeeRate |+| tag))
111111
money =
112-
bimap inspect newMoney
112+
bimap inspect Tagged
113113
. tryFrom @Rational @(Ratio Natural)
114114
parse ::
115115
Int ->
@@ -213,8 +213,8 @@ instance
213213
{ currencyPairPrecision = prec,
214214
currencyPairInitMargin = initMargin,
215215
currencyPairMinMargin = minMargin,
216-
currencyPairMaxOrderAmt = newMoney maxOrderAmt,
217-
currencyPairMinOrderAmt = newMoney minOrderAmt
216+
currencyPairMaxOrderAmt = Tagged maxOrderAmt,
217+
currencyPairMinOrderAmt = Tagged minOrderAmt
218218
}
219219
)
220220

@@ -263,23 +263,23 @@ instance
263263
balance <-
264264
first inspect
265265
. roundMoney
266-
. newMoney
266+
. Tagged
267267
. unsafeFrom @Rational @(Ratio Natural)
268268
=<< maybeToRight
269269
"Balance is missing"
270270
(toRational <$> x ^? nth 2 . _Number)
271271
unsettledInterest <-
272272
first inspect
273273
. roundMoney
274-
. newMoney
274+
. Tagged
275275
. unsafeFrom @Rational @(Ratio Natural)
276276
=<< maybeToRight
277277
"UnsettledBalance is missing"
278278
(toRational <$> x ^? nth 3 . _Number)
279279
availableBalance <-
280280
first inspect
281281
. roundMoney
282-
. newMoney
282+
. Tagged
283283
. unsafeFrom @Rational @(Ratio Natural)
284284
=<< maybeToRight
285285
"AvailableBalance is missing"
@@ -351,23 +351,23 @@ instance FromRpc 'Tickers (Map CurrencyPair Ticker) where
351351
bid <-
352352
first inspect
353353
. roundQuotePerBase
354-
. newMoney
354+
. Tagged
355355
. unsafeFrom @Rational @(Ratio Natural)
356356
=<< maybeToRight
357357
"Bid is missing"
358358
(toRational <$> x ^? nth 1 . _Number)
359359
ask0 <-
360360
first inspect
361361
. roundQuotePerBase
362-
. newMoney
362+
. Tagged
363363
. unsafeFrom @Rational @(Ratio Natural)
364364
=<< maybeToRight
365365
"Ask is missing"
366366
(toRational <$> x ^? nth 3 . _Number)
367367
vol <-
368368
first inspect
369369
. roundMoney
370-
. newMoney
370+
. Tagged
371371
. unsafeFrom @Rational @(Ratio Natural)
372372
=<< maybeToRight
373373
"Volume is missing"

‎pub/bfx/src/Bfx/Class/ToRequestParam.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -70,4 +70,4 @@ instance
7070
SSell -> toTextParam $ (-1) * success amt
7171
where
7272
success :: Money tags -> Rational
73-
success = abs . from @(Ratio Natural) @Rational . unMoney
73+
success = abs . from @(Ratio Natural) @Rational . unTagged

‎pub/bfx/src/Bfx/Data/MarketAveragePrice.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ where
88
import Bfx.Import
99

1010
data Request (bos :: BuyOrSell) = Request
11-
{ amount :: Money (Tags 'Unsigned |+| 'Base |+| bos),
11+
{ amount :: Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos),
1212
symbol :: CurrencyPair
1313
}
1414
deriving stock

‎pub/bfx/src/Bfx/Data/Metro.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -24,10 +24,10 @@ roundMoney ::
2424
m (Money tags)
2525
roundMoney money =
2626
if raw >= 0 && rounded >= 0
27-
then pure $ newMoney rounded
27+
then pure $ Tagged rounded
2828
else throw $ TryFromException @(Ratio Natural) @(Money tags) raw Nothing
2929
where
30-
raw = unMoney money
30+
raw = unTagged money
3131
rounded =
3232
unsafeFrom @Rational @(Ratio Natural)
3333
. roundMoneyRat
@@ -48,10 +48,10 @@ roundQuotePerBase ::
4848
m (Money tags)
4949
roundQuotePerBase money =
5050
if raw > 0 && rounded > 0
51-
then pure $ newMoney rounded
51+
then pure $ Tagged rounded
5252
else throw $ TryFromException @(Ratio Natural) @(Money tags) raw Nothing
5353
where
54-
raw = unMoney money
54+
raw = unTagged money
5555
rounded =
5656
unsafeFrom @Rational @(Ratio Natural)
5757
. roundQuotePerBaseRat

‎pub/bfx/src/Bfx/Data/SubmitOrder.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@ import Bfx.Import
1414
import qualified Data.Aeson as A
1515

1616
data Request (bos :: BuyOrSell) = Request
17-
{ amount :: Money (Tags 'Unsigned |+| 'Base |+| bos),
17+
{ amount :: Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos),
1818
symbol :: CurrencyPair,
1919
rate :: Money (Tags 'Unsigned |+| 'QuotePerBase |+| bos),
2020
options :: Options bos
@@ -60,8 +60,9 @@ optsPostOnlyStopLoss sl =
6060

6161
instance
6262
forall (bos :: BuyOrSell).
63-
( ToRequestParam (Money (Tags 'Unsigned |+| 'Base |+| bos)),
63+
( ToRequestParam (Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| bos)),
6464
ToRequestParam (Money (Tags 'Unsigned |+| 'QuotePerBase |+| bos)),
65+
Typeable bos,
6566
SingI bos
6667
) =>
6768
ToJSON (Request bos)

‎pub/bfx/src/Bfx/Data/Type.hs‎

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,6 @@ module Bfx.Data.Type
1818

1919
-- * Trading
2020
-- $trading
21-
FeeRate (..),
2221
RebateRate (..),
2322
CurrencyCode (..),
2423
newCurrencyCode,
@@ -105,7 +104,7 @@ data Order (act :: BuyOrSell) (loc :: LocalOrRemote) = Order
105104
-- | Field might be auto-generated by Bitfinex in case where
106105
-- it was not provided through 'Bfx.Data.SubmitOrder.Options'.
107106
orderClientId :: Maybe OrderClientId,
108-
orderAmount :: Money (Tags 'Unsigned |+| 'Base |+| act),
107+
orderAmount :: Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount |+| act),
109108
orderSymbol :: CurrencyPair,
110109
orderRate :: Money (Tags 'Unsigned |+| 'QuotePerBase |+| act),
111110
orderStatus :: OrderStatus
@@ -460,8 +459,10 @@ data CurrencyPairConf = CurrencyPairConf
460459
{ currencyPairPrecision :: Natural,
461460
currencyPairInitMargin :: Rational,
462461
currencyPairMinMargin :: Rational,
463-
currencyPairMaxOrderAmt :: Money (Tags 'Unsigned |+| 'Base |+| 'Max),
464-
currencyPairMinOrderAmt :: Money (Tags 'Unsigned |+| 'Base |+| 'Min)
462+
currencyPairMaxOrderAmt ::
463+
Money (Tags 'Unsigned |+| 'Base |+| 'Max |+| 'MoneyAmount),
464+
currencyPairMinOrderAmt ::
465+
Money (Tags 'Unsigned |+| 'Base |+| 'Min |+| 'MoneyAmount)
465466
}
466467
deriving stock
467468
( Eq,
@@ -476,7 +477,7 @@ data Candle = Candle
476477
candleClose :: Money (Tags 'Unsigned |+| 'QuotePerBase),
477478
candleHigh :: Money (Tags 'Unsigned |+| 'QuotePerBase),
478479
candleLow :: Money (Tags 'Unsigned |+| 'QuotePerBase),
479-
candleVolume :: Money (Tags 'Unsigned |+| 'Base)
480+
candleVolume :: Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount)
480481
}
481482
deriving stock
482483
( Eq,
@@ -515,7 +516,7 @@ instance ToRequestParam CandleTimeFrame where
515516

516517
data Ticker = Ticker
517518
{ tickerSymbol :: CurrencyPair,
518-
tickerVolume :: Money (Tags 'Unsigned |+| 'Base),
519+
tickerVolume :: Money (Tags 'Unsigned |+| 'Base |+| 'MoneyAmount),
519520
tickerBid :: Money (Tags 'Unsigned |+| 'QuotePerBase |+| 'Buy),
520521
tickerAsk :: Money (Tags 'Unsigned |+| 'QuotePerBase |+| 'Sell)
521522
}

0 commit comments

Comments
 (0)