{-|
Module      : SimFin.Types.Prices
Description : Type to represent a combination of SimFin prices and ratios.
Copyright   : (c) Owen Shepherd, 2022
License     : MIT
Maintainer  : owen@owen.cafe
-}

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}

module SimFin.Types.PricesAndRatios
  ( PricesAndRatiosRow(..)
  , PricesAndRatiosKeyed(..)
  ) where

import Data.Aeson

import SimFin.Types.Prices
import SimFin.Types.Ratios
import SimFin.Internal

-- | Represents a company's prices and ratios.

data PricesAndRatiosRow a
  = PricesAndRatiosRow
  { PricesAndRatiosRow a -> PricesRow a
prices :: PricesRow a
  , PricesAndRatiosRow a -> RatiosRow a
ratios :: RatiosRow a
  } deriving (a -> PricesAndRatiosRow b -> PricesAndRatiosRow a
(a -> b) -> PricesAndRatiosRow a -> PricesAndRatiosRow b
(forall a b.
 (a -> b) -> PricesAndRatiosRow a -> PricesAndRatiosRow b)
-> (forall a b. a -> PricesAndRatiosRow b -> PricesAndRatiosRow a)
-> Functor PricesAndRatiosRow
forall a b. a -> PricesAndRatiosRow b -> PricesAndRatiosRow a
forall a b.
(a -> b) -> PricesAndRatiosRow a -> PricesAndRatiosRow b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PricesAndRatiosRow b -> PricesAndRatiosRow a
$c<$ :: forall a b. a -> PricesAndRatiosRow b -> PricesAndRatiosRow a
fmap :: (a -> b) -> PricesAndRatiosRow a -> PricesAndRatiosRow b
$cfmap :: forall a b.
(a -> b) -> PricesAndRatiosRow a -> PricesAndRatiosRow b
Functor, Int -> PricesAndRatiosRow a -> ShowS
[PricesAndRatiosRow a] -> ShowS
PricesAndRatiosRow a -> String
(Int -> PricesAndRatiosRow a -> ShowS)
-> (PricesAndRatiosRow a -> String)
-> ([PricesAndRatiosRow a] -> ShowS)
-> Show (PricesAndRatiosRow a)
forall a. Show a => Int -> PricesAndRatiosRow a -> ShowS
forall a. Show a => [PricesAndRatiosRow a] -> ShowS
forall a. Show a => PricesAndRatiosRow a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PricesAndRatiosRow a] -> ShowS
$cshowList :: forall a. Show a => [PricesAndRatiosRow a] -> ShowS
show :: PricesAndRatiosRow a -> String
$cshow :: forall a. Show a => PricesAndRatiosRow a -> String
showsPrec :: Int -> PricesAndRatiosRow a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PricesAndRatiosRow a -> ShowS
Show)

instance (Read a, RealFrac a) => FromJSON (PricesAndRatiosRow a) where
  parseJSON :: Value -> Parser (PricesAndRatiosRow a)
parseJSON Value
v = PricesRow a -> RatiosRow a -> PricesAndRatiosRow a
forall a. PricesRow a -> RatiosRow a -> PricesAndRatiosRow a
PricesAndRatiosRow
    (PricesRow a -> RatiosRow a -> PricesAndRatiosRow a)
-> Parser (PricesRow a)
-> Parser (RatiosRow a -> PricesAndRatiosRow a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (PricesRow a)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Parser (RatiosRow a -> PricesAndRatiosRow a)
-> Parser (RatiosRow a) -> Parser (PricesAndRatiosRow a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser (RatiosRow a)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

-- | Wrapper to parse a PricesAndRatiosRow record from SimFin's JSON format.
-- You probably don't want to use this.

newtype PricesAndRatiosKeyed a = PricesAndRatiosKeyed { PricesAndRatiosKeyed a -> [PricesAndRatiosRow a]
unKeyPricesAndRatios :: [PricesAndRatiosRow a] }

instance (Read a, RealFrac a) => FromJSON (PricesAndRatiosKeyed a) where
  parseJSON :: Value -> Parser (PricesAndRatiosKeyed a)
parseJSON Value
o = [PricesAndRatiosRow a] -> PricesAndRatiosKeyed a
forall a. [PricesAndRatiosRow a] -> PricesAndRatiosKeyed a
PricesAndRatiosKeyed ([PricesAndRatiosRow a] -> PricesAndRatiosKeyed a)
-> Parser [PricesAndRatiosRow a] -> Parser (PricesAndRatiosKeyed a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Value -> Parser (PricesAndRatiosRow a))
-> [Value] -> Parser [PricesAndRatiosRow a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser (PricesAndRatiosRow a)
forall a. FromJSON a => Value -> Parser a
parseJSON ([Value] -> Parser [PricesAndRatiosRow a])
-> Parser [Value] -> Parser [PricesAndRatiosRow a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser [Value]
createKeyedRows Value
o)