{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | This module provides data definitions and functions for ledgers and
-- postings.
module Haspara.Accounting.Ledger where

import qualified Data.Aeson as Aeson
import Data.Default (def)
import Data.Foldable (foldl')
import qualified Data.Map.Strict as HM
import Data.Maybe (fromMaybe, listToMaybe, maybeToList)
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.Balance (Balance (Balance), updateBalance, updateBalanceWithInventory)
import Haspara.Accounting.Inventory (InventoryHistoryItem (MkInventoryHistoryItem, inventoryHistoryItemPnl), updateInventoryVV)
import Haspara.Accounting.Journal (JournalEntry (..), JournalEntryItem (..), JournalEntryItemInventoryEvent (JournalEntryItemInventoryEvent))
import Haspara.Accounting.Side (normalSideByAccountKind)
import Haspara.Internal.Aeson (commonAesonOptions)
import Haspara.Quantity (Quantity)


-- | Data definition for a general ledger.
newtype GeneralLedger (precision :: Nat) account event = GeneralLedger
  { forall (precision :: Nat) account event.
GeneralLedger precision account event
-> [Ledger precision account event]
generalLedgerLedgers :: [Ledger precision account event]
  }
  deriving (GeneralLedger precision account event
-> GeneralLedger precision account event -> Bool
(GeneralLedger precision account event
 -> GeneralLedger precision account event -> Bool)
-> (GeneralLedger precision account event
    -> GeneralLedger precision account event -> Bool)
-> Eq (GeneralLedger precision account event)
forall (precision :: Nat) account event.
(Eq account, Eq event) =>
GeneralLedger precision account event
-> GeneralLedger precision account event -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (precision :: Nat) account event.
(Eq account, Eq event) =>
GeneralLedger precision account event
-> GeneralLedger precision account event -> Bool
== :: GeneralLedger precision account event
-> GeneralLedger precision account event -> Bool
$c/= :: forall (precision :: Nat) account event.
(Eq account, Eq event) =>
GeneralLedger precision account event
-> GeneralLedger precision account event -> Bool
/= :: GeneralLedger precision account event
-> GeneralLedger precision account event -> Bool
Eq, (forall x.
 GeneralLedger precision account event
 -> Rep (GeneralLedger precision account event) x)
-> (forall x.
    Rep (GeneralLedger precision account event) x
    -> GeneralLedger precision account event)
-> Generic (GeneralLedger precision account event)
forall (precision :: Nat) account event x.
Rep (GeneralLedger precision account event) x
-> GeneralLedger precision account event
forall (precision :: Nat) account event x.
GeneralLedger precision account event
-> Rep (GeneralLedger precision account event) x
forall x.
Rep (GeneralLedger precision account event) x
-> GeneralLedger precision account event
forall x.
GeneralLedger precision account event
-> Rep (GeneralLedger precision account event) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (precision :: Nat) account event x.
GeneralLedger precision account event
-> Rep (GeneralLedger precision account event) x
from :: forall x.
GeneralLedger precision account event
-> Rep (GeneralLedger precision account event) x
$cto :: forall (precision :: Nat) account event x.
Rep (GeneralLedger precision account event) x
-> GeneralLedger precision account event
to :: forall x.
Rep (GeneralLedger precision account event) x
-> GeneralLedger precision account event
Generic, Int -> GeneralLedger precision account event -> ShowS
[GeneralLedger precision account event] -> ShowS
GeneralLedger precision account event -> String
(Int -> GeneralLedger precision account event -> ShowS)
-> (GeneralLedger precision account event -> String)
-> ([GeneralLedger precision account event] -> ShowS)
-> Show (GeneralLedger precision account event)
forall (precision :: Nat) account event.
(KnownNat precision, Show account, Show event) =>
Int -> GeneralLedger precision account event -> ShowS
forall (precision :: Nat) account event.
(KnownNat precision, Show account, Show event) =>
[GeneralLedger precision account event] -> ShowS
forall (precision :: Nat) account event.
(KnownNat precision, Show account, Show event) =>
GeneralLedger precision account event -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (precision :: Nat) account event.
(KnownNat precision, Show account, Show event) =>
Int -> GeneralLedger precision account event -> ShowS
showsPrec :: Int -> GeneralLedger precision account event -> ShowS
$cshow :: forall (precision :: Nat) account event.
(KnownNat precision, Show account, Show event) =>
GeneralLedger precision account event -> String
show :: GeneralLedger precision account event -> String
$cshowList :: forall (precision :: Nat) account event.
(KnownNat precision, Show account, Show event) =>
[GeneralLedger precision account event] -> ShowS
showList :: [GeneralLedger precision account event] -> ShowS
Show)


instance (KnownNat precision, Aeson.FromJSON account, Aeson.FromJSON event) => Aeson.FromJSON (GeneralLedger precision account event) where
  parseJSON :: Value -> Parser (GeneralLedger precision account event)
parseJSON = Options -> Value -> Parser (GeneralLedger precision account event)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON (Options
 -> Value -> Parser (GeneralLedger precision account event))
-> Options
-> Value
-> Parser (GeneralLedger precision account event)
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"generalLedger"


instance (KnownNat precision, Aeson.ToJSON account, Aeson.ToJSON event) => Aeson.ToJSON (GeneralLedger precision account event) where
  toJSON :: GeneralLedger precision account event -> Value
toJSON = Options -> GeneralLedger precision account event -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON (Options -> GeneralLedger precision account event -> Value)
-> Options -> GeneralLedger precision account event -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"generalLedger"
  toEncoding :: GeneralLedger precision account event -> Encoding
toEncoding = Options -> GeneralLedger precision account event -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding (Options -> GeneralLedger precision account event -> Encoding)
-> Options -> GeneralLedger precision account event -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"generalLedger"


-- | Data definition for a ledger.
data Ledger (precision :: Nat) account event = Ledger
  { forall (precision :: Nat) account event.
Ledger precision account event -> Account account
ledgerAccount :: !(Account account)
  , forall (precision :: Nat) account event.
Ledger precision account event -> Balance precision
ledgerOpening :: !(Balance precision)
  , forall (precision :: Nat) account event.
Ledger precision account event -> [LedgerEntry precision event]
ledgerRunning :: ![LedgerEntry precision event]
  }
  deriving (Ledger precision account event
-> Ledger precision account event -> Bool
(Ledger precision account event
 -> Ledger precision account event -> Bool)
-> (Ledger precision account event
    -> Ledger precision account event -> Bool)
-> Eq (Ledger precision account event)
forall (precision :: Nat) account event.
(Eq account, Eq event) =>
Ledger precision account event
-> Ledger precision account event -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (precision :: Nat) account event.
(Eq account, Eq event) =>
Ledger precision account event
-> Ledger precision account event -> Bool
== :: Ledger precision account event
-> Ledger precision account event -> Bool
$c/= :: forall (precision :: Nat) account event.
(Eq account, Eq event) =>
Ledger precision account event
-> Ledger precision account event -> Bool
/= :: Ledger precision account event
-> Ledger precision account event -> Bool
Eq, (forall x.
 Ledger precision account event
 -> Rep (Ledger precision account event) x)
-> (forall x.
    Rep (Ledger precision account event) x
    -> Ledger precision account event)
-> Generic (Ledger precision account event)
forall (precision :: Nat) account event x.
Rep (Ledger precision account event) x
-> Ledger precision account event
forall (precision :: Nat) account event x.
Ledger precision account event
-> Rep (Ledger precision account event) x
forall x.
Rep (Ledger precision account event) x
-> Ledger precision account event
forall x.
Ledger precision account event
-> Rep (Ledger precision account event) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (precision :: Nat) account event x.
Ledger precision account event
-> Rep (Ledger precision account event) x
from :: forall x.
Ledger precision account event
-> Rep (Ledger precision account event) x
$cto :: forall (precision :: Nat) account event x.
Rep (Ledger precision account event) x
-> Ledger precision account event
to :: forall x.
Rep (Ledger precision account event) x
-> Ledger precision account event
Generic, Int -> Ledger precision account event -> ShowS
[Ledger precision account event] -> ShowS
Ledger precision account event -> String
(Int -> Ledger precision account event -> ShowS)
-> (Ledger precision account event -> String)
-> ([Ledger precision account event] -> ShowS)
-> Show (Ledger precision account event)
forall (precision :: Nat) account event.
(KnownNat precision, Show account, Show event) =>
Int -> Ledger precision account event -> ShowS
forall (precision :: Nat) account event.
(KnownNat precision, Show account, Show event) =>
[Ledger precision account event] -> ShowS
forall (precision :: Nat) account event.
(KnownNat precision, Show account, Show event) =>
Ledger precision account event -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (precision :: Nat) account event.
(KnownNat precision, Show account, Show event) =>
Int -> Ledger precision account event -> ShowS
showsPrec :: Int -> Ledger precision account event -> ShowS
$cshow :: forall (precision :: Nat) account event.
(KnownNat precision, Show account, Show event) =>
Ledger precision account event -> String
show :: Ledger precision account event -> String
$cshowList :: forall (precision :: Nat) account event.
(KnownNat precision, Show account, Show event) =>
[Ledger precision account event] -> ShowS
showList :: [Ledger precision account event] -> ShowS
Show)


instance (KnownNat precision, Aeson.FromJSON account, Aeson.FromJSON event) => Aeson.FromJSON (Ledger precision account event) where
  parseJSON :: Value -> Parser (Ledger precision account event)
parseJSON = Options -> Value -> Parser (Ledger precision account event)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON (Options -> Value -> Parser (Ledger precision account event))
-> Options -> Value -> Parser (Ledger precision account event)
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"ledger"


instance (KnownNat precision, Aeson.ToJSON account, Aeson.ToJSON event) => Aeson.ToJSON (Ledger precision account event) where
  -- TODO: Add ledgerClosing, too.
  toJSON :: Ledger precision account event -> Value
toJSON = Options -> Ledger precision account event -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON (Options -> Ledger precision account event -> Value)
-> Options -> Ledger precision account event -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"ledger"
  toEncoding :: Ledger precision account event -> Encoding
toEncoding = Options -> Ledger precision account event -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding (Options -> Ledger precision account event -> Encoding)
-> Options -> Ledger precision account event -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"ledger"


-- | Returns the closing balance of a ledger.
ledgerClosing
  :: KnownNat precision
  => Ledger precision account event
  -> Balance precision
ledgerClosing :: forall (precision :: Nat) account event.
KnownNat precision =>
Ledger precision account event -> Balance precision
ledgerClosing Ledger precision account event
ledger = Balance precision
-> (LedgerEntry precision event -> Balance precision)
-> Maybe (LedgerEntry precision event)
-> Balance precision
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Ledger precision account event -> Balance precision
forall (precision :: Nat) account event.
Ledger precision account event -> Balance precision
ledgerOpening Ledger precision account event
ledger) LedgerEntry precision event -> Balance precision
forall (precision :: Nat) event.
LedgerEntry precision event -> Balance precision
ledgerEntryBalance ([LedgerEntry precision event]
-> Maybe (LedgerEntry precision event)
forall a. [a] -> Maybe a
listToMaybe (Ledger precision account event -> [LedgerEntry precision event]
forall (precision :: Nat) account event.
Ledger precision account event -> [LedgerEntry precision event]
ledgerRunning Ledger precision account event
ledger))


-- | Type encoding of a ledger item.
data LedgerEntry (precision :: Nat) event = LedgerEntry
  { forall (precision :: Nat) event. LedgerEntry precision event -> Day
ledgerEntryDate :: !Day
  , forall (precision :: Nat) event.
LedgerEntry precision event -> Amount precision
ledgerEntryAmount :: !(Amount precision)
  , forall (precision :: Nat) event.
LedgerEntry precision event -> Text
ledgerEntryDescription :: !T.Text
  , forall (precision :: Nat) event.
LedgerEntry precision event -> event
ledgerEntryEvent :: !event
  , forall (precision :: Nat) event.
LedgerEntry precision event -> Text
ledgerEntryPostingId :: !T.Text
  , forall (precision :: Nat) event.
LedgerEntry precision event -> Balance precision
ledgerEntryBalance :: !(Balance precision)
  }
  deriving (LedgerEntry precision event -> LedgerEntry precision event -> Bool
(LedgerEntry precision event
 -> LedgerEntry precision event -> Bool)
-> (LedgerEntry precision event
    -> LedgerEntry precision event -> Bool)
-> Eq (LedgerEntry precision event)
forall (precision :: Nat) event.
Eq event =>
LedgerEntry precision event -> LedgerEntry precision event -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (precision :: Nat) event.
Eq event =>
LedgerEntry precision event -> LedgerEntry precision event -> Bool
== :: LedgerEntry precision event -> LedgerEntry precision event -> Bool
$c/= :: forall (precision :: Nat) event.
Eq event =>
LedgerEntry precision event -> LedgerEntry precision event -> Bool
/= :: LedgerEntry precision event -> LedgerEntry precision event -> Bool
Eq, (forall x.
 LedgerEntry precision event -> Rep (LedgerEntry precision event) x)
-> (forall x.
    Rep (LedgerEntry precision event) x -> LedgerEntry precision event)
-> Generic (LedgerEntry precision event)
forall (precision :: Nat) event x.
Rep (LedgerEntry precision event) x -> LedgerEntry precision event
forall (precision :: Nat) event x.
LedgerEntry precision event -> Rep (LedgerEntry precision event) x
forall x.
Rep (LedgerEntry precision event) x -> LedgerEntry precision event
forall x.
LedgerEntry precision event -> Rep (LedgerEntry precision event) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (precision :: Nat) event x.
LedgerEntry precision event -> Rep (LedgerEntry precision event) x
from :: forall x.
LedgerEntry precision event -> Rep (LedgerEntry precision event) x
$cto :: forall (precision :: Nat) event x.
Rep (LedgerEntry precision event) x -> LedgerEntry precision event
to :: forall x.
Rep (LedgerEntry precision event) x -> LedgerEntry precision event
Generic, Int -> LedgerEntry precision event -> ShowS
[LedgerEntry precision event] -> ShowS
LedgerEntry precision event -> String
(Int -> LedgerEntry precision event -> ShowS)
-> (LedgerEntry precision event -> String)
-> ([LedgerEntry precision event] -> ShowS)
-> Show (LedgerEntry precision event)
forall (precision :: Nat) event.
(KnownNat precision, Show event) =>
Int -> LedgerEntry precision event -> ShowS
forall (precision :: Nat) event.
(KnownNat precision, Show event) =>
[LedgerEntry precision event] -> ShowS
forall (precision :: Nat) event.
(KnownNat precision, Show event) =>
LedgerEntry precision event -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (precision :: Nat) event.
(KnownNat precision, Show event) =>
Int -> LedgerEntry precision event -> ShowS
showsPrec :: Int -> LedgerEntry precision event -> ShowS
$cshow :: forall (precision :: Nat) event.
(KnownNat precision, Show event) =>
LedgerEntry precision event -> String
show :: LedgerEntry precision event -> String
$cshowList :: forall (precision :: Nat) event.
(KnownNat precision, Show event) =>
[LedgerEntry precision event] -> ShowS
showList :: [LedgerEntry precision event] -> ShowS
Show)


instance (KnownNat precision, Aeson.FromJSON event) => Aeson.FromJSON (LedgerEntry precision event) where
  parseJSON :: Value -> Parser (LedgerEntry precision event)
parseJSON = Options -> Value -> Parser (LedgerEntry precision event)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON (Options -> Value -> Parser (LedgerEntry precision event))
-> Options -> Value -> Parser (LedgerEntry precision event)
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"ledgerEntry"


instance (KnownNat precision, Aeson.ToJSON event) => Aeson.ToJSON (LedgerEntry precision event) where
  toJSON :: LedgerEntry precision event -> Value
toJSON = Options -> LedgerEntry precision event -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON (Options -> LedgerEntry precision event -> Value)
-> Options -> LedgerEntry precision event -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"ledgerEntry"
  toEncoding :: LedgerEntry precision event -> Encoding
toEncoding = Options -> LedgerEntry precision event -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding (Options -> LedgerEntry precision event -> Encoding)
-> Options -> LedgerEntry precision event -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"ledgerEntry"


-- | Initializes an empty ledger for a given account.
initLedger
  :: KnownNat precision
  => Account account
  -> Ledger precision account event
initLedger :: forall (precision :: Nat) account event.
KnownNat precision =>
Account account -> Ledger precision account event
initLedger Account account
acc = Account account
-> Balance precision
-> [LedgerEntry precision event]
-> Ledger precision account event
forall (precision :: Nat) account event.
Account account
-> Balance precision
-> [LedgerEntry precision event]
-> Ledger precision account event
Ledger Account account
acc Balance precision
balance []
  where
    balance :: Balance precision
balance = Side
-> Quantity precision
-> Inventory 8 12 precision
-> Balance precision
forall (precision :: Nat).
Side
-> Quantity precision
-> Inventory 8 12 precision
-> Balance precision
Balance (AccountKind -> Side
normalSideByAccountKind (Account account -> AccountKind
forall o. Account o -> AccountKind
accountKind Account account
acc)) Quantity precision
0 Inventory 8 12 precision
forall a. Default a => a
def


-- | Initializes a ledger with the given opening balance.
initLedgerWithOpeningBalance
  :: KnownNat precision
  => Account account
  -> Balance precision
  -> Ledger precision account event
initLedgerWithOpeningBalance :: forall (precision :: Nat) account event.
KnownNat precision =>
Account account
-> Balance precision -> Ledger precision account event
initLedgerWithOpeningBalance Account account
acc Balance precision
balance = Account account
-> Balance precision
-> [LedgerEntry precision event]
-> Ledger precision account event
forall (precision :: Nat) account event.
Account account
-> Balance precision
-> [LedgerEntry precision event]
-> Ledger precision account event
Ledger Account account
acc Balance precision
balance []


-- | Initializes a ledger with the given opening value.
--
-- See 'amountFromValue' for the meaning of the concept of value.
initLedgerWithOpeningValue
  :: KnownNat precision
  => Account account
  -> (Maybe (Quantity 12), Quantity precision)
  -> Ledger precision account event
initLedgerWithOpeningValue :: forall (precision :: Nat) account event.
KnownNat precision =>
Account account
-> (Maybe (Quantity 12), Quantity precision)
-> Ledger precision account event
initLedgerWithOpeningValue Account account
acc (Maybe (Quantity 12)
mstk, Quantity precision
qty) = Account account
-> Balance precision -> Ledger precision account event
forall (precision :: Nat) account event.
KnownNat precision =>
Account account
-> Balance precision -> Ledger precision account event
initLedgerWithOpeningBalance Account account
acc Balance precision
balance
  where
    inventory :: Inventory 8 12 precision
inventory = (Seq (InventoryHistoryItem 8 12 precision),
 Inventory 8 12 precision)
-> Inventory 8 12 precision
forall a b. (a, b) -> b
snd ((Seq (InventoryHistoryItem 8 12 precision),
  Inventory 8 12 precision)
 -> Inventory 8 12 precision)
-> (Seq (InventoryHistoryItem 8 12 precision),
    Inventory 8 12 precision)
-> Inventory 8 12 precision
forall a b. (a -> b) -> a -> b
$ case Maybe (Quantity 12)
mstk of
      Maybe (Quantity 12)
Nothing -> (Seq (InventoryHistoryItem 8 12 precision),
 Inventory 8 12 precision)
forall a. Default a => a
def
      Just Quantity 12
sq -> Day
-> Quantity precision
-> Quantity 12
-> Inventory 8 12 precision
-> (Seq (InventoryHistoryItem 8 12 precision),
    Inventory 8 12 precision)
forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat pprec, KnownNat sprec, KnownNat vprec) =>
Day
-> Quantity vprec
-> Quantity sprec
-> Inventory pprec sprec vprec
-> (Seq (InventoryHistoryItem pprec sprec vprec),
    Inventory pprec sprec vprec)
