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