aboutsummaryrefslogtreecommitdiff
path: root/client/src/Component/Table.hs
blob: 1482f91557c028678d70979cc73f273a01791803 (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
module Component.Table
  ( view
  , In(..)
  , Out(..)
  ) where

import qualified Data.Map         as M
import           Data.Text        (Text)
import           Reflex.Dom       (Event, MonadWidget)
import qualified Reflex.Dom       as R

import qualified Component.Button as Button
import qualified Component.Modal  as Modal
import qualified Util.Reflex      as ReflexUtil
import qualified View.Icon        as Icon

data In m t h r = In
  { _in_headerLabel :: h -> Text
  , _in_rows        :: [r]
  , _in_cell        :: h -> r -> m ()
  , _in_cloneModal  :: r -> Modal.Content t m
  , _in_editModal   :: r -> Modal.Content t m
  , _in_deleteModal :: r -> Modal.Content t m
  , _in_canEdit     :: r -> Bool
  , _in_canDelete   :: r -> Bool
  }

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

view :: forall t m h r. (MonadWidget t m, Bounded h, Enum h)  => In m t h r -> m (Out t)
view input =
  R.divClass "table" $ do
    rec
      result <- R.divClass "lines" $ do

        R.divClass "header" $ do
          flip mapM_ [minBound..] $ \header ->
            R.divClass "cell" . R.text $
              _in_headerLabel input header

          R.divClass "cell" $ R.blank
          R.divClass "cell" $ R.blank
          R.divClass "cell" $ R.blank

        flip mapM (_in_rows input) $ \row ->
          R.divClass "row" $ do
            flip mapM_ [minBound..] $ \header ->
              R.divClass "cell" $
                _in_cell input header row

            cloneButton <-
              R.divClass "cell button" $
                Button._out_clic <$> (Button.view $
                  Button.defaultIn Icon.clone)

            clone <-
              Modal.view $ Modal.In
                { Modal._in_show    = cloneButton
                , Modal._in_content = _in_cloneModal input row
                }

            let visibleIf cond =
                  R.elAttr
                    "div"
                    (if cond then M.empty else M.singleton "style" "display:none")

            editButton <-
              R.divClass "cell button" $
                visibleIf (_in_canEdit input row) $
                  Button._out_clic <$> (Button.view $
                    Button.defaultIn Icon.edit)

            edit <-
              Modal.view $ Modal.In
                { Modal._in_show    = editButton
                , Modal._in_content = _in_editModal input row
                }

            deleteButton <-
              R.divClass "cell button" $
                visibleIf (_in_canDelete input row) $
                  Button._out_clic <$> (Button.view $
                    Button.defaultIn Icon.delete)

            delete <-
              Modal.view $ Modal.In
                { Modal._in_show    = deleteButton
                , Modal._in_content = _in_deleteModal input row
                }

            return (clone, edit, delete)

    let add = R.leftmost . map (\(a, _, _) -> a) $ result
        edit = R.leftmost . map (\(_, a, _) -> a) $ result
        delete = R.leftmost . map (\(_, _, a) -> a) $ result

    return $ Out
      { _out_add = add
      , _out_edit = edit
      , _out_delete = delete
      }