{-|
Module      : SimFin.Types.StatementQuery
Description : Types to represent SimFin statement queries.
Copyright   : (c) Owen Shepherd, 2022
License     : MIT
Maintainer  : owen@owen.cafe
-}

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

module SimFin.Types.StatementQuery
  ( StatementQuery(..)
  , StatementQueryFree(..)
  , statementQueryToQueryParams
  , statementQueryFreeToQueryParams
  ) where

import Data.List.NonEmpty (NonEmpty)
import Data.Maybe (maybeToList)
import Data.Time.Calendar (Day)

import SimFin.Types.FiscalPeriod
import SimFin.Types.StockRef
import SimFin.Internal

-- | This represents all options the statement endpoint supports, minus the "statement"
-- parameter itself, which is set by simply calling the right function.
-- Some of these parameters are only available to SimFin+ users.
-- For free users, please use 'StatementQueryFree'.
-- If you provide a zero-length list for any field, the query parameter will be omitted,
-- and the API will try to return all relevant available statements.

data StatementQuery
  = StatementQuery
  { StatementQuery -> NonEmpty StockRef
stockRefs :: NonEmpty StockRef
  , StatementQuery -> [FiscalPeriod]
periods :: [FiscalPeriod]
  , StatementQuery -> [Int]
years :: [Int]
  , StatementQuery -> Maybe Day
start :: Maybe Day
  , StatementQuery -> Maybe Day
end :: Maybe Day
  , StatementQuery -> Bool
ttm :: Bool
  , StatementQuery -> Bool
asReported :: Bool
  -- TODO we don't model the result of this yet
  , StatementQuery -> Bool
shares :: Bool
  } deriving Int -> StatementQuery -> ShowS
[StatementQuery] -> ShowS
StatementQuery -> String
(Int -> StatementQuery -> ShowS)
-> (StatementQuery -> String)
-> ([StatementQuery] -> ShowS)
-> Show StatementQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StatementQuery] -> ShowS
$cshowList :: [StatementQuery] -> ShowS
show :: StatementQuery -> String
$cshow :: StatementQuery -> String
showsPrec :: Int -> StatementQuery -> ShowS
$cshowsPrec :: Int -> StatementQuery -> ShowS
Show

-- | Turn a 'StatementQuery' into query parameters for the SimFin "statements" endpoint.

statementQueryToQueryParams :: StatementQuery -> [QueryParam]
statementQueryToQueryParams :: StatementQuery -> [QueryParam]
statementQueryToQueryParams StatementQuery{Bool
[Int]
[FiscalPeriod]
Maybe Day
NonEmpty StockRef
shares :: Bool
asReported :: Bool
ttm :: Bool
end :: Maybe Day
start :: Maybe Day
years :: [Int]
periods :: [FiscalPeriod]
stockRefs :: NonEmpty StockRef
$sel:shares:StatementQuery :: StatementQuery -> Bool
$sel:asReported:StatementQuery :: StatementQuery -> Bool
$sel:ttm:StatementQuery :: StatementQuery -> Bool
$sel:end:StatementQuery :: StatementQuery -> Maybe Day
$sel:start:StatementQuery :: StatementQuery -> Maybe Day
$sel:years:StatementQuery :: StatementQuery -> [Int]
$sel:periods:StatementQuery :: StatementQuery -> [FiscalPeriod]
$sel:stockRefs:StatementQuery :: StatementQuery -> NonEmpty StockRef
..} =
  let
    refParams :: [QueryParam]
refParams = NonEmpty StockRef -> [QueryParam]
stockRefsToQueryParams NonEmpty StockRef
stockRefs
    startParam :: [QueryParam]
startParam = ByteString -> [Day] -> [QueryParam]
forall a. Show a => ByteString -> [a] -> [QueryParam]
toShownCommaQueryParam ByteString
"start "([Day] -> [QueryParam]) -> [Day] -> [QueryParam]
forall a b. (a -> b) -> a -> b
$ Maybe Day -> [Day]
forall a. Maybe a -> [a]
maybeToList Maybe Day
start
    endParam :: [QueryParam]
endParam = ByteString -> [Day] -> [QueryParam]
forall a. Show a => ByteString -> [a] -> [QueryParam]
toShownCommaQueryParam ByteString
"end" ([Day] -> [QueryParam]) -> [Day] -> [QueryParam]
forall a b. (a -> b) -> a -> b
$ Maybe Day -> [Day]
forall a. Maybe a -> [a]
maybeToList Maybe Day
end
    periodParam :: [QueryParam]