updateInventoryVV (String -> Day
forall a. Read a => String -> a
read String
"1970-01-01") Quantity precision
qty Quantity 12
sq Inventory 8 12 precision
forall a. Default a => a
def
    amount :: Amount precision
amount = AccountKind -> Quantity precision -> Amount precision
forall (precision :: Nat).
KnownNat precision =>
AccountKind -> Quantity precision -> Amount precision
amountFromValue (Account account -> AccountKind
forall o. Account o -> AccountKind
accountKind Account account
acc) Quantity precision
qty
    balance0 :: Balance precision
balance0 = Side
-> Quantity precision
-> Inventory 8 12 precision
-> Balance precision
forall (precision :: Nat).
Side
-> Quantity precision
-> Inventory 8 12 precision
-> Balance precision
Balance (AccountKind -> Side
normalSideByAccountKind (Account account -> AccountKind
forall o. Account o -> AccountKind
accountKind Account account
acc)) Quantity precision
0 Inventory 8 12 precision
inventory
    balance :: Balance precision
balance = Balance precision -> Amount precision -> Balance precision
forall (precision :: Nat).
KnownNat precision =>
Balance precision -> Amount precision -> Balance precision
updateBalance Balance precision
balance0 Amount precision
amount


-- | Initializes a ledger with the given opening quantity.
--
-- See 'amountFromQuantity' for the meaning of the concept of quantity.
initLedgerWithOpeningQuantity
  :: KnownNat precision
  => Account account
  -> (Maybe (Quantity 12), Quantity precision)
  -> Ledger precision account event
