aboutsummaryrefslogtreecommitdiff
path: root/client/src/View/Payment/Delete.hs
blob: 471463cff78d9ed3af45987ca2ca7af3887541a7 (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
  ( In(..)
  , 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 qualified Component.Button as Button
import qualified Component.Modal  as Modal
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 In t = In
  { _in_payment :: Dynamic t Payment
  }

view :: forall t m. MonadWidget t m => (In 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 <- 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
              })

          let url =
                R.ffor (_in_payment input) (\id ->
                  T.concat ["/api/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 $ _in_payment input) confirm
        )