{-# 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 {..}