{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE RecursiveDo               #-}

module View.Payment.Table
  ( widget
  , TableIn(..)
  , TableOut(..)
  ) where

import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.List as L
import qualified Data.Map as M
import Prelude hiding (init)
import Reflex.Dom (MonadWidget)
import qualified Reflex.Dom as R

import qualified Common.Message as Message
import qualified Common.Message.Key as Key
import Common.Model (Payment(..), PaymentCategory(..), Category(..), User(..), Init(..))
import qualified Common.Model as CM
import qualified Common.Util.Text as T
import qualified Common.View.Format as Format

import qualified Icon

data TableIn = TableIn
  { _tableIn_init :: Init
  }

data TableOut = TableOut
  {
  }

widget :: forall t m. MonadWidget t m => TableIn -> m TableOut
widget tableIn = do
  R.divClass "table" $
    R.divClass "lines" $ do
      R.divClass "header" $ do
        R.divClass "cell name" $ R.text $ Message.get Key.Payment_Name
        R.divClass "cell cost" $ R.text $ Message.get Key.Payment_Cost
        R.divClass "cell user" $ R.text $ Message.get Key.Payment_User
        R.divClass "cell category" $ R.text $ Message.get Key.Payment_Category
        R.divClass "cell date" $ R.text $ Message.get Key.Payment_Date
        R.divClass "cell" $ R.blank
        R.divClass "cell" $ R.blank
        R.divClass "cell" $ R.blank
      let init = _tableIn_init tableIn
          payments = _init_payments init
      mapM_
        (paymentRow init)
        (take 8 . reverse . L.sortOn _payment_date $ payments)
  return $ TableOut {}

paymentRow :: forall t m. MonadWidget t m => Init -> Payment -> m ()
paymentRow init payment =
  R.divClass "row" $ do
    R.divClass "cell name" . R.text $ _payment_name payment
    R.divClass "cell cost" . R.text . Format.price (_init_currency init) $ _payment_cost payment
    R.divClass "cell user" $
      case CM.findUser (_payment_user payment) (_init_users init) of
        Just user -> R.text (_user_name user)
        _ -> R.blank
    R.divClass "cell category" $
      case findCategory (_init_categories init) (_init_paymentCategories init) (_payment_name payment) of
        Just category ->
          R.elAttr "span" (M.fromList [("class", "tag"), ("style", T.concat [ "background-color: ", _category_color category ])]) $
            R.text $ _category_name category
        _ ->
          R.blank
    R.divClass "cell date" $ do
      R.elClass "span" "shortDate" . R.text $ Format.shortDay (_payment_date payment)
      R.elClass "span" "longDate" . R.text $ Format.longDay (_payment_date payment)
    R.divClass "cell button" . R.el "button" $ Icon.clone
    R.divClass "cell button" $
      if _payment_user payment == (_init_currentUser init)
        then R.el "button" $ Icon.edit
        else R.blank
    R.divClass "cell button" $
      if _payment_user payment == (_init_currentUser init)
        then R.el "button" $ Icon.delete
        else R.blank

findCategory :: [Category] -> [PaymentCategory] -> Text -> Maybe Category
findCategory categories paymentCategories paymentName = do
  paymentCategory <- L.find
    ((== (T.unaccent . T.toLower) paymentName) . _paymentCategory_name)
    paymentCategories
  L.find ((== (_paymentCategory_category paymentCategory)) . _category_id) categories