{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}

module Laskutin.Types 
    ( InvoiceRow(..)
    , Euro
    , IBAN
    , Invoice(..)
    , Reference
    , createReference
    , readEuro
    , readIBAN
    , readReference
    , renderEuro
    , renderIBAN
    , renderReference
    ) where

import Control.Monad (guard)
import Data.Char (isSpace, isDigit, toUpper)
import Data.List.NonEmpty (NonEmpty)
import Data.Ratio (numerator, denominator)
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Time (Day)
import Data.Csv (FromField(..), ToField(..))
import Data.Maybe (fromMaybe)

import qualified Data.Text as T

data InvoiceRow = InvoiceRow
    { price :: Euro
    , amount :: Int
    , name :: Text
    } deriving (Show, Eq)

data Invoice = Invoice
    { rows :: NonEmpty InvoiceRow
    , reference :: Reference
    , account :: IBAN
    , recipient :: Text
    , subject :: Text
    , message :: Text
    , due :: Maybe Day
    } deriving (Show, Eq)

data Reference = Reference {base :: [Digit], checksum :: Digit}
    deriving (Show, Eq)

data Digit = D0 | D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9
    deriving (Show, Eq)

data IBAN = IBAN {country :: Text, checksum :: (Digit, Digit), account :: Text}
    deriving (Show, Eq)

newtype Euro = Euro Integer -- Cents
    deriving (Eq, Ord, Show)

readIBAN :: Text -> Maybe IBAN
readIBAN text = do
    let text' = T.map toUpper $ T.filter (not . isSpace) text
    guard $ T.all ((||) <$> isDigit <*> (`elem` ['A'..'Z'])) text'
    let (country, rest) = T.splitAt 2 text'
        (checksum', account) = T.splitAt 2 rest
    guard $ T.length country == 2
    [a,b] <- sequence $ readDigit <$> T.unpack checksum'
    let checksum = (a,b)
    guard $ T.length account <= 30 -- TODO: this could check some country specific lengths
    let str = T.unpack $ account <> country <> checksum'
        charToNum c
          | isDigit c = [c] 
          | otherwise = show $ fromEnum c - fromEnum 'A' + 10
        remainder = read (concatMap charToNum str) `mod` 97
    guard $ remainder == (1 :: Integer)
    pure IBAN {country, checksum, account}

renderIBAN :: IBAN -> Text
renderIBAN IBAN {country, checksum, account} =
    T.unwords $ T.chunksOf 4 $ country <> renderedChecksum <> account
        where renderedChecksum = let (a,b) = checksum in T.pack $ renderDigit <$> [a,b]

createReference :: String -> Maybe Reference
createReference s = do
    base <- sequence $ readDigit <$> s
    guard $ length base >= 3
    let checksum = computeReferenceChecksum base
    pure Reference {base, checksum}

readReference :: String -> Maybe Reference
readReference s = do
    digits <- sequence $ readDigit <$> filter (not . isSpace) s
    guard $ length digits >= 4
    let checksum = last digits
        base = init digits
    guard $ computeReferenceChecksum base == checksum
    pure $ Reference {checksum, base}

computeReferenceChecksum :: [Digit] -> Digit
computeReferenceChecksum base =
    let checksum' = (`mod` 10) $ sum $ zipWith (*) (digitToInt <$> reverse base) (cycle [7,3,1])
     in fromMaybe (error "Impossible") $ intToDigit $ if checksum' == 0 then 0 else 10-checksum'

renderReference :: Reference -> Text
renderReference Reference {base, checksum} = T.pack $ (renderDigit <$> base) <> [renderDigit checksum]

renderReferenceBase :: Reference -> Text
renderReferenceBase Reference {base} = T.pack $ renderDigit <$> base

euroToCents :: Euro -> Integer
euroToCents (Euro a) = a

renderEuro :: Euro -> Text
renderEuro = do
    euros <- T.pack . show . (`div` 100) . euroToCents
    cents <- T.justifyRight 2 '0' . T.pack . show . (`mod` 100) . euroToCents
    pure $ euros <> "," <> cents <> "€"
    -- TODO: Test with negative euros

readEuro :: Text -> Maybe Euro
readEuro text'' = do
    guard $ not $ T.null text''
    let text' = if T.last text'' == '€' then T.init text'' else text''
        (sign, text) = if T.head text' == '-' then (negate, T.tail text') else (id, text')
    guard $ T.all (\c -> c `elem` (",." :: [Char]) || isSpace c || isDigit c) text
    sign <$> case T.split (`elem` (",." :: [Char])) $ T.filter (not . isSpace) text of
      [euros, cents] -> do
          guard $ T.length cents <= 2
          pure $ Euro (100 * read (T.unpack euros)) + Euro (read $ T.unpack $ T.justifyLeft 2 '0' cents)
      [euros] -> pure $ Euro (100 * read (T.unpack euros))
      _ -> Nothing

-- XXX: Do these instances make any sense. Multiplying euros with euros is quite weird
instance Num Euro where
    (Euro a) + (Euro b) = Euro (a + b)
    (Euro a) * (Euro b) = Euro (a * b `div` 100)
    abs (Euro a) = Euro (abs a)
    signum (Euro a) = Euro (signum a)
    negate (Euro a) = Euro (negate a)
    fromInteger x = Euro (fromInteger x * 100)

instance Fractional Euro where
    fromRational rational = Euro $ (numerator rational * 100) `div` denominator rational
    (Euro a) / (Euro b) = Euro $ (a * 100) `div` b

instance FromField Reference where
    parseField field = maybe (fail $ "Invalid reference: " <> show field) pure $
        createReference $ T.unpack $ decodeUtf8 field

instance ToField Reference where
    toField = encodeUtf8 . renderReferenceBase

instance FromField Euro where
    parseField field = maybe (fail $ "Invalid euro field: " <> show field) pure $
        readEuro $ decodeUtf8 field

instance ToField Euro where
    toField = encodeUtf8 . renderEuro

readDigit :: Char -> Maybe Digit
readDigit '0' = Just D0
readDigit '1' = Just D1
readDigit '2' = Just D2
readDigit '3' = Just D3
readDigit '4' = Just D4
readDigit '5' = Just D5
readDigit '6' = Just D6
readDigit '7' = Just D7
readDigit '8' = Just D8
readDigit '9' = Just D9
readDigit _ = Nothing

renderDigit :: Digit -> Char
renderDigit D0 = '0'
renderDigit D1 = '1'
renderDigit D2 = '2'
renderDigit D3 = '3'
renderDigit D4 = '4'
renderDigit D5 = '5'
renderDigit D6 = '6'
renderDigit D7 = '7'
renderDigit D8 = '8'
renderDigit D9 = '9'

digitToInt :: Digit -> Int
digitToInt digit = read [renderDigit digit]

intToDigit :: Int -> Maybe Digit
intToDigit x = case show x of
                 [c] -> readDigit c
                 _ -> Nothing