blob: 428997e73a8b072a76102ba7e690629ac737aca0 (
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
|
module View.SignIn
( SignInMessage (..)
, view
) where
import qualified Data.Either as Either
import Data.Text (Text)
import Prelude hiding (error)
import Reflex.Dom (Event, MonadWidget)
import qualified Reflex.Dom as R
import Common.Model (SignIn (SignIn))
import qualified Common.Msg as Msg
import Component (ButtonIn (..), ButtonOut (..), InputIn (..),
InputOut (..))
import qualified Component as Component
import qualified Util.Ajax as Ajax
import qualified Util.WaitFor as WaitFor
data SignInMessage =
SuccessMessage Text
| ErrorMessage Text
| EmptyMessage
view :: forall t m. MonadWidget t m => SignInMessage -> m ()
view signInMessage =
R.divClass "signIn" $
Component.form $ do
rec
input <- (Component.input
(Component.defaultInputIn { _inputIn_label = Msg.get Msg.SignIn_EmailLabel })
(R.ffilter Either.isRight signInResult))
button <- Component.button $
(Component.defaultButtonIn (R.text $ Msg.get Msg.SignIn_Button))
{ _buttonIn_class = R.constDyn "validate"
, _buttonIn_waiting = waiting
, _buttonIn_submit = True
}
(signInResult, waiting) <- WaitFor.waitFor
(\email -> Ajax.postJson "/askSignIn" (SignIn <$> email))
(R.tag (R.current (_inputOut_value input)) (_buttonOut_clic button))
showSignInResult signInMessage signInResult
showSignInResult :: forall t m. MonadWidget t m => SignInMessage -> Event t (Either Text Text) -> m ()
showSignInResult signInMessage signInResult = do
_ <- R.widgetHold (showInitResult signInMessage) $ R.ffor signInResult showResult
R.blank
where showInitResult (SuccessMessage success) = showSuccess success
showInitResult (ErrorMessage error) = showError error
showInitResult EmptyMessage = R.blank
showResult (Left error) = showError error
showResult (Right success) = showSuccess success
showError = R.divClass "error" . R.text
showSuccess = R.divClass "success" . R.text
|
