{-# LANGUAGE OverloadedStrings #-}

-- | This module provides definitions for and functions to work with
-- Debit/Credit dichotomy which is essential to double-entry bookkeeping.
--
-- In our concept, we refer to this dichotomy as "Side" (materialized via 'Side'
-- sum-type) which is either "Debit" (materialized via 'SideDebit' nullary data
-- constructor) or "Dredit" (materialized via 'SideCredit' nullary data
-- constructor).
--
-- This module provides 'Aeson.FromJSON' and 'Aeson.ToJSON' instances for 'Side'
-- as well. Following accounting conventions, we chose the JSON value for
-- "Debit" as @"db"@, and for "Credit" as @"cr"@.
module Haspara.Accounting.Side where

import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Encoding as Aeson.Encoding
import qualified Data.Text as T
import GHC.TypeLits (KnownNat)
import Haspara.Accounting.Account (AccountKind (..))
import Haspara.Quantity (Quantity)


-- | Data definition for encoding the debit/credit indicator.
data Side = SideDebit | SideCredit
  deriving (Side -> Side -> Bool
(Side -> Side -> Bool) -> (Side -> Side -> Bool) -> Eq Side
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Side -> Side -> Bool
== :: Side -> Side -> Bool
$c/= :: Side -> Side -> Bool
/= :: Side -> Side -> Bool
Eq, Eq Side
Eq Side =>
(Side -> Side -> Ordering)
-> (Side -> Side -> Bool)
-> (Side -> Side -> Bool)
-> (Side -> Side -> Bool)
-> (Side -> Side -> Bool)
-> (Side -> Side -> Side)
-> (Side -> Side -> Side)
-> Ord Side
Side -> Side -> Bool
Side -> Side -> Ordering
Side -> Side -> Side
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Side -> Side -> Ordering
compare :: Side -> Side -> Ordering
$c< :: Side -> Side -> Bool
< :: Side -> Side -> Bool
$c<= :: Side -> Side -> Bool
<= :: Side -> Side -> Bool
$c> :: Side -> Side -> Bool
> :: Side -> Side -> Bool
$c>= :: Side -> Side -> Bool
>= :: Side -> Side -> Bool
$cmax :: Side -> Side -> Side
max :: Side -> Side -> Side
$cmin :: Side -> Side -> Side
min :: Side -> Side -> Side
Ord, Int -> Side -> ShowS
[Side] -> ShowS
Side -> String
(Int -> Side -> ShowS)
-> (Side -> String) -> ([Side] -> ShowS) -> Show Side
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Side -> ShowS
showsPrec :: Int -> Side -> ShowS
$cshow :: Side -> String
show :: Side -> String
$cshowList :: [Side] -> ShowS
showList :: [Side] -> ShowS
Show)


-- | 'Aeson.FromJSON' instance for 'Side'.
--
-- >>> :set -XOverloadedStrings
-- >>> Aeson.eitherDecode "\"db\"" :: Either String Side
-- Right SideDebit
-- >>> Aeson.eitherDecode "\"cr\"" :: Either String Side
-- Right SideCredit
-- >>> Aeson.eitherDecode "\"hebele\"" :: Either String Side
-- Left "Error in $: Unkown side indicator: \"hebele\". Expecting one of \"db\" or \"cr\""
instance Aeson.FromJSON Side where
  parseJSON :: Value -> Parser Side
parseJSON = String -> (Text -> Parser Side) -> Value -> Parser Side
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"Side" ((Text -> Parser Side) -> Value -> Parser Side)
-> (Text -> Parser Side) -> Value -> Parser Side
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"db" -> Side -> Parser Side
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Side
SideDebit
    Text
"cr" -> Side -> Parser Side
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Side
SideCredit
    Text
_ -> String -> Parser Side
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Side) -> String -> Parser Side
forall a b. (a -> b) -> a -> b
$ String
"Unkown side indicator: \"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\". Expecting one of \"db\" or \"cr\""


-- | 'Aeson.ToJSON' instance for 'Side'.
--
-- >>> Aeson.encode SideDebit
-- "\"db\""
-- >>> Aeson.encode SideCredit
-- "\"cr\""
-- >>> Aeson.decode (Aeson.encode SideDebit) == Just SideDebit
-- True
-- >>> Aeson.decode (Aeson.encode SideCredit) == Just SideCredit
-- True
instance Aeson.ToJSON Side where
  toJSON :: Side -> Value
toJSON Side
SideDebit = Text -> Value
Aeson.String Text
"db"
  toJSON Side
SideCredit = Text -> Value
Aeson.String Text
"cr"


  toEncoding :: Side -> Encoding
toEncoding Side
SideDebit = Text -> Encoding
forall a. Text -> Encoding' a
Aeson.Encoding.text Text
"db"
  toEncoding Side
SideCredit = Text -> Encoding
forall a. Text -> Encoding' a
Aeson.Encoding.text Text
"cr"