initLedgerWithOpeningQuantity :: forall (precision :: Nat) account event.
KnownNat precision =>
Account account
-> (Maybe (Quantity 12), Quantity precision)
-> Ledger precision account event
initLedgerWithOpeningQuantity Account account
acc (Maybe (Quantity 12)
mstk, Quantity precision
qty) = Account account
-> Balance precision -> Ledger precision account event
forall (precision :: Nat) account event.
KnownNat precision =>
Account account
-> Balance precision -> Ledger precision account event
initLedgerWithOpeningBalance Account account
acc Balance precision
balance
  where
    inventory :: Inventory 8 12 precision
inventory = (Seq (InventoryHistoryItem 8 12 precision),
 Inventory 8 12 precision)
-> Inventory 8 12 precision
forall a b. (a, b) -> b
snd ((Seq (InventoryHistoryItem 8 12 precision),
  Inventory 8 12 precision)
 -> Inventory 8 12 precision)
-> (Seq (InventoryHistoryItem 8 12 precision),
    Inventory 8 12 precision)
-> Inventory 8 12 precision
forall a b. (a -> b) -> a -> b
$ case Maybe (Quantity 12)
mstk of
      Maybe (Quantity 12)
Nothing -> (Seq (InventoryHistoryItem 8 12 precision),
 Inventory 8 12 precision)
