asakul
/
mds
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

time parsing

master
Denis Tereshkin 7 years ago
parent
de1d32bbe3
commit
dd1cdd1f71
4 changed files with 148 additions and 122 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 40
      src/ATrade/MDS/HistoryServer.hs
  2. 78
      src/ATrade/MDS/Protocol.hs
  3. 142
      src/ATrade/Quotes/Finam.hs
  4. 4
      stack.yaml

40
src/ATrade/MDS/HistoryServer.hs
Unescape View File

@ -5,22 +5,22 @@ module ATrade.MDS.HistoryServer (
startHistoryServer startHistoryServer
) where ) where
import System.ZMQ4 import ATrade.MDS.Database
import ATrade.Types import ATrade.MDS.Protocol
import ATrade.MDS.Database import ATrade.Types
import ATrade.MDS.Protocol import Control.Concurrent
import Control.Concurrent import Control.Monad
import Control.Monad import Data.Aeson
import Data.Aeson import Data.Binary.Get
import Data.List.NonEmpty import Data.Binary.Put
import Data.Time.Clock.POSIX import qualified Data.ByteString as B
import qualified Data.Vector as V import qualified Data.ByteString.Lazy as BL
import Safe import Data.List.NonEmpty
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.ByteString as B import Data.Time.Clock.POSIX
import qualified Data.ByteString.Lazy as BL import qualified Data.Vector as V
import Data.Binary.Get import Safe
import Data.Binary.Put import System.ZMQ4
data HistoryServer = HistoryServer ThreadId ThreadId data HistoryServer = HistoryServer ThreadId ThreadId
@ -47,7 +47,7 @@ serveQHP db sock = forever $ do
let maybeCmd = (BL.fromStrict <$> rq `atMay` 2) >>= decode let maybeCmd = (BL.fromStrict <$> rq `atMay` 2) >>= decode
case (headMay rq, maybeCmd) of case (headMay rq, maybeCmd) of
(Just peerId, Just cmd) -> handleCmd peerId cmd (Just peerId, Just cmd) -> handleCmd peerId cmd
_ -> return () _ -> return ()
where where
handleCmd :: B.ByteString -> QHPRequest -> IO () handleCmd :: B.ByteString -> QHPRequest -> IO ()
handleCmd peerId cmd = case cmd of handleCmd peerId cmd = case cmd of
@ -56,8 +56,8 @@ serveQHP db sock = forever $ do
let bytes = serializeBars $ V.concat $ fmap snd qdata let bytes = serializeBars $ V.concat $ fmap snd qdata
sendMulti sock $ peerId :| B.empty : [BL.toStrict bytes] sendMulti sock $ peerId :| B.empty : [BL.toStrict bytes]
serializeBars :: V.Vector Bar -> BL.ByteString serializeBars :: V.Vector Bar -> BL.ByteString
serializeBars bars = runPut $ V.forM_ bars serializeBar serializeBars bars = runPut $ V.forM_ bars serializeBar'
serializeBar bar = do serializeBar' bar = do
putWord64le (truncate . utcTimeToPOSIXSeconds . barTimestamp $ bar) putWord64le (truncate . utcTimeToPOSIXSeconds . barTimestamp $ bar)
putDoublele (toDouble . barOpen $ bar) putDoublele (toDouble . barOpen $ bar)
putDoublele (toDouble . barHigh $ bar) putDoublele (toDouble . barHigh $ bar)
@ -84,7 +84,7 @@ serveHAP db sock = forever $ do
deserializeBars tickerId input = deserializeBars tickerId input =
case runGetOrFail parseBar input of case runGetOrFail parseBar input of
Left _ -> [] Left _ -> []
Right (rest, _, bar) -> bar : deserializeBars tickerId rest Right (rest, _, bar) -> bar : deserializeBars tickerId rest
where where
parseBar = do parseBar = do

