1 changed files with 361 additions and 0 deletions
@ -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