time parsing

src/ATrade/MDS/HistoryServer.hs

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

src/ATrade/MDS/Protocol.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE MultiWayIf        #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module ATrade.MDS.Protocol (
   QHPRequest(..),
@@ -9,10 +10,13 @@ module ATrade.MDS.Protocol (
 
 -- import ATrade.Types
 
-import Data.Aeson
-import Data.Aeson.Types
-import Data.Time.Clock
-import qualified Data.Text as T
+import           Control.Monad
+import           Data.Aeson
+import           Data.Aeson.Types     as Aeson
+import           Data.Attoparsec.Text as Attoparsec
+import qualified Data.Text            as T
+import           Data.Time.Calendar
+import           Data.Time.Clock
 
 data Period =
   Period1Min  |
@@ -26,41 +30,41 @@ data Period =
   deriving (Eq)
 
 instance Show Period where
-  show Period1Min = "M1"
-  show Period5Min = "M5"
+  show Period1Min  = "M1"
+  show Period5Min  = "M5"
   show Period15Min = "M15"
   show Period30Min = "M30"
-  show PeriodHour = "H1"
-  show PeriodDay = "D"
-  show PeriodWeek = "W"
+  show PeriodHour  = "H1"
+  show PeriodDay   = "D"
+  show PeriodWeek  = "W"
   show PeriodMonth = "MN"
 
 periodSeconds :: Period -> Int
-periodSeconds Period1Min = 60
-periodSeconds Period5Min = 60 * 5
+periodSeconds Period1Min  = 60
+periodSeconds Period5Min  = 60 * 5
 periodSeconds Period15Min = 60 * 15
 periodSeconds Period30Min = 60 * 30
-periodSeconds PeriodHour = 3600
-periodSeconds PeriodDay = 86400
-periodSeconds PeriodWeek = 86400 * 7
+periodSeconds PeriodHour  = 3600
+periodSeconds PeriodDay   = 86400
+periodSeconds PeriodWeek  = 86400 * 7
 periodSeconds PeriodMonth = 86400 * 7 * 4
 
 data QHPRequest =
   QHPRequest {
-    rqTicker :: T.Text,
+    rqTicker    :: T.Text,
     rqStartTime :: UTCTime,
-    rqEndTime :: UTCTime,
-    rqPeriod :: Period
+    rqEndTime   :: UTCTime,
+    rqPeriod    :: Period
   } deriving (Show, Eq)
-   
+
 instance FromJSON QHPRequest where
   parseJSON = withObject "Request" $ \v -> QHPRequest <$>
     v .: "ticker" <*>
-    v .: "from" <*>
-    v .: "to" <*>
+    (v .: "from" >>= parseTime) <*>
+    (v .: "to" >>= parseTime) <*>
     (v .: "timeframe" >>= parseTf)
     where
-      parseTf :: T.Text -> Parser Period
+      parseTf :: T.Text -> Aeson.Parser Period
       parseTf t = if
         | t == "M1" -> return Period1Min
         | t == "M5" -> return Period5Min
@@ -72,17 +76,39 @@ instance FromJSON QHPRequest where
         | t == "MN" -> return PeriodMonth
         | otherwise -> fail "Invalid period specified"
 
+
 data HAPRequest =
   HAPRequest {
-    hapTicker :: T.Text,
-    hapStartTime :: UTCTime,
-    hapEndTime :: UTCTime,
+    hapTicker       :: T.Text,
+    hapStartTime    :: UTCTime,
+    hapEndTime      :: UTCTime,
     hapTimeframeSec :: Int
   } deriving (Show, Eq)
 
 instance FromJSON HAPRequest where
   parseJSON = withObject "Request" $ \v -> HAPRequest <$>
     v .: "ticker" <*>
-    v .: "start_time" <*>
-    v .: "end_time" <*>
+    (v .: "start_time" >>= parseTime) <*>
+    (v .: "end_time" >>= parseTime) <*>
     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"

src/ATrade/Quotes/Finam.hs

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

stack.yaml

@@ -15,7 +15,7 @@
 # resolver:
 #  name: custom-snapshot
 #  location: "./custom-snapshot.yaml"
-resolver: lts-11.9
+resolver: lts-12.9
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.
@@ -41,7 +41,7 @@ packages:
 - '../zeromq4-haskell-zap'
 # Dependency packages to be pulled from upstream that are not in the resolver
 # (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
 flags: {}