Browse Source

Update resolver to lts-20.18

master
Denis Tereshkin 3 years ago
parent
commit
7ac33e83ef
  1. 1
      libatrade.cabal
  2. 26
      src/ATrade/Broker/Protocol.hs
  3. 6
      src/ATrade/Types.hs
  4. 9
      stack.yaml

1
libatrade.cabal

@ -38,7 +38,6 @@ library @@ -38,7 +38,6 @@ library
, bytestring
, connection
, containers
, datetime
, errors
, extra
, gitrev

26
src/ATrade/Broker/Protocol.hs

@ -22,8 +22,8 @@ import ATrade.Types @@ -22,8 +22,8 @@ import ATrade.Types
import Control.Applicative ((<|>))
import Control.Error.Util
import Data.Aeson
import Data.Aeson.KeyMap as KM
import Data.Aeson.Types hiding (parse)
import qualified Data.HashMap.Strict as HM
import Data.Int
import qualified Data.Text as T
import Data.Text.Encoding
@ -56,16 +56,16 @@ instance FromJSON Notification where @@ -56,16 +56,16 @@ instance FromJSON Notification where
parseJSON = withObject "notification" $ \obj -> parseNotification obj
where
parseNotification obj =
case HM.lookup "notification-sqnum" obj of
case KM.lookup "notification-sqnum" obj of
Just (Number sqnum) -> parseTrade (NotificationSqnum $ truncate sqnum) obj <|>
parseOrder (NotificationSqnum $ truncate sqnum) obj <|>
fail "Can't parse notification"
Just _ -> fail "Invalid sqnum"
Nothing -> fail "Unable to lookup notification sqnum"
parseTrade sqnum obj = case HM.lookup "trade" obj of
parseTrade sqnum obj = case KM.lookup "trade" obj of
Just val -> TradeNotification sqnum <$> (parseJSON val)
Nothing -> fail "Can't parse trade"
parseOrder sqnum obj = case HM.lookup "order-state" obj of
parseOrder sqnum obj = case KM.lookup "order-state" obj of
Just v -> withObject "object" (\os -> do
oid <- os .: "order-id"
ns <- os .: "new-state"
@ -97,16 +97,16 @@ instance FromJSON BrokerServerRequest where @@ -97,16 +97,16 @@ instance FromJSON BrokerServerRequest where
where
parseRequest :: RequestSqnum -> ClientIdentity -> Object -> Parser BrokerServerRequest
parseRequest sqnum clientIdentity obj
| HM.member "order" obj = do
| KM.member "order" obj = do
order <- obj .: "order"
RequestSubmitOrder sqnum clientIdentity <$> parseJSON order
| HM.member "cancel-order" obj = do
| KM.member "cancel-order" obj = do
orderId <- obj .: "cancel-order"
RequestCancelOrder sqnum clientIdentity <$> parseJSON orderId
| HM.member "request-notifications" obj = do
| KM.member "request-notifications" obj = do
initialSqnum <- obj .: "initial-sqnum"
return (RequestNotifications sqnum clientIdentity (NotificationSqnum initialSqnum))
| HM.member "request-current-sqnum" obj =
| KM.member "request-current-sqnum" obj =
return (RequestCurrentSqnum sqnum clientIdentity)
parseRequest _ _ _ = fail "Invalid request object"
@ -134,17 +134,17 @@ data BrokerServerResponse = ResponseOk @@ -134,17 +134,17 @@ data BrokerServerResponse = ResponseOk
instance FromJSON BrokerServerResponse where
parseJSON = withObject "object" (\obj ->
if | HM.member "result" obj -> do
if | KM.member "result" obj -> do
result <- obj .: "result"
if (result :: T.Text) == "success"
then return ResponseOk
else do
msg <- obj .:? "message" .!= ""
return (ResponseError msg)
| HM.member "notifications" obj -> do
| KM.member "notifications" obj -> do
notifications <- obj .: "notifications"
ResponseNotifications <$> parseJSON notifications
| HM.member "current-sqnum" obj -> do
| KM.member "current-sqnum" obj -> do
rawSqnum <- obj .: "current-sqnum"
return $ ResponseCurrentSqnum (NotificationSqnum rawSqnum)
| otherwise -> fail "Unable to parse BrokerServerResponse")
@ -234,11 +234,11 @@ instance ToJSON TradeSinkMessage where @@ -234,11 +234,11 @@ instance ToJSON TradeSinkMessage where
instance FromJSON TradeSinkMessage where
parseJSON = withObject "object" (\obj ->
case HM.lookup "command" obj of
case KM.lookup "command" obj of
Nothing -> parseTrade obj
Just cmd -> return TradeSinkHeartBeat)
where
parseTrade obj = case HM.lookup "trade" obj of
parseTrade obj = case KM.lookup "trade" obj of
Just (Object v) -> do
acc <- v .: "account"
sec <- v .: "security"

6
src/ATrade/Types.hs

@ -37,11 +37,11 @@ import ATrade.Price @@ -37,11 +37,11 @@ import ATrade.Price
import Control.Monad
import Data.Aeson
import Data.Aeson.Key
import Data.Aeson.Types
import Data.Binary.Get
import Data.Binary.Put
import Data.ByteString.Lazy as B
import Data.DateTime
import Data.Int
import Data.List as L
import Data.Maybe
@ -151,7 +151,7 @@ parseTick = do @@ -151,7 +151,7 @@ parseTick = do
volume = volume }
makeTimestamp :: Word64 -> Word32 -> UTCTime
makeTimestamp sec usec = addUTCTime (fromRational $ toInteger usec % 1000000) (fromSeconds . toInteger $ sec)
makeTimestamp sec usec = addUTCTime (fromRational $ toInteger usec % 1000000) (posixSecondsToUTCTime . fromIntegral $ sec)
deserializeTick :: [ByteString] -> Maybe Tick
deserializeTick (header:rawData:_) = case runGetOrFail parseTick rawData of
@ -386,7 +386,7 @@ instance ToJSON Order where @@ -386,7 +386,7 @@ instance ToJSON Order where
"state" .= orderState order,
"signal-id" .= orderSignalId order ]
ifMaybe :: (ToJSON a, KeyValue b) => Text -> (a -> Bool) -> a -> Maybe b
ifMaybe name pred val = if pred val then Just (name .= val) else Nothing
ifMaybe name pred val = if pred val then Just (fromText name .= val) else Nothing
data Trade = Trade {
tradeOrderId :: OrderId,

9
stack.yaml

@ -15,7 +15,7 @@ @@ -15,7 +15,7 @@
# resolver:
# name: custom-snapshot
# location: "./custom-snapshot.yaml"
resolver: lts-18.18
resolver: lts-20.18
# User packages to be built.
# Various formats can be used as shown in the example below.
@ -41,10 +41,11 @@ packages: @@ -41,10 +41,11 @@ packages:
# Dependency packages to be pulled from upstream that are not in the resolver
# (e.g., acme-missiles-0.3)
extra-deps:
- datetime-0.3.1
- hexdump-0.1
- co-log-0.4.0.1@sha256:3d4c17f37693c80d1aa2c41669bc3438fac3e89dc5f479e57d79bc3ddc4dfcc5,5087
- ansi-terminal-0.10.3@sha256:e2fbcef5f980dc234c7ad8e2fa433b0e8109132c9e643bc40ea5608cd5697797,3226
- co-log-0.5.0.0
- chronos-1.1.5@sha256:ca35be5fdbbb384414226b4467c6d1c8b44defe59a9c8a3af32c1c5fb250c781,3830
- typerep-map-0.5.0.0@sha256:34f1ba9b268a6d52e26ae460011a5571e8099b50a3f4a7c8db25dd8efe3be8ee,4667
# Override default flag values for local packages and extra-deps
flags: {}

Loading…
Cancel
Save