summaryrefslogtreecommitdiff
path: root/src/login
diff options
context:
space:
mode:
Diffstat (limited to 'src/login')
-rw-r--r--src/login/src/Struct/Flags.elm42
-rw-r--r--src/login/src/Struct/Model.elm6
-rw-r--r--src/login/src/Update/HandleConnected.elm19
-rw-r--r--src/login/src/Update/HandleServerReply.elm80
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
- )
- )
+ )