
  0 | module Web.MVC.Controller.Confirm
  1 | 
  2 | import Monocle
  3 | import Text.HTML
  4 | import Text.HTML.Class
  5 | import Text.HTML.Confirm
  6 | import Text.HTML.DomID
  7 | import Web.MVC
  8 | import Web.MVC.Controller
  9 | 
 10 | %default total
 11 | 
 12 | public export
 13 | record ConfirmEnv (i,s,e,t,event,state : Type) where
 14 |   constructor CE
 15 |   conf : ConfirmConfig i
 16 |   ed   : Editor i s e t
 17 |   val  : Lens' state s
 18 |   ini  : state -> Maybe t
 19 |   toEv : ConfirmEv e -> event
 20 |   onOK : t -> State state (Cmd event)
 21 | 
 22 | parameters {0 i,s,e,t,event,state : Type}
 23 |            {auto cst : Cast i DomID}
 24 |            (ce       : ConfirmEnv i s e t event state)
 25 | 
 26 |   export %inline
 27 |   curNew : state -> Either String t
 28 |   curNew = ce.ed.stToNew . ce.val.get_
 29 | 
 30 |   upd : ConfirmEv e -> state -> state
 31 |   upd Begin  st = setL ce.val (ce.ed.toState $ ce.ini st) st
 32 |   upd _      st = st
 33 | 
 34 |   disp : i -> ConfirmEv e -> state -> Cmd (ConfirmEv e)
 35 |   disp u Begin  st =
 36 |     let v := ce.ed.toState $ ce.ini st
 37 |      in batch
 38 |           [ elemChild u (dialog ce.conf u $ ce.ed.view u v)
 39 |           , Edited <$> ce.ed.init u v
 40 |           , disabledE (elemRef $ ce.conf.okID u) (ce.ed.stToNew v)
 41 |           ]
 42 |   disp u Cancel st = clearElem u
 43 |   disp u _      st = neutral
 44 | 
 45 |   export
 46 |   confirm : i -> ConfirmEv e -> State state (Cmd event)
 47 |   confirm u (Edited ev) = do
 48 |     c1 <- ce.toEv . Edited <$$> stL ce.val (ce.ed.ctrl u ev)
 49 |     c2 <- disabledE (elemRef $ ce.conf.okID u) . ce.ed.stToNew <$> getST ce.val
 50 |     pure $ c1 <+> c2
 51 |   confirm u OK          = do
 52 |     Right vt <- ce.ed.stToNew <$> getST ce.val | Left _ => neutral
 53 |     ce.onOK vt
 54 |   confirm u ev          = ce.toEv <$$> updateDisp upd (disp u) ev
 55 |