From 9ec5806bc721734923ff4c93f7ef1f97a6a03248 Mon Sep 17 00:00:00 2001 From: nsensfel Date: Thu, 13 Sep 2018 16:51:08 +0200 Subject: Starting an browser extension for TO... --- src/Update/HandleServerReply.elm | 104 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 104 insertions(+) create mode 100644 src/Update/HandleServerReply.elm (limited to 'src/Update/HandleServerReply.elm') diff --git a/src/Update/HandleServerReply.elm b/src/Update/HandleServerReply.elm new file mode 100644 index 0000000..d68496c --- /dev/null +++ b/src/Update/HandleServerReply.elm @@ -0,0 +1,104 @@ +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 +import Struct.Player +import Struct.ServerReply + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +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 + ( + 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, cmds) = current_state in + ({model | player = player}, cmds) + +apply_command : ( + Struct.ServerReply.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 + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : ( + Struct.Model.Type -> + (Result Http.Error (List Struct.ServerReply.Type)) -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +apply_to model query_result = + case query_result of + (Result.Err error) -> + ( + (Struct.Model.invalidate + (Struct.Error.new Struct.Error.Networking (toString error)) + model + ), + Cmd.none + ) + + (Result.Ok 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) + ) + ) -- cgit v1.2.3-70-g09d2