From 302a2e798f10e61c129753a2bd11634420c1f1a1 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 2 Jan 2016 20:31:25 +0100
Subject: Set a spinner for sign in

---
 src/client/elm/Main.elm                      |  3 +--
 src/client/elm/Model/Action.elm              |  1 +
 src/client/elm/Model/Action/SignInAction.elm |  3 ++-
 src/client/elm/Model/View/SignInView.elm     |  8 ++++----
 src/client/elm/Update.elm                    | 16 +++++++++++++++-
 src/client/elm/Update/SignIn.elm             |  7 ++++++-
 src/client/elm/View/Icon.elm                 |  7 +++++++
 src/client/elm/View/SignIn.elm               | 26 ++++++++++----------------
 src/server/Controller/SignIn.hs              |  2 +-
 src/server/Design/SignIn.hs                  |  5 ++---
 src/server/Model/Message/Key.hs              | 10 +++++++---
 src/server/Model/Message/Translations.hs     | 19 +++++++++++++------
 src/server/View/Page.hs                      |  2 +-
 13 files changed, 70 insertions(+), 39 deletions(-)

(limited to 'src')

diff --git a/src/client/elm/Main.elm b/src/client/elm/Main.elm
index 2f4acb6..684cd1b 100644
--- a/src/client/elm/Main.elm
+++ b/src/client/elm/Main.elm
@@ -13,7 +13,6 @@ import Time exposing (..)
 
 import Model exposing (Model, initialModel)
 import Model.Action exposing (..)
-import Model.Communication exposing (Communication(SignIn))
 
 import Update exposing (update)
 
@@ -36,7 +35,7 @@ app = StartApp.start
   , update = update
   , inputs =
       [ Signal.map UpdateTime (Time.every 1000)
-      , Signal.map (ServerCommunication << SignIn) validateSignIn
+      , Signal.map SignIn validateSignIn
       ]
   }
 
diff --git a/src/client/elm/Model/Action.elm b/src/client/elm/Model/Action.elm
index 9d5d125..d0fe597 100644
--- a/src/client/elm/Model/Action.elm
+++ b/src/client/elm/Model/Action.elm
@@ -15,6 +15,7 @@ import Model.Communication exposing (Communication)
 type Action =
   NoOp
   | ServerCommunication Communication
+  | SignIn String
   | UpdateTime Time
   | GoSignInView
   | GoLoggedInView Users UserId Payments Payments Int Payers
diff --git a/src/client/elm/Model/Action/SignInAction.elm b/src/client/elm/Model/Action/SignInAction.elm
index 6673c11..ed64c1d 100644
--- a/src/client/elm/Model/Action/SignInAction.elm
+++ b/src/client/elm/Model/Action/SignInAction.elm
@@ -3,4 +3,5 @@ module Model.Action.SignInAction
   ) where
 
 type SignInAction =
-  ErrorLogin String
+  Connecting
+  | ErrorLogin String
diff --git a/src/client/elm/Model/View/SignInView.elm b/src/client/elm/Model/View/SignInView.elm
index 0fbce39..cf7e6b2 100644
--- a/src/client/elm/Model/View/SignInView.elm
+++ b/src/client/elm/Model/View/SignInView.elm
@@ -4,12 +4,12 @@ module Model.View.SignInView
   ) where
 
 type alias SignInView =
