Skip to content

Commit b7bcbd8

Browse files
functorafunctora
committed
bfx refactoring numeric types Ratio Natural -> FixNonNeg
1 parent a28bf38 commit b7bcbd8

File tree

10 files changed

+84
-87
lines changed

10 files changed

+84
-87
lines changed

‎pub/bfx/bfx.cabal‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -94,12 +94,12 @@ common pkg-lib
9494
, functora
9595
, functora:cfg
9696
, functora:money
97+
, functora:round
9798
, http-client
9899
, http-client-tls
99100
, http-types
100101
, lens-aeson
101102
, memory
102-
, siggy-chardust
103103
, singlethongs
104104
, text
105105
, vector
@@ -199,12 +199,12 @@ test-suite bfx-test
199199
, cryptonite
200200
, envparse
201201
, functora:cfg
202+
, functora:round
202203
, http-client
203204
, http-client-tls
204205
, http-types
205206
, lens-aeson
206207
, memory
207-
, siggy-chardust
208208
, singlethongs
209209
, text
210210
, vector

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

Lines changed: 14 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -65,7 +65,7 @@ instance FromRpc 'MarketAveragePrice QuotePerBase where
6565
first (const $ "QuotePerBase is invalid " <> inspect x)
6666
. roundQuotePerBase
6767
. QuotePerBase
68-
$ unsafeFrom @Rational @(Ratio Natural) x
68+
$ unsafeFrom @Rational @FixNonNeg x
6969

7070
instance FromRpc 'FeeSummary FeeSummary.Response where
7171
fromRpc (RawResponse raw) = do
@@ -82,7 +82,7 @@ instance FromRpc 'FeeSummary FeeSummary.Response where
8282
rate :: Rational -> Either Text FeeRate
8383
rate =
8484
bimap inspect FeeRate
85-
. tryFrom @Rational @(Ratio Natural)
85+
. tryFrom @Rational @FixNonNeg
8686
parse ::
8787
Int ->
8888
Int ->
@@ -175,7 +175,9 @@ instance
175175
$ "Max Order Size is invalid "
176176
<> inspect maxOrderAmt0
177177
)
178-
MoneyAmount
178+
( MoneyAmount
179+
. unsafeFrom @Rational @FixNonNeg
180+
)
179181
$ parseRatio maxOrderAmt0
180182
minOrderAmt0 <-
181183
maybeToRight "Min Order Size is missing"
@@ -188,7 +190,9 @@ instance
188190
$ "Min Order Size is invalid "
189191
<> inspect minOrderAmt0
190192
)
191-
MoneyAmount
193+
( MoneyAmount
194+
. unsafeFrom @Rational @FixNonNeg
195+
)
192196
$ parseRatio minOrderAmt0
193197
pure
194198
( sym,
@@ -247,23 +251,23 @@ instance
247251
first inspect
248252
. roundMoneyAmount
249253
. MoneyAmount
250-
. unsafeFrom @Rational @(Ratio Natural)
254+
. unsafeFrom @Rational @FixNonNeg
251255
=<< maybeToRight
252256
"Balance is missing"
253257
(toRational <$> x ^? nth 2 . _Number)
254258
unsettledInterest <-
255259
first inspect
256260
. roundMoneyAmount
257261
. MoneyAmount
258-
. unsafeFrom @Rational @(Ratio Natural)
262+
. unsafeFrom @Rational @FixNonNeg
259263
=<< maybeToRight
260264
"UnsettledBalance is missing"
261265
(toRational <$> x ^? nth 3 . _Number)
262266
availableBalance <-
263267
first inspect
264268
. roundMoneyAmount
265269
. MoneyAmount
266-
. unsafeFrom @Rational @(Ratio Natural)
270+
. unsafeFrom @Rational @FixNonNeg
267271
=<< maybeToRight
268272
"AvailableBalance is missing"
269273
(toRational <$> x ^? nth 4 . _Number)
@@ -335,23 +339,23 @@ instance FromRpc 'Tickers (Map CurrencyPair Ticker) where
335339
first inspect
336340
. roundQuotePerBase
337341
. QuotePerBase
338-
. unsafeFrom @Rational @(Ratio Natural)
342+
. unsafeFrom @Rational @FixNonNeg
339343
=<< maybeToRight
340344
"Bid is missing"
341345
(toRational <$> x ^? nth 1 . _Number)
342346
ask0 <-
343347
first inspect
344348
. roundQuotePerBase
345349
. QuotePerBase
346-
. unsafeFrom @Rational @(Ratio Natural)
350+
. unsafeFrom @Rational @FixNonNeg
347351
=<< maybeToRight
348352
"Ask is missing"
349353
(toRational <$> x ^? nth 3 . _Number)
350354
vol <-
351355
first inspect
352356
. roundMoneyAmount
353357
. MoneyAmount
354-
. unsafeFrom @Rational @(Ratio Natural)
358+
. unsafeFrom @Rational @FixNonNeg
355359
=<< maybeToRight
356360
"Volume is missing"
357361
(toRational <$> x ^? nth 8 . _Number)

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

Lines changed: 11 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,12 @@ instance ToRequestParam Rational where
4141
T.pack
4242
$ showFixed True (fromRational x :: Fixed E8)
4343

44+
instance ToRequestParam Fix where
45+
toTextParam = inspectFix
46+
47+
instance ToRequestParam FixNonNeg where
48+
toTextParam = inspectFix
49+
4450
instance ToRequestParam Natural where
4551
toTextParam =
4652
T.pack . Prelude.show
@@ -54,18 +60,18 @@ instance ToRequestParam Text where
5460
id
5561

5662
instance ToRequestParam (BuyOrSell, MoneyAmount) where
57-
toTextParam (bos, MoneyAmount amt) =
63+
toTextParam (bos, amt) =
5864
if bos == Sell
59-
then toTextParam $ (-1) * rat amt
60-
else toTextParam $ rat amt
65+
then toTextParam $ (-1) * unAmt amt
66+
else toTextParam $ unAmt amt
6167
where
62-
rat = abs . from @(Ratio Natural) @Rational
68+
unAmt = abs . unFixNonNeg . unMoneyAmount
6369

6470
instance ToRequestParam QuotePerBase where
6571
toTextParam =
6672
toTextParam
6773
. abs
68-
. from @(Ratio Natural) @Rational
74+
. unFixNonNeg
6975
. unQuotePerBase
7076

7177
instance ToRequestParam AscOrDesc where

‎pub/bfx/src/Bfx/Indicator/Atr.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -65,7 +65,7 @@ mkAtrConduit mkCandle per = do
6565
Atr
6666
. QuotePerBase
6767
$ (sum $ unQuotePerBase . Tr.unTr . snd <$> trs)
68-
/ from @Natural @(Ratio Natural)
68+
/ unsafeFrom @Natural @FixNonNeg
6969
(unsafeFrom @Int @Natural period)
7070
)
7171
pure True

