Starting an browser extension for TO...

1 files changed, 104 insertions, 0 deletions

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)
+               )
+            )