{-# LANGUAGE OverloadedStrings #-}

-- | Here's a simple wrapper around API offered by Stooq.pl.
-- It's capable of returning the latest price for the given instrument.
-- For more information about tickers available, visit the service.
-- Keep in mind that in some situations their ticker convention is different to what's known e.g. from Yahoo Finance
-- e.g.
--
-- xxxx.UK: London Stock Exchange (LSE)
--
-- xxxx.US: NYSE (OTC market not available, so a lot of ADRs like `OGZPY` or `SBRCY` can't be fetched)
--
-- xxxx.DE: Deutsche Börse
--
-- xxxx.JP: Tokyo Stock Exchange
--
-- xxxx: (no exchange code after full stop) Warsaw Stock Exchange (GPW)
--
-- Use:
--
-- >>> fetch "SPY.US"
-- Just [StooqPrice {symbol = StooqSymbol "SPY.US", time = ..., ...}]
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

-- | A single-case DU that represents a ticker.
newtype StooqSymbol = StooqSymbol String
    deriving (Int -> StooqSymbol -> ShowS
[StooqSymbol] -> ShowS
StooqSymbol -> String
(Int -> StooqSymbol -> ShowS)
-> (StooqSymbol -> String)
-> ([StooqSymbol] -> ShowS)
-> Show StooqSymbol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StooqSymbol] -> ShowS
$cshowList :: [StooqSymbol] -> ShowS
show :: StooqSymbol -> String
$cshow :: StooqSymbol -> String
showsPrec :: Int -> StooqSymbol -> ShowS
$cshowsPrec :: Int -> StooqSymbol -> ShowS
Show, ReadPrec [StooqSymbol]
ReadPrec StooqSymbol
Int -> ReadS StooqSymbol
ReadS [StooqSymbol]
(Int -> ReadS StooqSymbol)
-> ReadS [StooqSymbol]
-> ReadPrec StooqSymbol
-> ReadPrec [StooqSymbol]
-> Read 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
(StooqSymbol -> StooqSymbol -> Bool)
-> (StooqSymbol -> StooqSymbol -> Bool) -> Eq StooqSymbol
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
Eq StooqSymbol
-> (StooqSymbol -> StooqSymbol -> Ordering)
-> (StooqSymbol -> StooqSymbol -> Bool)
-> (StooqSymbol -> StooqSymbol -> Bool)
-> (StooqSymbol -> StooqSymbol -> Bool)
-> (StooqSymbol -> StooqSymbol -> Bool)
-> (StooqSymbol -> StooqSymbol -> StooqSymbol)
-> (StooqSymbol -> StooqSymbol -> StooqSymbol)
-> Ord 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
$cp1Ord :: Eq StooqSymbol
Ord)

-- | A type representing market price data returned by Stooq.
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,
        StooqPrice -> Int
openint :: Int
    } deriving Int -> StooqPrice -> ShowS
[StooqPrice] -> ShowS
StooqPrice -> String
(Int -> StooqPrice -> ShowS)
-> (StooqPrice -> String)
-> ([StooqPrice] -> ShowS)
-> Show StooqPrice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StooqPrice] -> ShowS
$cshowList :: [StooqPrice] -> ShowS
show :: StooqPrice -> String
$cshow :: StooqPrice -> String
showsPrec :: Int -> StooqPrice -> ShowS
$cshowsPrec :: Int -> StooqPrice -> ShowS
Show

-- | Sends a request for the specified ticker and returns its latest price.
-- Returns "Nothing" if the response is invalid (this is most likely due to using a non-existent ticker).
fetchPrice :: StooqSymbol -> IO (Maybe [StooqPrice])
fetchPrice :: StooqSymbol -> IO (Maybe [StooqPrice])
fetchPrice StooqSymbol
ticker = do
    Response ByteString
r <- String -> IO (Response ByteString)
get (StooqSymbol -> String
queryUrl StooqSymbol
ticker)
    Maybe [StooqPrice] -> IO (Maybe [StooqPrice])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [StooqPrice] -> IO (Maybe [StooqPrice]))
-> Maybe [StooqPrice] -> IO (Maybe [StooqPrice])
forall a b. (a -> b) -> a -> b
$ (StooqResponse -> [StooqPrice])
-> Maybe StooqResponse -> Maybe [StooqPrice]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((StooqRow -> StooqPrice) -> [StooqRow] -> [StooqPrice]
forall a b. (a -> b) -> [a] -> [b]
map StooqRow -> StooqPrice
toApiType ([StooqRow] -> [StooqPrice])
-> (StooqResponse -> [StooqRow]) -> StooqResponse -> [StooqPrice]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StooqResponse -> [StooqRow]
Impl.symbols) (ByteString -> Maybe StooqResponse
Impl.parseResponse (Response ByteString
r Response ByteString
-> Getting ByteString (Response ByteString) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Response ByteString) ByteString
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
responseBody))

    where
        baseUrl :: String
        baseUrl :: String
