269 lines
9.2 KiB
Haskell
269 lines
9.2 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
|
|
module Data.TITO.Parser where
|
|
|
|
import Data.Time
|
|
import Data.Maybe
|
|
import Control.Monad
|
|
|
|
import Data.Char (isSpace)
|
|
import Data.Decimal (DecimalRaw(Decimal))
|
|
import Data.Text (Text)
|
|
import Data.Void (Void)
|
|
import Text.Megaparsec ((<|>))
|
|
import Data.List.NonEmpty (NonEmpty((:|)))
|
|
|
|
import qualified Data.ByteString as BS
|
|
import qualified Data.ByteString.Char8 as C8
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Encoding as TE
|
|
import qualified Text.Megaparsec as P
|
|
import qualified Text.Megaparsec.Byte as P
|
|
|
|
import Data.TITO.Types
|
|
|
|
type Parser = P.Parsec Void BS.ByteString
|
|
type ParseErrors = P.ParseErrorBundle BS.ByteString Void
|
|
|
|
record' :: BS.ByteString -> (Int -> Parser a) -> Parser a
|
|
record' typeId parser = do
|
|
P.char 84 -- T
|
|
P.string typeId
|
|
recordLength <- numeric 3
|
|
result <- parser $ fromIntegral recordLength
|
|
P.takeWhileP Nothing (/= 13) -- carriage return; we should accept longer records than documented
|
|
P.crlf
|
|
pure result
|
|
|
|
record :: BS.ByteString -> Parser a -> Parser a
|
|
record typeId parser = record' typeId $ const parser
|
|
|
|
numeric :: Int -> Parser Integer
|
|
numeric fieldLength = read . C8.unpack . BS.pack <$> P.count fieldLength P.digitChar
|
|
|
|
decodeCP1018 :: BS.ByteString -> Text
|
|
decodeCP1018 = T.map replacement . TE.decodeUtf8
|
|
where replacement '$' = '¤'
|
|
replacement '[' = 'Ä'
|
|
replacement '\\' = 'Ö'
|
|
replacement ']' = 'Å'
|
|
replacement '{' = 'ä'
|
|
replacement '|' = 'ö'
|
|
replacement '}' = 'å'
|
|
replacement '~' = '¯'
|
|
replacement x = x
|
|
|
|
alphaNumeric :: Int -> Parser Text
|
|
alphaNumeric fieldLength =
|
|
decodeCP1018 . C8.dropWhileEnd (== ' ') . BS.pack <$>
|
|
P.count fieldLength P.printChar
|
|
|
|
date :: Parser Day
|
|
date = do
|
|
year <- fromIntegral <$> numeric 2
|
|
month <- fromIntegral <$> numeric 2
|
|
day <- fromIntegral <$> numeric 2
|
|
pure $ fromGregorian (2000 + year) month day -- TODO: Validate
|
|
|
|
timestamp :: Parser LocalTime
|
|
timestamp = LocalTime <$> date <*> timeOfDay
|
|
|
|
timeOfDay :: Parser TimeOfDay
|
|
timeOfDay = do
|
|
hour <- fromIntegral <$> numeric 2
|
|
minute <- fromIntegral <$> numeric 2
|
|
pure $ TimeOfDay hour minute 0 -- TODO: Validate
|
|
|
|
money :: Parser Money
|
|
money = do
|
|
sign <- P.label "+ or -" $ P.oneOf [43, 45] -- +, -
|
|
let setSign | sign == 43 = id
|
|
| sign == 45 = negate
|
|
Money . Decimal 2 . setSign <$> numeric 18
|
|
|
|
optional :: Int -> Parser a -> Parser (Maybe a)
|
|
optional n p = P.try (P.count n (P.char 32) *> pure Nothing) <|> (Just <$> p)
|
|
|
|
optional' :: (Int -> Parser a) -> Int -> Parser (Maybe a)
|
|
optional' p n = P.try (P.count n (P.char 32) *> pure Nothing) <|> (Just <$> p n)
|
|
|
|
transactionType :: Parser TransactionType
|
|
transactionType = do
|
|
n <- numeric 1
|
|
case n of
|
|
1 -> pure Deposit
|
|
2 -> pure Withdrawal
|
|
3 -> pure DepositCorrection
|
|
4 -> pure WithdrawalCorrection
|
|
9 -> pure Declined
|
|
_ -> P.failure Nothing mempty -- TODO: proper error message
|
|
|
|
period :: Parser Period
|
|
period = do
|
|
n <- numeric 1
|
|
case n of
|
|
1 -> pure Day
|
|
2 -> pure Statement
|
|
3 -> pure Month
|
|
4 -> pure Year
|
|
_ -> P.failure Nothing mempty -- TODO: proper error message
|
|
|
|
nameSource :: Parser NameSource
|
|
nameSource = do
|
|
x <- alphaNumeric 1
|
|
case x of
|
|
"J" -> pure BankDatabase
|
|
"K" -> pure BankOffice
|
|
"A" -> pure Customer
|
|
_ -> P.failure Nothing mempty -- TODO: proper error message
|
|
|
|
accountStatement :: Parser AccountStatement
|
|
accountStatement = do
|
|
tito <- record "00" $ do
|
|
P.string "100" -- version number
|
|
account <- alphaNumeric 14
|
|
statementNumber <- alphaNumeric 3
|
|
startDate <- date
|
|
endDate <- date
|
|
created <- timestamp
|
|
customer <- alphaNumeric 17
|
|
startBalanceDate <- date
|
|
startBalance <- money
|
|
_records <- optional' numeric 6
|
|
currency <- optional' alphaNumeric 3
|
|
accountName <- optional' alphaNumeric 30
|
|
accountLimit <- fmap (Money . Decimal 2) <$> optional' numeric 18
|
|
accountOwnerName <- alphaNumeric 35
|
|
bankName <- alphaNumeric 40
|
|
contactInformation <- optional' alphaNumeric 40
|
|
bankSpecific <- optional' alphaNumeric 30
|
|
ibanAndBic <- fmap (fmap $ T.break isSpace) $ optional' alphaNumeric 30 -- FI1234567 XXXXX
|
|
return AccountStatement {events = [], ..}
|
|
events <- P.many titoRecord <* P.eof
|
|
pure $ tito {events}
|
|
|
|
titoRecord :: Parser Event
|
|
titoRecord = P.try transaction
|
|
<|> P.try balance
|
|
<|> P.try summary
|
|
<|> P.try correctionSummary
|
|
<|> P.try bankSpecific
|
|
<|> P.try message
|
|
<|> P.try transactionNotification
|
|
|
|
transaction, transactionNotification :: Parser Event
|
|
transaction = BasicTransaction <$> transaction' 0 False
|
|
transactionNotification = TransactionNotification <$> transaction' 0 True
|
|
|
|
transaction' :: Int -> Bool -> Parser Transaction
|
|
transaction' minimumDepth isNotification = do
|
|
(depth, transaction) <- record (if isNotification then "80" else "10") $ do
|
|
transactionNumber <- numeric 6
|
|
archiveId <- optional' alphaNumeric 18
|
|
parsedDate <- date
|
|
valueDate <- optional 6 date
|
|
paymentDate <- optional 6 date
|
|
transactionType <- transactionType
|
|
descriptionCode <- alphaNumeric 3
|
|
descriptionText <- alphaNumeric 35
|
|
amount <- money
|
|
receiptCode <- alphaNumeric 1
|
|
transferMethod <- alphaNumeric 1
|
|
payeeName <- optional' alphaNumeric 35
|
|
nameSource <- optional 1 nameSource
|
|
recipientAccount <- optional' alphaNumeric 14
|
|
accountChanged <- optional' alphaNumeric 1
|
|
reference <- optional' numeric 20
|
|
formNumber <- optional' alphaNumeric 8
|
|
depth <- fromIntegral <$> numeric 1 <|> const 0 <$> P.char 32 -- space
|
|
guard $ depth >= minimumDepth
|
|
return (depth, Transaction {details = [], itemisation = [], date = parsedDate, ..})
|
|
details <- P.many $ P.try $ transactionDetail' isNotification
|
|
itemisation <- P.many $ P.try $ transaction' (depth + 1) isNotification
|
|
pure $ transaction {details, itemisation}
|
|
|
|
transactionDetail' :: Bool -> Parser TransactionDetail
|
|
transactionDetail' isNotification =
|
|
record' (if isNotification then "81" else "11") $ \recordLength -> do
|
|
let detailLength = recordLength - 8
|
|
detailType <- optional' alphaNumeric 2
|
|
case detailType of
|
|
Just "00" -> do
|
|
first <- alphaNumeric 35
|
|
rest <- P.count' 0 11 (optional' alphaNumeric 35)
|
|
pure $ Freeform $ first :| catMaybes rest
|
|
Just "01" -> Number <$> numeric 8
|
|
Just "02" -> do
|
|
customer <- alphaNumeric 10
|
|
alphaNumeric 1
|
|
invoice <- alphaNumeric 15
|
|
alphaNumeric 1
|
|
date <- date
|
|
pure Invoice {..}
|
|
Just "03" -> Card <$> alphaNumeric 19 <* alphaNumeric 1 <*> optional' alphaNumeric 14
|
|
Just "04" -> Correction <$> alphaNumeric 18
|
|
Just "05" -> do
|
|
foreignAmount <- money
|
|
alphaNumeric 1
|
|
currency <- alphaNumeric 3
|
|
alphaNumeric 1
|
|
exchangeRate <- numeric 11
|
|
exchangeReference <- optional' alphaNumeric 6
|
|
pure ForeignCurrency {..}
|
|
Just "06" -> fmap Notes $ (:|) <$> alphaNumeric 35 <*> (maybeToList <$> optional' alphaNumeric 35)
|
|
Just "07" -> do
|
|
first <- alphaNumeric 35
|
|
rest <- P.count' 0 11 (optional' alphaNumeric 35)
|
|
pure $ BankFreeform $ first :| catMaybes rest
|
|
Just "08" -> PaymentSubject <$> numeric 3 <* alphaNumeric 1 <*> alphaNumeric 31
|
|
Just "09" -> Name <$> alphaNumeric 35
|
|
Just "11" -> do
|
|
payersReference <- optional' alphaNumeric 35
|
|
payeeIBAN <- optional' alphaNumeric 35
|
|
payeeBIC <- optional' alphaNumeric 35
|
|
payeeName <- optional' alphaNumeric 70
|
|
payerName <- optional' alphaNumeric 70
|
|
payerId <- optional' alphaNumeric 35
|
|
archiveId <- optional' alphaNumeric 35
|
|
pure SEPA {..}
|
|
_ -> Unknown <$> alphaNumeric detailLength
|
|
|
|
balance :: Parser Event
|
|
balance = record "40" $ do
|
|
date <- date
|
|
endBalance <- money
|
|
usableBalance <- optional 19 money
|
|
pure Balance {..}
|
|
|
|
summary :: Parser Event
|
|
summary = record "50" $ do
|
|
period <- period
|
|
date <- date
|
|
deposits <- numeric 8
|
|
depositsTotal <- money
|
|
withdrawals <- numeric 8
|
|
withdrawalsTotal <- money
|
|
pure Summary {..}
|
|
|
|
correctionSummary :: Parser Event
|
|
correctionSummary = record "51" $ do
|
|
period <- period
|
|
date <- date
|
|
depositCorrections <- numeric 8
|
|
depositCorrectionsTotal <- money
|
|
withdrawalCorrections <- numeric 8
|
|
withdrawalCorrectionsTotal <- money
|
|
pure CorrectionSummary {..}
|
|
|
|
bankSpecific :: Parser Event
|
|
bankSpecific = record' "60" $ \recordLength -> do
|
|
BankSpecific <$> alphaNumeric 3 <*> P.takeP Nothing (recordLength - 9)
|
|
|
|
message :: Parser Event
|
|
message = record' "70" $ \recordLength -> do
|
|
bankId <- alphaNumeric 3
|
|
message <- T.unlines . T.chunksOf 80 <$> alphaNumeric (recordLength - 9)
|
|
pure Message {..}
|