forall a. Default a => a
def
      Just Quantity 12
sq -> Day
-> Quantity precision
-> Quantity 12
-> Inventory 8 12 precision
-> (Seq (InventoryHistoryItem 8 12 precision),
    Inventory 8 12 precision)
forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
(KnownNat pprec, KnownNat sprec, KnownNat vprec) =>
Day
-> Quantity vprec
-> Quantity sprec
-> Inventory pprec sprec vprec
-> (Seq (InventoryHistoryItem pprec sprec vprec),
    Inventory pprec sprec vprec)
updateInventoryVV (String -> Day
forall a. Read a => String -> a
read String
"1970-01-01") Quantity precision
qty Quantity 12
sq Inventory 8 12 precision
forall a. Default a => a
def
    amount :: Amount precision
amount = AccountKind -> Quantity precision -> Amount precision
forall (precision :: Nat).
KnownNat precision =>
AccountKind -> Quantity precision -> Amount precision
amountFromQuantity (Account account -> AccountKind
forall o. Account o -> AccountKind
accountKind Account account
acc) Quantity precision
qty
    balance0 :: Balance precision
balance0 = Side
-> Quantity precision
-> Inventory 8 12 precision
-> Balance precision
forall (precision :: Nat).
Side
-> Quantity precision
-> Inventory 8 12 precision
-> Balance precision
Balance (AccountKind -> Side
normalSideByAccountKind (Account account -> AccountKind
forall o. Account o -> AccountKind
accountKind Account account
acc)) Quantity precision
0 Inventory 8 12 precision
inventory
    balance :: Balance precision
