diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,32 @@
## [Unreleased]
+
+## [0.0.0.4] - 2022-06-22
+### Chore
+- fix doctests and Haddock documentation
+- start working on Haspara.Accounting.Journal module
+- add new functions to Haspara.Quantity module
+- bump development version to 0.0.0.4
+
+### Feat
+- add Haspara.Accounting.Side module
+- **accounting:** improve Ledger module definitions
+- **accounting:** delineate value and quantity concepts wrt Amount
+- **accounting:** add Bounded instance to AccountKind
+- **accounting:** add TrialBalance definitions
+- **accounting:** add Amount and Balance definitions
+- **accounting:** improve the Haspara.Accounting.Side module
+- **accounting:** improve Balance module definitions
+
+### Refactor
+- **accounting:** remove Event definitions, revisit exports
+- **accounting:** revisit Ledger{Entry} and Journal{Entry,EntryItem}
+
+### Pull Requests
+- Merge pull request [#10](https://github.com/telostat/haspara/issues/10) from telostat/vst/issue-9
+
+
## [0.0.0.3] - 2022-06-17
### Chore
@@ -9,6 +35,7 @@
- adopt Stack lts-19.11 (and GHC902), add Nix Shell
- bump development version to 0.0.0.3
- **build:** specify dependency version ranges
+- **release:** 0.0.0.3
### Refactor
- revisit Haspara.FxQuote module, add new definitions
@@ -79,7 +106,8 @@
- Merge pull request [#1](https://github.com/telostat/haspara/issues/1) from telostat/init
-[Unreleased]: https://github.com/telostat/haspara/compare/0.0.0.3...HEAD
+[Unreleased]: https://github.com/telostat/haspara/compare/0.0.0.4...HEAD
+[0.0.0.4]: https://github.com/telostat/haspara/compare/0.0.0.3...0.0.0.4
[0.0.0.3]: https://github.com/telostat/haspara/compare/0.0.0.2...0.0.0.3
[0.0.0.2]: https://github.com/telostat/haspara/compare/0.0.0.1...0.0.0.2
[0.0.0.1]: https://github.com/telostat/haspara/compare/0.0.0.0...0.0.0.1
diff --git a/haspara.cabal b/haspara.cabal
--- a/haspara.cabal
+++ b/haspara.cabal
@@ -5,7 +5,7 @@
-- see: https://github.com/sol/hpack
name: haspara
-version: 0.0.0.3
+version: 0.0.0.4
synopsis: A library providing definitions to work with monetary values.
description: Please see the README on GitHub at
category: Finance
@@ -30,8 +30,12 @@
Haspara
Haspara.Accounting
Haspara.Accounting.Account
- Haspara.Accounting.Event
+ Haspara.Accounting.Amount
+ Haspara.Accounting.Balance
+ Haspara.Accounting.Journal
Haspara.Accounting.Ledger
+ Haspara.Accounting.Side
+ Haspara.Accounting.TrialBalance
Haspara.Currency
Haspara.FxQuote
Haspara.Internal.Aeson
diff --git a/src/Haspara/Accounting.hs b/src/Haspara/Accounting.hs
--- a/src/Haspara/Accounting.hs
+++ b/src/Haspara/Accounting.hs
@@ -2,46 +2,19 @@
-- accounting functionality.
module Haspara.Accounting
- ( Account(..)
- , AccountKind(..)
- , accountKindText
- , Entry(..)
- , buildEntry
- , Event(..)
- , eventDate
- , eventObject
- , negateEvent
- , mkEvent
- , Posting(..)
- , postingEvents
- , post
- , Ledger(..)
- , LedgerItem(..)
- , mkLedger
- , addEntry
- , entryDate
- , entryObject
- , entryQuantity
- , entryDebit
- , entryCredit
+ ( module Haspara.Accounting.Account
+ , module Haspara.Accounting.Amount
+ , module Haspara.Accounting.Balance
+ , module Haspara.Accounting.Journal
+ , module Haspara.Accounting.Ledger
+ , module Haspara.Accounting.Side
+ , module Haspara.Accounting.TrialBalance
) where
-
-import Haspara.Accounting.Account (Account(..), AccountKind(..), accountKindText)
-import Haspara.Accounting.Event (Event(..), eventDate, eventObject, mkEvent, negateEvent)
+import Haspara.Accounting.Account
+import Haspara.Accounting.Amount
+import Haspara.Accounting.Balance
+import Haspara.Accounting.Journal
import Haspara.Accounting.Ledger
- ( Entry(..)
- , Ledger(..)
- , LedgerItem(..)
- , Posting(..)
- , addEntry
- , buildEntry
- , entryCredit
- , entryDate
- , entryDebit
- , entryObject
- , entryQuantity
- , mkLedger
- , post
- , postingEvents
- )
+import Haspara.Accounting.Side
+import Haspara.Accounting.TrialBalance
diff --git a/src/Haspara/Accounting/Account.hs b/src/Haspara/Accounting/Account.hs
--- a/src/Haspara/Accounting/Account.hs
+++ b/src/Haspara/Accounting/Account.hs
@@ -57,7 +57,7 @@
| AccountKindEquity
| AccountKindRevenue
| AccountKindExpense
- deriving (Enum, Eq, Generic, Ord, Show)
+ deriving (Bounded, Enum, Eq, Generic, Ord, Show)
instance Hashable AccountKind
diff --git a/src/Haspara/Accounting/Amount.hs b/src/Haspara/Accounting/Amount.hs
new file mode 100644
--- /dev/null
+++ b/src/Haspara/Accounting/Amount.hs
@@ -0,0 +1,255 @@
+-- | This module provides definitions for amounts used as in accounting.
+--
+-- For balance definition that allows "Negative Balance" phenomenon, see
+-- 'Haspara.Accounting.Balance'.
+
+{-# LANGUAGE DataKinds #-}
+
+module Haspara.Accounting.Amount where
+
+import qualified Data.Aeson as Aeson
+import GHC.Generics (Generic)
+import GHC.TypeLits (KnownNat, Nat)
+import Haspara.Accounting.Account (AccountKind(..))
+import Haspara.Accounting.Side (Side(..), sideByAccountKind)
+import Haspara.Internal.Aeson (commonAesonOptions)
+import Haspara.Quantity (Quantity, UnsignedQuantity, absQuantity)
+import Refined (unrefine)
+
+
+-- | Data definition for amounts.
+data Amount (precision :: Nat) = Amount
+ { amountSide :: !Side
+ , amountValue :: !(UnsignedQuantity precision)
+ }
+ deriving (Eq, Generic, Ord, Show)
+
+
+-- | 'Aeson.FromJSON' instance for 'Amount'.
+--
+-- >>> Aeson.eitherDecode "{\"side\": \"db\", \"value\": 42}" :: Either String (Amount 2)
+-- Right (Amount {amountSide = SideDebit, amountValue = Refined 42.00})
+-- >>> Aeson.eitherDecode "{\"side\": \"cr\", \"value\": 42}" :: Either String (Amount 2)
+-- Right (Amount {amountSide = SideCredit, amountValue = Refined 42.00})
+instance KnownNat precision => Aeson.FromJSON (Amount precision) where
+ parseJSON = Aeson.genericParseJSON $ commonAesonOptions "amount"
+
+
+-- | 'Aeson.ToJSON' instance for 'Amount'.
+--
+-- >>> import Haspara.Accounting.Side
+-- >>> import Haspara.Quantity
+-- >>> import Refined.Unsafe
+-- >>> Aeson.encode (Amount SideDebit (unsafeRefine (mkQuantity 42 :: Quantity 2)))
+-- "{\"side\":\"db\",\"value\":42.0}"
+-- >>> Aeson.encode (Amount SideCredit (unsafeRefine (mkQuantity 42 :: Quantity 2)))
+-- "{\"side\":\"cr\",\"value\":42.0}"
+-- >>> Aeson.eitherDecode (Aeson.encode (Amount SideDebit (unsafeRefine (mkQuantity 42 :: Quantity 2)))) :: Either String (Amount 2)
+-- Right (Amount {amountSide = SideDebit, amountValue = Refined 42.00})
+-- >>> Aeson.eitherDecode (Aeson.encode (Amount SideCredit (unsafeRefine (mkQuantity 42 :: Quantity 2)))) :: Either String (Amount 2)
+-- Right (Amount {amountSide = SideCredit, amountValue = Refined 42.00})
+instance KnownNat precision => Aeson.ToJSON (Amount precision) where
+ toJSON = Aeson.genericToJSON $ commonAesonOptions "amount"
+
+
+-- | Returns the debit value of the 'Amount', if any.
+amountDebit :: KnownNat precision => Amount precision -> Maybe (UnsignedQuantity precision)
+amountDebit (Amount SideDebit value) = Just value
+amountDebit _ = Nothing
+
+
+-- | Returns the credit value of the 'Amount', if any.
+amountCredit :: KnownNat precision => Amount precision -> Maybe (UnsignedQuantity precision)
+amountCredit (Amount SideCredit value) = Just value
+amountCredit _ = Nothing
+
+
+-- | Builds the 'Amount' for the given /value/ for the given 'AccountKind'.
+--
+-- The /value/ concept here refers to the value of a particular economic event
+-- as in the contribution of that event to the net-worth of the entity.
+--
+-- This definition of the value is different than what we refer to in
+-- 'amountFromQuantity'. In 'amountFromQuantity' the /quantity/ is simply
+-- reflecting the increment or decrement in a particular account of a particular
+-- 'AccountKind'.
+--
+-- For example, consider getting a loan: There are two immediate events due to
+-- this exchange:
+--
+-- 1. Inflow of cash of some quantity to an 'AccountKindAsset' account.
+-- 2. Inflow of loan contract with some notional value of the same quantity to a
+-- 'AccountKindLiability acount.
+--
+-- Let's say, the notional is USD 1,000. Therefore:
+--
+-- 1. Inflow of USD 1,000 to the cash account.
+-- 2. Inflow of a Loan Contract of USD 1,000 to the liability account.
+--
+-- Conventionally, the latter is reflected as follow:
+--
+-- >>> import Haspara.Quantity
+-- >>> amountFromQuantity AccountKindLiability (mkQuantity 1000 :: Quantity 2)
+-- Amount {amountSide = SideCredit, amountValue = Refined 1000.00}
+--
+-- However, if the call-site is referring to values as in the net effect of the
+-- event to the net-worth of the entity, then:
+--
+-- >>> amountFromValue AccountKindLiability (mkQuantity (-1000) :: Quantity 2)
+-- Amount {amountSide = SideCredit, amountValue = Refined 1000.00}
+--
+-- For reference, given:
+--
+-- >>> let valPos = mkQuantity 42 :: Quantity 2
+-- >>> let valNeg = mkQuantity (-42) :: Quantity 2
+--
+-- ..., let's consider following events:
+--
+-- We have an inflow and outflow of some assets, respectively:
+--
+-- >>> amountFromValue AccountKindAsset valPos
+-- Amount {amountSide = SideDebit, amountValue = Refined 42.00}
+-- >>> amountFromValue AccountKindAsset valNeg
+-- Amount {amountSide = SideCredit, amountValue = Refined 42.00}
+--
+-- We have some decrease and increase in our liabilities, respectively:
+--
+-- >>> amountFromValue AccountKindLiability valPos
+-- Amount {amountSide = SideDebit, amountValue = Refined 42.00}
+-- >>> amountFromValue AccountKindLiability valNeg
+-- Amount {amountSide = SideCredit, amountValue = Refined 42.00}
+--
+-- We have some increase and decrease in our equity, respectively:
+--
+-- >>> amountFromValue AccountKindEquity valPos
+-- Amount {amountSide = SideCredit, amountValue = Refined 42.00}
+-- >>> amountFromValue AccountKindEquity valNeg
+-- Amount {amountSide = SideDebit, amountValue = Refined 42.00}
+--
+-- We have some profit and loss in our PnL, respectively:
+--
+-- >>> amountFromValue AccountKindRevenue valPos
+-- Amount {amountSide = SideCredit, amountValue = Refined 42.00}
+-- >>> amountFromValue AccountKindRevenue valNeg
+-- Amount {amountSide = SideDebit, amountValue = Refined 42.00}
+--
+-- We have some decrease and increase in our expenses, respectively:
+--
+-- >>> amountFromValue AccountKindExpense valPos
+-- Amount {amountSide = SideCredit, amountValue = Refined 42.00}
+-- >>> amountFromValue AccountKindExpense valNeg
+-- Amount {amountSide = SideDebit, amountValue = Refined 42.00}
+amountFromValue
+ :: KnownNat precision
+ => AccountKind
+ -> Quantity precision
+ -> Amount precision
+amountFromValue k q = case k of
+ AccountKindAsset -> Amount { amountSide = if q >= 0 then SideDebit else SideCredit, amountValue = absQuantity q }
+ AccountKindLiability -> Amount { amountSide = if q >= 0 then SideDebit else SideCredit, amountValue = absQuantity q }
+ AccountKindEquity -> Amount { amountSide = if q >= 0 then SideCredit else SideDebit, amountValue = absQuantity q }
+ AccountKindRevenue -> Amount { amountSide = if q >= 0 then SideCredit else SideDebit, amountValue = absQuantity q }
+ AccountKindExpense -> Amount { amountSide = if q >= 0 then SideCredit else SideDebit, amountValue = absQuantity q }
+
+
+-- | Returns the value for the given 'Amount' for the given 'AccountKind'.
+--
+-- This is dual to 'amountFromValue'.
+--
+-- For values of positive and negative net-effect on the net-worth of the
+-- entity, respectively:
+--
+-- >>> import Haspara.Quantity
+-- >>> let valPos = mkQuantity 42 :: Quantity 2
+-- >>> let valNeg = mkQuantity (-42) :: Quantity 2
+--
+-- ..., for a @check@ function that checks if the roundtrip to a value is
+-- successful for a given 'AccountKind':
+--
+-- >>> let check = \k v -> v == valueFromAmount k (amountFromValue k v)
+--
+-- ..., and for the list of 'AccountKind's.
+--
+-- >>> let kinds = [minBound .. maxBound] :: [AccountKind]
+-- >>> kinds
+-- [AccountKindAsset,AccountKindLiability,AccountKindEquity,AccountKindRevenue,AccountKindExpense]
+--
+-- All checks should pass:
+--
+-- >>> all (\k -> check k valPos && check k valNeg) kinds
+-- True
+valueFromAmount
+ :: KnownNat precision
+ => AccountKind
+ -> Amount precision
+ -> Quantity precision
+valueFromAmount k (Amount s v) = case (k, s, unrefine v) of
+ (AccountKindAsset, SideDebit, q) -> q
+ (AccountKindAsset, SideCredit, q) -> -q
+ (AccountKindLiability, SideDebit, q) -> q
+ (AccountKindLiability, SideCredit, q) -> -q
+ (AccountKindEquity, SideDebit, q) -> -q
+ (AccountKindEquity, SideCredit, q) -> q
+ (AccountKindRevenue, SideDebit, q) -> -q
+ (AccountKindRevenue, SideCredit, q) -> q
+ (AccountKindExpense, SideDebit, q) -> -q
+ (AccountKindExpense, SideCredit, q) -> q
+
+
+-- | Builds the 'Amount' value for the given account kind and quantity.
+--
+-- The concept of /quantity/ here refers to the conventional concept of what it
+-- means for an 'Haspara.Accounting.Account.Account' of a given 'AccountKind'.
+--
+-- For example, a loan of USD 1,000 has an increase in our liabilities.
+-- Therefore, the quantity is expected to be positive:
+--
+-- >>> import Haspara.Quantity
+-- >>> amountFromQuantity AccountKindLiability (mkQuantity 1000 :: Quantity 2)
+-- Amount {amountSide = SideCredit, amountValue = Refined 1000.00}
+--
+-- Note 'amountFromValue' function if you are rather working with values that
+-- are conceptually different than the /quantity/ here whereby a /value/ refers
+-- to the value of a particular economic event as in the contribution of that
+-- event to the net-worth of the entity. Therefore, above example would be
+-- reflected as follows to get the same 'Amount' value:
+--
+-- >>> amountFromValue AccountKindLiability (mkQuantity (-1000) :: Quantity 2)
+-- Amount {amountSide = SideCredit, amountValue = Refined 1000.00}
+--
+-- Check 'amountFromValue' documentation for further information.
+amountFromQuantity
+ :: KnownNat precision
+ => AccountKind
+ -> Quantity precision
+ -> Amount precision
+amountFromQuantity k q =
+ Amount
+ { amountSide = sideByAccountKind k q
+ , amountValue = absQuantity q
+ }
+
+
+-- | Returns the quantity for the given amount.
+--
+-- This is dual to 'amountFromQuantity'.
+quantityFromAmount
+ :: KnownNat precision
+ => AccountKind
+ -> Amount precision
+ -> Quantity precision
+quantityFromAmount k (Amount side absValue) =
+ let
+ value = unrefine absValue
+ in
+ case (k, side) of
+ (AccountKindAsset, SideDebit) -> value
+ (AccountKindAsset, SideCredit) -> -value
+ (AccountKindLiability, SideDebit) -> -value
+ (AccountKindLiability, SideCredit) -> value
+ (AccountKindEquity, SideDebit) -> -value
+ (AccountKindEquity, SideCredit) -> value
+ (AccountKindRevenue, SideDebit) -> -value
+ (AccountKindRevenue, SideCredit) -> value
+ (AccountKindExpense, SideDebit) -> value
+ (AccountKindExpense, SideCredit) -> -value
diff --git a/src/Haspara/Accounting/Balance.hs b/src/Haspara/Accounting/Balance.hs
new file mode 100644
--- /dev/null
+++ b/src/Haspara/Accounting/Balance.hs
@@ -0,0 +1,162 @@
+-- | This module provides definitions for balances used as in accounting.
+
+{-# LANGUAGE DataKinds #-}
+
+module Haspara.Accounting.Balance where
+
+import qualified Data.Aeson as Aeson
+import GHC.Generics (Generic)
+import GHC.TypeLits (KnownNat, Nat)
+import Haspara.Accounting.Account (AccountKind)
+import Haspara.Accounting.Amount (Amount(Amount), quantityFromAmount, valueFromAmount)
+import Haspara.Accounting.Side (Side(..), otherSide)
+import Haspara.Internal.Aeson (commonAesonOptions)
+import Haspara.Quantity (Quantity, absQuantity)
+import Refined (unrefine)
+
+
+-- | Data definition for balances.
+--
+-- This definition is similar to 'Haspara.Accounting.Amount.Amount', however,
+-- the value is allowed to be negative to reflect "Negative Balance" phenomenon.
+--
+-- See https://www.accountingtools.com/articles/what-is-a-negative-balance.html
+data Balance (precision :: Nat) = Balance
+ { balanceSide :: !Side
+ , balanceValue :: !(Quantity precision)
+ }
+ deriving (Eq, Generic, Show)
+
+
+-- | 'Aeson.FromJSON' instance for 'Balance'.
+--
+-- For normal balances:
+--
+-- >>> Aeson.eitherDecode "{\"side\": \"db\", \"value\": 42}" :: Either String (Balance 2)
+-- Right (Balance {balanceSide = SideDebit, balanceValue = 42.00})
+-- >>> Aeson.eitherDecode "{\"side\": \"cr\", \"value\": 42}" :: Either String (Balance 2)
+-- Right (Balance {balanceSide = SideCredit, balanceValue = 42.00})
+--
+-- For negative balances:
+--
+-- >>> Aeson.eitherDecode "{\"side\": \"db\", \"value\": -42}" :: Either String (Balance 2)
+-- Right (Balance {balanceSide = SideDebit, balanceValue = -42.00})
+-- >>> Aeson.eitherDecode "{\"side\": \"cr\", \"value\": -42}" :: Either String (Balance 2)
+-- Right (Balance {balanceSide = SideCredit, balanceValue = -42.00})
+instance KnownNat precision => Aeson.FromJSON (Balance precision) where
+ parseJSON = Aeson.genericParseJSON $ commonAesonOptions "balance"
+
+
+-- | 'Aeson.ToJSON' instance for 'Balance'.
+--
+-- For normal balances:
+--
+-- >>> import Haspara.Accounting.Side
+-- >>> import Haspara.Quantity
+-- >>> Aeson.encode (Balance SideDebit (mkQuantity 42 :: Quantity 2))
+-- "{\"side\":\"db\",\"value\":42.0}"
+-- >>> Aeson.encode (Balance SideCredit (mkQuantity 42 :: Quantity 2))
+-- "{\"side\":\"cr\",\"value\":42.0}"
+-- >>> Aeson.eitherDecode (Aeson.encode (Balance SideDebit (mkQuantity 42 :: Quantity 2))) :: Either String (Balance 2)
+-- Right (Balance {balanceSide = SideDebit, balanceValue = 42.00})
+-- >>> Aeson.eitherDecode (Aeson.encode (Balance SideCredit (mkQuantity 42 :: Quantity 2))) :: Either String (Balance 2)
+-- Right (Balance {balanceSide = SideCredit, balanceValue = 42.00})
+--
+-- For negative balances:
+--
+-- >>> Aeson.encode (Balance SideDebit (mkQuantity (-42) :: Quantity 2))
+-- "{\"side\":\"db\",\"value\":-42.0}"
+-- >>> Aeson.encode (Balance SideCredit (mkQuantity (-42) :: Quantity 2))
+-- "{\"side\":\"cr\",\"value\":-42.0}"
+-- >>> Aeson.eitherDecode (Aeson.encode (Balance SideDebit (mkQuantity (-42) :: Quantity 2))) :: Either String (Balance 2)
+-- Right (Balance {balanceSide = SideDebit, balanceValue = -42.00})
+-- >>> Aeson.eitherDecode (Aeson.encode (Balance SideCredit (mkQuantity (-42) :: Quantity 2))) :: Either String (Balance 2)
+-- Right (Balance {balanceSide = SideCredit, balanceValue = -42.00})
+instance KnownNat precision => Aeson.ToJSON (Balance precision) where
+ toJSON = Aeson.genericToJSON $ commonAesonOptions "balance"
+
+
+-- | Returns the debit quantity, if any.
+balanceDebit
+ :: KnownNat precision
+ => Balance precision
+ -> Maybe (Quantity precision)
+balanceDebit (Balance SideDebit v) = Just v
+balanceDebit _ = Nothing
+
+
+-- | Returns the credit quantity, if any.
+balanceCredit
+ :: KnownNat precision
+ => Balance precision
+ -> Maybe (Quantity precision)
+balanceCredit (Balance SideCredit v) = Just v
+balanceCredit _ = Nothing
+
+
+-- | Updates the balance with the given amount.
+--
+-- >>> import Haspara.Accounting.Amount
+-- >>> import Haspara.Accounting.Side
+-- >>> import Refined.Unsafe
+-- >>> let balance = Balance SideDebit 42 :: Balance 2
+-- >>> balance
+-- Balance {balanceSide = SideDebit, balanceValue = 42.00}
+-- >>> let amountDebit = Amount SideDebit (unsafeRefine 10) :: Amount 2
+-- >>> amountDebit
+-- Amount {amountSide = SideDebit, amountValue = Refined 10.00}
+-- >>> let amountCredit = Amount SideCredit (unsafeRefine 10) :: Amount 2
+-- >>> amountCredit
+-- Amount {amountSide = SideCredit, amountValue = Refined 10.00}
+-- >>> updateBalance balance amountDebit
+-- Balance {balanceSide = SideDebit, balanceValue = 52.00}
+-- >>> updateBalance balance amountCredit
+-- Balance {balanceSide = SideDebit, balanceValue = 32.00}
+updateBalance
+ :: KnownNat precision
+ => Balance precision
+ -> Amount precision
+ -> Balance precision
+updateBalance (Balance bSide bVal) (Amount aSide aVal) =
+ Balance bSide (bVal + (unrefine aVal * (if bSide == aSide then 1 else (-1))))
+
+
+-- | Converts the balance to amount.
+--
+-- >>> import Haspara.Accounting.Side
+-- >>> amountFromBalance (Balance SideDebit 42 :: Balance 2)
+-- Amount {amountSide = SideDebit, amountValue = Refined 42.00}
+-- >>> amountFromBalance (Balance SideDebit (-42) :: Balance 2)
+-- Amount {amountSide = SideCredit, amountValue = Refined 42.00}
+-- >>> amountFromBalance (Balance SideCredit 42 :: Balance 2)
+-- Amount {amountSide = SideCredit, amountValue = Refined 42.00}
+-- >>> amountFromBalance (Balance SideCredit (-42) :: Balance 2)
+-- Amount {amountSide = SideDebit, amountValue = Refined 42.00}
+amountFromBalance
+ :: KnownNat precision
+ => Balance precision
+ -> Amount precision
+amountFromBalance (Balance side value) =
+ Amount (if value < 0 then otherSide side else side) (absQuantity value)
+
+
+-- | Returns the quantity of the balance given the account kind.
+--
+-- See 'quantityFromAmount' for the meaning of quantity.
+quantityFromBalance
+ :: KnownNat precision
+ => AccountKind
+ -> Balance precision
+ -> Quantity precision
+quantityFromBalance k = quantityFromAmount k . amountFromBalance
+
+
+-- | Returns the value of the balance given the account kind.
+--
+-- See 'valueFromAmount' for the meaning of quantity.
+valueFromBalance
+ :: KnownNat precision
+ => AccountKind
+ -> Balance precision
+ -> Quantity precision
+valueFromBalance k = valueFromAmount k . amountFromBalance
diff --git a/src/Haspara/Accounting/Event.hs b/src/Haspara/Accounting/Event.hs
deleted file mode 100644
--- a/src/Haspara/Accounting/Event.hs
+++ /dev/null
@@ -1,91 +0,0 @@
--- | This module provides definitions for economic events.
---
--- /Note: The concept is not YET REA-compatible although we want to achieve it
--- at some point/.
-
-{-# LANGUAGE DataKinds #-}
-
-module Haspara.Accounting.Event where
-
-import Control.Monad.Except (MonadError(throwError))
-import Data.Aeson ((.:), (.=))
-import qualified Data.Aeson as Aeson
-import qualified Data.Char as C
-import qualified Data.Text as T
-import Data.Time (Day)
-import GHC.TypeLits (KnownNat, Nat)
-import Haspara.Quantity (Quantity, UnsignedQuantity)
-import Refined (refine)
-
-
--- | Type encoding of an economic increment/decrement event.
---
--- The event explicitly carries the date and quantity information along with a
--- parameterized, arbitrary object providing the source of the event.
---
--- >>> :set -XDataKinds
--- >>> let date = read "2021-01-01"
--- >>> let oid = 1 :: Int
--- >>> let qty = $$(Refined.refineTH 42) :: UnsignedQuantity 2
--- >>> let event = EventDecrement date oid qty
--- >>> let json = Data.Aeson.encode event
--- >>> json
--- "{\"qty\":42.0,\"type\":\"DECREMENT\",\"obj\":1,\"date\":\"2021-01-01\"}"
--- >>> Data.Aeson.decode @(Event Int 2) json
--- Just (EventDecrement 2021-01-01 1 (Refined 42.00))
--- >>> Data.Aeson.decode json == Just event
--- True
-data Event o (s :: Nat) =
- EventDecrement Day o (UnsignedQuantity s)
- | EventIncrement Day o (UnsignedQuantity s)
- deriving (Eq, Ord, Show)
-
-
-instance (Aeson.FromJSON o, KnownNat s) => Aeson.FromJSON (Event o s) where
- parseJSON = Aeson.withObject "Event" $ \o -> do
- dorc <- o .: "type"
- cons <- case T.map C.toUpper dorc of
- "DECREMENT" -> pure EventDecrement
- "INCREMENT" -> pure EventIncrement
- x -> fail ("Unknown event type: " <> T.unpack x)
- date <- o .: "date"
- obj <- o .: "obj"
- qty <- o .: "qty"
- pure (cons date obj qty)
-
-
-instance (Aeson.ToJSON o, KnownNat s) => Aeson.ToJSON (Event o s) where
- toJSON x = case x of
- EventDecrement d o q -> Aeson.object ["type" .= ("DECREMENT" :: T.Text), "date" .= d, "obj" .= o, "qty" .= q]
- EventIncrement d o q -> Aeson.object ["type" .= ("INCREMENT" :: T.Text), "date" .= d, "obj" .= o, "qty" .= q]
-
-
--- | Returns the date of the event.
-eventDate :: (KnownNat s) => Event o s -> Day
-eventDate (EventDecrement d _ _) = d
-eventDate (EventIncrement d _ _) = d
-
-
--- | Returns the source object of the event.
-eventObject :: (KnownNat s) => Event o s -> o
-eventObject (EventDecrement _ o _) = o
-eventObject (EventIncrement _ o _) = o
-
-
--- | Negates the event.
-negateEvent :: (KnownNat s) => Event o s -> Event o s
-negateEvent (EventDecrement d o x) = EventIncrement d o x
-negateEvent (EventIncrement d o x) = EventDecrement d o x
-
-
--- | Smart constuctor for 'Event' values.
-mkEvent
- :: MonadError String m
- => KnownNat s
- => Day -- ^ Date of the event.
- -> o -- ^ Source object of the event.
- -> Quantity s -- ^ Quantity of the event.
- -> m (Event o s)
-mkEvent d o x
- | x < 0 = either (throwError . show) pure $ EventDecrement d o <$> refine (abs x)
- | otherwise = either (throwError . show) pure $ EventIncrement d o <$> refine (abs x)
diff --git a/src/Haspara/Accounting/Journal.hs b/src/Haspara/Accounting/Journal.hs
new file mode 100644
--- /dev/null
+++ b/src/Haspara/Accounting/Journal.hs
@@ -0,0 +1,127 @@
+-- | This module provides data definitions and functions to work with journal
+-- entries.
+
+{-# LANGUAGE DataKinds #-}
+
+module Haspara.Accounting.Journal where
+
+import qualified Data.Text as T
+import Data.Time (Day)
+import GHC.Generics (Generic)
+import GHC.TypeLits (KnownNat, Nat)
+import Haspara.Accounting.Account (Account(accountKind))
+import Haspara.Accounting.Amount (Amount(..), amountFromQuantity, amountFromValue)
+import Haspara.Accounting.Side (Side(..))
+import Haspara.Quantity (Quantity, UnsignedQuantity, sumUnsignedQuantity)
+
+
+-- | Data definition for the journal entries of interest (like a general
+-- ledger.)
+--
+-- A 'Journal' is a list of 'JournalEntry' records which are polymorphic over
+-- the precision of the monetary quantities, the account and event objects.
+newtype Journal (precision :: Nat) account event = Journal
+ { journalEntries :: [JournalEntry precision account event]
+ }
+ deriving (Show)
+
+
+-- | Data definition for a journal entry.
+--
+-- A journal entry has a (unique) identifier, date and description, and a list
+-- of 'JournalEntryItem's. Journal entry definition is polymorphic over the
+-- precision of the monetary quantities, the account and event objects.
+data JournalEntry (precision :: Nat) account event = JournalEntry
+ { journalEntryId :: !T.Text
+ , journalEntryDate :: !Day
+ , journalEntryItems :: ![JournalEntryItem precision account event]
+ , journalEntryDescription :: !T.Text
+ }
+ deriving (Show)
+
+
+-- | Returns the total debit amount of a journal entry.
+journalEntryTotalDebit
+ :: KnownNat precision
+ => JournalEntry precision account event
+ -> UnsignedQuantity precision
+journalEntryTotalDebit =
+ sumUnsignedQuantity
+ . fmap (amountValue . journalEntryItemAmount)
+ . filter ((==) SideDebit . amountSide . journalEntryItemAmount)
+ . journalEntryItems
+
+
+-- | Returns the total credit amount of a journal entry.
+journalEntryTotalCredit
+ :: KnownNat precision
+ => JournalEntry precision account event
+ -> UnsignedQuantity precision
+journalEntryTotalCredit =
+ sumUnsignedQuantity
+ . fmap (amountValue . journalEntryItemAmount)
+ . filter ((==) SideCredit . amountSide . journalEntryItemAmount)
+ . journalEntryItems
+
+
+-- | Predicate to check if a journal entry is balanced or not.
+--
+-- The logical check is indeed whether the total debit amount is equal to the
+-- total credit amount or not.
+isJournalEntryBalanced
+ :: KnownNat precision
+ => JournalEntry precision account event
+ -> Bool
+isJournalEntryBalanced = (==)
+ <$> journalEntryTotalDebit
+ <*> journalEntryTotalCredit
+
+
+-- | Data definition for a journal entry item.
+--
+-- A journal entry item has a 'Side', an unsigned quantity as amount, an account
+-- that it belongs to and the event the item is originating from. Journal entry
+-- item definition is polymorphic over the precision of the monetary quantities,
+-- the account and event objects.
+data JournalEntryItem (precision :: Nat) account event = JournalEntryItem
+ { journalEntryItemAmount :: !(Amount precision)
+ , journalEntryItemAccount :: !(Account account)
+ , journalEntryItemEvent :: !event
+ }
+ deriving (Eq, Generic, Show)
+
+
+-- | Creates a 'JournalEntryItem' from the given signed /quantity/, the account
+-- it belongs to and the event it is originating from.
+--
+-- The /quantity/ is defined as in 'amountFromQuantity' function.
+mkJournalEntryItemFromQuantity
+ :: KnownNat precision
+ => Quantity precision
+ -> Account account
+ -> event
+ -> JournalEntryItem precision account event
+mkJournalEntryItemFromQuantity qty acc evt =
+ JournalEntryItem
+ { journalEntryItemAmount = amountFromQuantity (accountKind acc) qty
+ , journalEntryItemAccount = acc
+ , journalEntryItemEvent = evt
+ }
+
+
+-- | Creates a 'JournalEntryItem' from the given signed /value/, the account it
+-- belongs to and the event it is originating from.
+--
+-- The /value/ is defined as in 'amountFromValue' function.
+mkJournalEntryItemFromValue
+ :: KnownNat precision
+ => Quantity precision
+ -> Account account
+ -> event
+ -> JournalEntryItem precision account event
+mkJournalEntryItemFromValue val acc evt =
+ JournalEntryItem
+ { journalEntryItemAmount = amountFromValue (accountKind acc) val
+ , journalEntryItemAccount = acc
+ , journalEntryItemEvent = evt
+ }
diff --git a/src/Haspara/Accounting/Ledger.hs b/src/Haspara/Accounting/Ledger.hs
--- a/src/Haspara/Accounting/Ledger.hs
+++ b/src/Haspara/Accounting/Ledger.hs
@@ -1,213 +1,207 @@
--- | This module provides definitions for postings, ledgers and ledger entries.
+-- | This module provides data definitions and functions for ledgers and
+-- postings.
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
module Haspara.Accounting.Ledger where
-import Data.Aeson ((.:), (.=))
import qualified Data.Aeson as Aeson
-import qualified Data.Char as C
-import qualified Data.List.NonEmpty as NE
+import qualified Data.Map.Strict as HM
+import Data.Maybe (fromMaybe, listToMaybe)
import qualified Data.Text as T
import Data.Time (Day)
import GHC.Generics (Generic)
import GHC.TypeLits (KnownNat, Nat)
-import Haspara.Accounting.Account (Account(accountKind), AccountKind(..))
-import Haspara.Accounting.Event (Event(..), eventObject)
+import Haspara.Accounting.Account (Account(accountKind))
+import Haspara.Accounting.Amount (Amount, amountFromQuantity, amountFromValue)
+import Haspara.Accounting.Balance (Balance(Balance), updateBalance)
+import Haspara.Accounting.Journal (JournalEntry(..), JournalEntryItem(JournalEntryItem))
+import Haspara.Accounting.Side (normalSideByAccountKind)
import Haspara.Internal.Aeson (commonAesonOptions)
-import Haspara.Quantity (Quantity, UnsignedQuantity)
-import Refined (unrefine)
+import Haspara.Quantity (Quantity)
--- | Type encoding of a ledger.
-data Ledger a o (s :: Nat) = Ledger
- { ledgerAccount :: !(Account a)
- , ledgerOpening :: !(Quantity s)
- , ledgerClosing :: !(Quantity s)
- , ledgerRunning :: ![LedgerItem o s]
+-- | Data definition for a general ledger.
+newtype GeneralLedger (precision :: Nat) account event = GeneralLedger
+ { generalLedgerLedgers :: [Ledger precision account event]
}
- deriving (Eq, Generic, Ord, Show)
+ deriving (Eq, Generic, Show)
-instance (Aeson.FromJSON a, Aeson.FromJSON o, KnownNat s) => Aeson.FromJSON (Ledger a o s) where
- parseJSON = Aeson.genericParseJSON $ commonAesonOptions "ledger"
+instance (KnownNat precision, Aeson.FromJSON account, Aeson.FromJSON event) => Aeson.FromJSON (GeneralLedger precision account event) where
+ parseJSON = Aeson.genericParseJSON $ commonAesonOptions "generalLedger"
-instance (Aeson.ToJSON a, Aeson.ToJSON o, KnownNat s) => Aeson.ToJSON (Ledger a o s) where
- toJSON = Aeson.genericToJSON $ commonAesonOptions "ledger"
+instance (KnownNat precision, Aeson.ToJSON account, Aeson.ToJSON event) => Aeson.ToJSON (GeneralLedger precision account event) where
+ toJSON = Aeson.genericToJSON $ commonAesonOptions "generalLedger"
--- | Type encoding of a ledger item.
-data LedgerItem o (s :: Nat) = LedgerItem
- { ledgerItemEntry :: !(Entry o s)
- , ledgerItemBalance :: !(Quantity s)
+-- | Data definition for a ledger.
+data Ledger (precision :: Nat) account event = Ledger
+ { ledgerAccount :: !(Account account)
+ , ledgerOpening :: !(Balance precision)
+ , ledgerRunning :: ![LedgerEntry precision event]
}
- deriving (Eq, Generic, Ord, Show)
+ deriving (Eq, Generic, Show)
-instance (Aeson.FromJSON o, KnownNat s) => Aeson.FromJSON (LedgerItem o s) where
- parseJSON = Aeson.genericParseJSON $ commonAesonOptions "ledgerItem"
+instance (KnownNat precision, Aeson.FromJSON account, Aeson.FromJSON event) => Aeson.FromJSON (Ledger precision account event) where
+ parseJSON = Aeson.genericParseJSON $ commonAesonOptions "ledger"
-instance (Aeson.ToJSON o, KnownNat s) => Aeson.ToJSON (LedgerItem o s) where
- toJSON = Aeson.genericToJSON $ commonAesonOptions "ledgerItem"
+instance (KnownNat precision, Aeson.ToJSON account, Aeson.ToJSON event) => Aeson.ToJSON (Ledger precision account event) where
+ -- TODO: Add ledgerClosing, too.
+ toJSON = Aeson.genericToJSON $ commonAesonOptions "ledger"
--- | Creates a ledger from a given list of 'Entry' values.
-mkLedger :: KnownNat s => Account a -> Quantity s -> [Entry o s] -> Ledger a o s
-mkLedger a o = foldl addEntry (Ledger a o o [])
+-- | Returns the closing balance of a ledger.
+ledgerClosing
+ :: KnownNat precision
+ => Ledger precision account event
+ -> Balance precision
+ledgerClosing ledger = maybe (ledgerOpening ledger) ledgerEntryBalance (listToMaybe (ledgerRunning ledger))
--- | Adds a new entry to a ledger.
-addEntry :: KnownNat s => Ledger a o s -> Entry o s -> Ledger a o s
-addEntry l@(Ledger _ _ c r) e = l { ledgerClosing = balance, ledgerRunning = r <> [item]}
- where
- balance = c + entryQuantity e
- item = LedgerItem e balance
+-- | Type encoding of a ledger item.
+data LedgerEntry (precision :: Nat) event = LedgerEntry
+ { ledgerEntryDate :: !Day
+ , ledgerEntryAmount :: !(Amount precision)
+ , ledgerEntryDescription :: !T.Text
+ , ledgerEntryEvent :: !event
+ , ledgerEntryPostingId :: !T.Text
+ , ledgerEntryBalance :: !(Balance precision)
+ }
+ deriving (Eq, Generic, Show)
--- | Type encoding for a posting.
---
--- >>> :set -XDataKinds
--- >>> import Haspara.Accounting
--- >>> import Refined
--- >>> import qualified Data.Aeson as Aeson
--- >>> import qualified Data.List.NonEmpty as NE
--- >>> let date = read "2021-01-01"
--- >>> let oid = 1 :: Int
--- >>> let qty = $$(refineTH 42) :: UnsignedQuantity 2
--- >>> let event = EventDecrement date oid qty
--- >>> let account = Account AccountKindAsset ("Cash" :: String, 1 ::Int)
--- >>> let posting = Posting . NE.fromList $ [(event, account)]
--- >>> let json = Aeson.encode posting
--- >>> json
--- "[[{\"qty\":42.0,\"type\":\"DECREMENT\",\"obj\":1,\"date\":\"2021-01-01\"},{\"kind\":\"ASSET\",\"object\":[\"Cash\",1]}]]"
--- >>> Aeson.decode json :: Maybe (Posting (String, Int) Int 2)
--- Just (Posting ((EventDecrement 2021-01-01 1 (Refined 42.00),Account {accountKind = AccountKindAsset, accountObject = ("Cash",1)}) :| []))
--- >>> Aeson.decode json == Just posting
--- True
-newtype Posting a o (s :: Nat) = Posting (NE.NonEmpty (Event o s, Account a))
- deriving (Eq, Generic, Ord, Show)
+instance (KnownNat precision, Aeson.FromJSON event) => Aeson.FromJSON (LedgerEntry precision event) where
+ parseJSON = Aeson.genericParseJSON $ commonAesonOptions "ledgerEntry"
-instance (Aeson.FromJSON a, Aeson.FromJSON o, KnownNat s) => Aeson.FromJSON (Posting a o s) where
- parseJSON = Aeson.genericParseJSON Aeson.defaultOptions
+instance (KnownNat precision, Aeson.ToJSON event) => Aeson.ToJSON (LedgerEntry precision event) where
+ toJSON = Aeson.genericToJSON $ commonAesonOptions "ledgerEntry"
-instance (Aeson.ToJSON a, Aeson.ToJSON o, KnownNat s) => Aeson.ToJSON (Posting a o s) where
- toJSON = Aeson.genericToJSON Aeson.defaultOptions
+-- | Initializes an empty ledger for a given account.
+initLedger
+ :: KnownNat precision
+ => Account account
+ -> Ledger precision account event
+initLedger acc = Ledger acc balance []
+ where
+ balance = Balance (normalSideByAccountKind (accountKind acc)) 0
--- | Returns the list of posting event sources.
-postingEvents :: (KnownNat s) => Posting a o s -> [o]
-postingEvents (Posting es) = eventObject . fst <$> NE.toList es
+-- | Initializes a ledger with the given opening balance.
+initLedgerWithOpeningBalance
+ :: KnownNat precision
+ => Account account
+ -> Balance precision
+ -> Ledger precision account event
+initLedgerWithOpeningBalance acc balance = Ledger acc balance []
--- | Posts an event.
-post :: (KnownNat s) => Posting a o s -> [(Account a, Entry o s)]
-post (Posting xs) = go (NE.toList xs)
+-- | Initializes a ledger with the given opening value.
+--
+-- See 'amountFromValue' for the meaning of the concept of value.
+initLedgerWithOpeningValue
+ :: KnownNat precision
+ => Account account
+ -> Quantity precision
+ -> Ledger precision account event
+initLedgerWithOpeningValue acc qty = initLedgerWithOpeningBalance acc balance
where
- go [] = []
- go ((ev, ac) : ys) = (ac, buildEntry ev (accountKind ac)) : go ys
+ amount = amountFromValue (accountKind acc) qty
+ balance0 = Balance (normalSideByAccountKind (accountKind acc)) 0
+ balance = updateBalance balance0 amount
--- | Encoding of a posting entry.
+-- | Initializes a ledger with the given opening quantity.
--
--- >>> :set -XDataKinds
--- >>> import Refined
--- >>> let date = read "2021-01-01"
--- >>> let oid = 1 :: Int
--- >>> let qty = $$(refineTH 42) :: UnsignedQuantity 2
--- >>> let entry = EntryDebit date oid qty
--- >>> let json = Aeson.encode entry
--- >>> json
--- "{\"qty\":42.0,\"type\":\"DEBIT\",\"obj\":1,\"date\":\"2021-01-01\"}"
--- >>> Aeson.decode json :: Maybe (Entry Int 2)
--- Just (EntryDebit 2021-01-01 1 (Refined 42.00))
--- >>> Aeson.decode json == Just entry
--- True
-data Entry o (s :: Nat) =
- EntryDebit Day o (UnsignedQuantity s)
- | EntryCredit Day o (UnsignedQuantity s)
- deriving (Eq, Ord, Show)
-
-
-instance (Aeson.FromJSON o, KnownNat s) => Aeson.FromJSON (Entry o s) where
- parseJSON = Aeson.withObject "Entry" $ \o -> do
- dorc <- o .: "type"
- cons <- case T.map C.toUpper dorc of
- "DEBIT" -> pure EntryDebit
- "CREDIT" -> pure EntryCredit
- x -> fail ("Unknown entry type: " <> T.unpack x)
- date <- o .: "date"
- obj <- o .: "obj"
- qty <- o .: "qty"
- pure (cons date obj qty)
-
-
-instance (Aeson.ToJSON o, KnownNat s) => Aeson.ToJSON (Entry o s) where
- toJSON x = case x of
- EntryDebit d o q -> Aeson.object ["type" .= ("DEBIT" :: T.Text), "date" .= d, "obj" .= o, "qty" .= q]
- EntryCredit d o q -> Aeson.object ["type" .= ("CREDIT" :: T.Text), "date" .= d, "obj" .= o, "qty" .= q]
-
-
--- | Returns the date of the posting entry.
-entryDate :: KnownNat s => Entry o s -> Day
-entryDate (EntryDebit d _ _) = d
-entryDate (EntryCredit d _ _) = d
-
-
--- | Returns the quantity of the posting entry.
-entryQuantity :: KnownNat s => Entry o s -> Quantity s
-entryQuantity (EntryDebit _ _ q) = unrefine q
-entryQuantity (EntryCredit _ _ q) = -(unrefine q)
+-- See 'amountFromQuantity' for the meaning of the concept of quantity.
+initLedgerWithOpeningQuantity
+ :: KnownNat precision
+ => Account account
+ -> Quantity precision
+ -> Ledger precision account event
+initLedgerWithOpeningQuantity acc qty = initLedgerWithOpeningBalance acc balance
+ where
+ amount = amountFromQuantity (accountKind acc) qty
+ balance0 = Balance (normalSideByAccountKind (accountKind acc)) 0
+ balance = updateBalance balance0 amount
--- | Returns the source object of the posting entry.
-entryObject :: KnownNat s => Entry o s -> o
-entryObject (EntryDebit _ o _) = o
-entryObject (EntryCredit _ o _) = o
+-- | Posts a given list of journal entries to the given general ledger and
+-- returns the new general ledger.
+postEntries
+ :: KnownNat precision
+ => Eq account
+ => Ord account
+ => GeneralLedger precision account event
+ -> [JournalEntry precision account event]
+ -> GeneralLedger precision account event
+postEntries = foldl postEntry
--- | Returns the debit quantity of the posting entry.
-entryDebit :: KnownNat s => Entry o s -> Maybe (UnsignedQuantity s)
-entryDebit (EntryDebit _ _ x) = Just x
-entryDebit EntryCredit {} = Nothing
+-- | Posts a given journal entry to the given general ledger and returns the new
+-- general ledger.
+postEntry
+ :: KnownNat precision
+ => Eq account
+ => Ord account
+ => GeneralLedger precision account event
+ -> JournalEntry precision account event
+ -> GeneralLedger precision account event
+postEntry gl je = foldl (`postEntryItem` je) gl (journalEntryItems je)
--- | Returns the credit quantity of the posting entry.
-entryCredit :: KnownNat s => Entry o s -> Maybe (UnsignedQuantity s)
-entryCredit EntryDebit {} = Nothing
-entryCredit (EntryCredit _ _ x) = Just x
+-- | Posts a given journal entry item of a given journal entry to the given
+-- general ledger and returns the new general ledger.
+postEntryItem
+ :: KnownNat precision
+ => Eq account
+ => Ord account
+ => GeneralLedger precision account event
+ -> JournalEntry precision account event
+ -> JournalEntryItem precision account event
+ -> GeneralLedger precision account event
+postEntryItem gl je (JournalEntryItem amt acc evt) =
+ let
+ ledgers = generalLedgerLedgers gl
+ ledgersDb = HM.fromList $ zip (fmap ledgerAccount ledgers) ledgers
+ ledgerCurr = fromMaybe (initLedger acc) $ HM.lookup acc ledgersDb
+ ledgerNext = postItem ledgerCurr (journalEntryDate je) amt (journalEntryDescription je) evt (journalEntryId je)
+ ledgersDbNext = HM.insert acc ledgerNext ledgersDb
+ in
+ GeneralLedger
+ { generalLedgerLedgers = HM.elems ledgersDbNext
+ }
--- | Consumes an event and a type of account, and produces a posting entry.
---
--- Note the following map 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 |
--- +-----------------------+----------+----------+
---
-buildEntry :: (KnownNat s) => Event o s -> AccountKind -> Entry o s
-buildEntry (EventDecrement d o x) AccountKindAsset = EntryCredit d o x
-buildEntry (EventIncrement d o x) AccountKindAsset = EntryDebit d o x
-buildEntry (EventDecrement d o x) AccountKindLiability = EntryDebit d o x
-buildEntry (EventIncrement d o x) AccountKindLiability = EntryCredit d o x
-buildEntry (EventDecrement d o x) AccountKindEquity = EntryDebit d o x
-buildEntry (EventIncrement d o x) AccountKindEquity = EntryCredit d o x
-buildEntry (EventDecrement d o x) AccountKindRevenue = EntryDebit d o x
-buildEntry (EventIncrement d o x) AccountKindRevenue = EntryCredit d o x
-buildEntry (EventDecrement d o x) AccountKindExpense = EntryCredit d o x
-buildEntry (EventIncrement d o x) AccountKindExpense = EntryDebit d o x
+-- | Performs a posting to the given ledger.
+postItem
+ :: KnownNat precision
+ => Ledger precision account event
+ -> Day
+ -> Amount precision
+ -> T.Text
+ -> event
+ -> T.Text
+ -> Ledger precision account event
+postItem ledger date amt dsc evt pid =
+ let
+ balanceLast = ledgerClosing ledger
+ balanceNext = updateBalance balanceLast amt
+ item = LedgerEntry
+ { ledgerEntryDate = date
+ , ledgerEntryAmount = amt
+ , ledgerEntryDescription = dsc
+ , ledgerEntryEvent = evt
+ , ledgerEntryPostingId = pid
+ , ledgerEntryBalance = balanceNext
+ }
+ in
+ ledger
+ { ledgerRunning = item : ledgerRunning ledger
+ }
diff --git a/src/Haspara/Accounting/Side.hs b/src/Haspara/Accounting/Side.hs
new file mode 100644
--- /dev/null
+++ b/src/Haspara/Accounting/Side.hs
@@ -0,0 +1,149 @@
+-- | 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 (Eq, Ord, 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 = Aeson.withText "Side" $ \t -> case t of
+ "db" -> pure SideDebit
+ "cr" -> pure SideCredit
+ _ -> fail $ "Unkown side indicator: \"" <> T.unpack t <> "\". 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 SideDebit = Aeson.String "db"
+ toJSON SideCredit = Aeson.String "cr"
+
+
+-- | Gives the other side.
+--
+-- >>> otherSide SideDebit
+-- SideCredit
+-- >>> otherSide SideCredit
+-- SideDebit
+otherSide :: Side -> Side
+otherSide SideDebit = SideCredit
+otherSide SideCredit = 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 k q = case (k, signum q >= 0) of
+ (AccountKindAsset, False) -> SideCredit
+ (AccountKindAsset, True) -> SideDebit
+ (AccountKindLiability, False) -> SideDebit
+ (AccountKindLiability, True) -> SideCredit
+ (AccountKindEquity, False) -> SideDebit
+ (AccountKindEquity, True) -> SideCredit
+ (AccountKindRevenue, False) -> SideDebit
+ (AccountKindRevenue, True) -> SideCredit
+ (AccountKindExpense, False) -> SideCredit
+ (AccountKindExpense, True) -> 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 AccountKindAsset = SideDebit
+normalSideByAccountKind AccountKindLiability = SideCredit
+normalSideByAccountKind AccountKindEquity = SideCredit
+normalSideByAccountKind AccountKindRevenue = SideCredit
+normalSideByAccountKind AccountKindExpense = SideDebit
diff --git a/src/Haspara/Accounting/TrialBalance.hs b/src/Haspara/Accounting/TrialBalance.hs
new file mode 100644
--- /dev/null
+++ b/src/Haspara/Accounting/TrialBalance.hs
@@ -0,0 +1,87 @@
+-- | This module provides data definitions and functions for trial balances.
+
+{-# LANGUAGE DataKinds #-}
+
+module Haspara.Accounting.TrialBalance where
+
+import qualified Data.Aeson as Aeson
+import GHC.Generics (Generic)
+import GHC.TypeLits (KnownNat, Nat)
+import Haspara.Accounting.Amount (Amount)
+import Haspara.Accounting.Balance (Balance(Balance, balanceSide), amountFromBalance, updateBalance)
+import Haspara.Accounting.Ledger (GeneralLedger(generalLedgerLedgers), Ledger, ledgerClosing)
+import Haspara.Accounting.Side (Side(..))
+import Haspara.Internal.Aeson (commonAesonOptions)
+
+
+-- | Data definition for a trial balance.
+newtype TrialBalance (precision :: Nat) account event = TrialBalance
+ { trialBalanceItems :: [TrialBalanceItem precision account event]
+ }
+ deriving (Eq, Generic, Show)
+
+
+instance (KnownNat precision, Aeson.FromJSON account, Aeson.FromJSON event) => Aeson.FromJSON (TrialBalance precision account event) where
+ parseJSON = Aeson.genericParseJSON $ commonAesonOptions "trialBalance"
+
+
+instance (KnownNat precision, Aeson.ToJSON account, Aeson.ToJSON event) => Aeson.ToJSON (TrialBalance precision account event) where
+ toJSON = Aeson.genericToJSON $ commonAesonOptions "trialBalance"
+
+
+-- | Data definition for a trial balance item.
+data TrialBalanceItem (precision :: Nat) account event = TrialBalanceItem
+ { trialBalanceItemLedger :: !(Ledger precision account event)
+ , trialBalanceItemBalance :: !(Balance precision)
+ }
+ deriving (Eq, Generic, Show)
+
+
+instance (KnownNat precision, Aeson.FromJSON account, Aeson.FromJSON event) => Aeson.FromJSON (TrialBalanceItem precision account event) where
+ parseJSON = Aeson.genericParseJSON $ commonAesonOptions "trialBalanceItem"
+
+
+instance (KnownNat precision, Aeson.ToJSON account, Aeson.ToJSON event) => Aeson.ToJSON (TrialBalanceItem precision account event) where
+ toJSON = Aeson.genericToJSON $ commonAesonOptions "trialBalanceItem"
+
+
+-- | Returns the amount of the trial balance item. This is a simple conversion
+-- from 'Balance' to 'Amount'.
+trialBalanceItemAmount
+ :: KnownNat precision
+ => TrialBalanceItem precision account event
+ -> Amount precision
+trialBalanceItemAmount = amountFromBalance . trialBalanceItemBalance
+
+
+-- | Given a general ledger, prepares the trial balance.
+prepareTrialBalance
+ :: KnownNat precision
+ => GeneralLedger precision account event
+ -> TrialBalance precision account event
+prepareTrialBalance = TrialBalance . fmap mkTrialBalanceItem . generalLedgerLedgers
+
+
+-- | Converts a 'Ledger' to a 'TrialBalanceItem'.
+mkTrialBalanceItem
+ :: KnownNat precision
+ => Ledger precision account event
+ -> TrialBalanceItem precision account event
+mkTrialBalanceItem ledger =
+ TrialBalanceItem ledger (ledgerClosing ledger)
+
+
+-- | Computes the trial balance totals as a 2-tuple of total debits and total
+-- credits.
+trialBalanceTotals
+ :: KnownNat precision
+ => TrialBalance precision account event
+ -> (Balance precision, Balance precision)
+trialBalanceTotals (TrialBalance items) =
+ let
+ itemsFromDb = amountFromBalance . trialBalanceItemBalance <$> filter ((==) SideDebit . balanceSide . trialBalanceItemBalance) items
+ itemsFromCr = amountFromBalance . trialBalanceItemBalance <$> filter ((==) SideCredit . balanceSide . trialBalanceItemBalance) items
+ totalDb = foldl updateBalance (Balance SideDebit 0) itemsFromDb
+ totalCr = foldl updateBalance (Balance SideCredit 0) itemsFromCr
+ in
+ (totalDb, totalCr)
diff --git a/src/Haspara/Quantity.hs b/src/Haspara/Quantity.hs
--- a/src/Haspara/Quantity.hs
+++ b/src/Haspara/Quantity.hs
@@ -17,7 +17,8 @@
import GHC.TypeLits (KnownNat, Nat, natVal, type (+))
import qualified Language.Haskell.TH.Syntax as TH
import qualified Numeric.Decimal as D
-import Refined (NonNegative, Refined)
+import Refined (NonNegative, Refined, unrefine)
+import Refined.Unsafe (unsafeRefine)
-- * Data Definition
@@ -293,6 +294,32 @@
-- 0.1764
timesLossless :: (KnownNat s, KnownNat k) => Quantity s -> Quantity k -> Quantity (s + k)
timesLossless (MkQuantity d1) (MkQuantity d2) = MkQuantity (D.timesDecimal d1 d2)
+
+
+-- | Returns the total of a list of unsigned quantities.
+--
+-- >>> sumUnsignedQuantity [] :: UnsignedQuantity 2
+-- Refined 0.00
+sumUnsignedQuantity
+ :: KnownNat s
+ => [UnsignedQuantity s]
+ -> UnsignedQuantity s
+sumUnsignedQuantity = unsafeRefine . sum . fmap unrefine
+
+
+-- | Returns the absolute value of the 'Quantity' as 'UnsignedQuantity'.
+--
+-- >>> abs (mkQuantity 0.42 :: Quantity 2)
+-- 0.42
+-- >>> abs (mkQuantity 0 :: Quantity 2)
+-- 0.00
+-- >>> abs (mkQuantity (-0.42) :: Quantity 2)
+-- 0.42
+absQuantity
+ :: KnownNat s
+ => Quantity s
+ -> UnsignedQuantity s
+absQuantity = unsafeRefine . abs
-- * Internal