periodParam = ByteString
-> (FiscalPeriod -> ByteString) -> [FiscalPeriod] -> [QueryParam]
forall a. ByteString -> (a -> ByteString) -> [a] -> [QueryParam]
toCommaQueryParam ByteString
"period" FiscalPeriod -> ByteString
fiscalPeriodParam [FiscalPeriod]
periods
    yearParam :: [QueryParam]
yearParam = ByteString -> [Int] -> [QueryParam]
forall a. Show a => ByteString -> [a] -> [QueryParam]
toShownCommaQueryParam ByteString
"fyear" [Int]
years
    ttmParam :: [QueryParam]
ttmParam = ByteString -> Bool -> [QueryParam]
toBoolQueryParam ByteString
"ttm" Bool
ttm
    asReportedParam :: [QueryParam]
asReportedParam = ByteString -> Bool -> [QueryParam]
toBoolQueryParam ByteString
"asreported" Bool
asReported
    sharesParam :: [QueryParam]
sharesParam = ByteString -> Bool -> [QueryParam]
toBoolQueryParam ByteString
"shares" Bool
shares
  in
  [[QueryParam]] -> [QueryParam]
forall a. Monoid a => [a] -> a
mconcat
    [ [QueryParam]
refParams
    , [QueryParam]
startParam
    , [QueryParam]
endParam
    , [QueryParam]
periodParam
    , [QueryParam]
yearParam
    , [QueryParam]
ttmParam
    , [QueryParam]
asReportedParam
    , [QueryParam]
sharesParam
    ]

-- | This is a subset of the StatementQuery type, which models the parameters available
-- to non-SimFin+ users.

data StatementQueryFree
  = StatementQueryFree
  { StatementQueryFree -> StockRef
stockRef :: StockRef
  , StatementQueryFree -> FiscalPeriod
period :: FiscalPeriod
  , StatementQueryFree -> Int
year :: Int
  , StatementQueryFree -> Bool
ttm :: Bool
  }

freeStatementQueryToPaidStatementQuery :: StatementQueryFree -> StatementQuery
freeStatementQueryToPaidStatementQuery :: StatementQueryFree -> StatementQuery
freeStatementQueryToPaidStatementQuery StatementQueryFree{Bool
Int
FiscalPeriod
StockRef
ttm :: Bool
year :: Int
period :: FiscalPeriod
stockRef :: StockRef
$sel:ttm:StatementQueryFree :: StatementQueryFree -> Bool
$sel:year:StatementQueryFree :: StatementQueryFree -> Int
$sel:period:StatementQueryFree :: StatementQueryFree -> FiscalPeriod
$sel:stockRef:StatementQueryFree :: StatementQueryFree -> StockRef
..}
  = StatementQuery :: NonEmpty StockRef
-> [FiscalPeriod]
-> [Int]
-> Maybe Day
-> Maybe Day
-> Bool
-> Bool
-> Bool
-> StatementQuery
StatementQuery
  { $sel:stockRefs:StatementQuery :: NonEmpty StockRef
stockRefs = StockRef -> NonEmpty StockRef
forall (f :: * -> *) a. Applicative f => a -> f a
pure StockRef
stockRef
  , $sel:periods:StatementQuery :: [FiscalPeriod]
periods = FiscalPeriod -> [FiscalPeriod]
forall (f :: * -> *) a. Applicative f => a -> f a
pure FiscalPeriod
period
  , $sel:years:StatementQuery :: [Int]
years = Int -> [Int]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
year
  , $sel:start:StatementQuery :: Maybe Day
start = Maybe Day
forall a. Maybe a
Nothing
  , $sel:end:StatementQuery :: Maybe Day
end = Maybe Day
forall a. Maybe a
Nothing
  , $sel:ttm:StatementQuery :: Bool
ttm = Bool
ttm
  , $sel:asReported:StatementQuery :: Bool
asReported = Bool
False
  , $sel:shares:StatementQuery :: Bool
shares = Bool
False
  }

-- | Turn a 'StatementQueryFree' into query parameters for the SimFin "statements" endpoint.

statementQueryFreeToQueryParams :: StatementQueryFree -> [QueryParam]
statementQueryFreeToQueryParams :: StatementQueryFree -> [QueryParam]
statementQueryFreeToQueryParams = StatementQuery -> [QueryParam]
statementQueryToQueryParams (StatementQuery -> [QueryParam])
-> (StatementQueryFree -> StatementQuery)
-> StatementQueryFree
-> [QueryParam]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatementQueryFree -> StatementQuery
freeStatementQueryToPaidStatementQuery