{-|
Module      : SimFin.Types.CompanyInfo
Description : General information about a company.
Copyright   : (c) Owen Shepherd, 2022
License     : MIT
Maintainer  : owen@owen.cafe
-}

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

module SimFin.Types.CompanyInfo
  ( CompanyInfoRow(..)
  ) where

import Control.Monad ((>=>))
import Data.Aeson
import Data.Aeson.Types (Parser)
import Data.Text (Text)

import SimFin.Internal

-- | Genreal information about a company.
-- See the [SimFin docs](https://simfin.com/api/v2/documentation/#tag/Company/paths/~1companies~1general/get).

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

instance FromJSON CompanyInfoRow where
  parseJSON :: Value -> Parser CompanyInfoRow
parseJSON = Value -> Parser Value
createKeyedRow (Value -> Parser Value)
-> (Value -> Parser CompanyInfoRow)
-> Value
-> Parser CompanyInfoRow
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String
-> (Object -> Parser CompanyInfoRow)
-> Value
-> Parser CompanyInfoRow
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CompanyInfoRow" Object -> Parser CompanyInfoRow
f
    where
      f :: Object -> Parser CompanyInfoRow
      f :: Object -> Parser CompanyInfoRow
f = \Object
v -> Int -> Text -> Text -> Int -> Int -> Int -> Text -> CompanyInfoRow
CompanyInfoRow
        (Int
 -> Text -> Text -> Int -> Int -> Int -> Text -> CompanyInfoRow)
-> Parser Int
-> Parser
     (Text -> Text -> Int -> Int -> Int -> Text -> CompanyInfoRow)
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 -> Text -> Int -> Int -> Int -> Text -> CompanyInfoRow)
-> Parser Text
-> Parser (Text -> Int -> Int -> Int -> Text -> CompanyInfoRow)
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"
        Parser (Text -> Int -> Int -> Int -> Text -> CompanyInfoRow)
-> Parser Text
-> Parser (Int -> Int -> Int -> Text -> CompanyInfoRow)
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
"Company Name"
        Parser (Int -> Int -> Int -> Text -> CompanyInfoRow)
-> Parser Int -> Parser (Int -> Int -> Text -> CompanyInfoRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"IndustryId"
        Parser (Int -> Int -> Text -> CompanyInfoRow)
-> Parser Int -> Parser (Int -> Text -> CompanyInfoRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"Month FY End"
        Parser (Int -> Text -> CompanyInfoRow)
-> Parser Int -> Parser (Text -> CompanyInfoRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"Number Employees"
        Parser (Text -> CompanyInfoRow)
-> Parser Text -> Parser CompanyInfoRow
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
"Business Summary"