balance = Balance precision -> Amount precision -> Balance precision
forall (precision :: Nat).
KnownNat precision =>
Balance precision -> Amount precision -> Balance precision
updateBalance Balance precision
balance0 Amount precision
amount


-- | 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 :: forall (precision :: Nat) account event.
(KnownNat precision, Eq account, Ord account) =>
GeneralLedger precision account event
-> [JournalEntry precision account event]
-> GeneralLedger precision account event
postEntries = (GeneralLedger precision account event
 -> JournalEntry precision account event
 -> GeneralLedger precision account event)
-> GeneralLedger precision account event
-> [JournalEntry precision account event]
-> GeneralLedger precision account event
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl GeneralLedger precision account event
-> JournalEntry precision account event
-> GeneralLedger precision account event
forall (precision :: Nat) account event.
(KnownNat precision, Eq account, Ord account) =>
GeneralLedger precision account event
-> JournalEntry precision account event
-> GeneralLedger precision account event
postEntry


-- | 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 :: forall (precision :: Nat) account event.
(KnownNat precision, Eq account, Ord account) =>
GeneralLedger precision account event
-> JournalEntry precision account event
-> GeneralLedger precision account event
postEntry GeneralLedger precision account event
gl JournalEntry precision account event
je = (GeneralLedger precision account event
 -> JournalEntryItem precision account event
 -> GeneralLedger precision account event)
