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           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 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           System.ZMQ4
 
 data HistoryServer = HistoryServer ThreadId ThreadId
 
@@ -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)

src/ATrade/MDS/Protocol.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE MultiWayIf        #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module ATrade.MDS.Protocol (
   QHPRequest(..),
@@ -9,10 +10,13 @@ module ATrade.MDS.Protocol (
 
 -- import ATrade.Types
 
+import           Control.Monad
 import           Data.Aeson
-import Data.Aeson.Types
-import Data.Time.Clock
+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  |
@@ -56,11 +60,11 @@ data QHPRequest =
 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,6 +76,7 @@ instance FromJSON QHPRequest where
         | t == "MN" -> return PeriodMonth
         | otherwise -> fail "Invalid period specified"
 
+
 data HAPRequest =
   HAPRequest {
     hapTicker       :: T.Text,
@@ -83,6 +88,27 @@ data HAPRequest =
 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 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.Error.Util
+import           Control.Exception
 import           Control.Lens
-import Data.Either.Combinators
-import qualified Data.ByteString.Lazy as BL
+import           Control.Monad
 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 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 Control.Error.Util
+import qualified Data.Text                            as T
 import           Data.Text.Format
-import Data.Csv
-import Data.Time.Format
-import qualified Data.ByteString.Char8 as B8
+import qualified Data.Text.ICU.Convert                as TC
+import           Data.Time.Calendar
 import           Data.Time.Clock
-import Data.Decimal
-import Control.Monad
-import Control.Exception
+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  |

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: {}