{-|
Module      : SimFin.Types.CompanyListing
Description : Item of a list of company tickers and their SimFin IDs.
Copyright   : (c) Owen Shepherd, 2022
License     : MIT
Maintainer  : owen@owen.cafe
-}

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

module SimFin.Types.CompanyListing
  ( CompanyListingRow(..)
  , CompanyListingKeyed(..)
  ) where

import Data.Aeson
import Data.Text (Text)

import SimFin.Internal

-- | SimFin ID and company ticker. See the [SimFin docs](https://simfin.com/api/v2/documentation/#tag/Company/paths/~1companies~1list/get).

data CompanyListingRow
  = CompanyListingRow
  { CompanyListingRow -> Int
simFinId :: Int
  , CompanyListingRow -> Text
ticker :: Text
  } deriving Int -> CompanyListingRow -> ShowS
[CompanyListingRow] -> ShowS
CompanyListingRow -> String
(Int -> CompanyListingRow -> ShowS)
-> (CompanyListingRow -> String)
-> ([CompanyListingRow] -> ShowS)
-> Show CompanyListingRow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompanyListingRow] -> ShowS
$cshowList :: [CompanyListingRow] -> ShowS
show :: CompanyListingRow -> String
$cshow :: CompanyListingRow -> String
showsPrec :: Int -> CompanyListingRow -> ShowS
$cshowsPrec :: Int -> CompanyListingRow -> ShowS
Show

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

newtype CompanyListingKeyed = CompanyListingKeyed { CompanyListingKeyed -> [CompanyListingRow]
unKeyCompanyListing :: [CompanyListingRow] }

instance FromJSON CompanyListingRow where
  parseJSON :: Value -> Parser CompanyListingRow
parseJSON = String
-> (Object -> Parser CompanyListingRow)
-> Value
-> Parser CompanyListingRow
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CompanyListing" ((Object -> Parser CompanyListingRow)
 -> Value -> Parser CompanyListingRow)
-> (Object -> Parser CompanyListingRow)
-> Value
-> Parser CompanyListingRow
forall a b. (a -> b) -> a -> b
$ \Object
v -> Int -> Text -> CompanyListingRow
CompanyListingRow
    (Int -> Text -> CompanyListingRow)
-> Parser Int -> Parser (Text -> CompanyListingRow)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"SimFinId"
    Parser (Text -> CompanyListingRow)
-> Parser Text -> Parser CompanyListingRow
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"Ticker"

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