{-# LANGUAGE DeriveGeneric #-}

module Web.Data.Stooq.Internals where

import Data.Aeson (FromJSON, decode)
import Data.ByteString.Lazy.Internal (ByteString)
import Data.Text (Text)
import GHC.Generics (Generic)

data StooqRow =
    StooqRow {
        StooqRow -> Text
symbol  :: !Text,
        StooqRow -> Int
date    :: Int,
        StooqRow -> Text
time    :: !Text,
        StooqRow -> Double
open    :: Double,
        StooqRow -> Double
high    :: Double,
        StooqRow -> Double
low     :: Double,
        StooqRow -> Double
close   :: Double,
        StooqRow -> Int
volume  :: Int,
        StooqRow -> Int
openint :: Int
    } deriving (Int -> StooqRow -> ShowS
[StooqRow] -> ShowS
StooqRow -> String
(Int -> StooqRow -> ShowS)
-> (StooqRow -> String) -> ([StooqRow] -> ShowS) -> Show StooqRow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StooqRow] -> ShowS
$cshowList :: [StooqRow] -> ShowS
show :: StooqRow -> String
$cshow :: StooqRow -> String
showsPrec :: Int -> StooqRow -> ShowS
$cshowsPrec :: Int -> StooqRow -> ShowS
Show, (forall x. StooqRow -> Rep StooqRow x)
-> (forall x. Rep StooqRow x -> StooqRow) -> Generic StooqRow
forall x. Rep StooqRow x -> StooqRow
forall x. StooqRow -> Rep StooqRow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StooqRow x -> StooqRow
$cfrom :: forall x. StooqRow -> Rep StooqRow x
Generic)

data StooqResponse =
    StooqResponse {
        StooqResponse -> [StooqRow]
symbols :: [StooqRow]
    } deriving (Int -> StooqResponse -> ShowS
[StooqResponse] -> ShowS
StooqResponse -> String
(Int -> StooqResponse -> ShowS)
-> (StooqResponse -> String)
-> ([StooqResponse] -> ShowS)
-> Show StooqResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StooqResponse] -> ShowS
$cshowList :: [StooqResponse] -> ShowS
show :: StooqResponse -> String
$cshow :: StooqResponse -> String
showsPrec :: Int -> StooqResponse -> ShowS
$cshowsPrec :: Int -> StooqResponse -> ShowS
Show, (forall x. StooqResponse -> Rep StooqResponse x)
-> (forall x. Rep StooqResponse x -> StooqResponse)
-> Generic StooqResponse
forall x. Rep StooqResponse x -> StooqResponse
forall x. StooqResponse -> Rep StooqResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StooqResponse x -> StooqResponse
$cfrom :: forall x. StooqResponse -> Rep StooqResponse x
Generic)

instance FromJSON StooqRow
instance FromJSON StooqResponse

parseResponse :: ByteString -> Maybe StooqResponse
parseResponse :: ByteString -> Maybe StooqResponse
parseResponse = ByteString -> Maybe StooqResponse
forall a. FromJSON a => ByteString -> Maybe a
decode