-> GeneralLedger precision account event
-> [JournalEntryItem precision account event]
-> GeneralLedger precision account event
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (GeneralLedger precision account event
-> JournalEntry precision account event
-> JournalEntryItem precision account event
-> GeneralLedger precision account event
forall (precision :: Nat) account event.
(KnownNat precision, Eq account, Ord account) =>
GeneralLedger precision account event
-> JournalEntry precision account event
-> JournalEntryItem precision account event
-> GeneralLedger precision account event
`postEntryItem` JournalEntry precision account event
je) GeneralLedger precision account event
gl (JournalEntry precision account event
-> [JournalEntryItem precision account event]
forall (precision :: Nat) account event.
JournalEntry precision account event
-> [JournalEntryItem precision account event]
journalEntryItems JournalEntry precision account event
je)


-- | 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 :: forall (precision :: Nat) account event.
(KnownNat precision, Eq account, Ord account) =>
GeneralLedger precision account event
-> JournalEntry precision account event
-> JournalEntryItem precision account event
-> GeneralLedger precision account event
postEntryItem GeneralLedger precision account event
gl JournalEntry precision account event
je (JournalEntryItem Amount precision
amt Account account
acc event
evt Maybe (JournalEntryItemInventoryEvent account event)
invevt) =
  let ledgers :: [Ledger precision account event]
ledgers = GeneralLedger precision account event
-> [Ledger precision account event]
forall (precision :: Nat) account event.
GeneralLedger precision account event
-> [Ledger precision account event]
generalLedgerLedgers GeneralLedger precision account event
gl
      ledgersDb :: Map (Account account) (Ledger precision account event)
ledgersDb = [(Account account, Ledger precision account event)]
-> Map (Account account) (Ledger precision account event)
forall k a. Ord k => [(k, a)] -> Map k a
HM.fromList ([(Account account, Ledger precision account event)]
 -> Map (Account account) (Ledger precision account event))
-> [(Account account, Ledger precision account event)]
-> Map (Account account) (Ledger precision account event)
forall a b. (a -> b) -> a -> b
$ [Account account]
-> [Ledger precision account event]
-> [(Account account, Ledger precision account event)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Ledger precision account event -> Account account)
-> [Ledger precision account event] -> [Account account]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ledger precision account event -> Account account
forall (precision :: Nat) account event.
Ledger precision account event -> Account account
ledgerAccount [Ledger precision account event]
ledgers) [Ledger precision account event]
ledgers
      ledgerCurr :: Ledger precision account event
ledgerCurr = Ledger precision account event
-> Maybe (Ledger precision account event)
-> Ledger precision account event
forall a. a -> Maybe a -> a
fromMaybe (Account account -> Ledger precision account event
forall (precision :: Nat) account event.
KnownNat precision =>
Account account -> Ledger precision account event
initLedger Account account
acc) (Maybe (Ledger precision account event)
 -> Ledger precision account event)
-> Maybe (Ledger precision account event)
-> Ledger precision account event
forall a b. (a -> b) -> a -> b
$ Account account
-> Map (Account account) (Ledger precision account event)
-> Maybe (Ledger precision account event)
forall k a. Ord k => k -> Map k a -> Maybe a
HM.lookup Account account
acc Map (Account account) (Ledger precision account event)
ledgersDb
      jeDate :: Day
jeDate = JournalEntry precision account event -> Day
forall (precision :: Nat) account event.
JournalEntry precision account event -> Day
journalEntryDate JournalEntry precision account event
je
      jeDesc :: Text
jeDesc = JournalEntry precision account event -> Text
forall (precision :: Nat) account event.
JournalEntry precision account event -> Text
journalEntryDescription JournalEntry precision account event
je
      jeCode :: Text
jeCode = JournalEntry precision account event -> Text
forall (precision :: Nat) account event.
JournalEntry precision account event -> Text
journalEntryId JournalEntry precision account event
je
      (Maybe (JournalEntry precision account event)
jePnl, Ledger precision account event
ledgerNext) = Ledger precision account event
-> Day
-> Amount precision
-> Text
-> event
-> Text
-> Maybe (JournalEntryItemInventoryEvent account event)
-> (Maybe (JournalEntry precision account event),
    Ledger precision account event)
forall (precision :: Nat) account event.
KnownNat precision =>
Ledger precision account event
-> Day
-> Amount precision
-> Text
-> event
-> Text
-> Maybe (JournalEntryItemInventoryEvent account event)
-> (Maybe (JournalEntry precision account event),
    Ledger precision account event)
postItem Ledger precision account event
ledgerCurr Day
jeDate Amount precision
amt Text
jeDesc event
evt Text
jeCode Maybe (JournalEntryItemInventoryEvent account event)
invevt
      ledgersDbNext :: Map (Account account) (Ledger precision account event)
