summaryrefslogtreecommitdiff
path: root/src/main-menu
diff options
context:
space:
mode:
Diffstat (limited to 'src/main-menu')
-rw-r--r--src/main-menu/src/Comm/Send.elm1
-rw-r--r--src/main-menu/src/Struct/Flags.elm42
-rw-r--r--src/main-menu/src/Struct/Model.elm6
-rw-r--r--src/main-menu/src/Struct/ServerReply.elm1
-rw-r--r--src/main-menu/src/Update/HandleServerReply.elm100
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
- )
- )
+ )