From e40e290ef216656d304f4f3095dbef223e94191d Mon Sep 17 00:00:00 2001
From: Rutger Broekhoff
Date: Fri, 21 Mar 2025 09:45:22 +0100
Subject: Changes

---
 app/Data/Iban.hs                    | 49 ++++++++++++++++++++-----------------
 app/Import/Ing/SavingsAccountCsv.hs | 32 ++++++++++++------------
 app/Main.hs                         |  3 ++-
 3 files changed, 45 insertions(+), 39 deletions(-)

(limited to 'app')

diff --git a/app/Data/Iban.hs b/app/Data/Iban.hs
index a42e192..45343ec 100644
--- a/app/Data/Iban.hs
+++ b/app/Data/Iban.hs
@@ -15,26 +15,31 @@ mkIban :: T.Text -> Either String Iban
 mkIban t = validateIban t >> return (Iban t)
 
 validateIban :: T.Text -> Either String ()
-validateIban t = AP.parseOnly ibanP t
+validateIban = AP.parseOnly $ do
+  countryCode <- AP.count 2 AP.letter
+  checkDigits <- AP.count 2 AP.digit
+  chars <- AP.many1 (AP.letter <|> AP.digit)
+  endOfInput
+  if length chars < 30
+    then
+      if valid countryCode checkDigits chars
+        then return ()
+        else fail $ "IBAN checksum does not match (" <> countryCode <> checkDigits <> chars <> ")"
+    else fail "IBAN has more than 34 characters"
   where
-    ibanP = do
-      countryCode <- AP.count 2 ibanLetter
-      checkDigits <- AP.count 2 ibanDigit
-      chars <- AP.many1 ibanChar
-      endOfInput
-      if length chars < 30
-        then
-          if valid countryCode checkDigits chars
-            then return ()
-            else fail $ "IBAN checksum does not match (" ++ T.unpack t ++ ")"
-        else fail "IBAN has more than 34 characters"
-      where
-        ibanChar = ibanDigit <|> ibanLetter
-        ibanDigit = toInteger . digitToInt <$> AP.digit
-        ibanLetter = letterToInt <$> AP.letter
-        letterToInt c = toInteger (ord (toUpper c) - ord 'A' + 10)
-        charsToInteger = foldl' (\acc d -> if d >= 10 then acc * 100 + d else acc * 10 + d) 0
-        ibanToInteger countryCode checkDigits chars =
-          charsToInteger chars * 1000000 + charsToInteger countryCode * 100 + charsToInteger checkDigits
-        valid countryCode checkDigits chars =
-          ibanToInteger countryCode checkDigits chars `mod` 97 == 1
+    letterToInt c = ord (toUpper c) - ord 'A' + 10
+    charsToInteger =
+      foldl'
+        ( \acc -> \case
+            d
+              | '0' <= d && d <= '9' -> acc * 10 + toInteger (digitToInt d)
+              | 'A' <= d && d <= 'Z'
+                  || 'a' <= d && d <= 'z' ->
+                  acc * 100 + toInteger (letterToInt d)
+              | otherwise -> error "unreachable"
+        )
+        0
+    ibanToInteger countryCode checkDigits chars =
+      charsToInteger chars * 1000000 + charsToInteger countryCode * 100 + charsToInteger checkDigits
+    valid countryCode checkDigits chars =
+      ibanToInteger countryCode checkDigits chars `mod` 97 == 1
diff --git a/app/Import/Ing/SavingsAccountCsv.hs b/app/Import/Ing/SavingsAccountCsv.hs
index f6632fc..3f2e5e6 100644
--- a/app/Import/Ing/SavingsAccountCsv.hs
+++ b/app/Import/Ing/SavingsAccountCsv.hs
@@ -121,26 +121,26 @@ mutationTypeCP "Opname" = return WithdrawalMutation
 mutationTypeCP "Rente" = return InterestMutation
 mutationTypeCP t = fail ("Unknown mutation type '" ++ T.unpack t ++ "'")
 
-parseNamedRecord :: C.NamedRecord -> C.Parser Tx
-parseNamedRecord m =
-  eitherToCP . processPrimTx
-    =<< PrimTx
-      <$> (m .: "Datum" >>= dateCP "%Y-%m-%d")
-      <*> m .: "Omschrijving"
-      <*> m .: "Rekening"
-      <*> m .: "Rekening naam"
-      <*> (m .: "Tegenrekening" >>= maybeCP ibanCP)
-      <*> (m .: "Af Bij" >>= debitCreditCP)
-      <*> (m .: "Bedrag" >>= decimalCP)
-      <*> m .: "Valuta"
-      <*> (m .: "Mutatiesoort" >>= mutationTypeCP)
-      <*> m .: "Mededelingen"
-      <*> (m .: "Saldo na mutatie" >>= decimalCP)
+instance C.FromNamedRecord Tx where
+  parseNamedRecord m =
+    eitherToCP . processPrimTx
+      =<< PrimTx
+        <$> (m .: "Datum" >>= dateCP "%Y-%m-%d")
+        <*> m .: "Omschrijving"
+        <*> m .: "Rekening"
+        <*> m .: "Rekening naam"
+        <*> (m .: "Tegenrekening" >>= maybeCP ibanCP)
+        <*> (m .: "Af Bij" >>= debitCreditCP)
+        <*> (m .: "Bedrag" >>= decimalCP)
+        <*> m .: "Valuta"
+        <*> (m .: "Mutatiesoort" >>= mutationTypeCP)
+        <*> m .: "Mededelingen"
+        <*> (m .: "Saldo na mutatie" >>= decimalCP)
 
 readFile :: Handle -> IO (V.Vector Tx)
 readFile h = do
   contents <- BS.hGetContents h
-  case C.decodeByNameWithP parseNamedRecord scsvOptions contents of
+  case C.decodeByNameWith scsvOptions contents of
     Left err -> fail err
     Right
       ( [ "Datum",
diff --git a/app/Main.hs b/app/Main.hs
index 2438203..403b78f 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -16,6 +16,7 @@ import Brick.Widgets.Core
 import Brick.Widgets.Dialog qualified as D
 import Graphics.Vty qualified as V
 import Import.Ing.SavingsAccountCsv qualified
+import Import.Ing.CurrentAccountCsv qualified
 import System.IO (IOMode (ReadMode), withFile)
 import Text.Pretty.Simple (pPrint)
 
@@ -93,7 +94,7 @@ main = do
   let filename = "/home/rutgerbrf/Code/P/wayligmative/test.csv"
   putStrLn $ "Reading " ++ filename
   withFile filename ReadMode $ \h -> do
-    entries <- Import.Ing.SavingsAccountCsv.readFile h
+    entries <- Import.Ing.CurrentAccountCsv.readFile h
     pPrint entries
 
 --  d <- M.defaultMain theApp initialState
-- 
cgit v1.2.3