haspara 0.0.0.3 → 0.0.0.4

raw patch · 12 files changed

+1012/−297 lines, 12 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +29/−1
• haspara.cabal +6/−2
• src/Haspara/Accounting.hs +13/−40
• src/Haspara/Accounting/Account.hs +1/−1
• src/Haspara/Accounting/Amount.hs +255/−0
• src/Haspara/Accounting/Balance.hs +162/−0
• src/Haspara/Accounting/Event.hs +0/−91
• src/Haspara/Accounting/Journal.hs +127/−0
• src/Haspara/Accounting/Ledger.hs +155/−161
• src/Haspara/Accounting/Side.hs +149/−0
• src/Haspara/Accounting/TrialBalance.hs +87/−0
• src/Haspara/Quantity.hs +28/−1

@@ -2,6 +2,32 @@ ## [Unreleased]  +<a name="0.0.0.4"></a>+## [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++ <a name="0.0.0.3"></a> ## [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

@@ -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 <https://github.com/telostat/haspara#readme> 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

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

@@ -57,7 +57,7 @@   | AccountKindEquity   | AccountKindRevenue   | AccountKindExpense-  deriving (Enum, Eq, Generic, Ord, Show)+  deriving (Bounded, Enum, Eq, Generic, Ord, Show)   instance Hashable AccountKind

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

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

@@ -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)

@@ -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+    }

@@ -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+      }

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

@@ -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)

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