wip

Author: functora

pub/bfx/src/Bfx.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 module Bfx
@@ -54,15 +53,15 @@ platformStatus ::
   ) =>
   m PltStatus
 platformStatus =
-  Generic.pub @'PlatformStatus [] ()
+  Generic.pub @'PlatformStatus mempty emptyReq
 
 symbolsDetails ::
   ( MonadThrow m,
     MonadUnliftIO m
   ) =>
   m (Map CurrencyPair CurrencyPairConf)
 symbolsDetails =
-  Generic.pub @'SymbolsDetails [] ()
+  Generic.pub @'SymbolsDetails mempty emptyReq
 
 marketAveragePrice ::
   ( MonadThrow m,
@@ -80,7 +79,6 @@ marketAveragePrice args =
   where
     amt =
       ( MarketAveragePrice.buyOrSell args,
-        Base,
         MarketAveragePrice.baseAmount args
       )
     sym =
@@ -93,10 +91,7 @@ feeSummary ::
   Env ->
   m FeeSummary.Response
 feeSummary env =
-  Generic.prv
-    @'FeeSummary
-    env
-    (mempty :: Map Int Int)
+  Generic.prv @'FeeSummary env emptyReq
 
 wallets ::
   ( MonadThrow m,
@@ -109,10 +104,7 @@ wallets ::
         (Map Wallets.WalletType Wallets.Response)
     )
 wallets env =
-  Generic.prv
-    @'Wallets
-    env
-    (mempty :: Map Int Int)
+  Generic.prv @'Wallets env emptyReq
 
 spendableExchangeBalance ::
   ( MonadThrow m,

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

@@ -53,9 +53,9 @@ instance ToRequestParam Text where
   toTextParam =
     id
 
-instance ToRequestParam (BuyOrSell, BaseOrQuote, MoneyAmount) where
-  toTextParam (bos, boq, MoneyAmount amt) =
-    if bos == Sell && boq == Base
+instance ToRequestParam (BuyOrSell, MoneyAmount) where
+  toTextParam (bos, MoneyAmount amt) =
+    if bos == Sell
       then toTextParam $ (-1) * rat amt
       else toTextParam $ rat amt
     where

pub/bfx/src/Bfx/Data/FeeSummary.hs

@@ -16,7 +16,7 @@ data Response = Response
   { makerCrypto2CryptoFee :: FeeRate,
     makerCrypto2StableFee :: FeeRate,
     makerCrypto2FiatFee :: FeeRate,
-    makerDerivativeRebate :: RebateRate 'Maker,
+    makerDerivativeRebate :: RebateRate,
     takerCrypto2CryptoFee :: FeeRate,
     takerCrypto2StableFee :: FeeRate,
     takerCrypto2FiatFee :: FeeRate,

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

@@ -70,7 +70,6 @@ instance ToJSON Request where
           "amount"
             A..= toTextParam
               ( buyOrSell req,
-                Base,
                 baseAmount req
               ),
           "symbol"

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

@@ -33,6 +33,7 @@ module Bfx.Data.Type
     -- $misc
     PltStatus (..),
     Error (..),
+    emptyReq,
   )
 where
 
@@ -235,166 +236,18 @@ newOrderStatus = \case
 -- $trading
 -- Data related to trading and money.
 
--- newtype
---   FeeRate
---     (mrel :: MakerOrTaker)
---     (crel :: CurrencyRelation) = FeeRate
---   { unFeeRate :: Rational
---   }
---   deriving newtype
---     ( Eq,
---       Ord,
---       Show
---     )
---   deriving stock
---     ( Generic,
---       TH.Lift
---     )
---
--- instance From (FeeRate mrel crel) Rational
---
--- instance TryFrom Rational (FeeRate mrel crel) where
---   tryFrom x
---     | x >= 0 && x < 1 = Right $ FeeRate x
---     | otherwise = Left $ TryFromException x Nothing
---
--- deriving via
---   Rational
---   instance
---     ( Typeable mrel,
---       Typeable crel
---     ) =>
---     PersistFieldSql (FeeRate mrel crel)
---
--- instance
---   ( Typeable mrel,
---     Typeable crel
---   ) =>
---   PersistField (FeeRate mrel crel)
---   where
---   toPersistValue =
---     PersistRational . from
---   fromPersistValue raw =
---     case raw of
---       PersistRational x ->
---         first (const failure) $ tryFrom x
---       _ ->
---         Left failure
---     where
---       failure =
---         showType @(FeeRate mrel crel)
---           <> " PersistValue is invalid "
---           <> show raw
-
-newtype RebateRate (mrel :: MakerOrTaker)
-  = RebateRate Rational
-  deriving newtype
+newtype RebateRate = RebateRate
+  { unRebateRate :: Rational
+  }
+  deriving stock
     ( Eq,
       Ord,
       Show,
-      Num
-    )
-  deriving stock
-    ( Generic
+      Read,
+      Data,
+      Generic
     )
 
-instance From (RebateRate mrel) Rational
-
-instance From Rational (RebateRate mrel)
-
--- newtype ProfitRate = ProfitRate
---   { unProfitRate :: Rational
---   }
---   deriving newtype
---     ( Eq,
---       Ord,
---       Show,
---       NFData
---     )
---   deriving stock
---     ( Generic,
---       TH.Lift
---     )
---
--- instance TryFrom Rational ProfitRate where
---   tryFrom x
---     | x > 0 = Right $ ProfitRate x
---     | otherwise = Left $ TryFromException x Nothing
---
--- instance From ProfitRate Rational
---
--- instance FromJSON ProfitRate where
---   parseJSON =
---     withText (inspectType @ProfitRate)
---       $ either (fail . inspect) (pure . ProfitRate)
---       . parseRatio
---
--- newtype ProfitRateB (b :: MinOrMax) = ProfitRateB
---   { unProfitRateB :: ProfitRate
---   }
---   deriving newtype
---     ( Eq,
---       Ord,
---       Show,
---       NFData,
---       FromJSON
---     )
---   deriving stock
---     ( Generic,
---       TH.Lift
---     )
-
--- newtype CurrencyCode (crel :: CurrencyRelation) = CurrencyCode
---   { unCurrencyCode :: Text
---   }
---   deriving newtype
---     ( Eq,
---       Ord,
---       Show,
---       ToJSON,
---       NFData
---     )
---   deriving stock
---     ( Generic,
---       TH.Lift
---     )
---
--- instance From (CurrencyCode crel0) (CurrencyCode crel1)
---
--- instance (Typeable crel) => FromJSON (CurrencyCode crel) where
---   parseJSON = withText
---     (showType @(CurrencyCode crel))
---     $ \raw -> do
---       case newCurrencyCode raw of
---         Left x -> fail $ show x
---         Right x -> pure x
---
--- deriving via
---   Text
---   instance
---     ( Typeable crel
---     ) =>
---     PersistFieldSql (CurrencyCode crel)
---
--- instance
---   ( Typeable crel
---   ) =>
---   PersistField (CurrencyCode crel)
---   where
---   toPersistValue =
---     PersistText . coerce
---   fromPersistValue raw =
---     case raw of
---       PersistText x ->
---         first (const failure) $ newCurrencyCode x
---       _ ->
---         Left failure
---     where
---       failure =
---         showType @(CurrencyCode crel)
---           <> " PersistValue is invalid "
---           <> show raw
-
 newCurrencyCode :: (MonadThrow m) => Text -> m CurrencyCode
 newCurrencyCode raw =
   case T.strip raw of
@@ -576,3 +429,6 @@ data Error
     )
 
 instance Exception Error
+
+emptyReq :: Map Int Int
+emptyReq = mempty

pub/bfx/src/Bfx/Math.hs

@@ -6,7 +6,6 @@ module Bfx.Math
     newCounterOrder,
     CounterArgs (..),
     CounterExit (..),
-    -- newCounterOrderSimple,
   )
 where
 

pub/bfx/src/Bfx/Parser.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 module Bfx.Parser

pub/bfx/src/Bfx/Rpc/Generic.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 module Bfx.Rpc.Generic

pub/bfx/src/Bfx/Util.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 module Bfx.Util

pub/bfx/test/Bfx/Data/SubmitOrderSpec.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_HADDOCK show-extensions #-}
 
 module Bfx.Data.SubmitOrderSpec