‎pub/bfx/src/Bfx/Indicator/Ma.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -69,7 +69,7 @@ mkMaConduit mkCandle per =
6969
)
7070
candles
7171
)
72-
/ from @Natural @(Ratio Natural)
72+
/ unsafeFrom @Natural @FixNonNeg
7373
( unsafeFrom
7474
@Int
7575
@Natural

‎pub/bfx/src/Bfx/Indicator/Rsi.hs‎

Lines changed: 8 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,7 @@ import Functora.Prelude
1717
import qualified Prelude
1818

1919
newtype Rsi = Rsi
20-
{ unRsi :: Fixed E30
20+
{ unRsi :: FixNonNeg
2121
}
2222
deriving stock
2323
( Eq,
@@ -60,17 +60,13 @@ mkRsiConduit mkCandle (RsiPeriod natPer) =
6060
C.yield
6161
( c2,
6262
-- Loss
63-
fromRational @(Fixed E30)
64-
. from @(Ratio Natural) @Rational
65-
$ if p1 >= p2
66-
then p1 - p2
67-
else 0,
63+
if p1 >= p2
64+
then p1 - p2
65+
else 0,
6866
-- Gain
69-
fromRational @(Fixed E30)
70-
. from @(Ratio Natural) @Rational
71-
$ if p1 <= p2
72-
then p2 - p1
73-
else 0
67+
if p1 <= p2
68+
then p2 - p1
69+
else 0
7470
)
7571
pure True
7672
_ ->
@@ -95,7 +91,7 @@ mkRsiConduit mkCandle (RsiPeriod natPer) =
9591
pure $ Left (nextAvgLoss, nextAvgGain)
9692
)
9793
where
98-
fixPer :: Fixed E30
94+
fixPer :: FixNonNeg
9995
fixPer =
10096
Prelude.fromInteger $ from @Natural @Integer natPer
10197
intPer :: Int

‎pub/bfx/src/Bfx/Indicator/Tr.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -63,7 +63,7 @@ mkTr c0 c1 =
6363
absRange :: QuotePerBase -> QuotePerBase -> QuotePerBase
6464
absRange x y =
6565
QuotePerBase
66-
. unsafeFrom @Rational @(Ratio Natural)
66+
. unsafeFrom @Fix @FixNonNeg
6767
. abs
68-
$ abs (from @(Ratio Natural) @Rational $ unQuotePerBase x)
69-
- abs (from @(Ratio Natural) @Rational $ unQuotePerBase y)
68+
$ abs (unFixNonNeg $ unQuotePerBase x)
69+
- abs (unFixNonNeg $ unQuotePerBase y)

‎pub/bfx/src/Bfx/Math.hs‎

Lines changed: 32 additions & 41 deletions
Original file line numberDiff line numberDiff line change
@@ -8,37 +8,34 @@ module Bfx.Math
88
)
99
where
1010

11-
import Data.Ratio.Rounding (dpRound, sdRound)
1211
import Functora.Money
1312
import Functora.Prelude
13+
import Functora.Round (dpRound, sdRound)
1414

1515
roundMoneyAmount :: (MonadThrow m) => MoneyAmount -> m MoneyAmount
16-
roundMoneyAmount arg@(MoneyAmount raw) =
17-
if raw >= 0 && rounded >= 0
18-
then pure $ MoneyAmount rounded
19-
else throwString $ "Rounding error for " <> inspect @String arg
20-
where
21-
rounded =
22-
unsafeFrom @Rational @(Ratio Natural)
23-
. roundMoneyAmountRat
24-
$ from @(Ratio Natural) @Rational raw
16+
roundMoneyAmount prev = do
17+
next <-
18+
either throw (pure . MoneyAmount)
19+
. tryFrom @Fix @FixNonNeg
20+
. dpRound 8
21+
. unFixNonNeg
22+
$ unMoneyAmount prev
23+
if prev >= 0 && next >= 0
24+
then pure next
25+
else throwString $ "Rounding error for " <> inspect @Text prev
2526

2627
roundQuotePerBase :: (MonadThrow m) => QuotePerBase -> m QuotePerBase
27-
roundQuotePerBase arg@(QuotePerBase raw) =
28-
if raw > 0 && rounded > 0
29-
then pure $ QuotePerBase rounded
30-
else throwString $ "Rounding error for " <> inspect @String arg
31-
where
32-
rounded =
33-
unsafeFrom @Rational @(Ratio Natural)
34-
. roundQuotePerBaseRat
35-
$ from @(Ratio Natural) @Rational raw
36-
37-
roundMoneyAmountRat :: Rational -> Rational
38-
roundMoneyAmountRat = dpRound 8
39-
40-
roundQuotePerBaseRat :: Rational -> Rational
41-
roundQuotePerBaseRat = sdRound 5 . dpRound 8
28+
roundQuotePerBase prev = do
29+
next <-
30+
either throw (pure . QuotePerBase)
31+
. tryFrom @Fix @FixNonNeg
32+
. sdRound 5
33+
. dpRound 8
34+
. unFixNonNeg
35+
$ unQuotePerBase prev
36+
if prev > 0 && next > 0
37+
then pure next
38+
else throwString $ "Rounding error for " <> inspect @Text prev
4239

4340
tweakMoneyAmount ::
4441
( MonadThrow m
@@ -52,22 +49,20 @@ tweakMoneyAmount =
5249
tweakMoneyAmountRec ::
5350
( MonadThrow m
5451
) =>
55-
Ratio Natural ->
52+
MoneyAmount ->
5653
BuyOrSell ->
5754
MoneyAmount ->
5855
m MoneyAmount
5956
tweakMoneyAmountRec tweak bos prev = do
6057
next <-
61-
roundMoneyAmount
62-
. MoneyAmount
63-
$ case bos of
64-
Buy -> unMoneyAmount prev + tweak
65-
Sell -> unMoneyAmount prev - tweak
58+
roundMoneyAmount $ case bos of
59+
Buy -> prev + tweak
60+
Sell -> prev - tweak
6661
if next /= prev
6762
then pure next
6863
else tweakMoneyAmountRec (tweak + pip) bos prev
6964

70-
pip :: Ratio Natural
65+
pip :: MoneyAmount
7166
pip = 0.00000001
7267

7368
tweakQuotePerBase ::
@@ -79,24 +74,20 @@ tweakQuotePerBase ::
7974
tweakQuotePerBase bos rate =
8075
tweakQuotePerBaseRec rate (* tweak)
8176
where
82-
tweak :: Ratio Natural
77+
tweak :: QuotePerBase
8378
tweak =
8479
case bos of
85-
Buy -> 999 % 1000
86-
Sell -> 1001 % 1000
80+
Buy -> 0.999
81+
Sell -> 1.001
8782

8883
tweakQuotePerBaseRec ::
8984
( MonadThrow m
9085
) =>
9186
QuotePerBase ->
92-
(Ratio Natural -> Ratio Natural) ->
87+
(QuotePerBase -> QuotePerBase) ->
9388
m QuotePerBase
9489
tweakQuotePerBaseRec prev tweak = do
95-
next <-
96-
roundQuotePerBase
97-
. QuotePerBase
98-
. tweak
99-
$ unQuotePerBase prev
90+
next <- roundQuotePerBase $ tweak prev
10091
if next /= prev
10192
then pure next
10293
else tweakQuotePerBaseRec prev $ tweak . tweak

0 commit comments

Comments
 (0)