-- | This module provides definitions for postings, ledgers and ledger entries.

{-# 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.Text                  as T
import           Data.Time                  (Day)
import           Deriving.Aeson             (CustomJSON(CustomJSON), FromJSON, Generic, ToJSON)
import           Deriving.Aeson.Stock       (PrefixedSnake, Vanilla)
import           GHC.TypeLits               (KnownNat, Nat)
import           Haspara.Accounting.Account (Account(accountKind), AccountKind(..))
import           Haspara.Accounting.Event   (Event(..), eventObject)
import           Haspara.Quantity           (Quantity, UnsignedQuantity)
import           Refined                    (unrefine)


-- | Type encoding of a ledger.
data Ledger a o (s :: Nat) = Ledger
  { Ledger a o s -> Account a
ledgerAccount :: !(Account a)
  , Ledger a o s -> Quantity s
ledgerOpening :: !(Quantity s)
  , Ledger a o s -> Quantity s
ledgerClosing :: !(Quantity s)
  , Ledger a o s -> [LedgerItem o s]
ledgerRunning :: ![LedgerItem o s]
  } deriving (Ledger a o s -> Ledger a o s -> Bool
(Ledger a o s -> Ledger a o s -> Bool)
-> (Ledger a o s -> Ledger a o s -> Bool) -> Eq (Ledger a o s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a o (s :: Nat).
(Eq a, Eq o) =>
Ledger a o s -> Ledger a o s -> Bool
/= :: Ledger a o s -> Ledger a o s -> Bool
$c/= :: forall a o (s :: Nat).
(Eq a, Eq o) =>
Ledger a o s -> Ledger a o s -> Bool
== :: Ledger a o s -> Ledger a o s -> Bool
$c== :: forall a o (s :: Nat).
(Eq a, Eq o) =>
Ledger a o s -> Ledger a o s -> Bool
Eq, (forall x. Ledger a o s -> Rep (Ledger a o s) x)
-> (forall x. Rep (Ledger a o s) x -> Ledger a o s)
-> Generic (Ledger a o s)
forall x. Rep (Ledger a o s) x -> Ledger a o s
forall x. Ledger a o s -> Rep (Ledger a o s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a o (s :: Nat) x. Rep (Ledger a o s) x -> Ledger a o s
forall a o (s :: Nat) x. Ledger a o s -> Rep (Ledger a o s) x
$cto :: forall a o (s :: Nat) x. Rep (Ledger a o s) x -> Ledger a o s
$cfrom :: forall a o (s :: Nat) x. Ledger a o s -> Rep (Ledger a o s) x
Generic, Eq (Ledger a o s)
Eq (Ledger a o s)
-> (Ledger a o s -> Ledger a o s -> Ordering)
-> (Ledger a o s -> Ledger a o s -> Bool)
-> (Ledger a o s -> Ledger a o s -> Bool)
-> (Ledger a o s -> Ledger a o s -> Bool)
-> (Ledger a o s -> Ledger a o s -> Bool)
-> (Ledger a o s -> Ledger a o s -> Ledger a o s)
-> (Ledger a o s -> Ledger a o s -> Ledger a o s)
-> Ord (Ledger a o s)
Ledger a o s -> Ledger a o s -> Bool
Ledger a o s -> Ledger a o s -> Ordering
Ledger a o s -> Ledger a o s -> Ledger a o s
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a o (s :: Nat). (Ord a, Ord o) => Eq (Ledger a o s)
forall a o (s :: Nat).
(Ord a, Ord o) =>
Ledger a o s -> Ledger a o s -> Bool
forall a o (s :: Nat).
(Ord a, Ord o) =>
Ledger a o s -> Ledger a o s -> Ordering
forall a o (s :: Nat).
(Ord a, Ord o) =>
Ledger a o s -> Ledger a o s -> Ledger a o s
min :: Ledger a o s -> Ledger a o s -> Ledger a o s
$cmin :: forall a o (s :: Nat).
(Ord a, Ord o) =>
Ledger a o s -> Ledger a o s -> Ledger a o s
max :: Ledger a o s -> Ledger a o s -> Ledger a o s
$cmax :: forall a o (s :: Nat).
(Ord a, Ord o) =>
Ledger a o s -> Ledger a o s -> Ledger a o s
>= :: Ledger a o s -> Ledger a o s -> Bool
$c>= :: forall a o (s :: Nat).
(Ord a, Ord o) =>
Ledger a o s -> Ledger a o s -> Bool
> :: Ledger a o s -> Ledger a o s -> Bool
$c> :: forall a o (s :: Nat).
(Ord a, Ord o) =>
Ledger a o s -> Ledger a o s -> Bool
<= :: Ledger a o s -> Ledger a o s -> Bool
$c<= :: forall a o (s :: Nat).
(Ord a, Ord o) =>
Ledger a o s -> Ledger a o s -> Bool
< :: Ledger a o s -> Ledger a o s -> Bool
$c< :: forall a o (s :: Nat).
(Ord a, Ord o) =>
Ledger a o s -> Ledger a o s -> Bool
compare :: Ledger a o s -> Ledger a o s -> Ordering
$ccompare :: forall a o (s :: Nat).
(Ord a, Ord o) =>
Ledger a o s -> Ledger a o s -> Ordering
$cp1Ord :: forall a o (s :: Nat). (Ord a, Ord o) => Eq (Ledger a o s)
Ord, Int -> Ledger a o s -> ShowS
[Ledger a o s] -> ShowS
Ledger a o s -> String
(Int -> Ledger a o s -> ShowS)
-> (Ledger a o s -> String)
-> ([Ledger a o s] -> ShowS)
-> Show (Ledger a o s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a o (s :: Nat).
(KnownNat s, Show a, Show o) =>
Int -> Ledger a o s -> ShowS
forall a o (s :: Nat).
(KnownNat s, Show a, Show o) =>
[Ledger a o s] -> ShowS
forall a o (s :: Nat).
(KnownNat s, Show a, Show o) =>
Ledger a o s -> String
showList :: [Ledger a o s] -> ShowS
$cshowList :: forall a o (s :: Nat).
(KnownNat s, Show a, Show o) =>
[Ledger a o s] -> ShowS
show :: Ledger a o s -> String
$cshow :: forall a o (s :: Nat).
(KnownNat s, Show a, Show o) =>
Ledger a o s -> String
showsPrec :: Int -> Ledger a o s -> ShowS
$cshowsPrec :: forall a o (s :: Nat).
(KnownNat s, Show a, Show o) =>
Int -> Ledger a o s -> ShowS
Show)
  deriving (Value -> Parser [Ledger a o s]
Value -> Parser (Ledger a o s)
(Value -> Parser (Ledger a o s))
-> (Value -> Parser [Ledger a o s]) -> FromJSON (Ledger a o s)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall a o (s :: Nat).
(KnownNat s, FromJSON a, FromJSON o) =>
Value -> Parser [Ledger a o s]
forall a o (s :: Nat).
(KnownNat s, FromJSON a, FromJSON o) =>
Value -> Parser (Ledger a o s)
parseJSONList :: Value -> Parser [Ledger a o s]
$cparseJSONList :: forall a o (s :: Nat).
(KnownNat s, FromJSON a, FromJSON o) =>
Value -> Parser [Ledger a o s]
parseJSON :: Value -> Parser (Ledger a o s)
$cparseJSON :: forall a o (s :: Nat).
(KnownNat s, FromJSON a, FromJSON o) =>
Value -> Parser (Ledger a o s)
FromJSON, [Ledger a o s] -> Encoding
[Ledger a o s] -> Value
Ledger a o s -> Encoding
Ledger a o s -> Value
(Ledger a o s -> Value)
-> (Ledger a o s -> Encoding)
-> ([Ledger a o s] -> Value)
-> ([Ledger a o s] -> Encoding)
-> ToJSON (Ledger a o s)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall a o (s :: Nat).
(ToJSON o, ToJSON a, KnownNat s) =>
[Ledger a o s] -> Encoding
forall a o (s :: Nat).
(ToJSON o, ToJSON a, KnownNat s) =>
[Ledger a o s] -> Value
forall a o (s :: Nat).
(ToJSON o, ToJSON a, KnownNat s) =>
Ledger a o s -> Encoding
forall a o (s :: Nat).
(ToJSON o, ToJSON a, KnownNat s) =>
Ledger a o s -> Value
toEncodingList :: [Ledger a o s] -> Encoding
$ctoEncodingList :: forall a o (s :: Nat).
(ToJSON o, ToJSON a, KnownNat s) =>
[Ledger a o s] -> Encoding
toJSONList :: [Ledger a o s] -> Value
$ctoJSONList :: forall a o (s :: Nat).
(ToJSON o, ToJSON a, KnownNat s) =>
[Ledger a o s] -> Value
toEncoding :: Ledger a o s -> Encoding
$ctoEncoding :: forall a o (s :: Nat).
(ToJSON o, ToJSON a, KnownNat s) =>
Ledger a o s -> Encoding
toJSON :: Ledger a o s -> Value
$ctoJSON :: forall a o (s :: Nat).
(ToJSON o, ToJSON a, KnownNat s) =>
Ledger a o s -> Value
ToJSON) via PrefixedSnake "ledger" (Ledger a o s)


-- | Type encoding of a ledger item.
data LedgerItem o (s :: Nat) = LedgerItem
  { LedgerItem o s -> Entry o s
ledgerItemEntry   :: !(Entry o s)
  , LedgerItem o s -> Quantity s
ledgerItemBalance :: !(Quantity s)
  } deriving (LedgerItem o s -> LedgerItem o s -> Bool
(LedgerItem o s -> LedgerItem o s -> Bool)
-> (LedgerItem o s -> LedgerItem o s -> Bool)
-> Eq (LedgerItem o s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall o (s :: Nat).
Eq o =>
LedgerItem o s -> LedgerItem o s -> Bool
/= :: LedgerItem o s -> LedgerItem o s -> Bool
$c/= :: forall o (s :: Nat).
Eq o =>
LedgerItem o s -> LedgerItem o s -> Bool
== :: LedgerItem o s -> LedgerItem o s -> Bool
$c== :: forall o (s :: Nat).
Eq o =>
LedgerItem o s -> LedgerItem o s -> Bool
Eq, (forall x. LedgerItem o s -> Rep (LedgerItem o s) x)
-> (forall x. Rep (LedgerItem o s) x -> LedgerItem o s)
-> Generic (LedgerItem o s)
forall x. Rep (LedgerItem o s) x -> LedgerItem o s
forall x. LedgerItem o s -> Rep (LedgerItem o s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall o (s :: Nat) x. Rep (LedgerItem o s) x -> LedgerItem o s
forall o (s :: Nat) x. LedgerItem o s -> Rep (LedgerItem o s) x
$cto :: forall o (s :: Nat) x. Rep (LedgerItem o s) x -> LedgerItem o s
$cfrom :: forall o (s :: Nat) x. LedgerItem o s -> Rep (LedgerItem o s) x
Generic, Eq (LedgerItem o s)
Eq (LedgerItem o s)
-> (LedgerItem o s -> LedgerItem o s -> Ordering)
-> (LedgerItem o s -> LedgerItem o s -> Bool)
-> (LedgerItem o s -> LedgerItem o s -> Bool)
-> (LedgerItem o s -> LedgerItem o s -> Bool)
-> (LedgerItem o s -> LedgerItem o s -> Bool)
-> (LedgerItem o s -> LedgerItem o s -> LedgerItem o s)
-> (LedgerItem o s -> LedgerItem o s -> LedgerItem o s)
-> Ord (LedgerItem o s)
LedgerItem o s -> LedgerItem o s -> Bool
LedgerItem o s -> LedgerItem o s -> Ordering
LedgerItem o s -> LedgerItem o s -> LedgerItem o s
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall o (s :: Nat). Ord o => Eq (LedgerItem o s)
forall o (s :: Nat).
Ord o =>
LedgerItem o s -> LedgerItem o s -> Bool
forall o (s :: Nat).
Ord o =>
LedgerItem o s -> LedgerItem o s -> Ordering
forall o (s :: Nat).
Ord o =>
LedgerItem o s -> LedgerItem o s -> LedgerItem o s
min :: LedgerItem o s -> LedgerItem o s -> LedgerItem o s
$cmin :: forall o (s :: Nat).
Ord o =>
LedgerItem o s -> LedgerItem o s -> LedgerItem o s
max :: LedgerItem o s -> LedgerItem o s -> LedgerItem o s
$cmax :: forall o (s :: Nat).
Ord o =>
LedgerItem o s -> LedgerItem o s -> LedgerItem o s
>= :: LedgerItem o s -> LedgerItem o s -> Bool
$c>= :: forall o (s :: Nat).
Ord o =>
LedgerItem o s -> LedgerItem o s -> Bool
> :: LedgerItem o s -> LedgerItem o s -> Bool
$c> :: forall o (s :: Nat).
Ord o =>
LedgerItem o s -> LedgerItem o s -> Bool
<= :: LedgerItem o s -> LedgerItem o s -> Bool
$c<= :: forall o (s :: Nat).
Ord o =>
LedgerItem o s -> LedgerItem o s -> Bool
< :: LedgerItem o s -> LedgerItem o s -> Bool
$c< :: forall o (s :: Nat).
Ord o =>
LedgerItem o s -> LedgerItem o s -> Bool
compare :: LedgerItem o s -> LedgerItem o s -> Ordering
$ccompare :: forall o (s :: Nat).
Ord o =>
LedgerItem o s -> LedgerItem o s -> Ordering
$cp1Ord :: forall o (s :: Nat). Ord o => Eq (LedgerItem o s)
Ord, Int -> LedgerItem o s -> ShowS
[LedgerItem o s] -> ShowS
LedgerItem o s -> String
(Int -> LedgerItem o s -> ShowS)
-> (LedgerItem o s -> String)
-> ([LedgerItem o s] -> ShowS)
-> Show (LedgerItem o s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall o (s :: Nat).
(Show o, KnownNat s) =>
Int -> LedgerItem o s -> ShowS
forall o (s :: Nat).
(Show o, KnownNat s) =>
[LedgerItem o s] -> ShowS
forall o (s :: Nat).
(Show o, KnownNat s) =>
LedgerItem o s -> String
showList :: [LedgerItem o s] -> ShowS
$cshowList :: forall o (s :: Nat).
(Show o, KnownNat s) =>
[LedgerItem o s] -> ShowS
show :: LedgerItem o s -> String
$cshow :: forall o (s :: Nat).
(Show o, KnownNat s) =>
LedgerItem o s -> String
showsPrec :: Int -> LedgerItem o s -> ShowS
$cshowsPrec :: forall o (s :: Nat).
(Show o, KnownNat s) =>
Int -> LedgerItem o s -> ShowS
Show)
  deriving (Value -> Parser [LedgerItem o s]
Value -> Parser (LedgerItem o s)
(Value -> Parser (LedgerItem o s))
-> (Value -> Parser [LedgerItem o s]) -> FromJSON (LedgerItem o s)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall o (s :: Nat).
(FromJSON o, KnownNat s) =>
Value -> Parser [LedgerItem o s]
forall o (s :: Nat).
(FromJSON o, KnownNat s) =>
Value -> Parser (LedgerItem o s)
parseJSONList :: Value -> Parser [LedgerItem o s]
$cparseJSONList :: forall o (s :: Nat).
(FromJSON o, KnownNat s) =>
Value -> Parser [LedgerItem o s]
parseJSON :: Value -> Parser (LedgerItem o s)
$cparseJSON :: forall o (s :: Nat).
(FromJSON o, KnownNat s) =>
Value -> Parser (LedgerItem o s)
FromJSON, [LedgerItem o s] -> Encoding
[LedgerItem o s] -> Value
LedgerItem o s -> Encoding
LedgerItem o s -> Value
(LedgerItem o s -> Value)
-> (LedgerItem o s -> Encoding)
-> ([LedgerItem o s] -> Value)
-> ([LedgerItem o s] -> Encoding)
-> ToJSON (LedgerItem o s)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall o (s :: Nat).
(KnownNat s, ToJSON o) =>
[LedgerItem o s] -> Encoding
forall o (s :: Nat).
(KnownNat s, ToJSON o) =>
[LedgerItem o s] -> Value
forall o (s :: Nat).
(KnownNat s, ToJSON o) =>
LedgerItem o s -> Encoding
forall o (s :: Nat).
(KnownNat s, ToJSON o) =>
LedgerItem o s -> Value
toEncodingList :: [LedgerItem o s] -> Encoding
$ctoEncodingList :: forall o (s :: Nat).
(KnownNat s, ToJSON o) =>
[LedgerItem o s] -> Encoding
toJSONList :: [LedgerItem o s] -> Value
$ctoJSONList :: forall o (s :: Nat).
(KnownNat s, ToJSON o) =>
[LedgerItem o s] -> Value
toEncoding :: LedgerItem o s -> Encoding
$ctoEncoding :: forall o (s :: Nat).
(KnownNat s, ToJSON o) =>
LedgerItem o s -> Encoding
toJSON :: LedgerItem o s -> Value
$ctoJSON :: forall o (s :: Nat).
(KnownNat s, ToJSON o) =>
LedgerItem o s -> Value
ToJSON)
  via PrefixedSnake "ledgerItem" (LedgerItem o s)


-- | 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 :: Account a -> Quantity s -> [Entry o s] -> Ledger a o s
mkLedger Account a
a Quantity s
o = (Ledger a o s -> Entry o s -> Ledger a o s)
-> Ledger a o s -> [Entry o s] -> Ledger a o s
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Ledger a o s -> Entry o s -> Ledger a o s
forall (s :: Nat) a o.
KnownNat s =>
Ledger a o s -> Entry o s -> Ledger a o s
addEntry (Account a
-> Quantity s -> Quantity s -> [LedgerItem o s] -> Ledger a o s
forall a o (s :: Nat).
Account a
-> Quantity s -> Quantity s -> [LedgerItem o s] -> Ledger a o s
Ledger Account a
a Quantity s
o Quantity s
o [])


-- | Adds a new entry to a ledger.
addEntry :: KnownNat s => Ledger a o s -> Entry o s -> Ledger a o s
addEntry :: Ledger a o s -> Entry o s -> Ledger a o s
addEntry l :: Ledger a o s
l@(Ledger Account a
_ Quantity s
_ Quantity s
c [LedgerItem o s]
r) Entry o s
e = Ledger a o s
l { ledgerClosing :: Quantity s
ledgerClosing = Quantity s
balance, ledgerRunning :: [LedgerItem o s]
ledgerRunning = [LedgerItem o s]
r [LedgerItem o s] -> [LedgerItem o s] -> [LedgerItem o s]
forall a. Semigroup a => a -> a -> a
<> [LedgerItem o s
item]}
  where
    balance :: Quantity s
balance = Quantity s
c Quantity s -> Quantity s -> Quantity s
forall a. Num a => a -> a -> a
+ Entry o s -> Quantity s
forall (s :: Nat) o. KnownNat s => Entry o s -> Quantity s
entryQuantity Entry o s
e
    item :: LedgerItem o s
item = Entry o s -> Quantity s -> LedgerItem o s
forall o (s :: Nat). Entry o s -> Quantity s -> LedgerItem o s
LedgerItem Entry o s
e Quantity s
balance


-- | 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 (Posting a o s -> Posting a o s -> Bool
(Posting a o s -> Posting a o s -> Bool)
-> (Posting a o s -> Posting a o s -> Bool) -> Eq (Posting a o s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a o (s :: Nat).
(Eq o, Eq a) =>
Posting a o s -> Posting a o s -> Bool
/= :: Posting a o s -> Posting a o s -> Bool
$c/= :: forall a o (s :: Nat).
(Eq o, Eq a) =>
Posting a o s -> Posting a o s -> Bool
== :: Posting a o s -> Posting a o s -> Bool
$c== :: forall a o (s :: Nat).
(Eq o, Eq a) =>
Posting a o s -> Posting a o s -> Bool
Eq, (forall x. Posting a o s -> Rep (Posting a o s) x)
-> (forall x. Rep (Posting a o s) x -> Posting a o s)
-> Generic (Posting a o s)
forall x. Rep (Posting a o s) x -> Posting a o s
forall x. Posting a o s -> Rep (Posting a o s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a o (s :: Nat) x. Rep (Posting a o s) x -> Posting a o s
forall a o (s :: Nat) x. Posting a o s -> Rep (Posting a o s) x
$cto :: forall a o (s :: Nat) x. Rep (Posting a o s) x -> Posting a o s
$cfrom :: forall a o (s :: Nat) x. Posting a o s -> Rep (Posting a o s) x
Generic, Eq (Posting a o s)
Eq (Posting a o s)
-> (Posting a o s -> Posting a o s -> Ordering)
-> (Posting a o s -> Posting a o s -> Bool)
-> (Posting a o s -> Posting a o s -> Bool)
-> (Posting a o s -> Posting a o s -> Bool)
-> (Posting a o s -> Posting a o s -> Bool)
-> (Posting a o s -> Posting a o s -> Posting a o s)
-> (Posting a o s -> Posting a o s -> Posting a o s)
-> Ord (Posting a o s)
Posting a o s -> Posting a o s -> Bool
Posting a o s -> Posting a o s -> Ordering
Posting a o s -> Posting a o s -> Posting a o s
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a o (s :: Nat). (Ord o, Ord a) => Eq (Posting a o s)
forall a o (s :: Nat).
(Ord o, Ord a) =>
Posting a o s -> Posting a o s -> Bool
forall a o (s :: Nat).
(Ord o, Ord a) =>
Posting a o s -> Posting a o s -> Ordering
forall a o (s :: Nat).
(Ord o, Ord a) =>
Posting a o s -> Posting a o s -> Posting a o s
min :: Posting a o s -> Posting a o s -> Posting a o s
$cmin :: forall a o (s :: Nat).
(Ord o, Ord a) =>
Posting a o s -> Posting a o s -> Posting a o s
max :: Posting a o s -> Posting a o s -> Posting a o s
$cmax :: forall a o (s :: Nat).
(Ord o, Ord a) =>
Posting a o s -> Posting a o s -> Posting a o s
>= :: Posting a o s -> Posting a o s -> Bool
$c>= :: forall a o (s :: Nat).
(Ord o, Ord a) =>
Posting a o s -> Posting a o s -> Bool
> :: Posting a o s -> Posting a o s -> Bool
$c> :: forall a o (s :: Nat).
(Ord o, Ord a) =>
Posting a o s -> Posting a o s -> Bool
<= :: Posting a o s -> Posting a o s -> Bool
$c<= :: forall a o (s :: Nat).
(Ord o, Ord a) =>
Posting a o s -> Posting a o s -> Bool
< :: Posting a o s -> Posting a o s -> Bool
$c< :: forall a o (s :: Nat).
(Ord o, Ord a) =>
Posting a o s -> Posting a o s -> Bool
compare :: Posting a o s -> Posting a o s -> Ordering
$ccompare :: forall a o (s :: Nat).
(Ord o, Ord a) =>
Posting a o s -> Posting a o s -> Ordering
$cp1Ord :: forall a o (s :: Nat). (Ord o, Ord a) => Eq (Posting a o s)
Ord, Int -> Posting a o s -> ShowS
[Posting a o s] -> ShowS
Posting a o s -> String
(Int -> Posting a o s -> ShowS)
-> (Posting a o s -> String)
-> ([Posting a o s] -> ShowS)
-> Show (Posting a o s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a o (s :: Nat).
(KnownNat s, Show o, Show a) =>
Int -> Posting a o s -> ShowS
forall a o (s :: Nat).
(KnownNat s, Show o, Show a) =>
[Posting a o s] -> ShowS
forall a o (s :: Nat).
(KnownNat s, Show o, Show a) =>
Posting a o s -> String
showList :: [Posting a o s] -> ShowS
$cshowList :: forall a o (s :: Nat).
(KnownNat s, Show o, Show a) =>
[Posting a o s] -> ShowS
show :: Posting a o s -> String
$cshow :: forall a o (s :: Nat).
(KnownNat s, Show o, Show a) =>
Posting a o s -> String
showsPrec :: Int -> Posting a o s -> ShowS
$cshowsPrec :: forall a o (s :: Nat).
(KnownNat s, Show o, Show a) =>
Int -> Posting a o s -> ShowS
Show)
  deriving (Value -> Parser [Posting a o s]
Value -> Parser (Posting a o s)
(Value -> Parser (Posting a o s))
-> (Value -> Parser [Posting a o s]) -> FromJSON (Posting a o s)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall a o (s :: Nat).
(KnownNat s, FromJSON o, FromJSON a) =>
Value -> Parser [Posting a o s]
forall a o (s :: Nat).
(KnownNat s, FromJSON o, FromJSON a) =>
Value -> Parser (Posting a o s)
parseJSONList :: Value -> Parser [Posting a o s]
$cparseJSONList :: forall a o (s :: Nat).
(KnownNat s, FromJSON o, FromJSON a) =>
Value -> Parser [Posting a o s]
parseJSON :: Value -> Parser (Posting a o s)
$cparseJSON :: forall a o (s :: Nat).
(KnownNat s, FromJSON o, FromJSON a) =>
Value -> Parser (Posting a o s)
FromJSON, [Posting a o s] -> Encoding
[Posting a o s] -> Value
Posting a o s -> Encoding
Posting a o s -> Value
(Posting a o s -> Value)
-> (Posting a o s -> Encoding)
-> ([Posting a o s] -> Value)
-> ([Posting a o s] -> Encoding)
-> ToJSON (Posting a o s)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall a o (s :: Nat).
(ToJSON a, ToJSON o, KnownNat s) =>
[Posting a o s] -> Encoding
forall a o (s :: Nat).
(ToJSON a, ToJSON o, KnownNat s) =>
[Posting a o s] -> Value
forall a o (s :: Nat).
(ToJSON a, ToJSON o, KnownNat s) =>
Posting a o s -> Encoding
forall a o (s :: Nat).
(ToJSON a, ToJSON o, KnownNat s) =>
Posting a o s -> Value
toEncodingList :: [Posting a o s] -> Encoding
$ctoEncodingList :: forall a o (s :: Nat).
(ToJSON a, ToJSON o, KnownNat s) =>
[Posting a o s] -> Encoding
toJSONList :: [Posting a o s] -> Value
$ctoJSONList :: forall a o (s :: Nat).
(ToJSON a, ToJSON o, KnownNat s) =>
[Posting a o s] -> Value
toEncoding :: Posting a o s -> Encoding
$ctoEncoding :: forall a o (s :: Nat).
(ToJSON a, ToJSON o, KnownNat s) =>
Posting a o s -> Encoding
toJSON :: Posting a o s -> Value
$ctoJSON :: forall a o (s :: Nat).
(ToJSON a, ToJSON o, KnownNat s) =>
Posting a o s -> Value
ToJSON)
  via Vanilla (Posting a o s)


-- | Returns the list of posting event sources.
postingEvents :: (KnownNat s) => Posting a o s -> [o]
postingEvents :: Posting a o s -> [o]
postingEvents (Posting NonEmpty (Event o s, Account a)
es)  = Event o s -> o
forall (s :: Nat) o. KnownNat s => Event o s -> o
eventObject (Event o s -> o)
-> ((Event o s, Account a) -> Event o s)
-> (Event o s, Account a)
-> o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Event o s, Account a) -> Event o s
forall a b. (a, b) -> a
fst ((Event o s, Account a) -> o) -> [(Event o s, Account a)] -> [o]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Event o s, Account a) -> [(Event o s, Account a)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Event o s, Account a)
es


-- | Posts an event.
post :: (KnownNat s) => Posting a o s -> [(Account a, Entry o s)]
post :: Posting a o s -> [(Account a, Entry o s)]
post (Posting NonEmpty (Event o s, Account a)
xs)       = [(Event o s, Account a)] -> [(Account a, Entry o s)]
forall (s :: Nat) o o.
KnownNat s =>
[(Event o s, Account o)] -> [(Account o, Entry o s)]
go (NonEmpty (Event o s, Account a) -> [(Event o s, Account a)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Event o s, Account a)
xs)
  where
    go :: [(Event o s, Account o)] -> [(Account o, Entry o s)]
go []              = []
    go ((Event o s
ev, Account o
ac) : [(Event o s, Account o)]
ys) = (Account o
ac, Event o s -> AccountKind -> Entry o s
forall (s :: Nat) o.
KnownNat s =>
Event o s -> AccountKind -> Entry o s
buildEntry Event o s
ev (Account o -> AccountKind
forall o. Account o -> AccountKind
accountKind Account o
ac)) (Account o, Entry o s)
-> [(Account o, Entry o s)] -> [(Account o, Entry o s)]
forall a. a -> [a] -> [a]
: [(Event o s, Account o)] -> [(Account o, Entry o s)]
go [(Event o s, Account o)]
ys


-- | Encoding of a posting entry.
--
-- >>> :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 (Entry o s -> Entry o s -> Bool
(Entry o s -> Entry o s -> Bool)
-> (Entry o s -> Entry o s -> Bool) -> Eq (Entry o s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall o (s :: Nat). Eq o => Entry o s -> Entry o s -> Bool
/= :: Entry o s -> Entry o s -> Bool
$c/= :: forall o (s :: Nat). Eq o => Entry o s -> Entry o s -> Bool
== :: Entry o s -> Entry o s -> Bool
$c== :: forall o (s :: Nat). Eq o => Entry o s -> Entry o s -> Bool
Eq, Eq (Entry o s)
Eq (Entry o s)
-> (Entry o s -> Entry o s -> Ordering)
-> (Entry o s -> Entry o s -> Bool)
-> (Entry o s -> Entry o s -> Bool)
-> (Entry o s -> Entry o s -> Bool)
-> (Entry o s -> Entry o s -> Bool)
-> (Entry o s -> Entry o s -> Entry o s)
-> (Entry o s -> Entry o s -> Entry o s)
-> Ord (Entry o s)
Entry o s -> Entry o s -> Bool
Entry o s -> Entry o s -> Ordering
Entry o s -> Entry o s -> Entry o s
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall o (s :: Nat). Ord o => Eq (Entry o s)
forall o (s :: Nat). Ord o => Entry o s -> Entry o s -> Bool
forall o (s :: Nat). Ord o => Entry o s -> Entry o s -> Ordering
forall o (s :: Nat). Ord o => Entry o s -> Entry o s -> Entry o s
min :: Entry o s -> Entry o s -> Entry o s
$cmin :: forall o (s :: Nat). Ord o => Entry o s -> Entry o s -> Entry o s
max :: Entry o s -> Entry o s -> Entry o s
$cmax :: forall o (s :: Nat). Ord o => Entry o s -> Entry o s -> Entry o s
>= :: Entry o s -> Entry o s -> Bool
$c>= :: forall o (s :: Nat). Ord o => Entry o s -> Entry o s -> Bool
> :: Entry o s -> Entry o s -> Bool
$c> :: forall o (s :: Nat). Ord o => Entry o s -> Entry o s -> Bool
<= :: Entry o s -> Entry o s -> Bool
$c<= :: forall o (s :: Nat). Ord o => Entry o s -> Entry o s -> Bool
< :: Entry o s -> Entry o s -> Bool
$c< :: forall o (s :: Nat). Ord o => Entry o s -> Entry o s -> Bool
compare :: Entry o s -> Entry o s -> Ordering
$ccompare :: forall o (s :: Nat). Ord o => Entry o s -> Entry o s -> Ordering
$cp1Ord :: forall o (s :: Nat). Ord o => Eq (Entry o s)
Ord, Int -> Entry o s -> ShowS
[Entry o s] -> ShowS
Entry o s -> String
(Int -> Entry o s -> ShowS)
-> (Entry o s -> String)
-> ([Entry o s] -> ShowS)
-> Show (Entry o s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall o (s :: Nat).
(Show o, KnownNat s) =>
Int -> Entry o s -> ShowS
forall o (s :: Nat). (Show o, KnownNat s) => [Entry o s] -> ShowS
forall o (s :: Nat). (Show o, KnownNat s) => Entry o s -> String
showList :: [Entry o s] -> ShowS
$cshowList :: forall o (s :: Nat). (Show o, KnownNat s) => [Entry o s] -> ShowS
show :: Entry o s -> String
$cshow :: forall o (s :: Nat). (Show o, KnownNat s) => Entry o s -> String
showsPrec :: Int -> Entry o s -> ShowS
$cshowsPrec :: forall o (s :: Nat).
(Show o, KnownNat s) =>
Int -> Entry o s -> ShowS
Show)


instance (Aeson.FromJSON o, KnownNat s) => Aeson.FromJSON (Entry o s) where
  parseJSON :: Value -> Parser (Entry o s)
parseJSON = String
-> (Object -> Parser (Entry o s)) -> Value -> Parser (Entry o s)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Entry" ((Object -> Parser (Entry o s)) -> Value -> Parser (Entry o s))
-> (Object -> Parser (Entry o s)) -> Value -> Parser (Entry o s)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
dorc <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type"
    Day -> o -> UnsignedQuantity s -> Entry o s
cons <- case (Char -> Char) -> Text -> Text
T.map Char -> Char
C.toUpper Text
dorc of
      Text
"DEBIT"  -> (Day -> o -> UnsignedQuantity s -> Entry o s)
-> Parser (Day -> o -> UnsignedQuantity s -> Entry o s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Day -> o -> UnsignedQuantity s -> Entry o s
forall o (s :: Nat). Day -> o -> UnsignedQuantity s -> Entry o s
EntryDebit
      Text
"CREDIT" -> (Day -> o -> UnsignedQuantity s -> Entry o s)
-> Parser (Day -> o -> UnsignedQuantity s -> Entry o s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Day -> o -> UnsignedQuantity s -> Entry o s
forall o (s :: Nat). Day -> o -> UnsignedQuantity s -> Entry o s
EntryCredit
      Text
x        -> String -> Parser (Day -> o -> UnsignedQuantity s -> Entry o s)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown entry type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
x)
    Day
date <- Object
o Object -> Text -> Parser Day
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"date"
    o
obj <- Object
o Object -> Text -> Parser o
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"obj"
    UnsignedQuantity s
qty <- Object
o Object -> Text -> Parser (UnsignedQuantity s)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"qty"
    Entry o s -> Parser (Entry o s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Day -> o -> UnsignedQuantity s -> Entry o s
cons Day
date o
obj UnsignedQuantity s
qty)


instance (Aeson.ToJSON o, KnownNat s) => Aeson.ToJSON (Entry o s) where
  toJSON :: Entry o s -> Value
toJSON Entry o s
x = case Entry o s
x of
    EntryDebit Day
d o
o UnsignedQuantity s
q  -> [Pair] -> Value
Aeson.object [Text
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"DEBIT" :: T.Text), Text
"date" Text -> Day -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Day
d, Text
"obj" Text -> o -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= o
o, Text
"qty" Text -> UnsignedQuantity s -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UnsignedQuantity s
q]
    EntryCredit Day
d o
o UnsignedQuantity s
q -> [Pair] -> Value
Aeson.object [Text
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"CREDIT" :: T.Text), Text
"date" Text -> Day -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Day
d, Text
"obj" Text -> o -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= o
o, Text
"qty" Text -> UnsignedQuantity s -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UnsignedQuantity s
q]


-- | Returns the date of the posting entry.
entryDate :: KnownNat s => Entry o s -> Day
entryDate :: Entry o s -> Day
entryDate (EntryDebit Day
d o
_ UnsignedQuantity s
_)  = Day
d
entryDate (EntryCredit Day
d o
_ UnsignedQuantity s
_) = Day
d


-- | Returns the quantity of the posting entry.
entryQuantity :: KnownNat s => Entry o s -> Quantity s
entryQuantity :: Entry o s -> Quantity s
entryQuantity (EntryDebit Day
_ o
_ UnsignedQuantity s
q)  = UnsignedQuantity s -> Quantity s
forall p x. Refined p x -> x
unrefine UnsignedQuantity s
q
entryQuantity (EntryCredit Day
_ o
_ UnsignedQuantity s
q) = -(UnsignedQuantity s -> Quantity s
forall p x. Refined p x -> x
unrefine UnsignedQuantity s
q)


-- | Returns the source object of the posting entry.
entryObject :: KnownNat s => Entry o s -> o
entryObject :: Entry o s -> o
entryObject (EntryDebit Day
_ o
o UnsignedQuantity s
_)  = o
o
entryObject (EntryCredit Day
_ o
o UnsignedQuantity s
_) = o
o


-- | Returns the debit quantity of the posting entry.
entryDebit :: KnownNat s => Entry o s -> Maybe (UnsignedQuantity s)
entryDebit :: Entry o s -> Maybe (UnsignedQuantity s)
entryDebit (EntryDebit Day
_ o
_ UnsignedQuantity s
x) = UnsignedQuantity s -> Maybe (UnsignedQuantity s)
forall a. a -> Maybe a
Just UnsignedQuantity s
x
entryDebit EntryCredit {}     = Maybe (UnsignedQuantity s)
forall a. Maybe a
Nothing


-- | Returns the credit quantity of the posting entry.
entryCredit :: KnownNat s => Entry o s -> Maybe (UnsignedQuantity s)
entryCredit :: Entry o s -> Maybe (UnsignedQuantity s)
entryCredit EntryDebit {}       = Maybe (UnsignedQuantity s)
forall a. Maybe a
Nothing
entryCredit (EntryCredit Day
_ o
_ UnsignedQuantity s
x) = UnsignedQuantity s -> Maybe (UnsignedQuantity s)
forall a. a -> Maybe a
Just UnsignedQuantity s
x


-- | 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 :: Event o s -> AccountKind -> Entry o s
buildEntry (EventDecrement Day
d o
o UnsignedQuantity s
x) AccountKind
AccountKindAsset     = Day -> o -> UnsignedQuantity s -> Entry o s
forall o (s :: Nat). Day -> o -> UnsignedQuantity s -> Entry o s
EntryCredit Day
d o
o UnsignedQuantity s
x
buildEntry (EventIncrement Day
d o
o UnsignedQuantity s
x) AccountKind
AccountKindAsset     = Day -> o -> UnsignedQuantity s -> Entry o s
forall o (s :: Nat). Day -> o -> UnsignedQuantity s -> Entry o s
EntryDebit  Day
d o
o UnsignedQuantity s
x
buildEntry (EventDecrement Day
d o
o UnsignedQuantity s
x) AccountKind
AccountKindLiability = Day -> o -> UnsignedQuantity s -> Entry o s
forall o (s :: Nat). Day -> o -> UnsignedQuantity s -> Entry o s
EntryDebit  Day
d o
o UnsignedQuantity s
x
buildEntry (EventIncrement Day
d o
o UnsignedQuantity s
x) AccountKind
AccountKindLiability = Day -> o -> UnsignedQuantity s -> Entry o s
forall o (s :: Nat). Day -> o -> UnsignedQuantity s -> Entry o s
EntryCredit Day
d o
o UnsignedQuantity s
x
buildEntry (EventDecrement Day
d o
o UnsignedQuantity s
x) AccountKind
AccountKindEquity    = Day -> o -> UnsignedQuantity s -> Entry o s
forall o (s :: Nat). Day -> o -> UnsignedQuantity s -> Entry o s
EntryDebit  Day
d o
o UnsignedQuantity s
x
buildEntry (EventIncrement Day
d o
o UnsignedQuantity s
x) AccountKind
AccountKindEquity    = Day -> o -> UnsignedQuantity s -> Entry o s
forall o (s :: Nat). Day -> o -> UnsignedQuantity s -> Entry o s
EntryCredit Day
d o
o UnsignedQuantity s
x
buildEntry (EventDecrement Day
d o
o UnsignedQuantity s
x) AccountKind
AccountKindRevenue   = Day -> o -> UnsignedQuantity s -> Entry o s
forall o (s :: Nat). Day -> o -> UnsignedQuantity s -> Entry o s
EntryDebit  Day
d o
o UnsignedQuantity s
x
buildEntry (EventIncrement Day
d o
o UnsignedQuantity s
x) AccountKind
AccountKindRevenue   = Day -> o -> UnsignedQuantity s -> Entry o s
forall o (s :: Nat). Day -> o -> UnsignedQuantity s -> Entry o s
EntryCredit Day
d o
o UnsignedQuantity s
x
buildEntry (EventDecrement Day
d o
o UnsignedQuantity s
x) AccountKind
AccountKindExpense   = Day -> o -> UnsignedQuantity s -> Entry o s
forall o (s :: Nat). Day -> o -> UnsignedQuantity s -> Entry o s
EntryCredit Day
d o
o UnsignedQuantity s
x
buildEntry (EventIncrement Day
d o
o UnsignedQuantity s
x) AccountKind
AccountKindExpense   = Day -> o -> UnsignedQuantity s -> Entry o s
forall o (s :: Nat). Day -> o -> UnsignedQuantity s -> Entry o s
EntryDebit  Day
d o
o UnsignedQuantity s
x