{-# LANGUAGE OverloadedStrings #-}
module Web.Data.Stooq.API where
import Control.Lens ((^.))
import Data.Text (Text, unpack)
import Data.Time.Calendar (fromGregorian, Day)
import Data.Time.Clock (UTCTime(..))
import Data.Time.LocalTime (LocalTime(LocalTime), TimeOfDay(TimeOfDay), TimeZone, localTimeToUTC, hoursToTimeZone)
import Network.Wreq (get, responseBody)
import qualified Web.Data.Stooq.Internals as Impl
newtype StooqSymbol = StooqSymbol String
deriving (Int -> StooqSymbol -> ShowS
[StooqSymbol] -> ShowS
StooqSymbol -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [StooqSymbol] -> ShowS
$cshowList :: [StooqSymbol] -> ShowS
show :: StooqSymbol -> [Char]
$cshow :: StooqSymbol -> [Char]
showsPrec :: Int -> StooqSymbol -> ShowS
$cshowsPrec :: Int -> StooqSymbol -> ShowS
Show, ReadPrec [StooqSymbol]
ReadPrec StooqSymbol
Int -> ReadS StooqSymbol
ReadS [StooqSymbol]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StooqSymbol]
$creadListPrec :: ReadPrec [StooqSymbol]
readPrec :: ReadPrec StooqSymbol
$creadPrec :: ReadPrec StooqSymbol
readList :: ReadS [StooqSymbol]
$creadList :: ReadS [StooqSymbol]
readsPrec :: Int -> ReadS StooqSymbol
$creadsPrec :: Int -> ReadS StooqSymbol
Read, StooqSymbol -> StooqSymbol -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StooqSymbol -> StooqSymbol -> Bool
$c/= :: StooqSymbol -> StooqSymbol -> Bool
== :: StooqSymbol -> StooqSymbol -> Bool
$c== :: StooqSymbol -> StooqSymbol -> Bool
Eq, Eq StooqSymbol
StooqSymbol -> StooqSymbol -> Bool
StooqSymbol -> StooqSymbol -> Ordering
StooqSymbol -> StooqSymbol -> StooqSymbol
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StooqSymbol -> StooqSymbol -> StooqSymbol
$cmin :: StooqSymbol -> StooqSymbol -> StooqSymbol
max :: StooqSymbol -> StooqSymbol -> StooqSymbol
$cmax :: StooqSymbol -> StooqSymbol -> StooqSymbol
>= :: StooqSymbol -> StooqSymbol -> Bool
$c>= :: StooqSymbol -> StooqSymbol -> Bool
> :: StooqSymbol -> StooqSymbol -> Bool
$c> :: StooqSymbol -> StooqSymbol -> Bool
<= :: StooqSymbol -> StooqSymbol -> Bool
$c<= :: StooqSymbol -> StooqSymbol -> Bool
< :: StooqSymbol -> StooqSymbol -> Bool
$c< :: StooqSymbol -> StooqSymbol -> Bool
compare :: StooqSymbol -> StooqSymbol -> Ordering
$ccompare :: StooqSymbol -> StooqSymbol -> Ordering
Ord)
data StooqPrice =
StooqPrice {
StooqPrice -> StooqSymbol
symbol :: StooqSymbol,
StooqPrice -> UTCTime
time :: UTCTime,
StooqPrice -> Double
open :: Double,
StooqPrice -> Double
high :: Double,
StooqPrice -> Double
low :: Double,
StooqPrice -> Double
close :: Double,
StooqPrice -> Int
volume :: Int
} deriving Int -> StooqPrice -> ShowS
[StooqPrice] -> ShowS
StooqPrice -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [StooqPrice] -> ShowS
$cshowList :: [StooqPrice] -> ShowS
show :: StooqPrice -> [Char]
$cshow :: StooqPrice -> [Char]
showsPrec :: Int -> StooqPrice -> ShowS
$cshowsPrec :: Int -> StooqPrice -> ShowS
Show
fetchPrice :: StooqSymbol -> IO (Either String [StooqPrice])
fetchPrice :: StooqSymbol -> IO (Either [Char] [StooqPrice])
fetchPrice StooqSymbol
ticker = do
let url :: [Char]
url = StooqSymbol -> [Char]
queryUrl StooqSymbol
ticker
Response ByteString
r <- [Char] -> IO (Response ByteString)
get [Char]
url
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map StooqRow -> StooqPrice
toApiType forall b c a. (b -> c) -> (a -> b) -> a -> c
. StooqResponse -> [StooqRow]
Impl.symbols) (ByteString -> Either [Char] StooqResponse
Impl.parseResponse (Response ByteString
r forall s a. s -> Getting a s a -> a
^. forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
responseBody))
where
baseUrl :: String
baseUrl :: [Char]
baseUrl = [Char]
"https://stooq.pl/q/l/?s="
queryUrl :: StooqSymbol -> String
queryUrl :: StooqSymbol -> [Char]
queryUrl (StooqSymbol [Char]
ticker) = [Char]
baseUrl forall a. [a] -> [a] -> [a]
++ [Char]
ticker forall a. [a] -> [a] -> [a]
++ [Char]
"&e=xml"
toApiType :: Impl.StooqRow -> StooqPrice
toApiType :: StooqRow -> StooqPrice
toApiType StooqRow
row = StooqPrice {
symbol :: StooqSymbol
symbol = ([Char] -> StooqSymbol
StooqSymbol forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. StooqRow -> Text
Impl.symbol) StooqRow
row,
time :: UTCTime
time = TimeZone -> LocalTime -> UTCTime
localTimeToUTC TimeZone
stooqTimeZone forall a b. (a -> b) -> a -> b
$ Day -> TimeOfDay -> LocalTime
LocalTime ((Int -> Day
stooqIntToDay forall b c a. (b -> c) -> (a -> b) -> a -> c
. StooqRow -> Int
Impl.date) StooqRow
row) (([Char] -> TimeOfDay
stooqStringToTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. StooqRow -> Text
Impl.time) StooqRow
row),
open :: Double
open = StooqRow -> Double
Impl.open StooqRow
row,
high :: Double
high = StooqRow -> Double
Impl.high StooqRow
row,
low :: Double
low = StooqRow -> Double
Impl.low StooqRow
row,
close :: Double
close = StooqRow -> Double
Impl.close StooqRow
row,
volume :: Int
volume = StooqRow -> Int
Impl.volume StooqRow
row
}
stooqIntToDay :: Int -> Day
stooqIntToDay :: Int -> Day
stooqIntToDay Int
date = Integer -> Int -> Int -> Day
fromGregorian (forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ (Int
date forall a. Integral a => a -> a -> a
`div` Int
10000) forall a. Integral a => a -> a -> a
`mod` Int
10000) ((Int
date forall a. Integral a => a -> a -> a
`div` Int
100) forall a. Integral a => a -> a -> a
`mod` Int
100) (Int
date forall a. Integral a => a -> a -> a
`mod` Int
100)
stooqStringToTime :: String -> TimeOfDay
stooqStringToTime :: [Char] -> TimeOfDay
stooqStringToTime [Char
h1,Char
h2,Char
m1,Char
m2,Char
s1,Char
s2] = Int -> Int -> Pico -> TimeOfDay
TimeOfDay (forall a. Read a => [Char] -> a
read [Char
h1,Char
h2]) (forall a. Read a => [Char] -> a
read [Char
m1,Char
m2]) (forall a. Read a => [Char] -> a
read [Char
s1,Char
s2])
stooqStringToTime [Char]
x = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected time format: " forall a. [a] -> [a] -> [a]
++ [Char]
x
stooqTimeZone :: TimeZone
stooqTimeZone :: TimeZone
stooqTimeZone = Int -> TimeZone
hoursToTimeZone Int
1
fetchPrices :: [StooqSymbol] -> IO (Either String [StooqPrice])
fetchPrices :: [StooqSymbol] -> IO (Either [Char] [StooqPrice])
fetchPrices [StooqSymbol]
tickers = StooqSymbol -> IO (Either [Char] [StooqPrice])
fetchPrice ([StooqSymbol] -> StooqSymbol
concatTickers [StooqSymbol]
tickers)
where
concatTickers :: [StooqSymbol] -> StooqSymbol
concatTickers :: [StooqSymbol] -> StooqSymbol
concatTickers = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\(StooqSymbol [Char]
t1) (StooqSymbol [Char]
t2) -> [Char] -> StooqSymbol
StooqSymbol ([Char]
t1 forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ [Char]
t2))
fetch :: String -> IO (Either String [StooqPrice])
fetch :: [Char] -> IO (Either [Char] [StooqPrice])
fetch = StooqSymbol -> IO (Either [Char] [StooqPrice])
fetchPrice forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> StooqSymbol
StooqSymbol