Redirects to login (and back) if disconnected.

4 files changed, 49 insertions, 98 deletions

diff --git a/src/login/src/Struct/Flags.elm b/src/login/src/Struct/Flags.elm
deleted file mode 100644
index 228d258..0000000
--- a/src/login/src/Struct/Flags.elm
+++ /dev/null
@@ -1,42 +0,0 @@
-module Struct.Flags exposing
-   (
-      Type,
-      maybe_get_param
-   )
-
--- Elm -------------------------------------------------------------------------
-import List
-
--- Map -------------------------------------------------------------------
-import Util.List
-
---------------------------------------------------------------------------------
--- TYPES -----------------------------------------------------------------------
---------------------------------------------------------------------------------
-type alias Type =
-   {
-      user_id : String,
-      token : String,
-      url_params : (List (List String))
-   }
-
---------------------------------------------------------------------------------
--- LOCAL -----------------------------------------------------------------------
---------------------------------------------------------------------------------
-
---------------------------------------------------------------------------------
--- EXPORTED --------------------------------------------------------------------
---------------------------------------------------------------------------------
-maybe_get_param : String -> Type -> (Maybe String)
-maybe_get_param param flags =
-   case
-      (Util.List.get_first
-         (\e -> ((List.head e) == (Just param)))
-         flags.url_params
-      )
-   of
-      Nothing -> Nothing
-      (Just a) ->
-         case (List.tail a) of
-            Nothing -> Nothing
-            (Just b) -> (List.head b)
diff --git a/src/login/src/Struct/Model.elm b/src/login/src/Struct/Model.elm
index 859c054..7d14239 100644
--- a/src/login/src/Struct/Model.elm
+++ b/src/login/src/Struct/Model.elm
@@ -9,9 +9,11 @@ module Struct.Model exposing
 
 -- Elm -------------------------------------------------------------------------
 
+-- Shared ----------------------------------------------------------------------
+import Struct.Flags
+
 -- Login -----------------------------------------------------------------------
 import Struct.Error
-import Struct.Flags
 import Struct.HelpRequest
 import Struct.UI
 
@@ -22,6 +24,7 @@ type alias Type =
    {
       help_request: Struct.HelpRequest.Type,
       error: (Maybe Struct.Error.Type),
+      flags: Struct.Flags.Type,
       username: String,
       password1: String,
       password2: String,
@@ -46,6 +49,7 @@ new flags =
       model =
          {
             help_request = Struct.HelpRequest.None,
+            flags = flags,
             error = Nothing,
             username = "",
             password1 = "",
diff --git a/src/login/src/Update/HandleConnected.elm b/src/login/src/Update/HandleConnected.elm
index 2888153..8f6348b 100644
--- a/src/login/src/Update/HandleConnected.elm
+++ b/src/login/src/Update/HandleConnected.elm
@@ -1,13 +1,16 @@
 module Update.HandleConnected exposing (apply_to)
+
 -- Elm -------------------------------------------------------------------------
+import Http
 
 -- Login -----------------------------------------------------------------------
 import Action.Ports
 
 import Constants.IO
 
-import Struct.Model
 import Struct.Event
+import Struct.Flags
+import Struct.Model
 
 --------------------------------------------------------------------------------
 -- LOCAL -----------------------------------------------------------------------
@@ -20,5 +23,17 @@ apply_to : Struct.Model.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type))
 apply_to model =
    (
       model,
-      (Action.Ports.go_to (Constants.IO.base_url ++"/main-menu/"))
+      (Action.Ports.go_to
+         (Constants.IO.base_url ++
+            (
+               case (Struct.Flags.maybe_get_param "goto" model.flags) of
+                  Nothing -> "/main-menu/"
+                  (Just string) ->
+                     case (Http.decodeUri string) of
+                        Nothing -> "/main-menu/"
+                        (Just "") -> "/main-menu/"
+                        (Just url) -> url
+            )
+         )
+      )
    )
diff --git a/src/login/src/Update/HandleServerReply.elm b/src/login/src/Update/HandleServerReply.elm
index b0f4e6b..2cbcf08 100644
--- a/src/login/src/Update/HandleServerReply.elm
+++ b/src/login/src/Update/HandleServerReply.elm
@@ -3,9 +3,10 @@ module Update.HandleServerReply exposing (apply_to)
 -- Elm -------------------------------------------------------------------------
 import Http
 
--- Map -------------------------------------------------------------------
+-- Shared ----------------------------------------------------------------------
 import Action.Ports
 
+-- Login -----------------------------------------------------------------------
 import Struct.Error
 import Struct.Event
 import Struct.Model
@@ -21,46 +22,26 @@ import Struct.ServerReply
 set_session : (
       String ->
       String ->
-      (
-         Struct.Model.Type,
-         (Maybe Struct.Error.Type),
-         (List (Cmd Struct.Event.Type))
-      ) ->
-      (
-         Struct.Model.Type,
-         (Maybe Struct.Error.Type),
-         (List (Cmd Struct.Event.Type))
-      )
+      (Struct.Model.Type, (List (Cmd Struct.Event.Type))) ->
+      (Struct.Model.Type, (List (Cmd Struct.Event.Type)))
    )
 set_session pid stk current_state =
-   case current_state of
-      (_, (Just _), _) -> current_state
-
-      (model, _, cmd_list) ->
+   let (model, cmds) = current_state in
+      (
+         {model |
+            player_id = pid,
+            session_token = stk
+         },
          (
-            {model |
-               player_id = pid,
-               session_token = stk
-            },
-            Nothing,
-            (
-               (Action.Ports.store_new_session (pid, stk))
-               :: cmd_list
-            )
+            (Action.Ports.store_new_session (pid, stk))
+            :: cmds
          )
+      )
 
 apply_command : (
       Struct.ServerReply.Type ->
-      (
-         Struct.Model.Type,
-         (Maybe Struct.Error.Type),
-         (List (Cmd Struct.Event.Type))
-      ) ->
-      (
-         Struct.Model.Type,
-         (Maybe Struct.Error.Type),
-         (List (Cmd Struct.Event.Type))
-      )
+      (Struct.Model.Type, (List (Cmd Struct.Event.Type))) ->
+      (Struct.Model.Type, (List (Cmd Struct.Event.Type)))
    )
 apply_command command current_state =
    case command of
@@ -89,23 +70,16 @@ apply_to model query_result =
          )
 
       (Result.Ok commands) ->
-         (
-            case
-               (List.foldl
-                  (apply_command)
-                  (model, Nothing, [])
-                  commands
+         let
+            (new_model, elm_commands) =
+               (List.foldl (apply_command) (model, [Cmd.none]) commands)
+         in
+            (
+               new_model,
+               (
+                  case elm_commands of
+                     [] -> Cmd.none
+                     [cmd] -> cmd
+                     _ -> (Cmd.batch elm_commands)
                )
-            of
-               (updated_model, Nothing, cmds) ->
-                  (
-                     updated_model,
-                     (Cmd.batch cmds)
-                  )
-
-               (_, (Just error), _) ->
-                  (
-                     (Struct.Model.invalidate error model),
-                     Cmd.none
-                  )
-         )
+            )