{-# LANGUAGE OverloadedStrings #-}

module View.Mail.WeeklyReport
  ( mail
  ) where

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

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

import Database.Persist (Entity, entityVal)

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

import Conf (Conf)
import qualified Conf as Conf

import qualified View.Format as Format

import Utils.Time (monthToKey)

mail :: Conf -> [Entity User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Mail
mail conf users payments incomes start end =
  Mail
    { M.from = Conf.noReplyMail conf
    , M.to = map (D.userEmail . entityVal) 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 -> [Entity 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\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 -> [Entity User] -> [Payment] -> Text
paymentSection status conf users payments =
  section
    (plural (length payments) singleKey pluralKey)
    (map (payedFor status conf users) . sortOn D.paymentDate $ 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 -> [Entity User] -> Payment -> Text
payedFor status conf users payment =
  getParamMessage
    [ formatUserName (D.paymentUserId payment) users
    , Format.price conf . D.paymentCost $ payment
    , D.paymentName payment
    , formatDay $ D.paymentDate payment
    ]
    ( case status of
        Created -> K.PayedFor
        Edited -> K.PayedFor
        Deleted -> K.DidNotPayFor
    )

incomeSection :: Status -> Conf -> [Entity User] -> [Income] -> Text
incomeSection status conf users incomes =
  section
    (plural (length incomes) singleKey pluralKey)
    (map (isPayedFrom status conf users) . sortOn D.incomeDate $ 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 -> [Entity User] -> Income -> Text
isPayedFrom status conf users income =
  getParamMessage
    [ formatUserName (D.incomeUserId income) users
    , Format.price conf . D.incomeAmount $ income
    , formatDay $ D.incomeDate income
    ]
    ( case status of
        Created -> K.IsPayedFrom
        Edited -> K.IsPayedFrom
        Deleted -> K.IsNotPayedFrom
    )

formatUserName :: UserId -> [Entity User] -> Text
formatUserName userId = fromMaybe "−" . fmap D.userName . 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"
    , T.unlines . map ("  - " <>) $ items
    ]