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 | |
| parent | 16103a4d886605b49bc2f21f06eb99513e4fac60 (diff) | |
| download | rdcapsis-main.tar.gz rdcapsis-main.zip | |
| -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 |