{-# LANGUAGE OverloadedStrings #-}

-- | A set of data types corresponding to records returned from Yahoo API.
-- Note that this is a subject to modifications whenever the remote API changes on Yahoo side.
module Web.Data.Yahoo.Response (PriceResponse(..), tryParse, tryParseAsPrice) where

import Data.ByteString.Char8 (unpack)
import Data.ByteString.Lazy (ByteString)
import Data.Csv (FromField(..), FromNamedRecord(..), (.:), decodeByName)
import Data.Time (defaultTimeLocale)
import Data.Time.Calendar (Day)
import Data.Time.Format (parseTimeM)
import Data.Vector (toList)

import Web.Data.Yahoo.Utils (right)

instance FromField Day where
    parseField :: Field -> Parser Day
parseField = forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%Y-%m-%d" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> String
unpack

-- | A type representing market price data returned by Yahoo.
data PriceResponse = PriceResponse {
    PriceResponse -> Day
date     :: Day,
    PriceResponse -> Double
open     :: Double,
    PriceResponse -> Double
high     :: Double,
    PriceResponse -> Double
low      :: Double,
    PriceResponse -> Double
close    :: Double,
    PriceResponse -> Double
adjClose :: Double,
    PriceResponse -> Double
volume   :: Double
} deriving (Int -> PriceResponse -> ShowS
[PriceResponse] -> ShowS
PriceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PriceResponse] -> ShowS
$cshowList :: [PriceResponse] -> ShowS
show :: PriceResponse -> String
$cshow :: PriceResponse -> String
showsPrec :: Int -> PriceResponse -> ShowS
$cshowsPrec :: Int -> PriceResponse -> ShowS
Show, PriceResponse -> PriceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PriceResponse -> PriceResponse -> Bool
$c/= :: PriceResponse -> PriceResponse -> Bool
== :: PriceResponse -> PriceResponse -> Bool
$c== :: PriceResponse -> PriceResponse -> Bool
Eq)

instance FromNamedRecord PriceResponse where
    parseNamedRecord :: NamedRecord -> Parser PriceResponse
parseNamedRecord NamedRecord
r = 
        Day
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> PriceResponse
PriceResponse 
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamedRecord
r forall a. FromField a => NamedRecord -> Field -> Parser a
.: Field
"Date" 
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamedRecord
r forall a. FromField a => NamedRecord -> Field -> Parser a
.: Field
"Open"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamedRecord
r forall a. FromField a => NamedRecord -> Field -> Parser a
.: Field
"High"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamedRecord
r forall a. FromField a => NamedRecord -> Field -> Parser a
.: Field
"Low"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamedRecord
r forall a. FromField a => NamedRecord -> Field -> Parser a
.: Field
"Close"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamedRecord
r forall a. FromField a => NamedRecord -> Field -> Parser a
.: Field
"Adj Close"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamedRecord
r forall a. FromField a => NamedRecord -> Field -> Parser a
.: Field
"Volume"

-- | An auxiliary function that attempts to parse a string provided and interpret it as a CSV set of values of type a.
tryParse :: FromNamedRecord a => ByteString -> Either String [a]
tryParse :: forall a. FromNamedRecord a => ByteString -> Either String [a]
tryParse = forall t b a. (t -> b) -> Either a t -> Either a b
right (forall a. Vector a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
FromNamedRecord a =>
ByteString -> Either String (Header, Vector a)
decodeByName

-- | A specialized version of tryParse dedicated to parsing PriceResponse records
tryParseAsPrice :: ByteString -> Either String [PriceResponse]
tryParseAsPrice :: ByteString -> Either String [PriceResponse]
tryParseAsPrice = forall a. FromNamedRecord a => ByteString -> Either String [a]
tryParse