baseUrl = String
"https://stooq.pl/q/l/?s="

        queryUrl :: StooqSymbol -> String
        queryUrl :: StooqSymbol -> String
queryUrl (StooqSymbol String
ticker) = String
baseUrl String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ticker String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"&e=json"

        toApiType :: Impl.StooqRow -> StooqPrice
        toApiType :: StooqRow -> StooqPrice
toApiType StooqRow
row = StooqPrice :: StooqSymbol
-> UTCTime
-> Double
-> Double
-> Double
-> Double
-> Int
-> Int
-> StooqPrice
StooqPrice {
            symbol :: StooqSymbol
symbol  = (String -> StooqSymbol
StooqSymbol (String -> StooqSymbol)
-> (StooqRow -> String) -> StooqRow -> StooqSymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> String) -> (StooqRow -> Text) -> StooqRow -> String
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 (LocalTime -> UTCTime) -> LocalTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Day -> TimeOfDay -> LocalTime
LocalTime ((Int -> Day
stooqIntToDay (Int -> Day) -> (StooqRow -> Int) -> StooqRow -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StooqRow -> Int
Impl.date) StooqRow
row) ((String -> TimeOfDay
stooqStringToTime (String -> TimeOfDay)
-> (StooqRow -> String) -> StooqRow -> TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> String) -> (StooqRow -> Text) -> StooqRow -> String
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,
            openint :: Int
openint = StooqRow -> Int
Impl.openint StooqRow
row
        }

        stooqIntToDay :: Int -> Day
        stooqIntToDay :: Int -> Day
stooqIntToDay Int
date = Integer -> Int -> Int -> Day
fromGregorian (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ (Int
date Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10000) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
10000) ((Int
date Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
100) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
100) (Int
date Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
100)

        stooqStringToTime :: String -> TimeOfDay
        stooqStringToTime :: String -> TimeOfDay
stooqStringToTime [Char
h1,Char
h2,Char
m1,Char
m2,Char
s1,Char
s2] = Int -> Int -> Pico -> TimeOfDay
TimeOfDay (String -> Int
forall a. Read a => String -> a
read [Char
h1,Char
h2]) (String -> Int
forall a. Read a => String -> a
read [Char
m1,Char
m2]) (String -> Pico
forall a. Read a => String -> a
read [Char
s1,Char
s2])
        stooqStringToTime String
x = String -> TimeOfDay
forall a. HasCallStack => String -> a
error (String -> TimeOfDay) -> String -> TimeOfDay
forall a b. (a -> b) -> a -> b
$ String
"Unexpected time format: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x

        stooqTimeZone :: TimeZone
        stooqTimeZone :: TimeZone
stooqTimeZone = Int -> TimeZone
hoursToTimeZone Int
1

-- | Sends a request for multiple tickers at once.
-- The function makes only a single HTTP call.
fetchPrices :: [StooqSymbol] -> IO (Maybe [StooqPrice])
fetchPrices :: [StooqSymbol] -> IO (Maybe [StooqPrice])
fetchPrices [StooqSymbol]
tickers = StooqSymbol -> IO (Maybe [StooqPrice])
fetchPrice ([StooqSymbol] -> StooqSymbol
concatTickers [StooqSymbol]
tickers)
    where
        concatTickers :: [StooqSymbol] -> StooqSymbol
        concatTickers :: [StooqSymbol] -> StooqSymbol
concatTickers = (StooqSymbol -> StooqSymbol -> StooqSymbol)
-> [StooqSymbol] -> StooqSymbol
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\(StooqSymbol String
t1) (StooqSymbol String
t2) -> String -> StooqSymbol
StooqSymbol (String
t1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t2))

-- | A shorthand around "fetchPrice" that allows to call the function using a plain String, without converting it to a `StooqSymbol` first.
fetch :: String -> IO (Maybe [StooqPrice])
fetch :: String -> IO (Maybe [StooqPrice])
fetch = StooqSymbol -> IO (Maybe [StooqPrice])
fetchPrice (StooqSymbol -> IO (Maybe [StooqPrice]))
-> (String -> StooqSymbol) -> String -> IO (Maybe [StooqPrice])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StooqSymbol
StooqSymbol