{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}

module Web.Data.Stooq.Internals where

import Data.ByteString.Lazy (ByteString)
import Data.Maybe (fromMaybe, catMaybes)
import Data.Text (Text)
import GHC.Generics (Generic)

import Data.Csv (decode, HasHeader(NoHeader), FromField, parseField, runParser)
import qualified Data.Vector as V

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
    } deriving (Int -> StooqRow -> ShowS
[StooqRow] -> ShowS
StooqRow -> String
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. 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)

newtype StooqResponse =
    StooqResponse {
        StooqResponse -> [StooqRow]
symbols :: [StooqRow]
    } deriving (Int -> StooqResponse -> ShowS
[StooqResponse] -> ShowS
StooqResponse -> String
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. 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)

data TryField a = FieldValue a | NoValue

instance FromField (TryField Text) where
    parseField :: Field -> Parser (TryField Text)
parseField Field
s = case forall a. Parser a -> Either String a
runParser (forall a. FromField a => Field -> Parser a
parseField Field
s) of
        Left String
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. TryField a
NoValue
        Right Text
v  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> TryField a
FieldValue Text
v

instance FromField (TryField Double) where
    parseField :: Field -> Parser (TryField Double)
parseField Field
s = case forall a. Parser a -> Either String a
runParser (forall a. FromField a => Field -> Parser a
parseField Field
s) of
        Left String
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. TryField a
NoValue
        Right Double
v  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> TryField a
FieldValue Double
v

instance FromField (TryField Int) where
    parseField :: Field -> Parser (TryField Int)
parseField Field
s = case forall a. Parser a -> Either String a
runParser (forall a. FromField a => Field -> Parser a
parseField Field
s) of
        Left String
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. TryField a
NoValue
        Right Int
v  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> TryField a
FieldValue Int
v

parseResponse :: ByteString -> Either String StooqResponse
parseResponse :: ByteString -> Either String StooqResponse
parseResponse ByteString
input =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([StooqRow] -> StooqResponse
StooqResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [a]
V.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> Vector a -> Vector b
V.map (Text, TryField Int, TryField Text, TryField Double,
 TryField Double, TryField Double, TryField Double, TryField Int,
 Text)
-> Maybe StooqRow
tupleToStooqRow) (forall a.
FromRecord a =>
HasHeader -> ByteString -> Either String (Vector a)
decode HasHeader
NoHeader ByteString
input)

    where
        tupleToStooqRow :: (Text, TryField Int, TryField Text, TryField Double, TryField Double, TryField Double, TryField Double, TryField Int, Text) -> Maybe StooqRow
        tupleToStooqRow :: (Text, TryField Int, TryField Text, TryField Double,
 TryField Double, TryField Double, TryField Double, TryField Int,
 Text)
-> Maybe StooqRow
tupleToStooqRow (Text
name, FieldValue Int
date, FieldValue Text
time, FieldValue Double
open, FieldValue Double
high, FieldValue Double
low, FieldValue Double
close, TryField Int
volume, Text
_) =
            forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text
-> Int
-> Text
-> Double
-> Double
-> Double
-> Double
-> Int
-> StooqRow
StooqRow Text
name Int
date Text
time Double
open Double
high Double
low Double
close (TryField Int -> Int
defaultToZero TryField Int
volume)
        tupleToStooqRow (Text
name, TryField Int
_, TryField Text
_, TryField Double
_, TryField Double
_, TryField Double
_, TryField Double
_, TryField Int
_, Text
_) = forall a. Maybe a
Nothing

        defaultToZero :: TryField Int -> Int
        defaultToZero :: TryField Int -> Int
defaultToZero (FieldValue Int
x) = Int
x
        defaultToZero TryField Int
NoValue = Int
0