{-# LANGUAGE OverloadedStrings #-}

module View.Mail.WeeklyReport
  ( mail
  ) where

import Data.List (sortOn)
import Data.Map (Map)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Monoid ((<>))
import Data.Text (Text)
import Data.Time.Calendar (Day, toGregorian)
import Data.Time.Clock (UTCTime)
import qualified Data.Map as M
import qualified Data.Text as T

import Resource (Status(..), groupByStatus, statuses)

import Model.Income (Income)
import Model.Mail (Mail(Mail))
import Model.Message (getMessage, getParamMessage, plural)
import Model.Payment (Payment)
import Model.User (findUser)
import Model.User (User, UserId)
import qualified Model.Income as Income
import qualified Model.Mail as M
import qualified Model.Message.Key as K
import qualified Model.Payment as Payment
import qualified Model.User as User

import Conf (Conf)
import qualified Conf as Conf

import qualified View.Format as Format

import Utils.Time (monthToKey)

mail :: Conf -> [User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Mail
mail conf users payments incomes start end =
  Mail
    { M.from = Conf.noReplyMail conf
    , M.to = map User.email users
    , M.subject = T.concat [getMessage K.SharedCost, " − ", getMessage K.WeeklyReport]
    , M.plainBody = body conf users (groupByStatus start end payments) (groupByStatus start end incomes)
    }

body :: Conf -> [User] -> Map Status [Payment] -> Map Status [Income] -> Text
body conf users paymentsByStatus incomesByStatus =
  if M.null paymentsByStatus && M.null incomesByStatus
    then
      getMessage K.WeeklyReportEmpty
    else
      T.intercalate "\n" . catMaybes . concat $
        [ map (\s -> paymentSection s conf users <$> M.lookup s paymentsByStatus) statuses
        , map (\s -> incomeSection s conf users <$> M.lookup s incomesByStatus) statuses
        ]

paymentSection :: Status -> Conf -> [User] -> [Payment] -> Text
paymentSection status conf users payments =
  section
    (plural (length payments) singleKey pluralKey)
    (map (payedFor status conf users) . sortOn Payment.date $ payments)
  where (singleKey, pluralKey) =
          case status of
            Created -> (K.PaymentCreated, K.PaymentsCreated)
            Edited -> (K.PaymentEdited, K.PaymentsEdited)
            Deleted -> (K.PaymentDeleted, K.PaymentsDeleted)

payedFor :: Status -> Conf -> [User] -> Payment -> Text
payedFor status conf users payment =
  getParamMessage
    [ formatUserName (Payment.userId payment) users
    , Format.price conf . Payment.cost $ payment
    , Payment.name payment
    , formatDay $ Payment.date payment
    ]
    ( case status of
        Created -> K.PayedFor
        Edited -> K.PayedFor
        Deleted -> K.DidNotPayFor
    )

incomeSection :: Status -> Conf -> [User] -> [Income] -> Text
incomeSection status conf users incomes =
  section
    (plural (length incomes) singleKey pluralKey)
    (map (isPayedFrom status conf users) . sortOn Income.date $ incomes)
  where (singleKey, pluralKey) =
          case status of
            Created -> (K.IncomeCreated, K.IncomesCreated)
            Edited -> (K.IncomeEdited, K.IncomesEdited)
            Deleted -> (K.IncomeDeleted, K.IncomesDeleted)

isPayedFrom :: Status -> Conf -> [User] -> Income -> Text
isPayedFrom status conf users income =
  getParamMessage
    [ formatUserName (Income.userId income) users
    , Format.price conf . Income.amount $ income
    , formatDay $ Income.date income
    ]
    ( case status of
        Created -> K.IsPayedFrom
        Edited -> K.IsPayedFrom
        Deleted -> K.IsNotPayedFrom
    )

formatUserName :: UserId -> [User] -> Text
formatUserName userId = fromMaybe "−" . fmap User.name . findUser userId

formatDay :: Day -> Text
formatDay d =
  let (year, month, day) = toGregorian d
  in  getParamMessage
      [ T.pack . show $ day
      , fromMaybe "−" . fmap getMessage . monthToKey $ month
      , T.pack . show $ year
      ]
      K.LongDate

section :: Text -> [Text] -> Text
section title items =
  T.concat
    [ title
    , "\n\n"
    , T.unlines . map ("  - " <>) $ items
    ]