-- | Gives the other side.
--
-- >>> otherSide SideDebit
-- SideCredit
-- >>> otherSide SideCredit
-- SideDebit
otherSide :: Side -> Side
otherSide :: Side -> Side
otherSide Side
SideDebit = Side
SideCredit
otherSide Side
SideCredit = Side
SideDebit


-- | Computes the 'Side' by the given 'AccountKind' and the sign of the given
-- 'Quantity'.
--
-- The sign of the 'Quantity' is indeed a proxy for whether the event of the
-- 'Quantity' is an increment (@+1@) or decrement (@-1@) event.
--
-- @0@ quantities are considered to originate from an increment event. So far,
-- this seems to be a safe assumption that gives us totality in the context of
-- this function.
--
-- Note the following mapping as a guide:
--
-- +-----------------------+----------+----------+
-- | Kind of account       | Debit    | Credit   |
-- +-----------------------+----------+----------+
-- | Asset                 | Increase | Decrease |
-- +-----------------------+----------+----------+
-- | Liability             | Decrease | Increase |
-- +-----------------------+----------+----------+
-- | Equity/Capital        | Decrease | Increase |
-- +-----------------------+----------+----------+
-- | Income/Revenue        | Decrease | Increase |
-- +-----------------------+----------+----------+
-- | Expense/Cost/Dividend | Increase | Decrease |
-- +-----------------------+----------+----------+
--
-- >>> :set -XDataKinds
-- >>> import Haspara.Quantity
-- >>> let decrement = mkQuantity (-0.42) :: Quantity 2
-- >>> let nocrement = mkQuantity 0 :: Quantity 2
-- >>> let increment = mkQuantity 0.42 :: Quantity 2
-- >>> fmap (sideByAccountKind AccountKindAsset) [decrement, nocrement, increment]
-- [SideCredit,SideDebit,SideDebit]
-- >>> fmap (sideByAccountKind AccountKindLiability) [decrement, nocrement, increment]
-- [SideDebit,SideCredit,SideCredit]
-- >>> fmap (sideByAccountKind AccountKindEquity) [decrement, nocrement, increment]
-- [SideDebit,SideCredit,SideCredit]
-- >>> fmap (sideByAccountKind AccountKindRevenue) [decrement, nocrement, increment]
-- [SideDebit,SideCredit,SideCredit]
-- >>> fmap (sideByAccountKind AccountKindExpense) [decrement, nocrement, increment]
-- [SideCredit,SideDebit,SideDebit]
sideByAccountKind
  :: KnownNat precision
  => AccountKind
  -> Quantity precision
  -> Side
sideByAccountKind :: forall (precision :: Nat).
KnownNat precision =>
AccountKind -> Quantity precision -> Side
sideByAccountKind AccountKind
k Quantity precision
q = case (AccountKind
k, Quantity precision -> Quantity precision
forall a. Num a => a -> a
signum Quantity precision
q Quantity precision -> Quantity precision -> Bool
forall a. Ord a => a -> a -> Bool
>= Quantity precision
0) of
  (AccountKind
AccountKindAsset, Bool
False) -> Side
SideCredit
  (AccountKind
AccountKindAsset, Bool
True) -> Side
SideDebit
  (AccountKind
AccountKindLiability, Bool
False) -> Side
SideDebit
  (AccountKind
AccountKindLiability, Bool
True) -> Side
SideCredit
  (AccountKind
AccountKindEquity, Bool
False) -> Side
SideDebit
  (AccountKind
AccountKindEquity, Bool
True) -> Side
SideCredit
  (AccountKind
AccountKindRevenue, Bool
False) -> Side
SideDebit
  (AccountKind
AccountKindRevenue, Bool
True) -> Side
SideCredit
  (AccountKind
AccountKindExpense, Bool
False) -> Side
SideCredit
  (AccountKind
AccountKindExpense, Bool
True) -> Side
SideDebit


-- | Returns the "normal" side for a given 'AccountKind'.
--
-- Note the following mapping as a guide:
--
-- +-----------------+----------------+------------------+
-- | Kind of Account | Normal Balance | Negative Balance |
-- +-----------------+----------------+------------------+
-- | Asset           | Debit          | Credit           |
-- +-----------------+----------------+------------------+
-- | Liability       | Credit         | Debit            |
-- +-----------------+----------------+------------------+
-- | Equity          | Credit         | Debit            |
-- +-----------------+----------------+------------------+
-- | Revenue         | Credit         | Debit            |
-- +-----------------+----------------+------------------+
-- | Expense         | Debit          | Credit           |
-- +-----------------+----------------+------------------+
normalSideByAccountKind :: AccountKind -> Side
normalSideByAccountKind :: AccountKind -> Side
normalSideByAccountKind AccountKind
AccountKindAsset = Side
SideDebit
normalSideByAccountKind AccountKind
AccountKindLiability = Side
SideCredit
normalSideByAccountKind AccountKind
AccountKindEquity = Side
SideCredit
normalSideByAccountKind AccountKind
AccountKindRevenue = Side
SideCredit
normalSideByAccountKind AccountKind
AccountKindExpense = Side
SideDebit