{-# LANGUAGE DataKinds       #-}
{-# LANGUAGE DeriveGeneric   #-}
{-# LANGUAGE DerivingVia     #-}
{-# LANGUAGE KindSignatures  #-}
{-# LANGUAGE TemplateHaskell #-}

module Haspara.Accounting.Posting where

import qualified Data.List.NonEmpty         as NE
import           Deriving.Aeson             (CustomJSON(CustomJSON), FromJSON, Generic, ToJSON)
import           Deriving.Aeson.Stock       (Vanilla)
import           GHC.TypeLits               (KnownNat, Nat)
import           Haspara.Accounting.Account (Account(accountKind))
import           Haspara.Accounting.Entry   (Entry, buildEntry)
import           Haspara.Accounting.Event   (Event, eventObject)


-- | 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,\"obj\":1,\"date\":\"2021-01-01\",\"type\":\"DECREMENT\"},{\"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)


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


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