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