{-# 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 -> [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)

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

-- | 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 (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

-- | Sends a request for multiple tickers at once.
-- The function makes only a single HTTP call.
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))

-- | A shorthand around "fetchPrice" that allows to call the function using a plain String, without converting it to a `StooqSymbol` first.
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