From 4271c1284505597b00121a19aef8205e6208d491 Mon Sep 17 00:00:00 2001
From: Denis Tereshkin <denis@kasan.ws>
Date: Sun, 26 Dec 2021 18:25:21 +0700
Subject: [PATCH] Various QoL enhancements

---
 src/ATrade/RoboCom/Monad.hs     | 13 ++++++++++-
 src/ATrade/RoboCom/Positions.hs | 39 ++++++++++++++++++++++++---------
 src/ATrade/RoboCom/Types.hs     |  6 ++++-
 3 files changed, 46 insertions(+), 12 deletions(-)

diff --git a/src/ATrade/RoboCom/Monad.hs b/src/ATrade/RoboCom/Monad.hs
index 4466c03..0a25afd 100644
--- a/src/ATrade/RoboCom/Monad.hs
+++ b/src/ATrade/RoboCom/Monad.hs
@@ -20,7 +20,9 @@ module ATrade.RoboCom.Monad (
   also,
   t,
   st,
-  getFirstTickerId) where
+  getFirstTickerId,
+  getTickerAnyTimeframe
+  ) where
 
 import           ATrade.RoboCom.Types
 import           ATrade.Types
@@ -30,6 +32,7 @@ import           Data.Aeson.Types
 import qualified Data.Text                 as T
 import qualified Data.Text.Lazy            as TL
 import           Data.Time.Clock
+import qualified Data.List as L
 import           Language.Haskell.Printf
 import           Language.Haskell.TH.Quote (QuasiQuoter)
 import ATrade.Logging (Severity)
@@ -57,6 +60,14 @@ class (Monad m) => MonadRobot m c s | m -> c, m -> s where
 getFirstTickerId :: forall c s m. (Monad m, MonadRobot m c s) => m BarSeriesId
 getFirstTickerId = NE.head <$> getAvailableTickers
 
+getTickerAnyTimeframe :: forall c s m. (Monad m, MonadRobot m c s) => TickerId -> m (Maybe BarSeries)
+getTickerAnyTimeframe requestedTickerId = do
+  tickers <- getAvailableTickers
+  case L.find (\(BarSeriesId tid _) -> tid == requestedTickerId) tickers of
+    Just (BarSeriesId tid tf) -> getTicker tid tf
+    Nothing -> return Nothing
+
+
 st :: QuasiQuoter
 st = t
 
diff --git a/src/ATrade/RoboCom/Positions.hs b/src/ATrade/RoboCom/Positions.hs
index 397de93..4c6bf23 100644
--- a/src/ATrade/RoboCom/Positions.hs
+++ b/src/ATrade/RoboCom/Positions.hs
@@ -69,7 +69,10 @@ module ATrade.RoboCom.Positions
 
   handlePositions,
   calculateSizeIVS,
-  calculateSizeFixed
+  calculateSizeIVSWith,
+  calculateSizeFixed,
+  calculateSizeFixedCash,
+  calculateSizeFixedCashWith
 ) where
 
 import           GHC.Generics
@@ -152,21 +155,37 @@ modifyPositions f = do
   modifyState (\s -> setPositions s (f pos))
 
 class ParamsSize a where
-  getPositionSize :: a -> BarSeries -> Int
+  getPositionSize :: a -> BarSeries -> Operation -> Int
 
 calculateSizeIVS :: (HasField "riskSize" a Double,
                      HasField "stopSize" a Double,
                      HasField "atrPeriod" a Int) =>
-  a -> BarSeries -> Int
+  a -> BarSeries -> Operation -> Int
 
-calculateSizeIVS cfg series =
-  let atr = I.atr (getField @"atrPeriod" cfg) (bsBars series) in
-    truncate ((getField @"riskSize" cfg) / (atr * getField @"stopSize" cfg))
+calculateSizeIVS cfg = calculateSizeIVSWith (getField @"atrPeriod" cfg) (getField @"riskSize" cfg) (getField @"stopSize" cfg) cfg
+
+calculateSizeIVSWith :: Int -> Double -> Double -> a -> BarSeries -> Operation -> Int
+calculateSizeIVSWith atrPeriod riskSize stopSize cfg series _ =
+  let atr = I.atr atrPeriod (bsBars series) in
+    truncate (riskSize / (atr * stopSize))
 
 calculateSizeFixed :: (HasField "positionSize" a Int) =>
-  a -> BarSeries -> Int
+  a -> BarSeries -> Operation -> Int
+
+calculateSizeFixed cfg _ _ = getField @"positionSize" cfg
+
+calculateSizeFixedCash :: ( HasField "totalCash" a Double,
+                            HasField "maxPositions" a Int) =>
+                          a -> BarSeries -> Operation -> Int
+calculateSizeFixedCash cfg = calculateSizeFixedCashWith (getField @"totalCash" cfg) (getField @"maxPositions" cfg) cfg
 
-calculateSizeFixed cfg _ = getField @"positionSize" cfg
+calculateSizeFixedCashWith :: Double -> Int -> a -> BarSeries -> Operation -> Int
+calculateSizeFixedCashWith totalCash maxPositions cfg series _ =
+  case bsBars $ series of
+    (lastBar:_) ->
+      let cashPerPosition = totalCash / fromIntegral maxPositions in
+        truncate (cashPerPosition / (fromIntegral $ ipLotSize . bsParams $ series))
+    _ -> 0
 
 -- | Helper function. Finds first element in list which satisfies predicate 'p' and if found, applies 'm' to it, leaving other elements intact.
 findAndModify :: (a -> Bool) -> (a -> a) -> [a] -> [a]
@@ -514,7 +533,7 @@ enterAtMarketForTicker operationSignalName (BarSeriesId tid tf) operation = do
     Just series -> do
       env <- getEnvironment
       cfg <- getConfig
-      let quantity = getPositionSize cfg series
+      let quantity = getPositionSize cfg series operation
       enterAtMarketWithParams (env ^. seAccount) tid quantity (SignalId (env ^. seInstanceId) operationSignalName "") operation
     Nothing -> do
       appendToLog Warning $ "Unable to get ticker series: " <> TL.fromStrict tid
@@ -548,7 +567,7 @@ enterAtLimitForTicker (BarSeriesId tid tf) operationSignalName price operation =
   case maybeSeries of
     Just series -> do
       cfg <- getConfig
-      let quantity = getPositionSize cfg series
+      let quantity = getPositionSize cfg series operation
       let roundedPrice = roundTo (ipTickSize . bsParams $ series) price
       enterAtLimitForTickerWithParams tid (fromIntegral $ unBarTimeframe tf) acc quantity (SignalId inst operationSignalName "") roundedPrice operation
     Nothing -> rejectedPosition
diff --git a/src/ATrade/RoboCom/Types.hs b/src/ATrade/RoboCom/Types.hs
index 305eebb..59bd1be 100644
--- a/src/ATrade/RoboCom/Types.hs
+++ b/src/ATrade/RoboCom/Types.hs
@@ -13,7 +13,8 @@ module ATrade.RoboCom.Types (
   Bars,
   TickerInfoMap,
   InstrumentParameters(..),
-  bsidTickerId
+  bsidTickerId,
+  barSeriesId
 ) where
 
 import           ATrade.Types
@@ -42,6 +43,9 @@ data BarSeries =
     bsParams    :: InstrumentParameters
   } deriving (Show, Eq)
 
+barSeriesId :: BarSeries -> BarSeriesId
+barSeriesId s = BarSeriesId (bsTickerId s) (bsTimeframe s)
+
 -- | Ticker description record
 data Ticker = Ticker {
   code             :: T.Text, -- ^ Main ticker code, which is used to make orders and tick parsing