ledgersDbNext = Account account
-> Ledger precision account event
-> Map (Account account) (Ledger precision account event)
-> Map (Account account) (Ledger precision account event)
forall k a. Ord k => k -> a -> Map k a -> Map k a
HM.insert Account account
acc Ledger precision account event
ledgerNext Map (Account account) (Ledger precision account event)
ledgersDb
      ngl :: GeneralLedger precision account event
ngl =
        GeneralLedger
          { generalLedgerLedgers :: [Ledger precision account event]
generalLedgerLedgers = Map (Account account) (Ledger precision account event)
-> [Ledger precision account event]
forall k a. Map k a -> [a]
HM.elems Map (Account account) (Ledger precision account event)
ledgersDbNext
          }
   in GeneralLedger precision account event
-> [JournalEntry precision account event]
-> GeneralLedger precision account event
forall (precision :: Nat) account event.
(KnownNat precision, Eq account, Ord account) =>
GeneralLedger precision account event
-> [JournalEntry precision account event]
-> GeneralLedger precision account event
postEntries GeneralLedger precision account event
ngl (Maybe (JournalEntry precision account event)
-> [JournalEntry precision account event]
forall a. Maybe a -> [a]
maybeToList Maybe (JournalEntry precision account event)
jePnl)


-- | Performs a posting to the given ledger.
postItem
  :: KnownNat precision
  => Ledger precision account event
  -> Day
  -> Amount precision
  -> T.Text
  -> event
  -> T.Text
  -> Maybe (JournalEntryItemInventoryEvent account event)
  -> (Maybe (JournalEntry precision account event), Ledger precision account event)
postItem :: forall (precision :: Nat) account event.
KnownNat precision =>
Ledger precision account event
-> Day
-> Amount precision
-> Text
-> event
-> Text
-> Maybe (JournalEntryItemInventoryEvent account event)
-> (Maybe (JournalEntry precision account event),
    Ledger precision account event)
postItem Ledger precision account event
ledger Day
date Amount precision
amt Text
dsc event
evt Text
pid Maybe (JournalEntryItemInventoryEvent account event)
Nothing =
  let balanceLast :: Balance precision
balanceLast = Ledger precision account event -> Balance precision
forall (precision :: Nat) account event.
KnownNat precision =>
Ledger precision account event -> Balance precision
ledgerClosing Ledger precision account event
ledger
      balanceNext :: Balance precision
balanceNext = Balance precision -> Amount precision -> Balance precision
forall (precision :: Nat).
KnownNat precision =>
Balance precision -> Amount precision -> Balance precision
updateBalance Balance precision
balanceLast Amount precision
amt
      item :: LedgerEntry precision event
item =
        LedgerEntry
          { ledgerEntryDate :: Day
ledgerEntryDate = Day
date
          , ledgerEntryAmount :: Amount precision
ledgerEntryAmount = Amount precision
amt
          , ledgerEntryDescription :: Text
ledgerEntryDescription = Text
dsc
          , ledgerEntryEvent :: event
ledgerEntryEvent = event
evt
          , ledgerEntryPostingId :: Text
ledgerEntryPostingId = Text
pid
          , ledgerEntryBalance :: Balance precision
ledgerEntryBalance = Balance precision
balanceNext
          }
   in ( Maybe (JournalEntry precision account event)
forall a. Maybe a
Nothing
      , Ledger precision account event
ledger
          { ledgerRunning = item : ledgerRunning ledger
          }
      )
postItem Ledger precision account event
ledger Day
date Amount precision
amt Text
dsc event
evt Text
pid (Just (JournalEntryItemInventoryEvent Account account
pnlacc event
pnlevt Quantity 12
evtqty)) =
  let balanceLast :: Balance precision
balanceLast = Ledger precision account event -> Balance precision
forall (precision :: Nat) account event.
KnownNat precision =>
Ledger precision account event -> Balance precision
ledgerClosing Ledger precision account event
ledger
      ([InventoryHistoryItem 8 12 precision]
histitems, Balance precision
balanceNext) = Day
-> Balance precision
-> Amount precision
-> Quantity 12
-> ([InventoryHistoryItem 8 12 precision], Balance precision)
forall (precision :: Nat).
KnownNat precision =>
Day
-> Balance precision
-> Amount precision
-> Quantity 12
-> ([InventoryHistoryItem 8 12 precision], Balance precision)
updateBalanceWithInventory Day
date Balance precision
balanceLast Amount precision
amt Quantity 12
evtqty
      item :: LedgerEntry precision event
item =
        LedgerEntry
          { ledgerEntryDate :: Day
ledgerEntryDate = Day
date
          , ledgerEntryAmount :: Amount precision
ledgerEntryAmount = Amount precision
amt
          , ledgerEntryDescription :: Text
ledgerEntryDescription = Text
dsc
          , ledgerEntryEvent :: event
ledgerEntryEvent = event
evt
          , ledgerEntryPostingId :: Text
ledgerEntryPostingId = Text
pid
          , ledgerEntryBalance :: Balance precision
ledgerEntryBalance = Balance precision
balanceNext
          }
      mje :: Maybe (JournalEntry precision account event)
