diff options
Diffstat (limited to 'app')
| -rw-r--r-- | app/Data/Iban.hs | 49 | ||||
| -rw-r--r-- | app/Import/Ing/SavingsAccountCsv.hs | 32 | ||||
| -rw-r--r-- | app/Main.hs | 3 |
3 files changed, 45 insertions, 39 deletions
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 | |||
| 15 | mkIban t = validateIban t >> return (Iban t) | 15 | mkIban t = validateIban t >> return (Iban t) |
| 16 | 16 | ||
| 17 | validateIban :: T.Text -> Either String () | 17 | validateIban :: T.Text -> Either String () |
| 18 | validateIban t = AP.parseOnly ibanP t | 18 | validateIban = AP.parseOnly $ do |
| 19 | countryCode <- AP.count 2 AP.letter | ||
| 20 | checkDigits <- AP.count 2 AP.digit | ||
| 21 | chars <- AP.many1 (AP.letter <|> AP.digit) | ||
| 22 | endOfInput | ||
| 23 | if length chars < 30 | ||
| 24 | then | ||
| 25 | if valid countryCode checkDigits chars | ||
| 26 | then return () | ||
| 27 | else fail $ "IBAN checksum does not match (" <> countryCode <> checkDigits <> chars <> ")" | ||
| 28 | else fail "IBAN has more than 34 characters" | ||
| 19 | where | 29 | where |
| 20 | ibanP = do | 30 | letterToInt c = ord (toUpper c) - ord 'A' + 10 |
| 21 | countryCode <- AP.count 2 ibanLetter | 31 | charsToInteger = |
| 22 | checkDigits <- AP.count 2 ibanDigit | 32 | foldl' |
| 23 | chars <- AP.many1 ibanChar | 33 | ( \acc -> \case |
| 24 | endOfInput | 34 | d |
| 25 | if length chars < 30 | 35 | | '0' <= d && d <= '9' -> acc * 10 + toInteger (digitToInt d) |
| 26 | then | 36 | | 'A' <= d && d <= 'Z' |
| 27 | if valid countryCode checkDigits chars | 37 | || 'a' <= d && d <= 'z' -> |
| 28 | then return () | 38 | acc * 100 + toInteger (letterToInt d) |
| 29 | else fail $ "IBAN checksum does not match (" ++ T.unpack t ++ ")" | 39 | | otherwise -> error "unreachable" |
| 30 | else fail "IBAN has more than 34 characters" | 40 | ) |
| 31 | where | 41 | 0 |
| 32 | ibanChar = ibanDigit <|> ibanLetter | 42 | ibanToInteger countryCode checkDigits chars = |
| 33 | ibanDigit = toInteger . digitToInt <$> AP.digit | 43 | charsToInteger chars * 1000000 + charsToInteger countryCode * 100 + charsToInteger checkDigits |
| 34 | ibanLetter = letterToInt <$> AP.letter | 44 | valid countryCode checkDigits chars = |
| 35 | letterToInt c = toInteger (ord (toUpper c) - ord 'A' + 10) | 45 | ibanToInteger countryCode checkDigits chars `mod` 97 == 1 |
| 36 | charsToInteger = foldl' (\acc d -> if d >= 10 then acc * 100 + d else acc * 10 + d) 0 | ||
| 37 | ibanToInteger countryCode checkDigits chars = | ||
| 38 | charsToInteger chars * 1000000 + charsToInteger countryCode * 100 + charsToInteger checkDigits | ||
| 39 | valid countryCode checkDigits chars = | ||
| 40 | 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 | |||
| 121 | mutationTypeCP "Rente" = return InterestMutation | 121 | mutationTypeCP "Rente" = return InterestMutation |
| 122 | mutationTypeCP t = fail ("Unknown mutation type '" ++ T.unpack t ++ "'") | 122 | mutationTypeCP t = fail ("Unknown mutation type '" ++ T.unpack t ++ "'") |
| 123 | 123 | ||
| 124 | parseNamedRecord :: C.NamedRecord -> C.Parser Tx | 124 | instance C.FromNamedRecord Tx where |
| 125 | parseNamedRecord m = | 125 | parseNamedRecord m = |
| 126 | eitherToCP . processPrimTx | 126 | eitherToCP . processPrimTx |
| 127 | =<< PrimTx | 127 | =<< PrimTx |
| 128 | <$> (m .: "Datum" >>= dateCP "%Y-%m-%d") | 128 | <$> (m .: "Datum" >>= dateCP "%Y-%m-%d") |
| 129 | <*> m .: "Omschrijving" | 129 | <*> m .: "Omschrijving" |
| 130 | <*> m .: "Rekening" | 130 | <*> m .: "Rekening" |
| 131 | <*> m .: "Rekening naam" | 131 | <*> m .: "Rekening naam" |
| 132 | <*> (m .: "Tegenrekening" >>= maybeCP ibanCP) | 132 | <*> (m .: "Tegenrekening" >>= maybeCP ibanCP) |
| 133 | <*> (m .: "Af Bij" >>= debitCreditCP) | 133 | <*> (m .: "Af Bij" >>= debitCreditCP) |
| 134 | <*> (m .: "Bedrag" >>= decimalCP) | 134 | <*> (m .: "Bedrag" >>= decimalCP) |
| 135 | <*> m .: "Valuta" | 135 | <*> m .: "Valuta" |
| 136 | <*> (m .: "Mutatiesoort" >>= mutationTypeCP) | 136 | <*> (m .: "Mutatiesoort" >>= mutationTypeCP) |
| 137 | <*> m .: "Mededelingen" | 137 | <*> m .: "Mededelingen" |
| 138 | <*> (m .: "Saldo na mutatie" >>= decimalCP) | 138 | <*> (m .: "Saldo na mutatie" >>= decimalCP) |
| 139 | 139 | ||
| 140 | readFile :: Handle -> IO (V.Vector Tx) | 140 | readFile :: Handle -> IO (V.Vector Tx) |
| 141 | readFile h = do | 141 | readFile h = do |
| 142 | contents <- BS.hGetContents h | 142 | contents <- BS.hGetContents h |
| 143 | case C.decodeByNameWithP parseNamedRecord scsvOptions contents of | 143 | case C.decodeByNameWith scsvOptions contents of |
| 144 | Left err -> fail err | 144 | Left err -> fail err |
| 145 | Right | 145 | Right |
| 146 | ( [ "Datum", | 146 | ( [ "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 | |||
| 16 | import Brick.Widgets.Dialog qualified as D | 16 | import Brick.Widgets.Dialog qualified as D |
| 17 | import Graphics.Vty qualified as V | 17 | import Graphics.Vty qualified as V |
| 18 | import Import.Ing.SavingsAccountCsv qualified | 18 | import Import.Ing.SavingsAccountCsv qualified |
| 19 | import Import.Ing.CurrentAccountCsv qualified | ||
| 19 | import System.IO (IOMode (ReadMode), withFile) | 20 | import System.IO (IOMode (ReadMode), withFile) |
| 20 | import Text.Pretty.Simple (pPrint) | 21 | import Text.Pretty.Simple (pPrint) |
| 21 | 22 | ||
| @@ -93,7 +94,7 @@ main = do | |||
| 93 | let filename = "/home/rutgerbrf/Code/P/wayligmative/test.csv" | 94 | let filename = "/home/rutgerbrf/Code/P/wayligmative/test.csv" |
| 94 | putStrLn $ "Reading " ++ filename | 95 | putStrLn $ "Reading " ++ filename |
| 95 | withFile filename ReadMode $ \h -> do | 96 | withFile filename ReadMode $ \h -> do |
| 96 | entries <- Import.Ing.SavingsAccountCsv.readFile h | 97 | entries <- Import.Ing.CurrentAccountCsv.readFile h |
| 97 | pPrint entries | 98 | pPrint entries |
| 98 | 99 | ||
| 99 | -- d <- M.defaultMain theApp initialState | 100 | -- d <- M.defaultMain theApp initialState |