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

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

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

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

import qualified Icon
import qualified View.Payment.Constants as Constants

data TableIn t = TableIn
  { _tableIn_init        :: Init
  , _tableIn_currentPage :: Dynamic t Int
  }

data TableOut = TableOut
  {
  }

widget :: forall t m. MonadWidget t m => TableIn t -> 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
          currentPage = _tableIn_currentPage tableIn
          payments = _init_payments init
          paymentRange = fmap (getPaymentRange payments) currentPage
      R.simpleList paymentRange (paymentRow init)
  return $ TableOut {}

getPaymentRange :: [Payment] -> Int -> [Payment]
getPaymentRange payments currentPage =
  take Constants.paymentsPerPage
  . drop ((currentPage - 1) * Constants.paymentsPerPage)
  . reverse
  . L.sortOn _payment_date
  $ payments

paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t Payment -> m ()
paymentRow init payment =
  R.divClass "row" $ do
    R.divClass "cell name" . R.dynText . fmap _payment_name $ payment
    R.divClass "cell cost" . R.dynText . fmap (Format.price (_init_currency init) . _payment_cost) $  payment

    let user = flip fmap payment $ \p -> CM.findUser (_payment_user p) (_init_users init)
    R.divClass "cell user" $
      R.dynText $ flip fmap user $ \mbUser -> case mbUser of
        Just u -> _user_name u
        _      -> ""

    let category = flip fmap payment $ \p -> findCategory
          (_init_categories init)
          (_init_paymentCategories init)
          (_payment_name p)
    R.divClass "cell category" $ do
      let attrs = flip fmap category $ \maybeCategory -> case maybeCategory of
            Just c -> M.fromList
              [ ("class", "tag")
              , ("style", T.concat [ "background-color: ", _category_color c ])
              ]
            Nothing -> M.singleton "display" "none"
      R.elDynAttr "span" attrs $
        R.dynText $ flip fmap category $ \mbCategory -> case mbCategory of
          Just c -> _category_name c
          _      -> ""

    R.divClass "cell date" $ do
      R.elClass "span" "shortDate" . R.dynText . fmap (Format.shortDay . _payment_date) $ payment
      R.elClass "span" "longDate" . R.dynText . fmap (Format.longDay . _payment_date) $ payment
    R.divClass "cell button" . R.el "button" $ Icon.clone
    let modifyAttrs = flip fmap payment $ \p ->
          M.fromList [("class", "cell button"), ("display", if _payment_user p == _init_currentUser init then "block" else "none")]
    R.elDynAttr "div" modifyAttrs $
      R.el "button" $ Icon.edit
    R.elDynAttr "div" modifyAttrs $
      R.el "button" $ Icon.delete

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