aboutsummaryrefslogtreecommitdiff
path: root/client/src/Component/ConfirmDialog.hs
blob: 50e30ed895ec8acf002a3ce7daea9d88108bb9b2 (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
module Component.ConfirmDialog
  ( In(..)
  , view
  ) where

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

import qualified Common.Msg       as Msg
import qualified Component.Button as Button
import qualified Component.Modal  as Modal
import qualified Util.Either      as EitherUtil
import qualified Util.WaitFor     as WaitFor

data In t m a = In
  { _in_header  :: Text
  , _in_confirm :: Event t () -> m (Event t a)
  }

view :: forall t m a. MonadWidget t m => (In t m a) -> Modal.Content t m a
view input _ =
  R.divClass "confirm" $ do
    R.divClass "confirmHeader" $
      R.text $ _in_header input

    R.divClass "confirmContent" $ do
      (confirm, cancel) <- R.divClass "buttons" $ do

        cancel <- Button._out_clic <$> (Button.view $
          (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Undo))
            { Button._in_class = R.constDyn "undo" })

        rec
          confirm <- Button._out_clic <$> (Button.view $
            (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Confirm))
              { Button._in_class = R.constDyn "confirm"
              , Button._in_submit = True
              , Button._in_waiting = waiting
              })

          (result, waiting) <- WaitFor.waitFor (_in_confirm input) confirm

        return (result, cancel)

      return $
        ( R.leftmost [ cancel, () <$ confirm ]
        , confirm
        )