4 changed files with 430 additions and 15 deletions
@ -0,0 +1,361 @@
@@ -0,0 +1,361 @@
|
||||
{-# LANGUAGE OverloadedStrings #-} |
||||
{-# LANGUAGE TypeSynonymInstances #-} |
||||
{-# LANGUAGE FlexibleInstances #-} |
||||
|
||||
module ATrade.Quotes.Finam ( |
||||
downloadFinamSymbols, |
||||
Symbol(..), |
||||
Period(..), |
||||
DateFormat(..), |
||||
TimeFormat(..), |
||||
FieldSeparator(..), |
||||
RequestParams(..), |
||||
defaultParams, |
||||
downloadQuotes, |
||||
parseQuotes, |
||||
downloadAndParseQuotes, |
||||
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 |
||||
|
||||
data Period = |
||||
PeriodTick | |
||||
Period1Min | |
||||
Period5Min | |
||||
Period10Min | |
||||
Period15Min | |
||||
Period30Min | |
||||
PeriodHour | |
||||
PeriodDay | |
||||
PeriodWeek | |
||||
PeriodMonth |
||||
deriving (Show, Eq) |
||||
|
||||
instance Enum Period where |
||||
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 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 10 = PeriodMonth |
||||
toEnum _ = PeriodDay |
||||
|
||||
data DateFormat = |
||||
FormatYYYYMMDD | |
||||
FormatYYMMDD | |
||||
FormatDDMMYY | |
||||
FormatDD_MM_YY | |
||||
FormatMM_DD_YY |
||||
deriving (Show, Eq) |
||||
|
||||
instance Enum DateFormat where |
||||
fromEnum FormatYYYYMMDD = 1 |
||||
fromEnum FormatYYMMDD = 2 |
||||
fromEnum FormatDDMMYY = 3 |
||||
fromEnum FormatDD_MM_YY = 4 |
||||
fromEnum FormatMM_DD_YY = 5 |
||||
|
||||
toEnum 1 = FormatYYYYMMDD |
||||
toEnum 2 = FormatYYMMDD |
||||
toEnum 3 = FormatDDMMYY |
||||
toEnum 4 = FormatDD_MM_YY |
||||
toEnum 5 = FormatMM_DD_YY |
||||
toEnum _ = FormatYYYYMMDD |
||||
|
||||
|
||||
data TimeFormat = |
||||
FormatHHMMSS | |
||||
FormatHHMM | |
||||
FormatHH_MM_SS | |
||||
FormatHH_MM |
||||
deriving (Show, Eq) |
||||
|
||||
instance Enum TimeFormat where |
||||
fromEnum FormatHHMMSS = 1 |
||||
fromEnum FormatHHMM = 2 |
||||
fromEnum FormatHH_MM_SS = 3 |
||||
fromEnum FormatHH_MM = 4 |
||||
|
||||
toEnum 1 = FormatHHMMSS |
||||
toEnum 2 = FormatHHMM |
||||
toEnum 3 = FormatHH_MM_SS |
||||
toEnum 4 = FormatHH_MM |
||||
toEnum _ = FormatHHMMSS |
||||
|
||||
data FieldSeparator = |
||||
SeparatorComma | |
||||
SeparatorPeriod | |
||||
SeparatorSemicolon | |
||||
SeparatorTab | |
||||
SeparatorSpace |
||||
deriving (Show, Eq) |
||||
|
||||
instance Enum FieldSeparator where |
||||
fromEnum SeparatorComma = 1 |
||||
fromEnum SeparatorPeriod = 2 |
||||
fromEnum SeparatorSemicolon = 3 |
||||
fromEnum SeparatorTab = 4 |
||||
fromEnum SeparatorSpace = 5 |
||||
|
||||
toEnum 1 = SeparatorComma |
||||
toEnum 2 = SeparatorPeriod |
||||
toEnum 3 = SeparatorSemicolon |
||||
toEnum 4 = SeparatorTab |
||||
toEnum 5 = SeparatorSpace |
||||
toEnum _ = SeparatorComma |
||||
|
||||
data RequestParams = RequestParams { |
||||
ticker :: T.Text, |
||||
startDate :: Day, |
||||
endDate :: Day, |
||||
period :: Period, |
||||
dateFormat :: DateFormat, |
||||
timeFormat :: TimeFormat, |
||||
fieldSeparator :: FieldSeparator, |
||||
includeHeader :: Bool, |
||||
fillEmpty :: Bool |
||||
} |
||||
|
||||
defaultParams = RequestParams { |
||||
ticker = "", |
||||
startDate = fromGregorian 1970 1 1, |
||||
endDate = fromGregorian 1970 1 1, |
||||
period = PeriodDay, |
||||
dateFormat = FormatYYYYMMDD, |
||||
timeFormat = FormatHHMMSS, |
||||
fieldSeparator = SeparatorComma, |
||||
includeHeader = True, |
||||
fillEmpty = False |
||||
} |
||||
|
||||
data Symbol = Symbol { |
||||
symCode :: T.Text, |
||||
symName :: T.Text, |
||||
symId :: Integer, |
||||
symMarketCode :: Integer, |
||||
symMarketName :: T.Text |
||||
} |
||||
deriving (Show, Eq) |
||||
|
||||
data Row = Row { |
||||
rowTicker :: T.Text, |
||||
rowTime :: UTCTime, |
||||
rowOpen :: Decimal, |
||||
rowHigh :: Decimal, |
||||
rowLow :: Decimal, |
||||
rowClose :: Decimal, |
||||
rowVolume :: Integer |
||||
} deriving (Show, Eq) |
||||
|
||||
instance FromField Decimal where |
||||
parseField s = realFracToDecimal 10 <$> (parseField s :: Parser Double) |
||||
|
||||
instance FromRecord Row where |
||||
parseRecord v |
||||
| length v == 9 = do |
||||
tkr <- v .! 0 |
||||
date <- v .! 2 |
||||
time <- v .! 3 |
||||
dt <- parseDt date time |
||||
open <- v .! 4 |
||||
high <- v .! 5 |
||||
low <- v .! 6 |
||||
close <- v .! 7 |
||||
volume <- v .! 8 |
||||
return $ Row tkr dt open high low close volume |
||||
| otherwise = mzero |
||||
where |
||||
parseDt :: B.ByteString -> B.ByteString -> Parser UTCTime |
||||
parseDt d t = case parseTimeM True defaultTimeLocale "%Y%m%d %H%M%S" $ B8.unpack d ++ " " ++ B8.unpack t of |
||||
Just dt -> return dt |
||||
Nothing -> fail "Unable to parse date/time" |
||||
|
||||
downloadAndParseQuotes params = downloadAndParseQuotes' params 3 |
||||
where |
||||
downloadAndParseQuotes' params iter = do |
||||
raw <- downloadQuotes params `catch` (\e -> do |
||||
debugM "History" $ "exception: " ++ show (e :: SomeException) |
||||
return Nothing) |
||||
case raw of |
||||
Just r -> return $ parseQuotes r |
||||
Nothing -> if iter <= 0 then return Nothing else downloadAndParseQuotes' params (iter - 1) |
||||
|
||||
parseQuotes :: B.ByteString -> Maybe [Row] |
||||
parseQuotes csvData = case decode HasHeader $ BL.fromStrict csvData of |
||||
Left _ -> Nothing |
||||
Right d -> Just $ V.toList d |
||||
|
||||
downloadQuotes :: RequestParams -> IO (Maybe B.ByteString) |
||||
downloadQuotes params = do |
||||
symbols <- downloadFinamSymbols |
||||
case requestUrl symbols params of |
||||
Just (url, options) -> do |
||||
resp <- getWith options url |
||||
return $ Just $ BL.toStrict $ resp ^. responseBody |
||||
Nothing -> return Nothing |
||||
|
||||
requestUrl :: [Symbol] -> RequestParams -> Maybe (String, Options) |
||||
requestUrl symbols params = case getFinamCode symbols (ticker params) of |
||||
Just (sym, market) -> Just ("http://export.finam.ru/export9.out", getOptions sym market params) |
||||
Nothing -> Nothing |
||||
where |
||||
getOptions sym market params = defaults & |
||||
param "market" .~ [T.pack . show $ market] & |
||||
param "f" .~ [ticker params] & |
||||
param "e" .~ [".csv"] & |
||||
param "dtf" .~ [T.pack . show . fromEnum . dateFormat $ params] & |
||||
param "tmf" .~ [T.pack . show . fromEnum . dateFormat $ params] & |
||||
param "MSOR" .~ ["0"] & |
||||
param "mstime" .~ ["on"] & |
||||
param "mstimever" .~ ["1"] & |
||||
param "sep" .~ [T.pack . show . fromEnum . fieldSeparator $ params] & |
||||
param "sep2" .~ ["1"] & |
||||
param "at" .~ [if includeHeader params then "1" else "0"] & |
||||
param "fsp" .~ [if fillEmpty params then "1" else "0"] & |
||||
param "p" .~ [T.pack . show . fromEnum $ period params] & |
||||
param "em" .~ [T.pack . show $ sym ] & |
||||
param "df" .~ [T.pack . show $ dayFrom] & |
||||
param "mf" .~ [T.pack . show $ (monthFrom - 1)] & |
||||
param "yf" .~ [T.pack . show $ yearFrom] & |
||||
param "dt" .~ [T.pack . show $ dayTo] & |
||||
param "mt" .~ [T.pack . show $ (monthTo - 1)] & |
||||
param "yt" .~ [T.pack . show $ yearTo] & |
||||
param "code" .~ [ticker params] & |
||||
param "datf" .~ if period params == PeriodTick then ["11"] else ["1"] |
||||
(yearFrom, monthFrom, dayFrom) = toGregorian $ startDate params |
||||
(yearTo, monthTo, dayTo) = toGregorian $ endDate params |
||||
|
||||
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 |
||||
|
||||
downloadFinamSymbols :: IO [Symbol] |
||||
downloadFinamSymbols = do |
||||
conv <- TC.open "cp1251" Nothing |
||||
result <- get "http://www.finam.ru/cache/icharts/icharts.js" |
||||
if result ^. responseStatus . statusCode == 200 |
||||
then return $ parseSymbols . T.lines $ TC.toUnicode conv $ BL.toStrict $ result ^. responseBody |
||||
else return [] |
||||
where |
||||
parseSymbols :: [T.Text] -> [Symbol] |
||||
parseSymbols strs = zipWith5 Symbol codes names ids marketCodes marketNames |
||||
where |
||||
getWithParser parser pos = fromMaybe [] $ do |
||||
s <- T.unpack <$> strs `atMay` pos |
||||
hush $ parse parser "" s |
||||
|
||||
ids :: [Integer] |
||||
ids = getWithParser intlist 0 |
||||
|
||||
names :: [T.Text] |
||||
names = T.pack <$> getWithParser strlist 1 |
||||
|
||||
codes :: [T.Text] |
||||
codes = T.pack <$> getWithParser strlist 2 |
||||
|
||||
marketCodes :: [Integer] |
||||
marketCodes = getWithParser intlist 3 |
||||
|
||||
marketNames :: [T.Text] |
||||
marketNames = fmap (\code -> fromMaybe "" $ M.lookup code codeToName) marketCodes |
||||
|
||||
intlist = do |
||||
string "var" |
||||
spaces |
||||
skipMany1 alphaNum |
||||
spaces |
||||
char '=' |
||||
spaces |
||||
char '[' |
||||
manyTill (do |
||||
i <- int |
||||
char ',' <|> char ']' |
||||
return i) (char '\'' <|> char ';') |
||||
|
||||
strlist = do |
||||
string "var" |
||||
spaces |
||||
skipMany1 alphaNum |
||||
spaces |
||||
char '=' |
||||
spaces |
||||
char '[' |
||||
(char '\'' >> manyTill ((char '\\' >> char '\'') <|> anyChar) (char '\'')) `sepBy` char ',' |
||||
|
||||
codeToName :: M.Map Integer T.Text |
||||
codeToName = M.fromList [ |
||||
(200, "МосБиржа топ"), |
||||
(1 , "МосБиржа акции"), |
||||
(14 , "МосБиржа фьючерсы"), |
||||
(41, "Курс рубля"), |
||||
(45, "МосБиржа валютный рынок"), |
||||
(2, "МосБиржа облигации"), |
||||
(12, "МосБиржа внесписочные облигации"), |
||||
(29, "МосБиржа пифы"), |
||||
(8, "Расписки"), |
||||
(6, "Мировые Индексы"), |
||||
(24, "Товары"), |
||||
(5, "Мировые валюты"), |
||||
(25, "Акции США(BATS)"), |
||||
(7, "Фьючерсы США"), |
||||
(27, "Отрасли экономики США"), |
||||
(26, "Гособлигации США"), |
||||
(28, "ETF"), |
||||
(30, "Индексы мировой экономики"), |
||||
(3, "РТС"), |
||||
(20, "RTS Board"), |
||||
(10, "РТС-GAZ"), |
||||
(17, "ФОРТС Архив"), |
||||
(31, "Сырье Архив"), |
||||
(38, "RTS Standard Архив"), |
||||
(16, "ММВБ Архив"), |
||||
(18, "РТС Архив"), |
||||
(9, "СПФБ Архив"), |
||||
(32, "РТС-BOARD Архив"), |
||||
(39, "Расписки Архив"), |
||||
(-1, "Отрасли") ] |
||||
|
||||
|
||||
archives = [3, 8, 16, 17, 18, 31, 32, 38, 39, 517] |
||||
Loading…
Reference in new issue