78
src/ATrade/MDS/Protocol.hs
Unescape View File

@ -1,4 +1,5 @@
{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
module ATrade.MDS.Protocol ( module ATrade.MDS.Protocol (
QHPRequest(..), QHPRequest(..),
@ -9,10 +10,13 @@ module ATrade.MDS.Protocol (
-- import ATrade.Types -- import ATrade.Types
import Data.Aeson import Control.Monad
import Data.Aeson.Types import Data.Aeson
import Data.Time.Clock import Data.Aeson.Types as Aeson
import qualified Data.Text as T import Data.Attoparsec.Text as Attoparsec
import qualified Data.Text as T
import Data.Time.Calendar
import Data.Time.Clock
data Period = data Period =
Period1Min | Period1Min |
@ -26,41 +30,41 @@ data Period =
deriving (Eq) deriving (Eq)
instance Show Period where instance Show Period where
show Period1Min = "M1" show Period1Min = "M1"
show Period5Min = "M5" show Period5Min = "M5"
show Period15Min = "M15" show Period15Min = "M15"
show Period30Min = "M30" show Period30Min = "M30"
show PeriodHour = "H1" show PeriodHour = "H1"
show PeriodDay = "D" show PeriodDay = "D"
show PeriodWeek = "W" show PeriodWeek = "W"
show PeriodMonth = "MN" show PeriodMonth = "MN"
periodSeconds :: Period -> Int periodSeconds :: Period -> Int
periodSeconds Period1Min = 60 periodSeconds Period1Min = 60
periodSeconds Period5Min = 60 * 5 periodSeconds Period5Min = 60 * 5
periodSeconds Period15Min = 60 * 15 periodSeconds Period15Min = 60 * 15
periodSeconds Period30Min = 60 * 30 periodSeconds Period30Min = 60 * 30
periodSeconds PeriodHour = 3600 periodSeconds PeriodHour = 3600
periodSeconds PeriodDay = 86400 periodSeconds PeriodDay = 86400
periodSeconds PeriodWeek = 86400 * 7 periodSeconds PeriodWeek = 86400 * 7
periodSeconds PeriodMonth = 86400 * 7 * 4 periodSeconds PeriodMonth = 86400 * 7 * 4
data QHPRequest = data QHPRequest =
QHPRequest { QHPRequest {
rqTicker :: T.Text, rqTicker :: T.Text,
rqStartTime :: UTCTime, rqStartTime :: UTCTime,
rqEndTime :: UTCTime, rqEndTime :: UTCTime,
rqPeriod :: Period rqPeriod :: Period
} deriving (Show, Eq) } deriving (Show, Eq)
instance FromJSON QHPRequest where instance FromJSON QHPRequest where
parseJSON = withObject "Request" $ \v -> QHPRequest <$> parseJSON = withObject "Request" $ \v -> QHPRequest <$>
v .: "ticker" <*> v .: "ticker" <*>
v .: "from" <*> (v .: "from" >>= parseTime) <*>
v .: "to" <*> (v .: "to" >>= parseTime) <*>
(v .: "timeframe" >>= parseTf) (v .: "timeframe" >>= parseTf)
where where
parseTf :: T.Text -> Parser Period parseTf :: T.Text -> Aeson.Parser Period
parseTf t = if parseTf t = if
| t == "M1" -> return Period1Min | t == "M1" -> return Period1Min
| t == "M5" -> return Period5Min | t == "M5" -> return Period5Min
@ -72,17 +76,39 @@ instance FromJSON QHPRequest where
| t == "MN" -> return PeriodMonth | t == "MN" -> return PeriodMonth
| otherwise -> fail "Invalid period specified" | otherwise -> fail "Invalid period specified"
data HAPRequest = data HAPRequest =
HAPRequest { HAPRequest {
hapTicker :: T.Text, hapTicker :: T.Text,
hapStartTime :: UTCTime, hapStartTime :: UTCTime,
hapEndTime :: UTCTime, hapEndTime :: UTCTime,
hapTimeframeSec :: Int hapTimeframeSec :: Int
} deriving (Show, Eq) } deriving (Show, Eq)
instance FromJSON HAPRequest where instance FromJSON HAPRequest where
parseJSON = withObject "Request" $ \v -> HAPRequest <$> parseJSON = withObject "Request" $ \v -> HAPRequest <$>
v .: "ticker" <*> v .: "ticker" <*>
v .: "start_time" <*> (v .: "start_time" >>= parseTime) <*>
v .: "end_time" <*> (v .: "end_time" >>= parseTime) <*>
v .: "timeframe_sec" v .: "timeframe_sec"
parseTime :: T.Text -> Aeson.Parser UTCTime
parseTime text = case Attoparsec.parse timeParse text of
Done _ r -> return r
_ -> fail $ "Can't parse time: " ++ T.unpack text
timeParse :: Attoparsec.Parser UTCTime
timeParse = do
year <- decimal
void $ char '-'
month <- decimal
void $ char '-'
day <- decimal
void $ char 'T'
hour <- decimal
void $ char '-'
minute <- decimal
void $ char '-'
sec <- decimal
case fromGregorianValid year month day of
Just gregorianDay -> return $ UTCTime gregorianDay (secondsToDiffTime $ hour * 3600 + minute * 60 + sec)
_ -> fail "Can't parse date: invalid values"

142
src/ATrade/Quotes/Finam.hs
Unescape View File

@ -1,6 +1,6 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
module ATrade.Quotes.Finam ( module ATrade.Quotes.Finam (
downloadFinamSymbols, downloadFinamSymbols,
@ -17,32 +17,32 @@ module ATrade.Quotes.Finam (
Row(..) Row(..)
) where ) where
import qualified Data.Text as T import Control.Error.Util
import qualified Data.Text.ICU.Convert as TC import Control.Exception
import Data.Time.Calendar import Control.Lens
import Network.Wreq import Control.Monad
import Control.Lens import qualified Data.ByteString as B
import Data.Either.Combinators import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString as B import Data.Csv
import Safe import Data.Decimal
import qualified Data.Map as M import Data.Either.Combinators
import Text.Parsec import Data.List
import Text.ParserCombinators.Parsec.Char import qualified Data.Map as M
import Text.ParserCombinators.Parsec.Number import Data.Maybe
import Data.List import qualified Data.Text as T
import Data.Maybe import Data.Text.Format
import Control.Error.Util import qualified Data.Text.ICU.Convert as TC
import Data.Text.Format import Data.Time.Calendar
import Data.Csv import Data.Time.Clock
import Data.Time.Format import Data.Time.Format
import qualified Data.ByteString.Char8 as B8 import qualified Data.Vector as V
import Data.Time.Clock import Network.Wreq
import Data.Decimal import Safe
import Control.Monad import System.Log.Logger
import Control.Exception import Text.Parsec
import qualified Data.Vector as V import Text.ParserCombinators.Parsec.Char
import System.Log.Logger import Text.ParserCombinators.Parsec.Number
data Period = data Period =
PeriodTick | PeriodTick |
@ -58,28 +58,28 @@ data Period =
deriving (Show, Eq) deriving (Show, Eq)
instance Enum Period where instance Enum Period where
fromEnum PeriodTick = 1 fromEnum PeriodTick = 1
fromEnum Period1Min = 2 fromEnum Period1Min = 2
fromEnum Period5Min = 3 fromEnum Period5Min = 3
fromEnum Period10Min = 4 fromEnum Period10Min = 4
fromEnum Period15Min = 5 fromEnum Period15Min = 5
fromEnum Period30Min = 6 fromEnum Period30Min = 6
fromEnum PeriodHour = 7 fromEnum PeriodHour = 7
fromEnum PeriodDay = 8 fromEnum PeriodDay = 8
fromEnum PeriodWeek = 9 fromEnum PeriodWeek = 9
fromEnum PeriodMonth = 10 fromEnum PeriodMonth = 10
toEnum 1 = PeriodTick toEnum 1 = PeriodTick
toEnum 2 = Period1Min toEnum 2 = Period1Min
toEnum 3 = Period5Min toEnum 3 = Period5Min
toEnum 4 = Period10Min toEnum 4 = Period10Min
toEnum 5 = Period15Min toEnum 5 = Period15Min
toEnum 6 = Period30Min toEnum 6 = Period30Min
toEnum 7 = PeriodHour toEnum 7 = PeriodHour
toEnum 8 = PeriodDay toEnum 8 = PeriodDay
toEnum 9 = PeriodWeek toEnum 9 = PeriodWeek
toEnum 10 = PeriodMonth toEnum 10 = PeriodMonth
toEnum _ = PeriodDay toEnum _ = PeriodDay
data DateFormat = data DateFormat =
FormatYYYYMMDD | FormatYYYYMMDD |
@ -91,8 +91,8 @@ data DateFormat =
instance Enum DateFormat where instance Enum DateFormat where
fromEnum FormatYYYYMMDD = 1 fromEnum FormatYYYYMMDD = 1
fromEnum FormatYYMMDD = 2 fromEnum FormatYYMMDD = 2
fromEnum FormatDDMMYY = 3 fromEnum FormatDDMMYY = 3
fromEnum FormatDD_MM_YY = 4 fromEnum FormatDD_MM_YY = 4
fromEnum FormatMM_DD_YY = 5 fromEnum FormatMM_DD_YY = 5
@ -112,10 +112,10 @@ data TimeFormat =
deriving (Show, Eq) deriving (Show, Eq)
instance Enum TimeFormat where instance Enum TimeFormat where
fromEnum FormatHHMMSS = 1 fromEnum FormatHHMMSS = 1
fromEnum FormatHHMM = 2 fromEnum FormatHHMM = 2
fromEnum FormatHH_MM_SS = 3 fromEnum FormatHH_MM_SS = 3
fromEnum FormatHH_MM = 4 fromEnum FormatHH_MM = 4
toEnum 1 = FormatHHMMSS toEnum 1 = FormatHHMMSS
toEnum 2 = FormatHHMM toEnum 2 = FormatHHMM
@ -132,11 +132,11 @@ data FieldSeparator =
deriving (Show, Eq) deriving (Show, Eq)
instance Enum FieldSeparator where instance Enum FieldSeparator where
fromEnum SeparatorComma = 1 fromEnum SeparatorComma = 1
fromEnum SeparatorPeriod = 2 fromEnum SeparatorPeriod = 2
fromEnum SeparatorSemicolon = 3 fromEnum SeparatorSemicolon = 3
fromEnum SeparatorTab = 4 fromEnum SeparatorTab = 4
fromEnum SeparatorSpace = 5 fromEnum SeparatorSpace = 5
toEnum 1 = SeparatorComma toEnum 1 = SeparatorComma
toEnum 2 = SeparatorPeriod toEnum 2 = SeparatorPeriod
@ -146,15 +146,15 @@ instance Enum FieldSeparator where
toEnum _ = SeparatorComma toEnum _ = SeparatorComma
data RequestParams = RequestParams { data RequestParams = RequestParams {
ticker :: T.Text, ticker :: T.Text,
startDate :: Day, startDate :: Day,
endDate :: Day, endDate :: Day,
period :: Period, period :: Period,
dateFormat :: DateFormat, dateFormat :: DateFormat,
timeFormat :: TimeFormat, timeFormat :: TimeFormat,
fieldSeparator :: FieldSeparator, fieldSeparator :: FieldSeparator,
includeHeader :: Bool, includeHeader :: Bool,
fillEmpty :: Bool fillEmpty :: Bool
} }
defaultParams = RequestParams { defaultParams = RequestParams {
@ -170,9 +170,9 @@ defaultParams = RequestParams {
} }
data Symbol = Symbol { data Symbol = Symbol {
symCode :: T.Text, symCode :: T.Text,
symName :: T.Text, symName :: T.Text,
symId :: Integer, symId :: Integer,
symMarketCode :: Integer, symMarketCode :: Integer,
symMarketName :: T.Text symMarketName :: T.Text
} }
@ -180,11 +180,11 @@ data Symbol = Symbol {
data Row = Row { data Row = Row {
rowTicker :: T.Text, rowTicker :: T.Text,
rowTime :: UTCTime, rowTime :: UTCTime,
rowOpen :: Decimal, rowOpen :: Decimal,
rowHigh :: Decimal, rowHigh :: Decimal,
rowLow :: Decimal, rowLow :: Decimal,
rowClose :: Decimal, rowClose :: Decimal,
rowVolume :: Integer rowVolume :: Integer
} deriving (Show, Eq) } deriving (Show, Eq)
@ -223,7 +223,7 @@ downloadAndParseQuotes params = downloadAndParseQuotes' params 3
parseQuotes :: B.ByteString -> Maybe [Row] parseQuotes :: B.ByteString -> Maybe [Row]
parseQuotes csvData = case decode HasHeader $ BL.fromStrict csvData of parseQuotes csvData = case decode HasHeader $ BL.fromStrict csvData of
Left _ -> Nothing Left _ -> Nothing
Right d -> Just $ V.toList d Right d -> Just $ V.toList d
downloadQuotes :: RequestParams -> IO (Maybe B.ByteString) downloadQuotes :: RequestParams -> IO (Maybe B.ByteString)
@ -269,7 +269,7 @@ requestUrl symbols params = case getFinamCode symbols (ticker params) of
getFinamCode :: [Symbol] -> T.Text -> Maybe (Integer, Integer) getFinamCode :: [Symbol] -> T.Text -> Maybe (Integer, Integer)
getFinamCode symbols ticker = case find (\x -> symCode x == ticker && symMarketCode x `notElem` archives) symbols of getFinamCode symbols ticker = case find (\x -> symCode x == ticker && symMarketCode x `notElem` archives) symbols of
Just sym -> Just (symId sym, symMarketCode sym) Just sym -> Just (symId sym, symMarketCode sym)
Nothing -> Nothing Nothing -> Nothing
downloadFinamSymbols :: IO [Symbol] downloadFinamSymbols :: IO [Symbol]
downloadFinamSymbols = do downloadFinamSymbols = do

4
stack.yaml
Unescape View File

@ -15,7 +15,7 @@
# resolver: # resolver:
# name: custom-snapshot # name: custom-snapshot
# location: "./custom-snapshot.yaml" # location: "./custom-snapshot.yaml"
resolver: lts-11.9 resolver: lts-12.9
# User packages to be built. # User packages to be built.
# Various formats can be used as shown in the example below. # Various formats can be used as shown in the example below.
@ -41,7 +41,7 @@ packages:
- '../zeromq4-haskell-zap' - '../zeromq4-haskell-zap'
# Dependency packages to be pulled from upstream that are not in the resolver # Dependency packages to be pulled from upstream that are not in the resolver
# (e.g., acme-missiles-0.3) # (e.g., acme-missiles-0.3)
extra-deps: ["HDBC-sqlite3-2.3.3.1", "datetime-0.3.1", "th-printf-0.5.1"] extra-deps: ["HDBC-sqlite3-2.3.3.1", "datetime-0.3.1", "th-printf-0.5.1", "text-format-0.3.2"]
# Override default flag values for local packages and extra-deps # Override default flag values for local packages and extra-deps
flags: {} flags: {}

Write Preview
Loading…
Cancel
Save