Redirects to login (and back) if disconnected.

5 files changed, 58 insertions, 92 deletions

diff --git a/src/main-menu/src/Comm/Send.elm b/src/main-menu/src/Comm/Send.elm
index 925b956..3641e46 100644
--- a/src/main-menu/src/Comm/Send.elm
+++ b/src/main-menu/src/Comm/Send.elm
@@ -26,6 +26,7 @@ internal_decoder reply_type =
    case reply_type of
       "okay" -> (Comm.Okay.decode)
       "set_plr" -> (Comm.SetPlayer.decode)
+      "disconnected" -> (Json.Decode.succeed Struct.ServerReply.Disconnected)
       other ->
          (Json.Decode.fail
             (
diff --git a/src/main-menu/src/Struct/Flags.elm b/src/main-menu/src/Struct/Flags.elm
deleted file mode 100644
index 99c7458..0000000
--- a/src/main-menu/src/Struct/Flags.elm
+++ /dev/null
@@ -1,42 +0,0 @@
-module Struct.Flags exposing
-   (
-      Type,
-      maybe_get_param
-   )
-
--- Elm -------------------------------------------------------------------------
-import List
-
--- Main Menu -------------------------------------------------------------------
-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/main-menu/src/Struct/Model.elm b/src/main-menu/src/Struct/Model.elm
index d748cfa..747a39e 100644
--- a/src/main-menu/src/Struct/Model.elm
+++ b/src/main-menu/src/Struct/Model.elm
@@ -9,9 +9,11 @@ module Struct.Model exposing
 
 -- Elm -------------------------------------------------------------------------
 
+-- Shared ----------------------------------------------------------------------
+import Struct.Flags
+
 -- Main Menu -------------------------------------------------------------------
 import Struct.Error
-import Struct.Flags
 import Struct.Player
 import Struct.UI
 
@@ -20,6 +22,7 @@ import Struct.UI
 --------------------------------------------------------------------------------
 type alias Type =
    {
+      flags: Struct.Flags.Type,
       error: (Maybe Struct.Error.Type),
       player_id: String,
       session_token: String,
@@ -37,6 +40,7 @@ type alias Type =
 new : Struct.Flags.Type -> Type
 new flags =
    {
+      flags = flags,
       error = Nothing,
       player_id = flags.user_id,
       session_token = flags.token,
diff --git a/src/main-menu/src/Struct/ServerReply.elm b/src/main-menu/src/Struct/ServerReply.elm
index a0663a8..fb4967b 100644
--- a/src/main-menu/src/Struct/ServerReply.elm
+++ b/src/main-menu/src/Struct/ServerReply.elm
@@ -11,6 +11,7 @@ import Struct.Player
 
 type Type =
    Okay
+   | Disconnected
    | SetPlayer Struct.Player.Type
 
 --------------------------------------------------------------------------------
diff --git a/src/main-menu/src/Update/HandleServerReply.elm b/src/main-menu/src/Update/HandleServerReply.elm
index 96cb0f1..d68496c 100644
--- a/src/main-menu/src/Update/HandleServerReply.elm
+++ b/src/main-menu/src/Update/HandleServerReply.elm
@@ -3,7 +3,14 @@ module Update.HandleServerReply exposing (apply_to)
 -- Elm -------------------------------------------------------------------------
 import Http
 
+-- Shared ----------------------------------------------------------------------
+import Action.Ports
+
+import Struct.Flags
+
 -- Main Menu -------------------------------------------------------------------
+import Constants.IO
+
 import Struct.Error
 import Struct.Event
 import Struct.Model
@@ -17,46 +24,48 @@ import Struct.ServerReply
 --------------------------------------------------------------------------------
 -- LOCAL -----------------------------------------------------------------------
 --------------------------------------------------------------------------------
-set_player : (
-      Struct.Player.Type ->
-      (
-         Struct.Model.Type,
-         (Maybe Struct.Error.Type),
-         (List (Cmd Struct.Event.Type))
-      ) ->
+disconnected : (
+      (Struct.Model.Type, (List (Cmd Struct.Event.Type))) ->
+      (Struct.Model.Type, (List (Cmd Struct.Event.Type)))
+   )
+disconnected current_state =
+   let (model, cmds) = current_state in
       (
-         Struct.Model.Type,
-         (Maybe Struct.Error.Type),
-         (List (Cmd Struct.Event.Type))
+         model,
+         [
+            (Action.Ports.go_to
+               (
+                  Constants.IO.base_url
+                  ++ "/login/?action=disconnect&goto="
+                  ++
+                  (Http.encodeUri
+                     (
+                        "/main-menu/?"
+                        ++ (Struct.Flags.get_params_as_url model.flags)
+                     )
+                  )
+               )
+            )
+         ]
       )
+
+set_player : (
+      Struct.Player.Type ->
+      (Struct.Model.Type, (List (Cmd Struct.Event.Type))) ->
+      (Struct.Model.Type, (List (Cmd Struct.Event.Type)))
    )
 set_player player current_state =
-   let
-      (model, error, event_list) = current_state
-   in
-      (
-         {model |
-            player = player
-         },
-         error,
-         event_list
-      )
+   let (model, cmds) = current_state in
+      ({model | player = player}, 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
+      Struct.ServerReply.Disconnected -> (disconnected current_state)
       (Struct.ServerReply.SetPlayer player) -> (set_player player current_state)
       Struct.ServerReply.Okay -> current_state
 
@@ -80,23 +89,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
-                  )
-         )
+            )