-- | 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.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
/= :: Side -> Side -> Bool
$c/= :: Side -> Side -> Bool
== :: Side -> Side -> Bool
$c== :: 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
min :: Side -> Side -> Side
$cmin :: Side -> Side -> Side
max :: Side -> Side -> Side
$cmax :: Side -> Side -> Side
>= :: Side -> Side -> Bool
$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
compare :: Side -> Side -> Ordering
$ccompare :: Side -> Side -> Ordering
$cp1Ord :: Eq 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
showList :: [Side] -> ShowS
$cshowList :: [Side] -> ShowS
show :: Side -> String
$cshow :: Side -> String
showsPrec :: Int -> Side -> ShowS
$cshowsPrec :: Int -> Side -> ShowS
Show)


-- | 'Aeson.FromJSON' instance for 'Side'.
--
-- >>> 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 (f :: * -> *) a. Applicative f => a -> f a
pure Side
SideDebit
    Text
"cr" -> Side -> Parser Side
forall (f :: * -> *) a. Applicative f => a -> f a
pure Side
SideCredit
    Text
_    -> String -> Parser Side
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"


-- | 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 :: 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