mje = case [InventoryHistoryItem 8 12 precision]
histitems of
        [] -> Maybe (JournalEntry precision account event)
forall a. Maybe a
Nothing
        [InventoryHistoryItem 8 12 precision]
_ ->
          JournalEntry precision account event
-> Maybe (JournalEntry precision account event)
forall a. a -> Maybe a
Just (JournalEntry precision account event
 -> Maybe (JournalEntry precision account event))
-> JournalEntry precision account event
-> Maybe (JournalEntry precision account event)
forall a b. (a -> b) -> a -> b
$
            JournalEntry
              { journalEntryId :: Text
journalEntryId = Text
pid
              , journalEntryDate :: Day
journalEntryDate = Day
date
              , journalEntryItems :: [JournalEntryItem precision account event]
journalEntryItems = ([JournalEntryItem precision account event]
 -> InventoryHistoryItem 8 12 precision
 -> [JournalEntryItem precision account event])
-> [JournalEntryItem precision account event]
-> [InventoryHistoryItem 8 12 precision]
-> [JournalEntryItem precision account event]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\[JournalEntryItem precision account event]
a InventoryHistoryItem 8 12 precision
c -> [JournalEntryItem precision account event]
a [JournalEntryItem precision account event]
-> [JournalEntryItem precision account event]
-> [JournalEntryItem precision account event]
forall a. Semigroup a => a -> a -> a
<> event
-> Account account
-> Account account
-> InventoryHistoryItem 8 12 precision
-> [JournalEntryItem precision account event]
forall (precision :: Nat) event account.
KnownNat precision =>
event
-> Account account
-> Account account
-> InventoryHistoryItem 8 12 precision
-> [JournalEntryItem precision account event]
histItemToJournalEntryItem event
pnlevt (Ledger precision account event -> Account account
forall (precision :: Nat) account event.
Ledger precision account event -> Account account
ledgerAccount Ledger precision account event
ledger) Account account
pnlacc InventoryHistoryItem 8 12 precision
c) [] [InventoryHistoryItem 8 12 precision]
histitems
              , journalEntryDescription :: Text
journalEntryDescription = Text
"Realized PnL due to: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dsc
              }
   in ( Maybe (JournalEntry precision account event)
mje
      , Ledger precision account event
ledger
          { ledgerRunning = item : ledgerRunning ledger
          }
      )


-- | Creates 2 journal entry items for the captured non-zero PnL.
histItemToJournalEntryItem
  :: KnownNat precision
  => event
  -> Account account
  -> Account account
  -> InventoryHistoryItem 8 12 precision
  -> [JournalEntryItem precision account event]
histItemToJournalEntryItem :: forall (precision :: Nat) event account.
KnownNat precision =>
event
-> Account account
-> Account account
-> InventoryHistoryItem 8 12 precision
-> [JournalEntryItem precision account event]
histItemToJournalEntryItem event
event Account account
accAsset Account account
accRevenue MkInventoryHistoryItem {Quantity precision
inventoryHistoryItemPnl :: forall (pprec :: Nat) (sprec :: Nat) (vprec :: Nat).
InventoryHistoryItem pprec sprec vprec -> Quantity vprec
inventoryHistoryItemPnl :: Quantity precision
..} =
  if Quantity precision
inventoryHistoryItemPnl Quantity precision -> Quantity precision -> Bool
forall a. Eq a => a -> a -> Bool
== Quantity precision
0
    then []
    else
      [ JournalEntryItem
          { journalEntryItemAmount :: Amount precision
journalEntryItemAmount = AccountKind -> Quantity precision -> Amount precision
forall (precision :: Nat).
KnownNat precision =>
AccountKind -> Quantity precision -> Amount precision
amountFromQuantity (Account account -> AccountKind
forall o. Account o -> AccountKind
accountKind Account account
accAsset) Quantity precision
inventoryHistoryItemPnl
          , journalEntryItemAccount :: Account account
journalEntryItemAccount = Account account
accAsset
          , journalEntryItemEvent :: event
journalEntryItemEvent = event
event
          , journalEntryItemInventoryEvent :: Maybe (JournalEntryItemInventoryEvent account event)
journalEntryItemInventoryEvent = Maybe (JournalEntryItemInventoryEvent account event)
forall a. Maybe a
Nothing
          }
      , JournalEntryItem
          { journalEntryItemAmount :: Amount precision
journalEntryItemAmount = AccountKind -> Quantity precision -> Amount precision
forall (precision :: Nat).
KnownNat precision =>
AccountKind -> Quantity precision -> Amount precision
amountFromQuantity (Account account -> AccountKind
forall o. Account o -> AccountKind
accountKind Account account
accRevenue) Quantity precision
inventoryHistoryItemPnl
          , journalEntryItemAccount :: Account account
journalEntryItemAccount = Account account
accRevenue
          , journalEntryItemEvent :: event
journalEntryItemEvent = event
event
          , journalEntryItemInventoryEvent :: Maybe (JournalEntryItemInventoryEvent account event)
journalEntryItemInventoryEvent = Maybe (JournalEntryItemInventoryEvent account event)
forall a. Maybe a
Nothing
          }
      ]