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