blob: e68755fa3663aed4e8c195ba3a619941f634a5e9 (
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
|
module View.SignIn
( view
, Out(..)
) where
import qualified Data.Either as Either
import qualified Data.Maybe as Maybe
import Data.Text (Text)
import qualified Data.Validation as V
import Reflex.Dom (Event, MonadWidget)
import qualified Reflex.Dom as R
import Common.Model (Init, SignInForm (SignInForm))
import qualified Common.Msg as Msg
import qualified Common.Validation.SignIn as SignInValidation
import qualified Component.Button as Button
import qualified Component.Form as Form
import qualified Component.Input as Input
import qualified Util.Ajax as Ajax
import qualified Util.Validation as ValidationUtil
import qualified Util.WaitFor as WaitFor
data Out t = Out
{ _out_success :: Event t Init
}
view :: forall t m. MonadWidget t m => m (Out t)
view = do
signInResult <- R.divClass "signIn" $
Form.view $ do
rec
let resetForm = ("" <$ R.ffilter Either.isRight signInResult)
email <- Input._out_raw <$> (Input.view
(Input.defaultIn
{ Input._in_label = Msg.get Msg.SignIn_EmailLabel
, Input._in_validation = SignInValidation.email
})
resetForm
validate)
password <- Input._out_raw <$> (Input.view
(Input.defaultIn
{ Input._in_label = Msg.get Msg.SignIn_PasswordLabel
, Input._in_validation = SignInValidation.password
, Input._in_inputType = "password"
})
resetForm
validate)
validate <- Button._out_clic <$> (Button.view $
(Button.defaultIn (R.text $ Msg.get Msg.SignIn_Button))
{ Button._in_class = R.constDyn "validate"
, Button._in_waiting = waiting
, Button._in_submit = True
})
let form = do
e <- email
p <- password
return . V.Success $ SignInForm e p
(signInResult, waiting) <- WaitFor.waitFor
(Ajax.postAndParseResult "/api/signIn")
(ValidationUtil.fireValidation form validate)
showSignInResult signInResult
return signInResult
return $ Out
{ _out_success = R.filterRight signInResult
}
showSignInResult :: forall t m. MonadWidget t m => Event t (Either Text Init) -> m ()
showSignInResult signInResult = do
_ <- R.widgetHold R.blank $ showResult <$> signInResult
R.blank
where showResult (Left error) = R.divClass "error" . R.text $ error
showResult (Right _) = R.blank
|
