diff options
author | Rutger Broekhoff | 2025-07-23 20:25:55 +0200 |
---|---|---|
committer | Rutger Broekhoff | 2025-07-23 20:25:55 +0200 |
commit | 29b26dcbc1404925bbf12cddd66f7fcd3c57cfe7 (patch) | |
tree | 9a6d7e7a83b7627bbe29e30c658b991bf45b62f7 /app | |
parent | 16103a4d886605b49bc2f21f06eb99513e4fac60 (diff) | |
download | rdcapsis-main.tar.gz rdcapsis-main.zip |
Diffstat (limited to 'app')
-rw-r--r-- | app/Data/Ledger.hs | 10 | ||||
-rw-r--r-- | app/Import/Ing/Convert.hs | 31 |
2 files changed, 31 insertions, 10 deletions
diff --git a/app/Data/Ledger.hs b/app/Data/Ledger.hs index 53901cb..4aa5137 100644 --- a/app/Data/Ledger.hs +++ b/app/Data/Ledger.hs | |||
@@ -94,8 +94,8 @@ data Account = Account | |||
94 | -- cleared and the balance of the account agrees with the amount in the | 94 | -- cleared and the balance of the account agrees with the amount in the |
95 | -- assertion. | 95 | -- assertion. |
96 | data BalAssert = BalAssert | 96 | data BalAssert = BalAssert |
97 | { account :: Account, | 97 | { account :: AccountId, |
98 | amount :: Integer, | 98 | amount :: Money, |
99 | labels :: Labels | 99 | labels :: Labels |
100 | } | 100 | } |
101 | 101 | ||
@@ -108,8 +108,8 @@ data Tx = Tx | |||
108 | } | 108 | } |
109 | deriving (Show, Generic) | 109 | deriving (Show, Generic) |
110 | 110 | ||
111 | data SeqTx = SeqTx [Integer] Tx | 111 | -- data SeqTx = SeqTx [Integer] Tx |
112 | 112 | ||
113 | data LedgerEntry = TxEntry SeqTx | BalAssertEntry BalAssert | 113 | data Entry = TxEntry Tx | BalAssertEntry BalAssert |
114 | 114 | ||
115 | data Ledger = Ledger [LedgerEntry] | 115 | data Ledger = Ledger [Entry] |
diff --git a/app/Import/Ing/Convert.hs b/app/Import/Ing/Convert.hs index 36ce99f..5dcda0b 100644 --- a/app/Import/Ing/Convert.hs +++ b/app/Import/Ing/Convert.hs | |||
@@ -8,6 +8,7 @@ import Data.Functor.Identity | |||
8 | import Data.Iban qualified as Iban | 8 | import Data.Iban qualified as Iban |
9 | import Data.Ledger as L | 9 | import Data.Ledger as L |
10 | import Data.Map qualified as M | 10 | import Data.Map qualified as M |
11 | import Data.Res | ||
11 | import Data.Text qualified as T | 12 | import Data.Text qualified as T |
12 | import Import.Ing.CurrentAccountCsv as C | 13 | import Import.Ing.CurrentAccountCsv as C |
13 | import Import.Ing.SavingsAccountCsv as S | 14 | import Import.Ing.SavingsAccountCsv as S |
@@ -21,12 +22,12 @@ virtSavingsAcc = AccountId ["Unfiled", "Savings"] | |||
21 | virtCounterparty :: L.AccountId | 22 | virtCounterparty :: L.AccountId |
22 | virtCounterparty = AccountId ["Unfiled", "Counterparty"] | 23 | virtCounterparty = AccountId ["Unfiled", "Counterparty"] |
23 | 24 | ||
24 | toCents :: Decimal -> Either String L.Money | 25 | toCents :: Decimal -> Res String L.Money |
25 | toCents m | 26 | toCents m |
26 | | f == 0 = | 27 | | f == 0 = |
27 | return (L.Money m') | 28 | return (L.Money m') |
28 | | otherwise = | 29 | | otherwise = |
29 | Left "Cannot convert to whole cents: amount of money is more specific" | 30 | fail "Cannot convert to whole cents: amount of money is more specific" |
30 | where | 31 | where |
31 | (m', f) = properFraction (m * 100) | 32 | (m', f) = properFraction (m * 100) |
32 | 33 | ||
@@ -34,10 +35,30 @@ condUnitLabel :: UnitTag -> Bool -> L.Labels | |||
34 | condUnitLabel _ False = empty | 35 | condUnitLabel _ False = empty |
35 | condUnitLabel t True = singleton (UnitLabel t) (Identity ()) | 36 | condUnitLabel t True = singleton (UnitLabel t) (Identity ()) |
36 | 37 | ||
37 | fromCurrentAccTx :: CommodityId -> C.Tx -> Either String L.Tx | 38 | lesFromCurrentAcc :: CommodityId -> C.Tx -> Res String [L.Entry] |
38 | fromCurrentAccTx eucId (C.Tx base spec) = do | 39 | lesFromCurrentAcc eucId tx@(C.Tx base _) = do |
40 | tx' <- txFromCurrentAcc eucId tx | ||
41 | ba <- baFromCurrentAccBase base | ||
42 | return [BalAssertEntry ba, TxEntry tx'] | ||
43 | |||
44 | baFromCurrentAccBase :: C.TxBase -> Res String L.BalAssert | ||
45 | baFromCurrentAccBase base = do | ||
46 | resBal <- toCents base.resBal | ||
47 | return $ | ||
48 | L.BalAssert | ||
49 | { account = virtCheckingAcc, | ||
50 | amount = resBal, | ||
51 | labels = | ||
52 | fromList [IbanLabel AccountTag ==> base.account] | ||
53 | } | ||
54 | |||
55 | baFromCurrentAcc :: C.Tx -> Res String L.BalAssert | ||
56 | baFromCurrentAcc (C.Tx base _) = baFromCurrentAccBase base | ||
57 | |||
58 | txFromCurrentAcc :: CommodityId -> C.Tx -> Res String L.Tx | ||
59 | txFromCurrentAcc eucId (C.Tx base spec) = do | ||
39 | when (base.amount < 0) $ | 60 | when (base.amount < 0) $ |
40 | Left "Transaction amount may not be lower than zero" | 61 | fail "Transaction amount may not be lower than zero" |
41 | amount <- L.Amount <$> toCents base.amount | 62 | amount <- L.Amount <$> toCents base.amount |
42 | case spec of | 63 | case spec of |
43 | PaymentTerminalPayment | 64 | PaymentTerminalPayment |