diff options
Diffstat (limited to 'client/src/View/SignIn.hs')
-rw-r--r-- | client/src/View/SignIn.hs | 82 |
1 files changed, 82 insertions, 0 deletions
diff --git a/client/src/View/SignIn.hs b/client/src/View/SignIn.hs new file mode 100644 index 0000000..e68755f --- /dev/null +++ b/client/src/View/SignIn.hs @@ -0,0 +1,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 |