aboutsummaryrefslogtreecommitdiff
path: root/client/src/View/Payment/Delete.hs
blob: e7e319e6f2aea22636ba948db420afc5a6fa3d6f (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
module View.Payment.Delete
  ( Input(..)
  , view
  ) where

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    (Payment (..))
import qualified Common.Msg      as Msg
import           Component       (ButtonIn (..), ButtonOut (..))
import qualified Component       as Component
import qualified Component.Modal as Modal
import qualified Util.Ajax       as Ajax
import qualified Util.Either     as EitherUtil
import qualified Util.WaitFor    as WaitFor

data Input t = Input
  { _input_payment :: Dynamic t Payment
  }

view :: forall t m. MonadWidget t m => (Input t) -> Modal.Content t m Payment
view input _ =
  R.divClass "delete" $ do
    R.divClass "deleteHeader" $ R.text $ Msg.get Msg.Payment_DeleteConfirm

    R.divClass "deleteContent" $ do

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

        cancel <- Component._buttonOut_clic <$> (Component.button $
          (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
            { _buttonIn_class = R.constDyn "undo" })

        rec
          confirm <- Component._buttonOut_clic <$> (Component.button $
            (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
              { _buttonIn_class = R.constDyn "confirm"
              , _buttonIn_submit = True
              , _buttonIn_waiting = waiting
              })

          let url =
                R.ffor (_input_payment input) (\id ->
                  T.concat ["/payment/", T.pack . show $ _payment_id id]
                )

          (result, waiting) <- WaitFor.waitFor
            (Ajax.delete url)
            confirm

        return (R.fmapMaybe EitherUtil.eitherToMaybe result, cancel)

      return $
        ( R.leftmost [ cancel, () <$ confirm ]
        , R.tag (R.current $ _input_payment input) confirm
        )