-- | 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           GHC.Generics               (Generic)
import           GHC.TypeLits               (KnownNat, Nat)
import           Haspara.Accounting.Account (Account(accountKind), AccountKind(..))
import           Haspara.Accounting.Event   (Event(..), eventObject)
import           Haspara.Internal.Aeson     (commonAesonOptions)
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)


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


instance (Aeson.ToJSON a, Aeson.ToJSON o, KnownNat s) => Aeson.ToJSON (Ledger a o s) where
  toJSON :: Ledger a o s -> Value
toJSON = Options -> Ledger a o s -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON (Options -> Ledger a o s -> Value)
-> Options -> Ledger a o s -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"ledger"


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


instance (Aeson.FromJSON o, KnownNat s) => Aeson.FromJSON (LedgerItem o s) where
  parseJSON :: Value -> Parser (LedgerItem o s)
parseJSON = Options -> Value -> Parser (LedgerItem o s)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON (Options -> Value -> Parser (LedgerItem o s))
-> Options -> Value -> Parser (LedgerItem o s)
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"ledgerItem"


instance (Aeson.ToJSON o, KnownNat s) => Aeson.ToJSON (LedgerItem o s) where
  toJSON :: LedgerItem o s -> Value
toJSON = Options -> LedgerItem o s -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON (Options -> LedgerItem o s -> Value)
-> Options -> LedgerItem o s -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"ledgerItem"


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


instance (Aeson.FromJSON a, Aeson.FromJSON o, KnownNat s) => Aeson.FromJSON (Posting a o s) where
  parseJSON :: Value -> Parser (Posting a o s)
parseJSON = Options -> Value -> Parser (Posting a o s)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
Aeson.defaultOptions


instance (Aeson.ToJSON a, Aeson.ToJSON o, KnownNat s) => Aeson.ToJSON (Posting a o s) where
  toJSON :: Posting a o s -> Value
toJSON = Options -> Posting a o s -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
Aeson.defaultOptions


-- | 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 -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 -> Key -> Parser Day
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"date"
    o
obj <- Object
o Object -> Key -> Parser o
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"obj"
    UnsignedQuantity s
qty <- Object
o Object -> Key -> Parser (UnsignedQuantity s)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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 [Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"DEBIT" :: T.Text), Key
"date" Key -> Day -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Day
d, Key
"obj" Key -> o -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= o
o, Key
"qty" Key -> UnsignedQuantity s -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UnsignedQuantity s
q]
    EntryCredit Day
d o
o UnsignedQuantity s
q -> [Pair] -> Value
Aeson.object [Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"CREDIT" :: T.Text), Key
"date" Key -> Day -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Day
d, Key
"obj" Key -> o -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= o
o, Key
"qty" Key -> UnsignedQuantity s -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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