aboutsummaryrefslogtreecommitdiff
path: root/client/src/View/Payment/Table.hs
blob: 66065afd6555213c198dde4ab9656ec5ff945c4c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
module View.Payment.Table
  ( view
  , In(..)
  , Out(..)
  ) where

import qualified Data.List               as L
import qualified Data.Map                as M
import qualified Data.Maybe              as Maybe
import           Data.Text               (Text)
import qualified Data.Text               as T
import           Reflex.Dom              (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom              as R

import           Common.Model            (Category (..), Currency,
                                          Frequency (..), Payment (..),
                                          User (..), UserId)
import qualified Common.Model            as CM
import qualified Common.Msg              as Msg
import qualified Common.View.Format      as Format

import qualified Component.ConfirmDialog as ConfirmDialog
import qualified Component.Table         as Table
import qualified Component.Tag           as Tag
import qualified Util.Ajax               as Ajax
import qualified Util.Either             as EitherUtil
import qualified View.Payment.Form       as Form

data In t = In
  { _in_users       :: [User]
  , _in_currentUser :: UserId
  , _in_categories  :: [Category]
  , _in_currency    :: Currency
  , _in_payments    :: [Payment]
  , _in_frequency   :: Frequency
  }

data Out t = Out
  { _out_add    :: Event t ()
  , _out_edit   :: Event t ()
  , _out_delete :: Event t ()
  }

view :: forall t m. MonadWidget t m => In t -> m (Out t)
view input = do

  table <- Table.view $ Table.In
    { Table._in_headerLabel = headerLabel (_in_frequency input)
    , Table._in_rows = _in_payments input
    , Table._in_cell =
      cell
        (_in_users input)
        (_in_categories input)
        (_in_frequency input)
        (_in_currency input)
    , Table._in_cloneModal = \payment ->
      Form.view $ Form.In
        { Form._in_categories = _in_categories input
        , Form._in_operation = Form.Clone payment
        , Form._in_frequency = _in_frequency input
        }
    , Table._in_editModal = \payment ->
      Form.view $ Form.In
        { Form._in_categories = _in_categories input
        , Form._in_operation = Form.Edit payment
        , Form._in_frequency = _in_frequency input
        }
    , Table._in_deleteModal = \payment ->
      ConfirmDialog.view $ ConfirmDialog.In
        { ConfirmDialog._in_header  = Msg.get Msg.Payment_DeleteConfirm
        , ConfirmDialog._in_confirm = \e -> do
          res <- Ajax.delete
            (R.constDyn $ T.concat ["/api/payment/", T.pack . show $ _payment_id payment])
            e
          return $ () <$ R.fmapMaybe EitherUtil.eitherToMaybe res
        }
    , Table._in_canEdit = (== (_in_currentUser input)) . _payment_user
    , Table._in_canDelete = (== (_in_currentUser input)) . _payment_user
    }

  return $ Out
    { _out_add = Table._out_add table
    , _out_edit = Table._out_edit table
    , _out_delete = Table._out_delete table
    }

data Header
  = NameHeader
  | CostHeader
  | UserHeader
  | CategoryHeader
  | DateHeader
  deriving (Eq, Show, Bounded, Enum)

headerLabel :: Frequency -> Header -> Text
headerLabel _ NameHeader        = Msg.get Msg.Payment_Name
headerLabel _ CostHeader        = Msg.get Msg.Payment_Cost
headerLabel _ UserHeader        = Msg.get Msg.Payment_User
headerLabel _ CategoryHeader    = Msg.get Msg.Payment_Category
headerLabel Punctual DateHeader = Msg.get Msg.Payment_Date
headerLabel Monthly DateHeader  = ""

cell
  :: forall t m. MonadWidget t m
  => [User]
  -> [Category]
  -> Frequency
  -> Currency
  -> Header
  -> Payment
  -> m ()
cell users categories frequency currency header payment =
  case header of
    NameHeader ->
      R.text $ _payment_name payment

    CostHeader ->
      R.divClass (if amount < 0 then "g-Payment__Refund" else "") $
        R.text $ Format.price currency amount
      where amount = _payment_cost payment

    UserHeader ->
      R.text . Maybe.fromMaybe "" . fmap _user_name $ CM.findUser (_payment_user payment) users

    CategoryHeader ->
      let
        category =
          L.find ((== (_payment_category payment)) . _category_id) categories
      in
        Maybe.fromMaybe R.blank . flip fmap category $ \c ->
          Tag.view $ Tag.In
            { Tag._in_text = _category_name c
            , Tag._in_color = _category_color c
            }

    DateHeader ->
      if frequency == Punctual then
        do
          R.elClass "span" "shortDate" $
            R.text . Format.shortDay . _payment_date $ payment

          R.elClass "span" "longDate" $
            R.text . Format.longDay . _payment_date $ payment
      else
        R.blank