{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module SimFin.Free
( SimFinContext(..)
, Industry(..)
, CompanyListingRow(..)
, CompanyInfoRow(..)
, GeneralBalanceSheetRow(..)
, BankBalanceSheetRow(..)
, InsuranceBalanceSheetRow(..)
, GeneralProfitAndLossRow(..)
, BankProfitAndLossRow(..)
, InsuranceProfitAndLossRow(..)
, GeneralCashFlowRow(..)
, BankCashFlowRow(..)
, InsuranceCashFlowRow(..)
, DerivedRow(..)
, PricesRow(..)
, PricesQueryFree
, StatementQueryFree(..)
, StockRef(..)
, FiscalPeriod(..)
, ApiError(..)
, ApiResult
, createDefaultContext
, fetchCompanyList
, fetchCompanyInfo
, fetchBalanceSheet
, fetchProfitAndLoss
, fetchCashFlow
, fetchDerived
, fetchPrices
) where
import Control.Monad.Catch
import Control.Monad.IO.Class
import Data.Functor.Syntax
import Data.Maybe (listToMaybe)
import SimFin.Common
import SimFin.Internal
import SimFin.Types.BalanceSheet
import SimFin.Types.CompanyInfo
import SimFin.Types.CompanyListing
import SimFin.Types.CashFlow
import SimFin.Types.Derived
import SimFin.Types.FiscalPeriod
import SimFin.Types.Industry
import SimFin.Types.Prices
import SimFin.Types.PricesQuery
import SimFin.Types.ProfitAndLoss
import SimFin.Types.StatementQuery
import SimFin.Types.StockRef
import SimFin.Util
fetchCompanyInfo
:: (MonadThrow m, MonadIO m)
=> SimFinContext
-> StockRef
-> m (ApiResult (Maybe CompanyInfoRow))
fetchCompanyInfo :: SimFinContext -> StockRef -> m (ApiResult (Maybe CompanyInfoRow))
fetchCompanyInfo SimFinContext
ctx StockRef
refs = do
ApiResult [CompanyInfoRow]
rows :: ApiResult [CompanyInfoRow] <- SimFinContext
-> ByteString -> [QueryParam] -> m (ApiResult [CompanyInfoRow])
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
SimFinContext -> ByteString -> [QueryParam] -> m (ApiResult a)
performRequest SimFinContext
ctx ByteString
"companies/general"
([QueryParam] -> m (ApiResult [CompanyInfoRow]))
-> [QueryParam] -> m (ApiResult [CompanyInfoRow])
forall a b. (a -> b) -> a -> b
$ NonEmpty StockRef -> [QueryParam]
stockRefsToQueryParams (NonEmpty StockRef -> [QueryParam])
-> NonEmpty StockRef -> [QueryParam]
forall a b. (a -> b) -> a -> b
$ StockRef -> NonEmpty StockRef
forall (f :: * -> *) a. Applicative f => a -> f a
pure StockRef
refs
ApiResult (Maybe CompanyInfoRow)
-> m (ApiResult (Maybe CompanyInfoRow))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiResult (Maybe CompanyInfoRow)
-> m (ApiResult (Maybe CompanyInfoRow)))
-> ApiResult (Maybe CompanyInfoRow)
-> m (ApiResult (Maybe CompanyInfoRow))
forall a b. (a -> b) -> a -> b
$ [CompanyInfoRow] -> Maybe CompanyInfoRow
forall a. [a] -> Maybe a
listToMaybe ([CompanyInfoRow] -> Maybe CompanyInfoRow)
-> ApiResult [CompanyInfoRow] -> ApiResult (Maybe CompanyInfoRow)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiResult [CompanyInfoRow]
rows
fetchBalanceSheet
:: (MonadThrow m, MonadIO m)
=> SimFinContext
-> StatementQueryFree
-> m (ApiResult (Maybe IndustryBalanceSheet))
fetchBalanceSheet :: SimFinContext
-> StatementQueryFree -> m (ApiResult (Maybe IndustryBalanceSheet))
fetchBalanceSheet SimFinContext
ctx StatementQueryFree
query = do
ApiResult [IndustryBalanceSheets]
nested :: ApiResult [IndustryBalanceSheets] <- SimFinContext
-> ByteString
-> [QueryParam]
-> m (ApiResult [IndustryBalanceSheets])
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
SimFinContext -> ByteString -> [QueryParam] -> m (ApiResult a)
performRequest SimFinContext
ctx ByteString
"companies/statements"
([QueryParam] -> m (ApiResult [IndustryBalanceSheets]))
-> [QueryParam] -> m (ApiResult [IndustryBalanceSheets])
forall a b. (a -> b) -> a -> b
$ (ByteString
"statement", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"bs") QueryParam -> [QueryParam] -> [QueryParam]
forall a. a -> [a] -> [a]
: StatementQueryFree -> [QueryParam]
statementQueryFreeToQueryParams StatementQueryFree
query
ApiResult (Maybe IndustryBalanceSheet)
-> m (ApiResult (Maybe IndustryBalanceSheet))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiResult (Maybe IndustryBalanceSheet)
-> m (ApiResult (Maybe IndustryBalanceSheet)))
-> ApiResult (Maybe IndustryBalanceSheet)
-> m (ApiResult (Maybe IndustryBalanceSheet))
forall a b. (a -> b) -> a -> b
$ [IndustryBalanceSheet] -> Maybe IndustryBalanceSheet
forall a. [a] -> Maybe a
listToMaybe ([IndustryBalanceSheet] -> Maybe IndustryBalanceSheet)
-> ([IndustryBalanceSheets] -> [IndustryBalanceSheet])
-> [IndustryBalanceSheets]
-> Maybe IndustryBalanceSheet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IndustryBalanceSheets] -> [IndustryBalanceSheet]
forall a b c. [Industry [a] [b] [c]] -> [Industry a b c]
invertIndustries ([IndustryBalanceSheets] -> Maybe IndustryBalanceSheet)
-> ApiResult [IndustryBalanceSheets]
-> ApiResult (Maybe IndustryBalanceSheet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiResult [IndustryBalanceSheets]
nested
fetchProfitAndLoss
:: (MonadThrow m, MonadIO m)
=> SimFinContext
-> StatementQueryFree
-> m (ApiResult (Maybe IndustryProfitAndLoss))
fetchProfitAndLoss :: SimFinContext
-> StatementQueryFree
-> m (ApiResult (Maybe IndustryProfitAndLoss))
fetchProfitAndLoss SimFinContext
ctx StatementQueryFree
query = do
ApiResult [IndustryProfitsAndLosses]
nested :: ApiResult [IndustryProfitsAndLosses] <- SimFinContext
-> ByteString
-> [QueryParam]
-> m (ApiResult [IndustryProfitsAndLosses])
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
SimFinContext -> ByteString -> [QueryParam] -> m (ApiResult a)
performRequest SimFinContext
ctx ByteString
"companies/statements"
([QueryParam] -> m (ApiResult [IndustryProfitsAndLosses]))
-> [QueryParam] -> m (ApiResult [IndustryProfitsAndLosses])
forall a b. (a -> b) -> a -> b
$ (ByteString
"statement", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"pl") QueryParam -> [QueryParam] -> [QueryParam]
forall a. a -> [a] -> [a]
: StatementQueryFree -> [QueryParam]
statementQueryFreeToQueryParams StatementQueryFree
query
ApiResult (Maybe IndustryProfitAndLoss)
-> m (ApiResult (Maybe IndustryProfitAndLoss))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiResult (Maybe IndustryProfitAndLoss)
-> m (ApiResult (Maybe IndustryProfitAndLoss)))
-> ApiResult (Maybe IndustryProfitAndLoss)
-> m (ApiResult (Maybe IndustryProfitAndLoss))
forall a b. (a -> b) -> a -> b
$ [IndustryProfitAndLoss] -> Maybe IndustryProfitAndLoss
forall a. [a] -> Maybe a
listToMaybe ([IndustryProfitAndLoss] -> Maybe IndustryProfitAndLoss)
-> ([IndustryProfitsAndLosses] -> [IndustryProfitAndLoss])
-> [IndustryProfitsAndLosses]
-> Maybe IndustryProfitAndLoss
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IndustryProfitsAndLosses] -> [IndustryProfitAndLoss]
forall a b c. [Industry [a] [b] [c]] -> [Industry a b c]
invertIndustries ([IndustryProfitsAndLosses] -> Maybe IndustryProfitAndLoss)
-> ApiResult [IndustryProfitsAndLosses]
-> ApiResult (Maybe IndustryProfitAndLoss)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiResult [IndustryProfitsAndLosses]
nested
fetchCashFlow
:: (MonadThrow m, MonadIO m)
=> SimFinContext
-> StatementQueryFree
-> m (ApiResult (Maybe IndustryCashFlow))
fetchCashFlow :: SimFinContext
-> StatementQueryFree -> m (ApiResult (Maybe IndustryCashFlow))
fetchCashFlow SimFinContext
ctx StatementQueryFree
query = do
ApiResult [IndustryCashFlows]
nested :: ApiResult [IndustryCashFlows] <- SimFinContext
-> ByteString -> [QueryParam] -> m (ApiResult [IndustryCashFlows])
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
SimFinContext -> ByteString -> [QueryParam] -> m (ApiResult a)
performRequest SimFinContext
ctx ByteString
"companies/statements"
([QueryParam] -> m (ApiResult [IndustryCashFlows]))
-> [QueryParam] -> m (ApiResult [IndustryCashFlows])
forall a b. (a -> b) -> a -> b
$ (ByteString
"statement", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"cf") QueryParam -> [QueryParam] -> [QueryParam]
forall a. a -> [a] -> [a]
: StatementQueryFree -> [QueryParam]
statementQueryFreeToQueryParams StatementQueryFree
query
ApiResult (Maybe IndustryCashFlow)
-> m (ApiResult (Maybe IndustryCashFlow))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiResult (Maybe IndustryCashFlow)
-> m (ApiResult (Maybe IndustryCashFlow)))
-> ApiResult (Maybe IndustryCashFlow)
-> m (ApiResult (Maybe IndustryCashFlow))
forall a b. (a -> b) -> a -> b
$ [IndustryCashFlow] -> Maybe IndustryCashFlow
forall a. [a] -> Maybe a
listToMaybe ([IndustryCashFlow] -> Maybe IndustryCashFlow)
-> ([IndustryCashFlows] -> [IndustryCashFlow])
-> [IndustryCashFlows]
-> Maybe IndustryCashFlow
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IndustryCashFlows] -> [IndustryCashFlow]
forall a b c. [Industry [a] [b] [c]] -> [Industry a b c]
invertIndustries ([IndustryCashFlows] -> Maybe IndustryCashFlow)
-> ApiResult [IndustryCashFlows]
-> ApiResult (Maybe IndustryCashFlow)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiResult [IndustryCashFlows]
nested
fetchDerived
:: forall m a. (Read a, RealFrac a, MonadThrow m, MonadIO m)
=> SimFinContext
-> StatementQueryFree
-> m (ApiResult (Maybe (DerivedRow a)))
fetchDerived :: SimFinContext
-> StatementQueryFree -> m (ApiResult (Maybe (DerivedRow a)))
fetchDerived SimFinContext
ctx StatementQueryFree
query = do
ApiResult [DerivedRowsKeyed a]
nested :: ApiResult [DerivedRowsKeyed a] <- SimFinContext
-> ByteString -> [QueryParam] -> m (ApiResult [DerivedRowsKeyed a])
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
SimFinContext -> ByteString -> [QueryParam] -> m (ApiResult a)
performRequest SimFinContext
ctx ByteString
"companies/statements"
((ByteString
"statement", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"derived") QueryParam -> [QueryParam] -> [QueryParam]
forall a. a -> [a] -> [a]
: StatementQueryFree -> [QueryParam]
statementQueryFreeToQueryParams StatementQueryFree
query)
ApiResult (Maybe (DerivedRow a))
-> m (ApiResult (Maybe (DerivedRow a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiResult (Maybe (DerivedRow a))
-> m (ApiResult (Maybe (DerivedRow a))))
-> ApiResult (Maybe (DerivedRow a))
-> m (ApiResult (Maybe (DerivedRow a)))
forall a b. (a -> b) -> a -> b
$ [DerivedRow a] -> Maybe (DerivedRow a)
forall a. [a] -> Maybe a
listToMaybe ([DerivedRow a] -> Maybe (DerivedRow a))
-> ([DerivedRowsKeyed a] -> [DerivedRow a])
-> [DerivedRowsKeyed a]
-> Maybe (DerivedRow a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[DerivedRow a]] -> [DerivedRow a]
forall a. Monoid a => [a] -> a
mconcat ([[DerivedRow a]] -> [DerivedRow a])
-> ([DerivedRowsKeyed a] -> [[DerivedRow a]])
-> [DerivedRowsKeyed a]
-> [DerivedRow a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DerivedRowsKeyed a -> [DerivedRow a])
-> [DerivedRowsKeyed a] -> [[DerivedRow a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DerivedRowsKeyed a -> [DerivedRow a]
forall a. DerivedRowsKeyed a -> [DerivedRow a]
unDerivedRows ([DerivedRowsKeyed a] -> Maybe (DerivedRow a))
-> ApiResult [DerivedRowsKeyed a]
-> ApiResult (Maybe (DerivedRow a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiResult [DerivedRowsKeyed a]
nested
fetchPrices
:: (Read a, RealFrac a, MonadThrow m, MonadIO m)
=> SimFinContext
-> PricesQueryFree
-> m (ApiResult [PricesRow a])
fetchPrices :: SimFinContext -> StockRef -> m (ApiResult [PricesRow a])
fetchPrices SimFinContext
ctx StockRef
query =
[[PricesRow a]] -> [PricesRow a]
forall a. Monoid a => [a] -> a
mconcat ([[PricesRow a]] -> [PricesRow a])
-> ([PricesKeyed a] -> [[PricesRow a]])
-> [PricesKeyed a]
-> [PricesRow a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PricesKeyed a -> [PricesRow a])
-> [PricesKeyed a] -> [[PricesRow a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PricesKeyed a -> [PricesRow a]
forall a. PricesKeyed a -> [PricesRow a]
unKeyPrices ([PricesKeyed a] -> [PricesRow a])
-> m (Either ApiError [PricesKeyed a])
-> m (ApiResult [PricesRow a])
forall (f0 :: * -> *) (f1 :: * -> *) a b.
(Functor f0, Functor f1) =>
(a -> b) -> f1 (f0 a) -> f1 (f0 b)
<$$> SimFinContext
-> ByteString
-> [QueryParam]
-> m (Either ApiError [PricesKeyed a])
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
SimFinContext -> ByteString -> [QueryParam] -> m (ApiResult a)
performRequest SimFinContext
ctx ByteString
"companies/prices"
(StockRef -> [QueryParam]
pricesQueryFreeToQueryParams StockRef
query)