-  { login : String
-  , result : Maybe (Result String String)
+  { connecting : Bool
+  , error : Maybe String
   }
 
 initSignInView : SignInView
 initSignInView =
-  { login = ""
-  , result = Nothing
+  { connecting = False
+  , error = Nothing
   }
diff --git a/src/client/elm/Update.elm b/src/client/elm/Update.elm
index c955f8c..c61e2f5 100644
--- a/src/client/elm/Update.elm
+++ b/src/client/elm/Update.elm
@@ -9,15 +9,20 @@ import Effects exposing (Effects)
 import ServerCommunication exposing (sendRequest)
 
 import Model exposing (Model)
+import Model.Translations exposing (getMessage)
 import Model.Action exposing (..)
+import Model.Action.SignInAction as SignInAction
 import Model.View as V
 import Model.View.SignInView exposing (..)
 import Model.View.LoggedInView exposing (..)
-import Model.Communication exposing (Communication)
+import Model.Communication as Communication exposing (Communication)
 
 import Update.LoggedIn exposing (updateLoggedIn)
 import Update.SignIn exposing (updateSignIn)
 
+import SimpleHTTP exposing (post)
+import InitViewAction exposing (initViewAction)
+
 update : Action -> Model -> (Model, Effects Action)
 update action model =
   case action of
@@ -25,6 +30,15 @@ update action model =
     NoOp ->
       (model, Effects.none)
 
+    SignIn assertion ->
+      ( case model.view of
+          V.SignInView signInView -> { model | view = V.SignInView (updateSignIn SignInAction.Connecting signInView) }
+          _ -> model
+      , sendRequest (Communication.SignIn assertion)
+          |> flip Task.onError (always <| Task.succeed (UpdateSignIn (SignInAction.ErrorLogin (getMessage "ErrorSignIn" model.translations))))
+          |> Effects.task
+      )
+
     ServerCommunication communication ->
       ( model
       , sendRequest communication
diff --git a/src/client/elm/Update/SignIn.elm b/src/client/elm/Update/SignIn.elm
index c0aaf33..5e8a9bb 100644
--- a/src/client/elm/Update/SignIn.elm
+++ b/src/client/elm/Update/SignIn.elm
@@ -8,5 +8,10 @@ import Model.View.SignInView exposing (..)
 updateSignIn : SignInAction -> SignInView -> SignInView
 updateSignIn action signInView =
   case action of
+    Connecting ->
+      { signInView | connecting = True }
     ErrorLogin message ->
-      { signInView | result = Just (Err message) }
+      { signInView
+      | error = Just message
+      , connecting = False
+      }
diff --git a/src/client/elm/View/Icon.elm b/src/client/elm/View/Icon.elm
index f22c1a2..9fa5f8a 100644
--- a/src/client/elm/View/Icon.elm
+++ b/src/client/elm/View/Icon.elm
@@ -1,5 +1,6 @@
 module View.Icon
   ( renderIcon
+  , renderSpinIcon
   ) where
 
 import Html exposing (..)
@@ -10,3 +11,9 @@ renderIcon iconClass =
   i
     [ class <| "fa fa-fw fa-" ++ iconClass ]
     []
+
+renderSpinIcon : String -> Html
+renderSpinIcon iconClass =
+  i
+    [ class <| "fa fa-fw fa-spin fa-" ++ iconClass ]
+    []
diff --git a/src/client/elm/View/SignIn.elm b/src/client/elm/View/SignIn.elm
index 6d253e7..f662a97 100644
--- a/src/client/elm/View/SignIn.elm
+++ b/src/client/elm/View/SignIn.elm
@@ -16,7 +16,7 @@ import Model.View.SignInView exposing (..)
 import Model.Translations exposing (getMessage)
 
 import View.Events exposing (onSubmitPrevDefault)
-import View.Icon exposing (renderIcon)
+import View.Icon exposing (..)
 
 import Persona exposing (operations)
 
@@ -27,25 +27,19 @@ renderSignIn address model signInView =
     [ button
         [ onClick operations.address Persona.SignIn ]
         [ span [] [ text (getMessage "SignIn" model.translations) ]
-        , renderIcon "plug"
+        , if signInView.connecting
+            then renderSpinIcon "refresh"
+            else renderIcon "power-off"
         ]
-    , div
-        [ class "result" ]
-        [ signInResult model signInView ]
+    , signInResult model signInView
     ]
 
 signInResult : Model -> SignInView -> Html
 signInResult model signInView =
-  case signInView.result of
-    Just result ->
-      case result of
-        Ok login ->
-          div
-            [ class "success" ]
-            [ text (getMessage "SignInEmailSent" model.translations) ]
-        Err error ->
-          div
-            [ class "error" ]
-            [ text error ]
+  case signInView.error of
+    Just error ->
+      div
+        [ class "error" ]
+        [ text error ]
     Nothing ->
       text ""
diff --git a/src/server/Controller/SignIn.hs b/src/server/Controller/SignIn.hs
index 8eceb56..ddd8852 100644
--- a/src/server/Controller/SignIn.hs
+++ b/src/server/Controller/SignIn.hs
@@ -41,4 +41,4 @@ signIn config assertion = do
           LoginSession.put token
           status ok200
         else
-          jsonError (getMessage Unauthorized)
+          jsonError (getMessage UnauthorizedSignIn)
diff --git a/src/server/Design/SignIn.hs b/src/server/Design/SignIn.hs
index 92e485b..a90832e 100644
--- a/src/server/Design/SignIn.hs
+++ b/src/server/Design/SignIn.hs
@@ -21,7 +21,6 @@ signInDesign =
       fontSize (em 1.5)
       position relative
 
-    ".result" ? do
+    ".error" ? do
       textAlign (alignSide sideCenter)
-      ".success" ? color C.greenSuccess
-      ".error" ? color C.redError
+      color C.redError
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index 1a1e944..34c9d71 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -4,16 +4,20 @@ module Model.Message.Key
 
 data Key =
 
+  -- Title
+
+  SharedCost
+
   -- Mail
 
-  NoReplyMail
+  | NoReplyMail
 
   -- Sign
 
-  | SharedCost
   | SignIn
   | InvalidEmail
-  | Unauthorized
+  | UnauthorizedSignIn
+  | ErrorSignIn
 
   -- Dates
 
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index 05187aa..2212e1a 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -15,6 +15,13 @@ getNonFormattedMessage = m
 
 m :: Lang -> Key -> Text
 
+-- Title
+
+m l SharedCost =
+  case l of
+    English -> "Shared Cost"
+    French  -> "Partage des frais"
+
 -- Mail
 
 m l NoReplyMail =
@@ -24,11 +31,6 @@ m l NoReplyMail =
 
 -- Sign in
 
-m l SharedCost =
-  case l of
-    English -> "Shared Cost"
-    French  -> "Partage des frais"
-
 m l SignIn =
   case l of
     English -> "Sign in"
@@ -39,11 +41,16 @@ m l InvalidEmail =
     English -> "Your email is not valid."
     French  -> "Votre courriel n'est pas valide."
 
-m l Unauthorized =
+m l UnauthorizedSignIn =
   case l of
     English -> "You are not authorized to sign in."
     French  -> "Tu n'es pas autorisé à te connecter."
 
+m l ErrorSignIn =
+  case l of
+    English -> "An error occured, please retry later."
+    French  -> "Une erreur est survenue, veuillez réessayer ultérieurement."
+
 -- Date
 
 m l January =
diff --git a/src/server/View/Page.hs b/src/server/View/Page.hs
index 7310fbb..e85ed33 100644
--- a/src/server/View/Page.hs
+++ b/src/server/View/Page.hs
@@ -33,7 +33,7 @@ page config =
       script ! A.id "messages" ! type_ "application/json" $ toHtml . decodeUtf8 . encode $ getTranslations
       script ! A.id "config" ! type_ "application/json" $ toHtml . decodeUtf8 . encode $ config
       link ! rel "stylesheet" ! type_ "text/css" ! href "css/reset.css"
-      link ! rel "stylesheet" ! href "css/font-awesome/css/font-awesome.min.css"
+      link ! rel "stylesheet" ! href "css/font-awesome-4.5.0/css/font-awesome.min.css"
       link ! rel "icon" ! type_ "image/png" ! href "images/icon.png"
       H.style $ toHtml globalDesign
     body $ do
-- 
cgit v1.2.3