{-# LANGUAGE DataKinds      #-}
{-# LANGUAGE KindSignatures #-}

module Haspara.Accounting.Entry where

import           Data.Aeson                     ((.:), (.=))
import qualified Data.Aeson                     as Aeson
import qualified Data.Char                      as C
import qualified Data.Text                      as T
import           GHC.TypeLits                   (KnownNat, Nat)
import qualified Haspara                        as H
import           Haspara.Accounting.AccountKind (AccountKind(..))
import           Haspara.Accounting.Event       (Event(..))
import           Haspara.Accounting.Types       (UnsignedQuantity)
import           Refined                        (unrefine)


-- | 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,\"obj\":1,\"date\":\"2021-01-01\",\"type\":\"DEBIT\"}"
-- >>> 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 H.Date o (UnsignedQuantity s)
  | EntryCredit H.Date 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"
    Date -> o -> UnsignedQuantity s -> Entry o s
cons <- case (Char -> Char) -> Text -> Text
T.map Char -> Char
C.toUpper Text
dorc of
      Text
"DEBIT"  -> (Date -> o -> UnsignedQuantity s -> Entry o s)
-> Parser (Date -> o -> UnsignedQuantity s -> Entry o s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Date -> o -> UnsignedQuantity s -> Entry o s
forall o (s :: Nat). Date -> o -> UnsignedQuantity s -> Entry o s
EntryDebit
      Text
"CREDIT" -> (Date -> o -> UnsignedQuantity s -> Entry o s)
-> Parser (Date -> o -> UnsignedQuantity s -> Entry o s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Date -> o -> UnsignedQuantity s -> Entry o s
forall o (s :: Nat). Date -> o -> UnsignedQuantity s -> Entry o s
EntryCredit
      Text
x        -> String -> Parser (Date -> 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)
    Date
date <- Object
o Object -> Text -> Parser Date
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 (Date -> o -> UnsignedQuantity s -> Entry o s
cons Date
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 Date
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 -> Date -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Date
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 Date
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 -> Date -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Date
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]


entryDate :: KnownNat s => Entry o s -> H.Date
entryDate :: Entry o s -> Date
entryDate (EntryDebit Date
d o
_ UnsignedQuantity s
_)  = Date
d
entryDate (EntryCredit Date
d o
_ UnsignedQuantity s
_) = Date
d


entryQuantity :: KnownNat s => Entry o s -> H.Quantity s
entryQuantity :: Entry o s -> Quantity s
entryQuantity (EntryDebit Date
_ o
_ UnsignedQuantity s
q)  = UnsignedQuantity s -> Quantity s
forall p x. Refined p x -> x
unrefine UnsignedQuantity s
q
entryQuantity (EntryCredit Date
_ o
_ UnsignedQuantity s
q) = -(UnsignedQuantity s -> Quantity s
forall p x. Refined p x -> x
unrefine UnsignedQuantity s
q)


entryObject :: KnownNat s => Entry o s -> o
entryObject :: Entry o s -> o
entryObject (EntryDebit Date
_ o
o UnsignedQuantity s
_)  = o
o
entryObject (EntryCredit Date
_ o
o UnsignedQuantity s
_) = o
o


entryDebit :: KnownNat s => Entry o s -> Maybe (UnsignedQuantity s)
entryDebit :: Entry o s -> Maybe (UnsignedQuantity s)
entryDebit (EntryDebit Date
_ 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


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 Date
_ o
_ UnsignedQuantity s
x) = UnsignedQuantity s -> Maybe (UnsignedQuantity s)
forall a. a -> Maybe a
Just UnsignedQuantity s
x


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