From 2f22e667fbea56884d74ed27777f2e9f3fc9fd53 Mon Sep 17 00:00:00 2001 From: nsensfel Date: Thu, 27 Sep 2018 15:40:30 +0200 Subject: Starting to separate background and popup code. --- src/Action/Ports.elm | 4 - src/Comm/GetBattles.elm | 45 -------- src/Comm/GetID.elm | 43 -------- src/Comm/Okay.elm | 21 ---- src/Comm/Send.elm | 66 ------------ src/Comm/SetBattles.elm | 51 --------- src/ElmModule/Init.elm | 29 ------ src/ElmModule/Subscriptions.elm | 17 --- src/ElmModule/Update.elm | 51 --------- src/ElmModule/View.elm | 71 ------------- src/Main.elm | 23 ---- src/Struct/BattleSummary.elm | 65 ------------ src/Struct/Error.elm | 45 -------- src/Struct/Event.elm | 30 ------ src/Struct/Flags.elm | 42 -------- src/Struct/Model.elm | 66 ------------ src/Struct/Player.elm | 133 ------------------------ src/Struct/ServerReply.elm | 29 ------ src/Update/AddPlayer.elm | 24 ----- src/Update/HandleServerReply.elm | 119 --------------------- src/Update/RefreshBattles.elm | 28 ----- src/Update/StoreParams.elm | 38 ------- src/Util/Array.elm | 34 ------ src/Util/Html.elm | 6 -- src/Util/List.elm | 36 ------- src/View/Header.elm | 79 -------------- src/View/Player.elm | 97 ----------------- src/background/Makefile | 36 +++++++ src/background/elm-package.json | 19 ++++ src/background/src/Action/Ports.elm | 4 + src/background/src/Comm/GetBattles.elm | 45 ++++++++ src/background/src/Comm/GetID.elm | 43 ++++++++ src/background/src/Comm/Okay.elm | 21 ++++ src/background/src/Comm/Send.elm | 66 ++++++++++++ src/background/src/Comm/SetBattles.elm | 51 +++++++++ src/background/src/ElmModule/Init.elm | 29 ++++++ src/background/src/ElmModule/Subscriptions.elm | 17 +++ src/background/src/ElmModule/Update.elm | 51 +++++++++ src/background/src/ElmModule/View.elm | 71 +++++++++++++ src/background/src/Main.elm | 23 ++++ src/background/src/Struct/BattleSummary.elm | 65 ++++++++++++ src/background/src/Struct/Error.elm | 45 ++++++++ src/background/src/Struct/Event.elm | 30 ++++++ src/background/src/Struct/Flags.elm | 42 ++++++++ src/background/src/Struct/Model.elm | 66 ++++++++++++ src/background/src/Struct/Player.elm | 133 ++++++++++++++++++++++++ src/background/src/Struct/ServerReply.elm | 29 ++++++ src/background/src/Update/AddPlayer.elm | 24 +++++ src/background/src/Update/HandleServerReply.elm | 119 +++++++++++++++++++++ src/background/src/Update/RefreshBattles.elm | 28 +++++ src/background/src/Update/StoreParams.elm | 38 +++++++ src/background/src/Util/Array.elm | 34 ++++++ src/background/src/Util/Html.elm | 6 ++ src/background/src/Util/List.elm | 36 +++++++ src/background/src/View/Header.elm | 79 ++++++++++++++ src/background/src/View/Player.elm | 97 +++++++++++++++++ src/popup/Makefile | 36 +++++++ src/popup/elm-package.json | 19 ++++ src/popup/src/Action/Ports.elm | 4 + src/popup/src/Comm/GetBattles.elm | 45 ++++++++ src/popup/src/Comm/GetID.elm | 43 ++++++++ src/popup/src/Comm/Okay.elm | 21 ++++ src/popup/src/Comm/Send.elm | 66 ++++++++++++ src/popup/src/Comm/SetBattles.elm | 51 +++++++++ src/popup/src/ElmModule/Init.elm | 29 ++++++ src/popup/src/ElmModule/Subscriptions.elm | 17 +++ src/popup/src/ElmModule/Update.elm | 51 +++++++++ src/popup/src/ElmModule/View.elm | 71 +++++++++++++ src/popup/src/Main.elm | 23 ++++ src/popup/src/Struct/BattleSummary.elm | 65 ++++++++++++ src/popup/src/Struct/Error.elm | 45 ++++++++ src/popup/src/Struct/Event.elm | 30 ++++++ src/popup/src/Struct/Flags.elm | 42 ++++++++ src/popup/src/Struct/Model.elm | 66 ++++++++++++ src/popup/src/Struct/Player.elm | 133 ++++++++++++++++++++++++ src/popup/src/Struct/ServerReply.elm | 29 ++++++ src/popup/src/Update/AddPlayer.elm | 24 +++++ src/popup/src/Update/HandleServerReply.elm | 119 +++++++++++++++++++++ src/popup/src/Update/RefreshBattles.elm | 28 +++++ src/popup/src/Update/StoreParams.elm | 38 +++++++ src/popup/src/Util/Array.elm | 34 ++++++ src/popup/src/Util/Html.elm | 6 ++ src/popup/src/Util/List.elm | 36 +++++++ src/popup/src/View/Header.elm | 79 ++++++++++++++ src/popup/src/View/Player.elm | 97 +++++++++++++++++ 85 files changed, 2694 insertions(+), 1292 deletions(-) delete mode 100644 src/Action/Ports.elm delete mode 100644 src/Comm/GetBattles.elm delete mode 100644 src/Comm/GetID.elm delete mode 100644 src/Comm/Okay.elm delete mode 100644 src/Comm/Send.elm delete mode 100644 src/Comm/SetBattles.elm delete mode 100644 src/ElmModule/Init.elm delete mode 100644 src/ElmModule/Subscriptions.elm delete mode 100644 src/ElmModule/Update.elm delete mode 100644 src/ElmModule/View.elm delete mode 100644 src/Main.elm delete mode 100644 src/Struct/BattleSummary.elm delete mode 100644 src/Struct/Error.elm delete mode 100644 src/Struct/Event.elm delete mode 100644 src/Struct/Flags.elm delete mode 100644 src/Struct/Model.elm delete mode 100644 src/Struct/Player.elm delete mode 100644 src/Struct/ServerReply.elm delete mode 100644 src/Update/AddPlayer.elm delete mode 100644 src/Update/HandleServerReply.elm delete mode 100644 src/Update/RefreshBattles.elm delete mode 100644 src/Update/StoreParams.elm delete mode 100644 src/Util/Array.elm delete mode 100644 src/Util/Html.elm delete mode 100644 src/Util/List.elm delete mode 100644 src/View/Header.elm delete mode 100644 src/View/Player.elm create mode 100644 src/background/Makefile create mode 100644 src/background/elm-package.json create mode 100644 src/background/src/Action/Ports.elm create mode 100644 src/background/src/Comm/GetBattles.elm create mode 100644 src/background/src/Comm/GetID.elm create mode 100644 src/background/src/Comm/Okay.elm create mode 100644 src/background/src/Comm/Send.elm create mode 100644 src/background/src/Comm/SetBattles.elm create mode 100644 src/background/src/ElmModule/Init.elm create mode 100644 src/background/src/ElmModule/Subscriptions.elm create mode 100644 src/background/src/ElmModule/Update.elm create mode 100644 src/background/src/ElmModule/View.elm create mode 100644 src/background/src/Main.elm create mode 100644 src/background/src/Struct/BattleSummary.elm create mode 100644 src/background/src/Struct/Error.elm create mode 100644 src/background/src/Struct/Event.elm create mode 100644 src/background/src/Struct/Flags.elm create mode 100644 src/background/src/Struct/Model.elm create mode 100644 src/background/src/Struct/Player.elm create mode 100644 src/background/src/Struct/ServerReply.elm create mode 100644 src/background/src/Update/AddPlayer.elm create mode 100644 src/background/src/Update/HandleServerReply.elm create mode 100644 src/background/src/Update/RefreshBattles.elm create mode 100644 src/background/src/Update/StoreParams.elm create mode 100644 src/background/src/Util/Array.elm create mode 100644 src/background/src/Util/Html.elm create mode 100644 src/background/src/Util/List.elm create mode 100644 src/background/src/View/Header.elm create mode 100644 src/background/src/View/Player.elm create mode 100644 src/popup/Makefile create mode 100644 src/popup/elm-package.json create mode 100644 src/popup/src/Action/Ports.elm create mode 100644 src/popup/src/Comm/GetBattles.elm create mode 100644 src/popup/src/Comm/GetID.elm create mode 100644 src/popup/src/Comm/Okay.elm create mode 100644 src/popup/src/Comm/Send.elm create mode 100644 src/popup/src/Comm/SetBattles.elm create mode 100644 src/popup/src/ElmModule/Init.elm create mode 100644 src/popup/src/ElmModule/Subscriptions.elm create mode 100644 src/popup/src/ElmModule/Update.elm create mode 100644 src/popup/src/ElmModule/View.elm create mode 100644 src/popup/src/Main.elm create mode 100644 src/popup/src/Struct/BattleSummary.elm create mode 100644 src/popup/src/Struct/Error.elm create mode 100644 src/popup/src/Struct/Event.elm create mode 100644 src/popup/src/Struct/Flags.elm create mode 100644 src/popup/src/Struct/Model.elm create mode 100644 src/popup/src/Struct/Player.elm create mode 100644 src/popup/src/Struct/ServerReply.elm create mode 100644 src/popup/src/Update/AddPlayer.elm create mode 100644 src/popup/src/Update/HandleServerReply.elm create mode 100644 src/popup/src/Update/RefreshBattles.elm create mode 100644 src/popup/src/Update/StoreParams.elm create mode 100644 src/popup/src/Util/Array.elm create mode 100644 src/popup/src/Util/Html.elm create mode 100644 src/popup/src/Util/List.elm create mode 100644 src/popup/src/View/Header.elm create mode 100644 src/popup/src/View/Player.elm (limited to 'src') diff --git a/src/Action/Ports.elm b/src/Action/Ports.elm deleted file mode 100644 index 4d83077..0000000 --- a/src/Action/Ports.elm +++ /dev/null @@ -1,4 +0,0 @@ -port module Action.Ports exposing (..) - -port store_params : (Int, String) -> (Cmd msg) -port reset_params : () -> (Cmd msg) diff --git a/src/Comm/GetBattles.elm b/src/Comm/GetBattles.elm deleted file mode 100644 index 0956972..0000000 --- a/src/Comm/GetBattles.elm +++ /dev/null @@ -1,45 +0,0 @@ -module Comm.GetBattles exposing (try) - --- Elm ------------------------------------------------------------------------- -import Json.Encode - --- Extension ------------------------------------------------------------------- -import Comm.Send - -import Struct.Event -import Struct.Model -import Struct.Player - --------------------------------------------------------------------------------- --- TYPES ------------------------------------------------------------------------ --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -try_encoding : String -> Struct.Model.Type -> (Maybe Json.Encode.Value) -try_encoding player_id model = - let - encoded_player_id = (Json.Encode.string player_id) - in - (Just - (Json.Encode.object - [ - ("id", encoded_player_id) - ] - ) - ) - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -try : Struct.Model.Type -> Struct.Player.Type -> (Maybe (Cmd Struct.Event.Type)) -try model player = - (Comm.Send.try_sending - model - ( - (Struct.Player.get_query_url player) - ++ "/handler/player/plr_get_battles" - ) - (try_encoding (Struct.Player.get_id player)) - ) diff --git a/src/Comm/GetID.elm b/src/Comm/GetID.elm deleted file mode 100644 index 14d668c..0000000 --- a/src/Comm/GetID.elm +++ /dev/null @@ -1,43 +0,0 @@ -module Comm.GetID exposing (try) - --- Elm ------------------------------------------------------------------------- -import Json.Encode - --- Extension ------------------------------------------------------------------- -import Comm.Send - -import Constants.IO - -import Struct.Event -import Struct.Model - --------------------------------------------------------------------------------- --- TYPES ------------------------------------------------------------------------ --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -try_encoding : String -> Struct.Model.Type -> (Maybe Json.Encode.Value) -try_encoding player_id model = - let - encoded_player_id = (Json.Encode.string player_id) - in - (Just - (Json.Encode.object - [ - ("id", encoded_player_id) - ] - ) - ) - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -try : Struct.Model.Type -> String -> (Maybe (Cmd Struct.Event.Type)) -try model = - (Comm.Send.try_sending - model - Constants.IO.get_battles_handler - (try_encoding player_id) - ) diff --git a/src/Comm/Okay.elm b/src/Comm/Okay.elm deleted file mode 100644 index 9281558..0000000 --- a/src/Comm/Okay.elm +++ /dev/null @@ -1,21 +0,0 @@ -module Comm.Okay exposing (decoder) - --- Elm ------------------------------------------------------------------------- -import Json.Decode - --- Battlemap ------------------------------------------------------------------- -import Struct.ServerReply - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -decoder : (Json.Decode.Decoder Struct.ServerReply.Type) -decoder = (Json.Decode.succeed Struct.ServerReply.Okay) diff --git a/src/Comm/Send.elm b/src/Comm/Send.elm deleted file mode 100644 index 3fc30ae..0000000 --- a/src/Comm/Send.elm +++ /dev/null @@ -1,66 +0,0 @@ -module Comm.Send exposing (try_sending) - --- Elm ------------------------------------------------------------------------- -import Http - -import Json.Decode -import Json.Encode - --- Extension ------------------------------------------------------------------- -import Comm.Okay -import Comm.SetBattles - -import Struct.Event -import Struct.ServerReply -import Struct.Model - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -internal_decoder : String -> (Json.Decode.Decoder Struct.ServerReply.Type) -internal_decoder reply_type = - case reply_type of - "okay" -> (Comm.Okay.decoder) - "set_battles" -> (Comm.SetBattles.decoder) - other -> - (Json.Decode.fail - ( - "Unknown server command \"" - ++ other - ++ "\"" - ) - ) - -decoder : (Json.Decode.Decoder Struct.ServerReply.Type) -decoder = - (Json.Decode.field "msg" Json.Decode.string) - |> (Json.Decode.andThen (internal_decoder)) - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -try_sending : ( - Struct.Model.Type -> - String -> - (Struct.Model.Type -> (Maybe Json.Encode.Value)) -> - (Maybe (Cmd Struct.Event.Type)) - ) -try_sending model recipient try_encoding_fun = - case (try_encoding_fun model) of - (Just serial) -> - (Just - (Http.send - Struct.Event.ServerReplied - (Http.post - recipient - (Http.jsonBody serial) - (Json.Decode.list (decoder)) - ) - ) - ) - - Nothing -> Nothing diff --git a/src/Comm/SetBattles.elm b/src/Comm/SetBattles.elm deleted file mode 100644 index 0add112..0000000 --- a/src/Comm/SetBattles.elm +++ /dev/null @@ -1,51 +0,0 @@ -module Comm.SetBattles exposing (decoder) - --- Elm ------------------------------------------------------------------------- -import Json.Decode - --- Extension ------------------------------------------------------------------- -import Struct.BattleSummary -import Struct.Player -import Struct.ServerReply - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -type alias Battles = - { - campaigns : (List Struct.BattleSummary.Type), - invasions : (List Struct.BattleSummary.Type), - events : (List Struct.BattleSummary.Type) - } - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -internal_decoder : (Json.Decode.Decoder Battles) -internal_decoder = - (Json.Decode.map3 - Battles - (Json.Decode.field - "cmps" - (Json.Decode.list (Struct.BattleSummary.decoder)) - ) - (Json.Decode.field - "invs" - (Json.Decode.list (Struct.BattleSummary.decoder)) - ) - (Json.Decode.field - "evts" - (Json.Decode.list (Struct.BattleSummary.decoder)) - ) - ) - -to_server_reply : Battles -> Struct.ServerReply.Type -to_server_reply t = - (Struct.ServerReply.SetBattles (t.campaigns, t.invasions, t.events)) - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -decoder : (Json.Decode.Decoder Struct.ServerReply.Type) -decoder = - (Json.Decode.map (to_server_reply) (internal_decoder)) diff --git a/src/ElmModule/Init.elm b/src/ElmModule/Init.elm deleted file mode 100644 index 65d31b7..0000000 --- a/src/ElmModule/Init.elm +++ /dev/null @@ -1,29 +0,0 @@ -module ElmModule.Init exposing (init) - --- Elm ------------------------------------------------------------------------- -import Delay - -import Time - --- Extension ------------------------------------------------------------------- -import Struct.Event -import Struct.Flags -import Struct.Model - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -init : Struct.Flags.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type)) -init flags = - ( - (Struct.Model.new flags), - (Delay.after - (toFloat (Struct.Flags.get_frequency flags)) - (Time.minute) - Struct.Event.ShouldRefresh - ) - ) diff --git a/src/ElmModule/Subscriptions.elm b/src/ElmModule/Subscriptions.elm deleted file mode 100644 index e9b557e..0000000 --- a/src/ElmModule/Subscriptions.elm +++ /dev/null @@ -1,17 +0,0 @@ -module ElmModule.Subscriptions exposing (..) - --- Elm ------------------------------------------------------------------------- - --- Main Menu ------------------------------------------------------------------- -import Struct.Model -import Struct.Event - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -subscriptions : Struct.Model.Type -> (Sub Struct.Event.Type) -subscriptions model = Sub.none diff --git a/src/ElmModule/Update.elm b/src/ElmModule/Update.elm deleted file mode 100644 index 9e162fe..0000000 --- a/src/ElmModule/Update.elm +++ /dev/null @@ -1,51 +0,0 @@ -module ElmModule.Update exposing (update) - --- Elm ------------------------------------------------------------------------- - --- Main Menu ------------------------------------------------------------------- -import Struct.Event -import Struct.Model - -import Update.AddPlayer -import Update.HandleServerReply -import Update.RefreshBattles -import Update.StoreParams - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -update : ( - Struct.Event.Type -> - Struct.Model.Type -> - (Struct.Model.Type, (Cmd Struct.Event.Type)) - ) -update event model = - let - new_model = (Struct.Model.clear_error model) - in - case event of - Struct.Event.None -> (model, Cmd.none) - - (Struct.Event.SetUsername str) -> (model, Cmd.none) - (Struct.Event.SetID str) -> (model, Cmd.none) - (Struct.Event.SetURLPrefix str) -> (model, Cmd.none) - (Struct.Event.SetFrequency val) -> (model, Cmd.none) - - Struct.Event.ShouldRefresh -> (Update.RefreshBattles.apply_to model) - - Struct.Event.StoreParams -> (Update.StoreParams.apply_to model) - - Struct.Event.AddPlayer -> (Update.AddPlayer.apply_to model) - - (Struct.Event.Failed err) -> - ( - (Struct.Model.invalidate err new_model), - Cmd.none - ) - - (Struct.Event.ServerReplied result) -> - (Update.HandleServerReply.apply_to model result) diff --git a/src/ElmModule/View.elm b/src/ElmModule/View.elm deleted file mode 100644 index 946bf8e..0000000 --- a/src/ElmModule/View.elm +++ /dev/null @@ -1,71 +0,0 @@ -module ElmModule.View exposing (view) - --- Elm ------------------------------------------------------------------------- -import Array - -import Html -import Html.Events -import Html.Attributes - --- Extension ------------------------------------------------------------------- -import Util.Html - -import Struct.Error -import Struct.Event -import Struct.Model - -import View.Player --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -view : Struct.Model.Type -> (Html.Html Struct.Event.Type) -view model = - (Html.div - [ - (Html.Attributes.class "fullscreen-module") - ] - [ - ( - case model.error of - Nothing -> (Util.Html.nothing) - (Just err) -> - (Html.div - [] - [ - (Html.text (Struct.Error.to_string err)) - ] - ) - ), - (Html.div - [ - ] - (List.map (View.Player.get_html) (Array.toList model.players)) - ), - (Html.div - [ - ] - [ - (Html.button - [ - (Html.Events.onClick Struct.Event.AddPlayer) - ] - [ - (Html.text "Add Player") - ] - ), - (Html.button - [ - (Html.Events.onClick Struct.Event.StoreParams) - ] - [ - (Html.text "Save Params") - ] - ) - ] - ) - ] - ) diff --git a/src/Main.elm b/src/Main.elm deleted file mode 100644 index 8140041..0000000 --- a/src/Main.elm +++ /dev/null @@ -1,23 +0,0 @@ --- Elm ------------------------------------------------------------------------ -import Html - --- Map ------------------------------------------------------------------- -import Struct.Model -import Struct.Event -import Struct.Flags - -import ElmModule.Init -import ElmModule.Subscriptions -import ElmModule.View -import ElmModule.Update - -main : (Program Struct.Flags.Type Struct.Model.Type Struct.Event.Type) -main = - (Html.programWithFlags - { - init = ElmModule.Init.init, - view = ElmModule.View.view, - update = ElmModule.Update.update, - subscriptions = ElmModule.Subscriptions.subscriptions - } - ) diff --git a/src/Struct/BattleSummary.elm b/src/Struct/BattleSummary.elm deleted file mode 100644 index adab965..0000000 --- a/src/Struct/BattleSummary.elm +++ /dev/null @@ -1,65 +0,0 @@ -module Struct.BattleSummary exposing - ( - Type, - get_id, - get_name, - get_last_edit, - is_players_turn, - decoder, - none - ) - --- Elm ------------------------------------------------------------------------- -import Json.Decode -import Json.Decode.Pipeline - --- Main Menu ------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -type alias Type = - { - id : String, - name : String, - last_edit : String, - is_players_turn : Bool - } - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -get_id : Type -> String -get_id t = t.id - -get_name : Type -> String -get_name t = t.name - -get_last_edit : Type -> String -get_last_edit t = t.last_edit - -is_players_turn : Type -> Bool -is_players_turn t = t.is_players_turn - -decoder : (Json.Decode.Decoder Type) -decoder = - (Json.Decode.Pipeline.decode - Type - |> (Json.Decode.Pipeline.required "id" Json.Decode.string) - |> (Json.Decode.Pipeline.required "nme" Json.Decode.string) - |> (Json.Decode.Pipeline.required "ldt" Json.Decode.string) - |> (Json.Decode.Pipeline.required "ipt" Json.Decode.bool) - ) - -none : Type -none = - { - id = "", - name = "Unknown", - last_edit = "Never", - is_players_turn = False - } diff --git a/src/Struct/Error.elm b/src/Struct/Error.elm deleted file mode 100644 index 5f40c09..0000000 --- a/src/Struct/Error.elm +++ /dev/null @@ -1,45 +0,0 @@ -module Struct.Error exposing (Type, Mode(..), new, to_string) - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -type Mode = - IllegalAction - | Programming - | Unimplemented - | Networking - | Failure - -type alias Type = - { - mode: Mode, - message: String - } - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -new : Mode -> String -> Type -new mode str = - { - mode = mode, - message = str - } - -to_string : Type -> String -to_string e = - ( - (case e.mode of - Failure -> "The action failed: " - IllegalAction -> "Request discarded: " - Programming -> "Error in the program (please report): " - Unimplemented -> "Update discarded due to unimplemented feature: " - Networking -> "Error while conversing with the server: " - ) - ++ e.message - ) - diff --git a/src/Struct/Event.elm b/src/Struct/Event.elm deleted file mode 100644 index eafd812..0000000 --- a/src/Struct/Event.elm +++ /dev/null @@ -1,30 +0,0 @@ -module Struct.Event exposing (Type(..), attempted) - --- Elm ------------------------------------------------------------------------- -import Http - --- Main Menu ------------------------------------------------------------------- -import Struct.Error -import Struct.ServerReply - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -type Type = - None - | Failed Struct.Error.Type - | AddPlayer - | ShouldRefresh - | SetUsername String - | SetID String - | SetURLPrefix String - | SetFrequency Int - | StoreParams - | ServerReplied (Result Http.Error (List Struct.ServerReply.Type)) - -attempted : (Result.Result err val) -> Type -attempted act = - case act of - (Result.Ok _) -> None - (Result.Err msg) -> - (Failed (Struct.Error.new Struct.Error.Failure (toString msg))) diff --git a/src/Struct/Flags.elm b/src/Struct/Flags.elm deleted file mode 100644 index e5a79f8..0000000 --- a/src/Struct/Flags.elm +++ /dev/null @@ -1,42 +0,0 @@ -module Struct.Flags exposing - ( - Type, - get_frequency, - get_players - ) - --- Elm ------------------------------------------------------------------------- -import Json.Decode - --- Extension ------------------------------------------------------------------- -import Struct.Player - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -type alias Type = - { - frequency : Int, - players : String - } - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -get_frequency : Type -> Int -get_frequency flags = flags.frequency - -get_players : Type -> (List Struct.Player.Type) -get_players flags = - case - (Json.Decode.decodeString - (Json.Decode.list (Struct.Player.decoder)) - flags.players - ) - of - (Ok result) -> result - (Err _) -> [] diff --git a/src/Struct/Model.elm b/src/Struct/Model.elm deleted file mode 100644 index 6742e96..0000000 --- a/src/Struct/Model.elm +++ /dev/null @@ -1,66 +0,0 @@ -module Struct.Model exposing - ( - Type, - new, - invalidate, - reset, - clear_error - ) - --- Elm ------------------------------------------------------------------------- -import Array - --- Extension ------------------------------------------------------------------- -import Struct.Flags -import Struct.Error -import Struct.Player - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -type alias Type = - { - flags: Struct.Flags.Type, - error: (Maybe Struct.Error.Type), - players: (Array.Array Struct.Player.Type), - query_index: Int, - notify: Bool - } - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -new : Struct.Flags.Type -> Type -new flags = - { - flags = flags, - error = Nothing, - players = - (Array.push - (Struct.Player.default) - (Array.fromList (Struct.Flags.get_players flags)) - ), - query_index = -1, - notify = False - } - -reset : Type -> Type -reset model = - {model | - error = Nothing, - notify = False, - query_index = -1 - } - -invalidate : Struct.Error.Type -> Type -> Type -invalidate err model = - {model | - error = (Just err) - } - -clear_error : Type -> Type -clear_error model = {model | error = Nothing} diff --git a/src/Struct/Player.elm b/src/Struct/Player.elm deleted file mode 100644 index 1e8365a..0000000 --- a/src/Struct/Player.elm +++ /dev/null @@ -1,133 +0,0 @@ -module Struct.Player exposing - ( - Type, - get_id, - set_id, - get_query_url, - set_query_url, - get_username, - set_username, - get_campaigns, - get_invasions, - get_events, - set_battles, - has_active_battles, - decoder, - encode, - default - ) - --- Elm ------------------------------------------------------------------------- -import Json.Decode -import Json.Decode.Pipeline -import Json.Encode - --- Extension ------------------------------------------------------------------- -import Struct.BattleSummary - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -type alias Type = - { - id : String, - name : String, - query_url : String, - campaigns : (List Struct.BattleSummary.Type), - invasions : (List Struct.BattleSummary.Type), - events : (List Struct.BattleSummary.Type) - } - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -get_id : Type -> String -get_id t = t.id - -set_id : String -> Type -> Type -set_id str t = {t | id = str} - -get_username : Type -> String -get_username t = t.name - -set_username : String -> Type -> Type -set_username str t = {t | name = str} - -get_query_url : Type -> String -get_query_url t = t.query_url - -set_query_url : String -> Type -> Type -set_query_url str t = {t | query_url = str} - -get_campaigns : Type -> (List Struct.BattleSummary.Type) -get_campaigns t = t.campaigns - -get_invasions : Type -> (List Struct.BattleSummary.Type) -get_invasions t = t.invasions - -get_events : Type -> (List Struct.BattleSummary.Type) -get_events t = t.events - -set_battles : ( - (List Struct.BattleSummary.Type) -> - (List Struct.BattleSummary.Type) -> - (List Struct.BattleSummary.Type) -> - Type -> - Type - ) -set_battles campaigns invasions events t = - {t | - campaigns = - (List.filter (Struct.BattleSummary.is_players_turn) campaigns), - invasions = - (List.filter (Struct.BattleSummary.is_players_turn) invasions), - events = (List.filter (Struct.BattleSummary.is_players_turn) events) - } - -has_active_battles : Type -> Bool -has_active_battles t = - ( - ( - (List.length t.campaigns) - + (List.length t.invasions) - + (List.length t.events) - ) - > 0 - ) - -decoder : (Json.Decode.Decoder Type) -decoder = - (Json.Decode.Pipeline.decode - Type - |> (Json.Decode.Pipeline.required "id" Json.Decode.string) - |> (Json.Decode.Pipeline.required "name" Json.Decode.string) - |> (Json.Decode.Pipeline.required "query_url" Json.Decode.string) - |> (Json.Decode.Pipeline.hardcoded []) - |> (Json.Decode.Pipeline.hardcoded []) - |> (Json.Decode.Pipeline.hardcoded []) - ) - -encode : Type -> Json.Encode.Value -encode t = - (Json.Encode.object - [ - ("id", (Json.Encode.string t.id)), - ("name", (Json.Encode.string t.name)), - ("query_url", (Json.Encode.string t.query_url)) - ] - ) - -default : Type -default = - { - id = "0", - name = "Username", - query_url = "http://127.0.0.1/", - campaigns = [], - invasions = [], - events = [] - } diff --git a/src/Struct/ServerReply.elm b/src/Struct/ServerReply.elm deleted file mode 100644 index f0530d8..0000000 --- a/src/Struct/ServerReply.elm +++ /dev/null @@ -1,29 +0,0 @@ -module Struct.ServerReply exposing (Type(..)) - --- Elm ------------------------------------------------------------------------- - --- ------------------------------------------------------------------- -import Struct.BattleSummary - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - -type Type = - Okay - | SetID String - | SetUsername String - | SetBattles - ( - (List Struct.BattleSummary.Type), - (List Struct.BattleSummary.Type), - (List Struct.BattleSummary.Type) - ) - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- diff --git a/src/Update/AddPlayer.elm b/src/Update/AddPlayer.elm deleted file mode 100644 index ed9da4a..0000000 --- a/src/Update/AddPlayer.elm +++ /dev/null @@ -1,24 +0,0 @@ -module Update.AddPlayer exposing (apply_to) - --- Elm ------------------------------------------------------------------------- -import Array - --- Extension ------------------------------------------------------------------- -import Struct.Event -import Struct.Flags -import Struct.Model -import Struct.Player - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -apply_to : Struct.Model.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type)) -apply_to model = - ( - {model | players = (Array.push (Struct.Player.default) model.players)}, - Cmd.none - ) diff --git a/src/Update/HandleServerReply.elm b/src/Update/HandleServerReply.elm deleted file mode 100644 index b80c7b4..0000000 --- a/src/Update/HandleServerReply.elm +++ /dev/null @@ -1,119 +0,0 @@ -module Update.HandleServerReply exposing (apply_to) - --- Elm ------------------------------------------------------------------------- -import Array - -import Http - --- Extension ------------------------------------------------------------------- -import Comm.GetBattles - -import Struct.BattleSummary -import Struct.Error -import Struct.Event -import Struct.Model -import Struct.Player -import Struct.ServerReply - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -handle_set_battles : ( - ( - (List Struct.BattleSummary.Type), - (List Struct.BattleSummary.Type), - (List Struct.BattleSummary.Type) - ) -> - (Struct.Model.Type, (List (Cmd Struct.Event.Type))) -> - (Struct.Model.Type, (List (Cmd Struct.Event.Type))) - ) -handle_set_battles battles current_state = - let - (model, cmds) = current_state - (campaigns, invasions, events) = battles - in - case (Array.get model.query_index model.players) of - Nothing -> current_state -- TODO: error - (Just player) -> - let - updated_player = - (Struct.Player.set_battles - campaigns - invasions - events - player - ) - updated_model = - {model | - players = - (Array.set - model.query_index - updated_player - model.players - ), - query_index = (model.query_index + 1), - notify = - ( - model.notify - || (Struct.Player.has_active_battles updated_player) - ) - } - in - case (Array.get updated_model.query_index model.players) of - Nothing -> ({updated_model| query_index = -1}, cmds) - - (Just next_player) -> - case (Comm.GetBattles.try updated_model next_player) of - Nothing -> ({updated_model| query_index = -1}, cmds) - (Just query) -> (updated_model, (query :: 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.Okay -> current_state - (Struct.ServerReply.SetID str) -> current_state -- TODO - (Struct.ServerReply.SetUsername str) -> current_state -- TODO - (Struct.ServerReply.SetBattles battles) -> - (handle_set_battles battles 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) - ) - ) diff --git a/src/Update/RefreshBattles.elm b/src/Update/RefreshBattles.elm deleted file mode 100644 index 2ff739f..0000000 --- a/src/Update/RefreshBattles.elm +++ /dev/null @@ -1,28 +0,0 @@ -module Update.RefreshBattles exposing (apply_to) - --- Elm ------------------------------------------------------------------------- -import Array - --- Extension ------------------------------------------------------------------- -import Comm.GetBattles - -import Struct.Event -import Struct.Flags -import Struct.Model - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -apply_to : Struct.Model.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type)) -apply_to model = - case (Array.get 0 model.players) of - Nothing -> (model, Cmd.none) - (Just player) -> - case (Comm.GetBattles.try model player) of - -- TODO: Invalidate only this player, refresh the others. - Nothing -> (model, Cmd.none) - (Just cmd) -> ({model | query_index = 0}, cmd) diff --git a/src/Update/StoreParams.elm b/src/Update/StoreParams.elm deleted file mode 100644 index f369be8..0000000 --- a/src/Update/StoreParams.elm +++ /dev/null @@ -1,38 +0,0 @@ -module Update.StoreParams exposing (apply_to) - --- Elm ------------------------------------------------------------------------- -import Array - -import Json.Encode - --- Extension ------------------------------------------------------------------- -import Action.Ports - -import Struct.Event -import Struct.Flags -import Struct.Model -import Struct.Player - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -apply_to : Struct.Model.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type)) -apply_to model = - ( - model, - (Action.Ports.store_params - ( - (Struct.Flags.get_frequency model.flags), - (Json.Encode.encode - 0 - (Json.Encode.list - (List.map (Struct.Player.encode) (Array.toList model.players)) - ) - ) - ) - ) - ) diff --git a/src/Util/Array.elm b/src/Util/Array.elm deleted file mode 100644 index 9e57c18..0000000 --- a/src/Util/Array.elm +++ /dev/null @@ -1,34 +0,0 @@ -module Util.Array exposing - ( - update, - update_unsafe, - filter_first - ) - -import Array - -update : ( - Int -> - ((Maybe t) -> (Maybe t)) -> - (Array.Array t) -> - (Array.Array t) - ) -update index fun array = - case (fun (Array.get index array)) of - Nothing -> array - (Just e) -> (Array.set index e array) - -update_unsafe : ( - Int -> - (t -> t) -> - (Array.Array t) -> - (Array.Array t) - ) -update_unsafe index fun array = - case (Array.get index array) of - Nothing -> array - (Just e) -> (Array.set index (fun e) array) - -filter_first : (t -> Bool) -> (Array.Array t) -> (Maybe t) -filter_first fun array = - (Array.get 0 (Array.filter fun array)) diff --git a/src/Util/Html.elm b/src/Util/Html.elm deleted file mode 100644 index 42eadba..0000000 --- a/src/Util/Html.elm +++ /dev/null @@ -1,6 +0,0 @@ -module Util.Html exposing (nothing) - -import Html - -nothing : (Html.Html a) -nothing = (Html.text "") diff --git a/src/Util/List.elm b/src/Util/List.elm deleted file mode 100644 index 1f914b1..0000000 --- a/src/Util/List.elm +++ /dev/null @@ -1,36 +0,0 @@ -module Util.List exposing (..) - -import List - -pop : List a -> (Maybe (a, List a)) -pop l = - case - ((List.head l), (List.tail l)) - of - (Nothing, _) -> Nothing - (_ , Nothing) -> Nothing - ((Just head), (Just tail)) -> (Just (head, tail)) - -get_first : (a -> Bool) -> (List a) -> (Maybe a) -get_first fun list = - (List.head (List.filter fun list)) - -product_map : (a -> b -> c) -> (List a) -> (List b) -> (List c) -product_map product_fun list_a list_b = - (product_map_rec (product_fun) list_a list_b []) - -product_map_rec : (a -> b -> c) -> (List a) -> (List b) -> (List c) -> (List c) -product_map_rec product_fun list_a list_b result = - case (pop list_a) of - Nothing -> result - (Just (head, tail)) -> - (product_map_rec - (product_fun) - tail - list_b - (List.append - (List.map (product_fun head) list_b) - result - ) - ) - diff --git a/src/View/Header.elm b/src/View/Header.elm deleted file mode 100644 index fd8e693..0000000 --- a/src/View/Header.elm +++ /dev/null @@ -1,79 +0,0 @@ -module View.Header exposing (get_html) - --- Elm ------------------------------------------------------------------------- -import Html -import Html.Attributes - --- Map ------------------------------------------------------------------- -import Struct.Event - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -link_html : String -> String -> Bool -> (Html.Html Struct.Event.Type) -link_html src label is_active = - (Html.a - [ - (Html.Attributes.href src) - ] - [ - ( - if (is_active) - then (Html.text label) - else (Html.s [] [(Html.text label)]) - ) - ] - ) - -navigation_html : (Html.Html Struct.Event.Type) -navigation_html = - (Html.nav - [] - [ - (link_html "/about.html" "About" True), - (link_html "/news/" "News" False), - (link_html "/community/" "Community" False), - (link_html "/login/?action=disconnect" "Disconnect" True) - ] - ) - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -get_html : (Html.Html Struct.Event.Type) -get_html = - (Html.header - [] - [ - (Html.div - [ - (Html.Attributes.class "main-server-logo") - ] - [ - (Html.a - [ - (Html.Attributes.href "http://127.0.0.1") - ] - [ - (Html.img - [ - (Html.Attributes.src "/asset/svg/to-logo-no-bg.svg") - ] - [ - ] - ) - ] - ) - ] - ), - (Html.div - [ - (Html.Attributes.class "main-server-version") - ] - [ - (Html.text "Latest Dev. Build (Mon, 10 Sep 2018 10:30:17 +0000)") - ] - ), - (navigation_html) - ] - ) diff --git a/src/View/Player.elm b/src/View/Player.elm deleted file mode 100644 index 07dc292..0000000 --- a/src/View/Player.elm +++ /dev/null @@ -1,97 +0,0 @@ -module View.Player exposing (get_html) - --- Elm ------------------------------------------------------------------------- -import Html -import Html.Attributes --- import Html.Events - --- Extension ------------------------------------------------------------------- -import Struct.BattleSummary -import Struct.Event -import Struct.Player - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -get_item_html : ( - String -> - String -> - Struct.BattleSummary.Type -> - (Html.Html Struct.Event.Type) - ) -get_item_html query_url additional_class item = - (Html.a - [ - (Html.Attributes.class additional_class), - (Html.Attributes.href - ( - query_url - ++ "/battle/?id=" - ++ (Struct.BattleSummary.get_id item) - ) - ) - ] - [ - (Html.div - [ - (Html.Attributes.class "battle-summary-name") - ] - [ - (Html.text (Struct.BattleSummary.get_name item)) - ] - ), - (Html.div - [ - (Html.Attributes.class "battle-summary-date") - ] - [ - (Html.text (Struct.BattleSummary.get_last_edit item)) - ] - ) - ] - ) - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -get_html : Struct.Player.Type -> (Html.Html Struct.Event.Type) -get_html player = - let - query_url = (Struct.Player.get_query_url player) - in - (Html.div - [ - (Html.Attributes.class "player-summary") - ] - [ - (Html.div - [ - (Html.Attributes.class "player-summary-listing-header") - ] - [ - (Html.text (Struct.Player.get_username player)) - ] - ), - (Html.div - [ - (Html.Attributes.class "player-summary-listing-body") - ] - ( - (List.map - (get_item_html query_url "campaign-link") - (Struct.Player.get_campaigns player) - ) - ++ - (List.map - (get_item_html query_url "invasion-link") - (Struct.Player.get_invasions player) - ) - ++ - (List.map - (get_item_html query_url "event-link") - (Struct.Player.get_events player) - ) - ) - ) - ] - ) diff --git a/src/background/Makefile b/src/background/Makefile new file mode 100644 index 0000000..3b58a08 --- /dev/null +++ b/src/background/Makefile @@ -0,0 +1,36 @@ +################################################################################ +## CONFIG ###################################################################### +################################################################################ +SRC_DIR ?= src +WWW_DIR ?= www +WWW_SCRIPT_DIR ?= $(WWW_DIR)/script + +ELM_CC ?= elm-make --warn + +MAIN_MODULE ?= $(SRC_DIR)/Main.elm + +################################################################################ +## MAKEFILE MAGIC ############################################################## +################################################################################ +SUB_MODULES = $(shell find $(SRC_DIR) -type f | grep "elm$$") + +################################################################################ +## SANITY CHECKS ############################################################### +################################################################################ + +################################################################################ +## TARGET RULES ################################################################ +################################################################################ +build: $(WWW_SCRIPT_DIR)/main.js + +clean: + rm -f $(WWW_SCRIPT_DIR)/main.js + +reset: + rm -rf elm-stuff + +################################################################################ +## INTERNAL RULES ############################################################## +################################################################################ +$(WWW_SCRIPT_DIR)/main.js: $(MAIN_MODULE) $(SUB_MODULES) + $(ELM_CC) $(MAIN_MODULE) --output $@ diff --git a/src/background/elm-package.json b/src/background/elm-package.json new file mode 100644 index 0000000..a8b8580 --- /dev/null +++ b/src/background/elm-package.json @@ -0,0 +1,19 @@ +{ + "version": "1.0.0", + "summary": "helpful summary of your project, less than 80 characters", + "repository": "https://github.com/nsensfel/tacticians-extension.git", + "license": "Apache 2.0", + "source-directories": [ + "src" + ], + "exposed-modules": [], + "dependencies": { + "NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0", + "andrewMacmurray/elm-delay": "2.0.3 <= v < 3.0.0", + "elm-lang/core": "5.1.1 <= v < 6.0.0", + "elm-lang/dom": "1.1.1 <= v < 2.0.0", + "elm-lang/html": "2.0.0 <= v < 3.0.0", + "elm-lang/http": "1.0.0 <= v < 2.0.0" + }, + "elm-version": "0.18.0 <= v < 0.19.0" +} diff --git a/src/background/src/Action/Ports.elm b/src/background/src/Action/Ports.elm new file mode 100644 index 0000000..4d83077 --- /dev/null +++ b/src/background/src/Action/Ports.elm @@ -0,0 +1,4 @@ +port module Action.Ports exposing (..) + +port store_params : (Int, String) -> (Cmd msg) +port reset_params : () -> (Cmd msg) diff --git a/src/background/src/Comm/GetBattles.elm b/src/background/src/Comm/GetBattles.elm new file mode 100644 index 0000000..0956972 --- /dev/null +++ b/src/background/src/Comm/GetBattles.elm @@ -0,0 +1,45 @@ +module Comm.GetBattles exposing (try) + +-- Elm ------------------------------------------------------------------------- +import Json.Encode + +-- Extension ------------------------------------------------------------------- +import Comm.Send + +import Struct.Event +import Struct.Model +import Struct.Player + +-------------------------------------------------------------------------------- +-- TYPES ------------------------------------------------------------------------ +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +try_encoding : String -> Struct.Model.Type -> (Maybe Json.Encode.Value) +try_encoding player_id model = + let + encoded_player_id = (Json.Encode.string player_id) + in + (Just + (Json.Encode.object + [ + ("id", encoded_player_id) + ] + ) + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +try : Struct.Model.Type -> Struct.Player.Type -> (Maybe (Cmd Struct.Event.Type)) +try model player = + (Comm.Send.try_sending + model + ( + (Struct.Player.get_query_url player) + ++ "/handler/player/plr_get_battles" + ) + (try_encoding (Struct.Player.get_id player)) + ) diff --git a/src/background/src/Comm/GetID.elm b/src/background/src/Comm/GetID.elm new file mode 100644 index 0000000..14d668c --- /dev/null +++ b/src/background/src/Comm/GetID.elm @@ -0,0 +1,43 @@ +module Comm.GetID exposing (try) + +-- Elm ------------------------------------------------------------------------- +import Json.Encode + +-- Extension ------------------------------------------------------------------- +import Comm.Send + +import Constants.IO + +import Struct.Event +import Struct.Model + +-------------------------------------------------------------------------------- +-- TYPES ------------------------------------------------------------------------ +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +try_encoding : String -> Struct.Model.Type -> (Maybe Json.Encode.Value) +try_encoding player_id model = + let + encoded_player_id = (Json.Encode.string player_id) + in + (Just + (Json.Encode.object + [ + ("id", encoded_player_id) + ] + ) + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +try : Struct.Model.Type -> String -> (Maybe (Cmd Struct.Event.Type)) +try model = + (Comm.Send.try_sending + model + Constants.IO.get_battles_handler + (try_encoding player_id) + ) diff --git a/src/background/src/Comm/Okay.elm b/src/background/src/Comm/Okay.elm new file mode 100644 index 0000000..9281558 --- /dev/null +++ b/src/background/src/Comm/Okay.elm @@ -0,0 +1,21 @@ +module Comm.Okay exposing (decoder) + +-- Elm ------------------------------------------------------------------------- +import Json.Decode + +-- Battlemap ------------------------------------------------------------------- +import Struct.ServerReply + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +decoder : (Json.Decode.Decoder Struct.ServerReply.Type) +decoder = (Json.Decode.succeed Struct.ServerReply.Okay) diff --git a/src/background/src/Comm/Send.elm b/src/background/src/Comm/Send.elm new file mode 100644 index 0000000..3fc30ae --- /dev/null +++ b/src/background/src/Comm/Send.elm @@ -0,0 +1,66 @@ +module Comm.Send exposing (try_sending) + +-- Elm ------------------------------------------------------------------------- +import Http + +import Json.Decode +import Json.Encode + +-- Extension ------------------------------------------------------------------- +import Comm.Okay +import Comm.SetBattles + +import Struct.Event +import Struct.ServerReply +import Struct.Model + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +internal_decoder : String -> (Json.Decode.Decoder Struct.ServerReply.Type) +internal_decoder reply_type = + case reply_type of + "okay" -> (Comm.Okay.decoder) + "set_battles" -> (Comm.SetBattles.decoder) + other -> + (Json.Decode.fail + ( + "Unknown server command \"" + ++ other + ++ "\"" + ) + ) + +decoder : (Json.Decode.Decoder Struct.ServerReply.Type) +decoder = + (Json.Decode.field "msg" Json.Decode.string) + |> (Json.Decode.andThen (internal_decoder)) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +try_sending : ( + Struct.Model.Type -> + String -> + (Struct.Model.Type -> (Maybe Json.Encode.Value)) -> + (Maybe (Cmd Struct.Event.Type)) + ) +try_sending model recipient try_encoding_fun = + case (try_encoding_fun model) of + (Just serial) -> + (Just + (Http.send + Struct.Event.ServerReplied + (Http.post + recipient + (Http.jsonBody serial) + (Json.Decode.list (decoder)) + ) + ) + ) + + Nothing -> Nothing diff --git a/src/background/src/Comm/SetBattles.elm b/src/background/src/Comm/SetBattles.elm new file mode 100644 index 0000000..0add112 --- /dev/null +++ b/src/background/src/Comm/SetBattles.elm @@ -0,0 +1,51 @@ +module Comm.SetBattles exposing (decoder) + +-- Elm ------------------------------------------------------------------------- +import Json.Decode + +-- Extension ------------------------------------------------------------------- +import Struct.BattleSummary +import Struct.Player +import Struct.ServerReply + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Battles = + { + campaigns : (List Struct.BattleSummary.Type), + invasions : (List Struct.BattleSummary.Type), + events : (List Struct.BattleSummary.Type) + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +internal_decoder : (Json.Decode.Decoder Battles) +internal_decoder = + (Json.Decode.map3 + Battles + (Json.Decode.field + "cmps" + (Json.Decode.list (Struct.BattleSummary.decoder)) + ) + (Json.Decode.field + "invs" + (Json.Decode.list (Struct.BattleSummary.decoder)) + ) + (Json.Decode.field + "evts" + (Json.Decode.list (Struct.BattleSummary.decoder)) + ) + ) + +to_server_reply : Battles -> Struct.ServerReply.Type +to_server_reply t = + (Struct.ServerReply.SetBattles (t.campaigns, t.invasions, t.events)) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +decoder : (Json.Decode.Decoder Struct.ServerReply.Type) +decoder = + (Json.Decode.map (to_server_reply) (internal_decoder)) diff --git a/src/background/src/ElmModule/Init.elm b/src/background/src/ElmModule/Init.elm new file mode 100644 index 0000000..65d31b7 --- /dev/null +++ b/src/background/src/ElmModule/Init.elm @@ -0,0 +1,29 @@ +module ElmModule.Init exposing (init) + +-- Elm ------------------------------------------------------------------------- +import Delay + +import Time + +-- Extension ------------------------------------------------------------------- +import Struct.Event +import Struct.Flags +import Struct.Model + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +init : Struct.Flags.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type)) +init flags = + ( + (Struct.Model.new flags), + (Delay.after + (toFloat (Struct.Flags.get_frequency flags)) + (Time.minute) + Struct.Event.ShouldRefresh + ) + ) diff --git a/src/background/src/ElmModule/Subscriptions.elm b/src/background/src/ElmModule/Subscriptions.elm new file mode 100644 index 0000000..e9b557e --- /dev/null +++ b/src/background/src/ElmModule/Subscriptions.elm @@ -0,0 +1,17 @@ +module ElmModule.Subscriptions exposing (..) + +-- Elm ------------------------------------------------------------------------- + +-- Main Menu ------------------------------------------------------------------- +import Struct.Model +import Struct.Event + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +subscriptions : Struct.Model.Type -> (Sub Struct.Event.Type) +subscriptions model = Sub.none diff --git a/src/background/src/ElmModule/Update.elm b/src/background/src/ElmModule/Update.elm new file mode 100644 index 0000000..9e162fe --- /dev/null +++ b/src/background/src/ElmModule/Update.elm @@ -0,0 +1,51 @@ +module ElmModule.Update exposing (update) + +-- Elm ------------------------------------------------------------------------- + +-- Main Menu ------------------------------------------------------------------- +import Struct.Event +import Struct.Model + +import Update.AddPlayer +import Update.HandleServerReply +import Update.RefreshBattles +import Update.StoreParams + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +update : ( + Struct.Event.Type -> + Struct.Model.Type -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +update event model = + let + new_model = (Struct.Model.clear_error model) + in + case event of + Struct.Event.None -> (model, Cmd.none) + + (Struct.Event.SetUsername str) -> (model, Cmd.none) + (Struct.Event.SetID str) -> (model, Cmd.none) + (Struct.Event.SetURLPrefix str) -> (model, Cmd.none) + (Struct.Event.SetFrequency val) -> (model, Cmd.none) + + Struct.Event.ShouldRefresh -> (Update.RefreshBattles.apply_to model) + + Struct.Event.StoreParams -> (Update.StoreParams.apply_to model) + + Struct.Event.AddPlayer -> (Update.AddPlayer.apply_to model) + + (Struct.Event.Failed err) -> + ( + (Struct.Model.invalidate err new_model), + Cmd.none + ) + + (Struct.Event.ServerReplied result) -> + (Update.HandleServerReply.apply_to model result) diff --git a/src/background/src/ElmModule/View.elm b/src/background/src/ElmModule/View.elm new file mode 100644 index 0000000..946bf8e --- /dev/null +++ b/src/background/src/ElmModule/View.elm @@ -0,0 +1,71 @@ +module ElmModule.View exposing (view) + +-- Elm ------------------------------------------------------------------------- +import Array + +import Html +import Html.Events +import Html.Attributes + +-- Extension ------------------------------------------------------------------- +import Util.Html + +import Struct.Error +import Struct.Event +import Struct.Model + +import View.Player +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +view : Struct.Model.Type -> (Html.Html Struct.Event.Type) +view model = + (Html.div + [ + (Html.Attributes.class "fullscreen-module") + ] + [ + ( + case model.error of + Nothing -> (Util.Html.nothing) + (Just err) -> + (Html.div + [] + [ + (Html.text (Struct.Error.to_string err)) + ] + ) + ), + (Html.div + [ + ] + (List.map (View.Player.get_html) (Array.toList model.players)) + ), + (Html.div + [ + ] + [ + (Html.button + [ + (Html.Events.onClick Struct.Event.AddPlayer) + ] + [ + (Html.text "Add Player") + ] + ), + (Html.button + [ + (Html.Events.onClick Struct.Event.StoreParams) + ] + [ + (Html.text "Save Params") + ] + ) + ] + ) + ] + ) diff --git a/src/background/src/Main.elm b/src/background/src/Main.elm new file mode 100644 index 0000000..8140041 --- /dev/null +++ b/src/background/src/Main.elm @@ -0,0 +1,23 @@ +-- Elm ------------------------------------------------------------------------ +import Html + +-- Map ------------------------------------------------------------------- +import Struct.Model +import Struct.Event +import Struct.Flags + +import ElmModule.Init +import ElmModule.Subscriptions +import ElmModule.View +import ElmModule.Update + +main : (Program Struct.Flags.Type Struct.Model.Type Struct.Event.Type) +main = + (Html.programWithFlags + { + init = ElmModule.Init.init, + view = ElmModule.View.view, + update = ElmModule.Update.update, + subscriptions = ElmModule.Subscriptions.subscriptions + } + ) diff --git a/src/background/src/Struct/BattleSummary.elm b/src/background/src/Struct/BattleSummary.elm new file mode 100644 index 0000000..adab965 --- /dev/null +++ b/src/background/src/Struct/BattleSummary.elm @@ -0,0 +1,65 @@ +module Struct.BattleSummary exposing + ( + Type, + get_id, + get_name, + get_last_edit, + is_players_turn, + decoder, + none + ) + +-- Elm ------------------------------------------------------------------------- +import Json.Decode +import Json.Decode.Pipeline + +-- Main Menu ------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + id : String, + name : String, + last_edit : String, + is_players_turn : Bool + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_id : Type -> String +get_id t = t.id + +get_name : Type -> String +get_name t = t.name + +get_last_edit : Type -> String +get_last_edit t = t.last_edit + +is_players_turn : Type -> Bool +is_players_turn t = t.is_players_turn + +decoder : (Json.Decode.Decoder Type) +decoder = + (Json.Decode.Pipeline.decode + Type + |> (Json.Decode.Pipeline.required "id" Json.Decode.string) + |> (Json.Decode.Pipeline.required "nme" Json.Decode.string) + |> (Json.Decode.Pipeline.required "ldt" Json.Decode.string) + |> (Json.Decode.Pipeline.required "ipt" Json.Decode.bool) + ) + +none : Type +none = + { + id = "", + name = "Unknown", + last_edit = "Never", + is_players_turn = False + } diff --git a/src/background/src/Struct/Error.elm b/src/background/src/Struct/Error.elm new file mode 100644 index 0000000..5f40c09 --- /dev/null +++ b/src/background/src/Struct/Error.elm @@ -0,0 +1,45 @@ +module Struct.Error exposing (Type, Mode(..), new, to_string) + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type Mode = + IllegalAction + | Programming + | Unimplemented + | Networking + | Failure + +type alias Type = + { + mode: Mode, + message: String + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +new : Mode -> String -> Type +new mode str = + { + mode = mode, + message = str + } + +to_string : Type -> String +to_string e = + ( + (case e.mode of + Failure -> "The action failed: " + IllegalAction -> "Request discarded: " + Programming -> "Error in the program (please report): " + Unimplemented -> "Update discarded due to unimplemented feature: " + Networking -> "Error while conversing with the server: " + ) + ++ e.message + ) + diff --git a/src/background/src/Struct/Event.elm b/src/background/src/Struct/Event.elm new file mode 100644 index 0000000..eafd812 --- /dev/null +++ b/src/background/src/Struct/Event.elm @@ -0,0 +1,30 @@ +module Struct.Event exposing (Type(..), attempted) + +-- Elm ------------------------------------------------------------------------- +import Http + +-- Main Menu ------------------------------------------------------------------- +import Struct.Error +import Struct.ServerReply + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type Type = + None + | Failed Struct.Error.Type + | AddPlayer + | ShouldRefresh + | SetUsername String + | SetID String + | SetURLPrefix String + | SetFrequency Int + | StoreParams + | ServerReplied (Result Http.Error (List Struct.ServerReply.Type)) + +attempted : (Result.Result err val) -> Type +attempted act = + case act of + (Result.Ok _) -> None + (Result.Err msg) -> + (Failed (Struct.Error.new Struct.Error.Failure (toString msg))) diff --git a/src/background/src/Struct/Flags.elm b/src/background/src/Struct/Flags.elm new file mode 100644 index 0000000..e5a79f8 --- /dev/null +++ b/src/background/src/Struct/Flags.elm @@ -0,0 +1,42 @@ +module Struct.Flags exposing + ( + Type, + get_frequency, + get_players + ) + +-- Elm ------------------------------------------------------------------------- +import Json.Decode + +-- Extension ------------------------------------------------------------------- +import Struct.Player + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + frequency : Int, + players : String + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_frequency : Type -> Int +get_frequency flags = flags.frequency + +get_players : Type -> (List Struct.Player.Type) +get_players flags = + case + (Json.Decode.decodeString + (Json.Decode.list (Struct.Player.decoder)) + flags.players + ) + of + (Ok result) -> result + (Err _) -> [] diff --git a/src/background/src/Struct/Model.elm b/src/background/src/Struct/Model.elm new file mode 100644 index 0000000..6742e96 --- /dev/null +++ b/src/background/src/Struct/Model.elm @@ -0,0 +1,66 @@ +module Struct.Model exposing + ( + Type, + new, + invalidate, + reset, + clear_error + ) + +-- Elm ------------------------------------------------------------------------- +import Array + +-- Extension ------------------------------------------------------------------- +import Struct.Flags +import Struct.Error +import Struct.Player + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + flags: Struct.Flags.Type, + error: (Maybe Struct.Error.Type), + players: (Array.Array Struct.Player.Type), + query_index: Int, + notify: Bool + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +new : Struct.Flags.Type -> Type +new flags = + { + flags = flags, + error = Nothing, + players = + (Array.push + (Struct.Player.default) + (Array.fromList (Struct.Flags.get_players flags)) + ), + query_index = -1, + notify = False + } + +reset : Type -> Type +reset model = + {model | + error = Nothing, + notify = False, + query_index = -1 + } + +invalidate : Struct.Error.Type -> Type -> Type +invalidate err model = + {model | + error = (Just err) + } + +clear_error : Type -> Type +clear_error model = {model | error = Nothing} diff --git a/src/background/src/Struct/Player.elm b/src/background/src/Struct/Player.elm new file mode 100644 index 0000000..1e8365a --- /dev/null +++ b/src/background/src/Struct/Player.elm @@ -0,0 +1,133 @@ +module Struct.Player exposing + ( + Type, + get_id, + set_id, + get_query_url, + set_query_url, + get_username, + set_username, + get_campaigns, + get_invasions, + get_events, + set_battles, + has_active_battles, + decoder, + encode, + default + ) + +-- Elm ------------------------------------------------------------------------- +import Json.Decode +import Json.Decode.Pipeline +import Json.Encode + +-- Extension ------------------------------------------------------------------- +import Struct.BattleSummary + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + id : String, + name : String, + query_url : String, + campaigns : (List Struct.BattleSummary.Type), + invasions : (List Struct.BattleSummary.Type), + events : (List Struct.BattleSummary.Type) + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_id : Type -> String +get_id t = t.id + +set_id : String -> Type -> Type +set_id str t = {t | id = str} + +get_username : Type -> String +get_username t = t.name + +set_username : String -> Type -> Type +set_username str t = {t | name = str} + +get_query_url : Type -> String +get_query_url t = t.query_url + +set_query_url : String -> Type -> Type +set_query_url str t = {t | query_url = str} + +get_campaigns : Type -> (List Struct.BattleSummary.Type) +get_campaigns t = t.campaigns + +get_invasions : Type -> (List Struct.BattleSummary.Type) +get_invasions t = t.invasions + +get_events : Type -> (List Struct.BattleSummary.Type) +get_events t = t.events + +set_battles : ( + (List Struct.BattleSummary.Type) -> + (List Struct.BattleSummary.Type) -> + (List Struct.BattleSummary.Type) -> + Type -> + Type + ) +set_battles campaigns invasions events t = + {t | + campaigns = + (List.filter (Struct.BattleSummary.is_players_turn) campaigns), + invasions = + (List.filter (Struct.BattleSummary.is_players_turn) invasions), + events = (List.filter (Struct.BattleSummary.is_players_turn) events) + } + +has_active_battles : Type -> Bool +has_active_battles t = + ( + ( + (List.length t.campaigns) + + (List.length t.invasions) + + (List.length t.events) + ) + > 0 + ) + +decoder : (Json.Decode.Decoder Type) +decoder = + (Json.Decode.Pipeline.decode + Type + |> (Json.Decode.Pipeline.required "id" Json.Decode.string) + |> (Json.Decode.Pipeline.required "name" Json.Decode.string) + |> (Json.Decode.Pipeline.required "query_url" Json.Decode.string) + |> (Json.Decode.Pipeline.hardcoded []) + |> (Json.Decode.Pipeline.hardcoded []) + |> (Json.Decode.Pipeline.hardcoded []) + ) + +encode : Type -> Json.Encode.Value +encode t = + (Json.Encode.object + [ + ("id", (Json.Encode.string t.id)), + ("name", (Json.Encode.string t.name)), + ("query_url", (Json.Encode.string t.query_url)) + ] + ) + +default : Type +default = + { + id = "0", + name = "Username", + query_url = "http://127.0.0.1/", + campaigns = [], + invasions = [], + events = [] + } diff --git a/src/background/src/Struct/ServerReply.elm b/src/background/src/Struct/ServerReply.elm new file mode 100644 index 0000000..f0530d8 --- /dev/null +++ b/src/background/src/Struct/ServerReply.elm @@ -0,0 +1,29 @@ +module Struct.ServerReply exposing (Type(..)) + +-- Elm ------------------------------------------------------------------------- + +-- ------------------------------------------------------------------- +import Struct.BattleSummary + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +type Type = + Okay + | SetID String + | SetUsername String + | SetBattles + ( + (List Struct.BattleSummary.Type), + (List Struct.BattleSummary.Type), + (List Struct.BattleSummary.Type) + ) + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- diff --git a/src/background/src/Update/AddPlayer.elm b/src/background/src/Update/AddPlayer.elm new file mode 100644 index 0000000..ed9da4a --- /dev/null +++ b/src/background/src/Update/AddPlayer.elm @@ -0,0 +1,24 @@ +module Update.AddPlayer exposing (apply_to) + +-- Elm ------------------------------------------------------------------------- +import Array + +-- Extension ------------------------------------------------------------------- +import Struct.Event +import Struct.Flags +import Struct.Model +import Struct.Player + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : Struct.Model.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type)) +apply_to model = + ( + {model | players = (Array.push (Struct.Player.default) model.players)}, + Cmd.none + ) diff --git a/src/background/src/Update/HandleServerReply.elm b/src/background/src/Update/HandleServerReply.elm new file mode 100644 index 0000000..b80c7b4 --- /dev/null +++ b/src/background/src/Update/HandleServerReply.elm @@ -0,0 +1,119 @@ +module Update.HandleServerReply exposing (apply_to) + +-- Elm ------------------------------------------------------------------------- +import Array + +import Http + +-- Extension ------------------------------------------------------------------- +import Comm.GetBattles + +import Struct.BattleSummary +import Struct.Error +import Struct.Event +import Struct.Model +import Struct.Player +import Struct.ServerReply + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +handle_set_battles : ( + ( + (List Struct.BattleSummary.Type), + (List Struct.BattleSummary.Type), + (List Struct.BattleSummary.Type) + ) -> + (Struct.Model.Type, (List (Cmd Struct.Event.Type))) -> + (Struct.Model.Type, (List (Cmd Struct.Event.Type))) + ) +handle_set_battles battles current_state = + let + (model, cmds) = current_state + (campaigns, invasions, events) = battles + in + case (Array.get model.query_index model.players) of + Nothing -> current_state -- TODO: error + (Just player) -> + let + updated_player = + (Struct.Player.set_battles + campaigns + invasions + events + player + ) + updated_model = + {model | + players = + (Array.set + model.query_index + updated_player + model.players + ), + query_index = (model.query_index + 1), + notify = + ( + model.notify + || (Struct.Player.has_active_battles updated_player) + ) + } + in + case (Array.get updated_model.query_index model.players) of + Nothing -> ({updated_model| query_index = -1}, cmds) + + (Just next_player) -> + case (Comm.GetBattles.try updated_model next_player) of + Nothing -> ({updated_model| query_index = -1}, cmds) + (Just query) -> (updated_model, (query :: 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.Okay -> current_state + (Struct.ServerReply.SetID str) -> current_state -- TODO + (Struct.ServerReply.SetUsername str) -> current_state -- TODO + (Struct.ServerReply.SetBattles battles) -> + (handle_set_battles battles 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) + ) + ) diff --git a/src/background/src/Update/RefreshBattles.elm b/src/background/src/Update/RefreshBattles.elm new file mode 100644 index 0000000..2ff739f --- /dev/null +++ b/src/background/src/Update/RefreshBattles.elm @@ -0,0 +1,28 @@ +module Update.RefreshBattles exposing (apply_to) + +-- Elm ------------------------------------------------------------------------- +import Array + +-- Extension ------------------------------------------------------------------- +import Comm.GetBattles + +import Struct.Event +import Struct.Flags +import Struct.Model + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : Struct.Model.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type)) +apply_to model = + case (Array.get 0 model.players) of + Nothing -> (model, Cmd.none) + (Just player) -> + case (Comm.GetBattles.try model player) of + -- TODO: Invalidate only this player, refresh the others. + Nothing -> (model, Cmd.none) + (Just cmd) -> ({model | query_index = 0}, cmd) diff --git a/src/background/src/Update/StoreParams.elm b/src/background/src/Update/StoreParams.elm new file mode 100644 index 0000000..f369be8 --- /dev/null +++ b/src/background/src/Update/StoreParams.elm @@ -0,0 +1,38 @@ +module Update.StoreParams exposing (apply_to) + +-- Elm ------------------------------------------------------------------------- +import Array + +import Json.Encode + +-- Extension ------------------------------------------------------------------- +import Action.Ports + +import Struct.Event +import Struct.Flags +import Struct.Model +import Struct.Player + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : Struct.Model.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type)) +apply_to model = + ( + model, + (Action.Ports.store_params + ( + (Struct.Flags.get_frequency model.flags), + (Json.Encode.encode + 0 + (Json.Encode.list + (List.map (Struct.Player.encode) (Array.toList model.players)) + ) + ) + ) + ) + ) diff --git a/src/background/src/Util/Array.elm b/src/background/src/Util/Array.elm new file mode 100644 index 0000000..9e57c18 --- /dev/null +++ b/src/background/src/Util/Array.elm @@ -0,0 +1,34 @@ +module Util.Array exposing + ( + update, + update_unsafe, + filter_first + ) + +import Array + +update : ( + Int -> + ((Maybe t) -> (Maybe t)) -> + (Array.Array t) -> + (Array.Array t) + ) +update index fun array = + case (fun (Array.get index array)) of + Nothing -> array + (Just e) -> (Array.set index e array) + +update_unsafe : ( + Int -> + (t -> t) -> + (Array.Array t) -> + (Array.Array t) + ) +update_unsafe index fun array = + case (Array.get index array) of + Nothing -> array + (Just e) -> (Array.set index (fun e) array) + +filter_first : (t -> Bool) -> (Array.Array t) -> (Maybe t) +filter_first fun array = + (Array.get 0 (Array.filter fun array)) diff --git a/src/background/src/Util/Html.elm b/src/background/src/Util/Html.elm new file mode 100644 index 0000000..42eadba --- /dev/null +++ b/src/background/src/Util/Html.elm @@ -0,0 +1,6 @@ +module Util.Html exposing (nothing) + +import Html + +nothing : (Html.Html a) +nothing = (Html.text "") diff --git a/src/background/src/Util/List.elm b/src/background/src/Util/List.elm new file mode 100644 index 0000000..1f914b1 --- /dev/null +++ b/src/background/src/Util/List.elm @@ -0,0 +1,36 @@ +module Util.List exposing (..) + +import List + +pop : List a -> (Maybe (a, List a)) +pop l = + case + ((List.head l), (List.tail l)) + of + (Nothing, _) -> Nothing + (_ , Nothing) -> Nothing + ((Just head), (Just tail)) -> (Just (head, tail)) + +get_first : (a -> Bool) -> (List a) -> (Maybe a) +get_first fun list = + (List.head (List.filter fun list)) + +product_map : (a -> b -> c) -> (List a) -> (List b) -> (List c) +product_map product_fun list_a list_b = + (product_map_rec (product_fun) list_a list_b []) + +product_map_rec : (a -> b -> c) -> (List a) -> (List b) -> (List c) -> (List c) +product_map_rec product_fun list_a list_b result = + case (pop list_a) of + Nothing -> result + (Just (head, tail)) -> + (product_map_rec + (product_fun) + tail + list_b + (List.append + (List.map (product_fun head) list_b) + result + ) + ) + diff --git a/src/background/src/View/Header.elm b/src/background/src/View/Header.elm new file mode 100644 index 0000000..fd8e693 --- /dev/null +++ b/src/background/src/View/Header.elm @@ -0,0 +1,79 @@ +module View.Header exposing (get_html) + +-- Elm ------------------------------------------------------------------------- +import Html +import Html.Attributes + +-- Map ------------------------------------------------------------------- +import Struct.Event + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +link_html : String -> String -> Bool -> (Html.Html Struct.Event.Type) +link_html src label is_active = + (Html.a + [ + (Html.Attributes.href src) + ] + [ + ( + if (is_active) + then (Html.text label) + else (Html.s [] [(Html.text label)]) + ) + ] + ) + +navigation_html : (Html.Html Struct.Event.Type) +navigation_html = + (Html.nav + [] + [ + (link_html "/about.html" "About" True), + (link_html "/news/" "News" False), + (link_html "/community/" "Community" False), + (link_html "/login/?action=disconnect" "Disconnect" True) + ] + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_html : (Html.Html Struct.Event.Type) +get_html = + (Html.header + [] + [ + (Html.div + [ + (Html.Attributes.class "main-server-logo") + ] + [ + (Html.a + [ + (Html.Attributes.href "http://127.0.0.1") + ] + [ + (Html.img + [ + (Html.Attributes.src "/asset/svg/to-logo-no-bg.svg") + ] + [ + ] + ) + ] + ) + ] + ), + (Html.div + [ + (Html.Attributes.class "main-server-version") + ] + [ + (Html.text "Latest Dev. Build (Mon, 10 Sep 2018 10:30:17 +0000)") + ] + ), + (navigation_html) + ] + ) diff --git a/src/background/src/View/Player.elm b/src/background/src/View/Player.elm new file mode 100644 index 0000000..07dc292 --- /dev/null +++ b/src/background/src/View/Player.elm @@ -0,0 +1,97 @@ +module View.Player exposing (get_html) + +-- Elm ------------------------------------------------------------------------- +import Html +import Html.Attributes +-- import Html.Events + +-- Extension ------------------------------------------------------------------- +import Struct.BattleSummary +import Struct.Event +import Struct.Player + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_item_html : ( + String -> + String -> + Struct.BattleSummary.Type -> + (Html.Html Struct.Event.Type) + ) +get_item_html query_url additional_class item = + (Html.a + [ + (Html.Attributes.class additional_class), + (Html.Attributes.href + ( + query_url + ++ "/battle/?id=" + ++ (Struct.BattleSummary.get_id item) + ) + ) + ] + [ + (Html.div + [ + (Html.Attributes.class "battle-summary-name") + ] + [ + (Html.text (Struct.BattleSummary.get_name item)) + ] + ), + (Html.div + [ + (Html.Attributes.class "battle-summary-date") + ] + [ + (Html.text (Struct.BattleSummary.get_last_edit item)) + ] + ) + ] + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_html : Struct.Player.Type -> (Html.Html Struct.Event.Type) +get_html player = + let + query_url = (Struct.Player.get_query_url player) + in + (Html.div + [ + (Html.Attributes.class "player-summary") + ] + [ + (Html.div + [ + (Html.Attributes.class "player-summary-listing-header") + ] + [ + (Html.text (Struct.Player.get_username player)) + ] + ), + (Html.div + [ + (Html.Attributes.class "player-summary-listing-body") + ] + ( + (List.map + (get_item_html query_url "campaign-link") + (Struct.Player.get_campaigns player) + ) + ++ + (List.map + (get_item_html query_url "invasion-link") + (Struct.Player.get_invasions player) + ) + ++ + (List.map + (get_item_html query_url "event-link") + (Struct.Player.get_events player) + ) + ) + ) + ] + ) diff --git a/src/popup/Makefile b/src/popup/Makefile new file mode 100644 index 0000000..3b58a08 --- /dev/null +++ b/src/popup/Makefile @@ -0,0 +1,36 @@ +################################################################################ +## CONFIG ###################################################################### +################################################################################ +SRC_DIR ?= src +WWW_DIR ?= www +WWW_SCRIPT_DIR ?= $(WWW_DIR)/script + +ELM_CC ?= elm-make --warn + +MAIN_MODULE ?= $(SRC_DIR)/Main.elm + +################################################################################ +## MAKEFILE MAGIC ############################################################## +################################################################################ +SUB_MODULES = $(shell find $(SRC_DIR) -type f | grep "elm$$") + +################################################################################ +## SANITY CHECKS ############################################################### +################################################################################ + +################################################################################ +## TARGET RULES ################################################################ +################################################################################ +build: $(WWW_SCRIPT_DIR)/main.js + +clean: + rm -f $(WWW_SCRIPT_DIR)/main.js + +reset: + rm -rf elm-stuff + +################################################################################ +## INTERNAL RULES ############################################################## +################################################################################ +$(WWW_SCRIPT_DIR)/main.js: $(MAIN_MODULE) $(SUB_MODULES) + $(ELM_CC) $(MAIN_MODULE) --output $@ diff --git a/src/popup/elm-package.json b/src/popup/elm-package.json new file mode 100644 index 0000000..a8b8580 --- /dev/null +++ b/src/popup/elm-package.json @@ -0,0 +1,19 @@ +{ + "version": "1.0.0", + "summary": "helpful summary of your project, less than 80 characters", + "repository": "https://github.com/nsensfel/tacticians-extension.git", + "license": "Apache 2.0", + "source-directories": [ + "src" + ], + "exposed-modules": [], + "dependencies": { + "NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0", + "andrewMacmurray/elm-delay": "2.0.3 <= v < 3.0.0", + "elm-lang/core": "5.1.1 <= v < 6.0.0", + "elm-lang/dom": "1.1.1 <= v < 2.0.0", + "elm-lang/html": "2.0.0 <= v < 3.0.0", + "elm-lang/http": "1.0.0 <= v < 2.0.0" + }, + "elm-version": "0.18.0 <= v < 0.19.0" +} diff --git a/src/popup/src/Action/Ports.elm b/src/popup/src/Action/Ports.elm new file mode 100644 index 0000000..4d83077 --- /dev/null +++ b/src/popup/src/Action/Ports.elm @@ -0,0 +1,4 @@ +port module Action.Ports exposing (..) + +port store_params : (Int, String) -> (Cmd msg) +port reset_params : () -> (Cmd msg) diff --git a/src/popup/src/Comm/GetBattles.elm b/src/popup/src/Comm/GetBattles.elm new file mode 100644 index 0000000..0956972 --- /dev/null +++ b/src/popup/src/Comm/GetBattles.elm @@ -0,0 +1,45 @@ +module Comm.GetBattles exposing (try) + +-- Elm ------------------------------------------------------------------------- +import Json.Encode + +-- Extension ------------------------------------------------------------------- +import Comm.Send + +import Struct.Event +import Struct.Model +import Struct.Player + +-------------------------------------------------------------------------------- +-- TYPES ------------------------------------------------------------------------ +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +try_encoding : String -> Struct.Model.Type -> (Maybe Json.Encode.Value) +try_encoding player_id model = + let + encoded_player_id = (Json.Encode.string player_id) + in + (Just + (Json.Encode.object + [ + ("id", encoded_player_id) + ] + ) + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +try : Struct.Model.Type -> Struct.Player.Type -> (Maybe (Cmd Struct.Event.Type)) +try model player = + (Comm.Send.try_sending + model + ( + (Struct.Player.get_query_url player) + ++ "/handler/player/plr_get_battles" + ) + (try_encoding (Struct.Player.get_id player)) + ) diff --git a/src/popup/src/Comm/GetID.elm b/src/popup/src/Comm/GetID.elm new file mode 100644 index 0000000..14d668c --- /dev/null +++ b/src/popup/src/Comm/GetID.elm @@ -0,0 +1,43 @@ +module Comm.GetID exposing (try) + +-- Elm ------------------------------------------------------------------------- +import Json.Encode + +-- Extension ------------------------------------------------------------------- +import Comm.Send + +import Constants.IO + +import Struct.Event +import Struct.Model + +-------------------------------------------------------------------------------- +-- TYPES ------------------------------------------------------------------------ +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +try_encoding : String -> Struct.Model.Type -> (Maybe Json.Encode.Value) +try_encoding player_id model = + let + encoded_player_id = (Json.Encode.string player_id) + in + (Just + (Json.Encode.object + [ + ("id", encoded_player_id) + ] + ) + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +try : Struct.Model.Type -> String -> (Maybe (Cmd Struct.Event.Type)) +try model = + (Comm.Send.try_sending + model + Constants.IO.get_battles_handler + (try_encoding player_id) + ) diff --git a/src/popup/src/Comm/Okay.elm b/src/popup/src/Comm/Okay.elm new file mode 100644 index 0000000..9281558 --- /dev/null +++ b/src/popup/src/Comm/Okay.elm @@ -0,0 +1,21 @@ +module Comm.Okay exposing (decoder) + +-- Elm ------------------------------------------------------------------------- +import Json.Decode + +-- Battlemap ------------------------------------------------------------------- +import Struct.ServerReply + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +decoder : (Json.Decode.Decoder Struct.ServerReply.Type) +decoder = (Json.Decode.succeed Struct.ServerReply.Okay) diff --git a/src/popup/src/Comm/Send.elm b/src/popup/src/Comm/Send.elm new file mode 100644 index 0000000..3fc30ae --- /dev/null +++ b/src/popup/src/Comm/Send.elm @@ -0,0 +1,66 @@ +module Comm.Send exposing (try_sending) + +-- Elm ------------------------------------------------------------------------- +import Http + +import Json.Decode +import Json.Encode + +-- Extension ------------------------------------------------------------------- +import Comm.Okay +import Comm.SetBattles + +import Struct.Event +import Struct.ServerReply +import Struct.Model + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +internal_decoder : String -> (Json.Decode.Decoder Struct.ServerReply.Type) +internal_decoder reply_type = + case reply_type of + "okay" -> (Comm.Okay.decoder) + "set_battles" -> (Comm.SetBattles.decoder) + other -> + (Json.Decode.fail + ( + "Unknown server command \"" + ++ other + ++ "\"" + ) + ) + +decoder : (Json.Decode.Decoder Struct.ServerReply.Type) +decoder = + (Json.Decode.field "msg" Json.Decode.string) + |> (Json.Decode.andThen (internal_decoder)) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +try_sending : ( + Struct.Model.Type -> + String -> + (Struct.Model.Type -> (Maybe Json.Encode.Value)) -> + (Maybe (Cmd Struct.Event.Type)) + ) +try_sending model recipient try_encoding_fun = + case (try_encoding_fun model) of + (Just serial) -> + (Just + (Http.send + Struct.Event.ServerReplied + (Http.post + recipient + (Http.jsonBody serial) + (Json.Decode.list (decoder)) + ) + ) + ) + + Nothing -> Nothing diff --git a/src/popup/src/Comm/SetBattles.elm b/src/popup/src/Comm/SetBattles.elm new file mode 100644 index 0000000..0add112 --- /dev/null +++ b/src/popup/src/Comm/SetBattles.elm @@ -0,0 +1,51 @@ +module Comm.SetBattles exposing (decoder) + +-- Elm ------------------------------------------------------------------------- +import Json.Decode + +-- Extension ------------------------------------------------------------------- +import Struct.BattleSummary +import Struct.Player +import Struct.ServerReply + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Battles = + { + campaigns : (List Struct.BattleSummary.Type), + invasions : (List Struct.BattleSummary.Type), + events : (List Struct.BattleSummary.Type) + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +internal_decoder : (Json.Decode.Decoder Battles) +internal_decoder = + (Json.Decode.map3 + Battles + (Json.Decode.field + "cmps" + (Json.Decode.list (Struct.BattleSummary.decoder)) + ) + (Json.Decode.field + "invs" + (Json.Decode.list (Struct.BattleSummary.decoder)) + ) + (Json.Decode.field + "evts" + (Json.Decode.list (Struct.BattleSummary.decoder)) + ) + ) + +to_server_reply : Battles -> Struct.ServerReply.Type +to_server_reply t = + (Struct.ServerReply.SetBattles (t.campaigns, t.invasions, t.events)) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +decoder : (Json.Decode.Decoder Struct.ServerReply.Type) +decoder = + (Json.Decode.map (to_server_reply) (internal_decoder)) diff --git a/src/popup/src/ElmModule/Init.elm b/src/popup/src/ElmModule/Init.elm new file mode 100644 index 0000000..65d31b7 --- /dev/null +++ b/src/popup/src/ElmModule/Init.elm @@ -0,0 +1,29 @@ +module ElmModule.Init exposing (init) + +-- Elm ------------------------------------------------------------------------- +import Delay + +import Time + +-- Extension ------------------------------------------------------------------- +import Struct.Event +import Struct.Flags +import Struct.Model + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +init : Struct.Flags.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type)) +init flags = + ( + (Struct.Model.new flags), + (Delay.after + (toFloat (Struct.Flags.get_frequency flags)) + (Time.minute) + Struct.Event.ShouldRefresh + ) + ) diff --git a/src/popup/src/ElmModule/Subscriptions.elm b/src/popup/src/ElmModule/Subscriptions.elm new file mode 100644 index 0000000..e9b557e --- /dev/null +++ b/src/popup/src/ElmModule/Subscriptions.elm @@ -0,0 +1,17 @@ +module ElmModule.Subscriptions exposing (..) + +-- Elm ------------------------------------------------------------------------- + +-- Main Menu ------------------------------------------------------------------- +import Struct.Model +import Struct.Event + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +subscriptions : Struct.Model.Type -> (Sub Struct.Event.Type) +subscriptions model = Sub.none diff --git a/src/popup/src/ElmModule/Update.elm b/src/popup/src/ElmModule/Update.elm new file mode 100644 index 0000000..9e162fe --- /dev/null +++ b/src/popup/src/ElmModule/Update.elm @@ -0,0 +1,51 @@ +module ElmModule.Update exposing (update) + +-- Elm ------------------------------------------------------------------------- + +-- Main Menu ------------------------------------------------------------------- +import Struct.Event +import Struct.Model + +import Update.AddPlayer +import Update.HandleServerReply +import Update.RefreshBattles +import Update.StoreParams + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +update : ( + Struct.Event.Type -> + Struct.Model.Type -> + (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +update event model = + let + new_model = (Struct.Model.clear_error model) + in + case event of + Struct.Event.None -> (model, Cmd.none) + + (Struct.Event.SetUsername str) -> (model, Cmd.none) + (Struct.Event.SetID str) -> (model, Cmd.none) + (Struct.Event.SetURLPrefix str) -> (model, Cmd.none) + (Struct.Event.SetFrequency val) -> (model, Cmd.none) + + Struct.Event.ShouldRefresh -> (Update.RefreshBattles.apply_to model) + + Struct.Event.StoreParams -> (Update.StoreParams.apply_to model) + + Struct.Event.AddPlayer -> (Update.AddPlayer.apply_to model) + + (Struct.Event.Failed err) -> + ( + (Struct.Model.invalidate err new_model), + Cmd.none + ) + + (Struct.Event.ServerReplied result) -> + (Update.HandleServerReply.apply_to model result) diff --git a/src/popup/src/ElmModule/View.elm b/src/popup/src/ElmModule/View.elm new file mode 100644 index 0000000..946bf8e --- /dev/null +++ b/src/popup/src/ElmModule/View.elm @@ -0,0 +1,71 @@ +module ElmModule.View exposing (view) + +-- Elm ------------------------------------------------------------------------- +import Array + +import Html +import Html.Events +import Html.Attributes + +-- Extension ------------------------------------------------------------------- +import Util.Html + +import Struct.Error +import Struct.Event +import Struct.Model + +import View.Player +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +view : Struct.Model.Type -> (Html.Html Struct.Event.Type) +view model = + (Html.div + [ + (Html.Attributes.class "fullscreen-module") + ] + [ + ( + case model.error of + Nothing -> (Util.Html.nothing) + (Just err) -> + (Html.div + [] + [ + (Html.text (Struct.Error.to_string err)) + ] + ) + ), + (Html.div + [ + ] + (List.map (View.Player.get_html) (Array.toList model.players)) + ), + (Html.div + [ + ] + [ + (Html.button + [ + (Html.Events.onClick Struct.Event.AddPlayer) + ] + [ + (Html.text "Add Player") + ] + ), + (Html.button + [ + (Html.Events.onClick Struct.Event.StoreParams) + ] + [ + (Html.text "Save Params") + ] + ) + ] + ) + ] + ) diff --git a/src/popup/src/Main.elm b/src/popup/src/Main.elm new file mode 100644 index 0000000..8140041 --- /dev/null +++ b/src/popup/src/Main.elm @@ -0,0 +1,23 @@ +-- Elm ------------------------------------------------------------------------ +import Html + +-- Map ------------------------------------------------------------------- +import Struct.Model +import Struct.Event +import Struct.Flags + +import ElmModule.Init +import ElmModule.Subscriptions +import ElmModule.View +import ElmModule.Update + +main : (Program Struct.Flags.Type Struct.Model.Type Struct.Event.Type) +main = + (Html.programWithFlags + { + init = ElmModule.Init.init, + view = ElmModule.View.view, + update = ElmModule.Update.update, + subscriptions = ElmModule.Subscriptions.subscriptions + } + ) diff --git a/src/popup/src/Struct/BattleSummary.elm b/src/popup/src/Struct/BattleSummary.elm new file mode 100644 index 0000000..adab965 --- /dev/null +++ b/src/popup/src/Struct/BattleSummary.elm @@ -0,0 +1,65 @@ +module Struct.BattleSummary exposing + ( + Type, + get_id, + get_name, + get_last_edit, + is_players_turn, + decoder, + none + ) + +-- Elm ------------------------------------------------------------------------- +import Json.Decode +import Json.Decode.Pipeline + +-- Main Menu ------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + id : String, + name : String, + last_edit : String, + is_players_turn : Bool + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_id : Type -> String +get_id t = t.id + +get_name : Type -> String +get_name t = t.name + +get_last_edit : Type -> String +get_last_edit t = t.last_edit + +is_players_turn : Type -> Bool +is_players_turn t = t.is_players_turn + +decoder : (Json.Decode.Decoder Type) +decoder = + (Json.Decode.Pipeline.decode + Type + |> (Json.Decode.Pipeline.required "id" Json.Decode.string) + |> (Json.Decode.Pipeline.required "nme" Json.Decode.string) + |> (Json.Decode.Pipeline.required "ldt" Json.Decode.string) + |> (Json.Decode.Pipeline.required "ipt" Json.Decode.bool) + ) + +none : Type +none = + { + id = "", + name = "Unknown", + last_edit = "Never", + is_players_turn = False + } diff --git a/src/popup/src/Struct/Error.elm b/src/popup/src/Struct/Error.elm new file mode 100644 index 0000000..5f40c09 --- /dev/null +++ b/src/popup/src/Struct/Error.elm @@ -0,0 +1,45 @@ +module Struct.Error exposing (Type, Mode(..), new, to_string) + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type Mode = + IllegalAction + | Programming + | Unimplemented + | Networking + | Failure + +type alias Type = + { + mode: Mode, + message: String + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +new : Mode -> String -> Type +new mode str = + { + mode = mode, + message = str + } + +to_string : Type -> String +to_string e = + ( + (case e.mode of + Failure -> "The action failed: " + IllegalAction -> "Request discarded: " + Programming -> "Error in the program (please report): " + Unimplemented -> "Update discarded due to unimplemented feature: " + Networking -> "Error while conversing with the server: " + ) + ++ e.message + ) + diff --git a/src/popup/src/Struct/Event.elm b/src/popup/src/Struct/Event.elm new file mode 100644 index 0000000..eafd812 --- /dev/null +++ b/src/popup/src/Struct/Event.elm @@ -0,0 +1,30 @@ +module Struct.Event exposing (Type(..), attempted) + +-- Elm ------------------------------------------------------------------------- +import Http + +-- Main Menu ------------------------------------------------------------------- +import Struct.Error +import Struct.ServerReply + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type Type = + None + | Failed Struct.Error.Type + | AddPlayer + | ShouldRefresh + | SetUsername String + | SetID String + | SetURLPrefix String + | SetFrequency Int + | StoreParams + | ServerReplied (Result Http.Error (List Struct.ServerReply.Type)) + +attempted : (Result.Result err val) -> Type +attempted act = + case act of + (Result.Ok _) -> None + (Result.Err msg) -> + (Failed (Struct.Error.new Struct.Error.Failure (toString msg))) diff --git a/src/popup/src/Struct/Flags.elm b/src/popup/src/Struct/Flags.elm new file mode 100644 index 0000000..e5a79f8 --- /dev/null +++ b/src/popup/src/Struct/Flags.elm @@ -0,0 +1,42 @@ +module Struct.Flags exposing + ( + Type, + get_frequency, + get_players + ) + +-- Elm ------------------------------------------------------------------------- +import Json.Decode + +-- Extension ------------------------------------------------------------------- +import Struct.Player + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + frequency : Int, + players : String + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_frequency : Type -> Int +get_frequency flags = flags.frequency + +get_players : Type -> (List Struct.Player.Type) +get_players flags = + case + (Json.Decode.decodeString + (Json.Decode.list (Struct.Player.decoder)) + flags.players + ) + of + (Ok result) -> result + (Err _) -> [] diff --git a/src/popup/src/Struct/Model.elm b/src/popup/src/Struct/Model.elm new file mode 100644 index 0000000..6742e96 --- /dev/null +++ b/src/popup/src/Struct/Model.elm @@ -0,0 +1,66 @@ +module Struct.Model exposing + ( + Type, + new, + invalidate, + reset, + clear_error + ) + +-- Elm ------------------------------------------------------------------------- +import Array + +-- Extension ------------------------------------------------------------------- +import Struct.Flags +import Struct.Error +import Struct.Player + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + flags: Struct.Flags.Type, + error: (Maybe Struct.Error.Type), + players: (Array.Array Struct.Player.Type), + query_index: Int, + notify: Bool + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +new : Struct.Flags.Type -> Type +new flags = + { + flags = flags, + error = Nothing, + players = + (Array.push + (Struct.Player.default) + (Array.fromList (Struct.Flags.get_players flags)) + ), + query_index = -1, + notify = False + } + +reset : Type -> Type +reset model = + {model | + error = Nothing, + notify = False, + query_index = -1 + } + +invalidate : Struct.Error.Type -> Type -> Type +invalidate err model = + {model | + error = (Just err) + } + +clear_error : Type -> Type +clear_error model = {model | error = Nothing} diff --git a/src/popup/src/Struct/Player.elm b/src/popup/src/Struct/Player.elm new file mode 100644 index 0000000..1e8365a --- /dev/null +++ b/src/popup/src/Struct/Player.elm @@ -0,0 +1,133 @@ +module Struct.Player exposing + ( + Type, + get_id, + set_id, + get_query_url, + set_query_url, + get_username, + set_username, + get_campaigns, + get_invasions, + get_events, + set_battles, + has_active_battles, + decoder, + encode, + default + ) + +-- Elm ------------------------------------------------------------------------- +import Json.Decode +import Json.Decode.Pipeline +import Json.Encode + +-- Extension ------------------------------------------------------------------- +import Struct.BattleSummary + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + id : String, + name : String, + query_url : String, + campaigns : (List Struct.BattleSummary.Type), + invasions : (List Struct.BattleSummary.Type), + events : (List Struct.BattleSummary.Type) + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_id : Type -> String +get_id t = t.id + +set_id : String -> Type -> Type +set_id str t = {t | id = str} + +get_username : Type -> String +get_username t = t.name + +set_username : String -> Type -> Type +set_username str t = {t | name = str} + +get_query_url : Type -> String +get_query_url t = t.query_url + +set_query_url : String -> Type -> Type +set_query_url str t = {t | query_url = str} + +get_campaigns : Type -> (List Struct.BattleSummary.Type) +get_campaigns t = t.campaigns + +get_invasions : Type -> (List Struct.BattleSummary.Type) +get_invasions t = t.invasions + +get_events : Type -> (List Struct.BattleSummary.Type) +get_events t = t.events + +set_battles : ( + (List Struct.BattleSummary.Type) -> + (List Struct.BattleSummary.Type) -> + (List Struct.BattleSummary.Type) -> + Type -> + Type + ) +set_battles campaigns invasions events t = + {t | + campaigns = + (List.filter (Struct.BattleSummary.is_players_turn) campaigns), + invasions = + (List.filter (Struct.BattleSummary.is_players_turn) invasions), + events = (List.filter (Struct.BattleSummary.is_players_turn) events) + } + +has_active_battles : Type -> Bool +has_active_battles t = + ( + ( + (List.length t.campaigns) + + (List.length t.invasions) + + (List.length t.events) + ) + > 0 + ) + +decoder : (Json.Decode.Decoder Type) +decoder = + (Json.Decode.Pipeline.decode + Type + |> (Json.Decode.Pipeline.required "id" Json.Decode.string) + |> (Json.Decode.Pipeline.required "name" Json.Decode.string) + |> (Json.Decode.Pipeline.required "query_url" Json.Decode.string) + |> (Json.Decode.Pipeline.hardcoded []) + |> (Json.Decode.Pipeline.hardcoded []) + |> (Json.Decode.Pipeline.hardcoded []) + ) + +encode : Type -> Json.Encode.Value +encode t = + (Json.Encode.object + [ + ("id", (Json.Encode.string t.id)), + ("name", (Json.Encode.string t.name)), + ("query_url", (Json.Encode.string t.query_url)) + ] + ) + +default : Type +default = + { + id = "0", + name = "Username", + query_url = "http://127.0.0.1/", + campaigns = [], + invasions = [], + events = [] + } diff --git a/src/popup/src/Struct/ServerReply.elm b/src/popup/src/Struct/ServerReply.elm new file mode 100644 index 0000000..f0530d8 --- /dev/null +++ b/src/popup/src/Struct/ServerReply.elm @@ -0,0 +1,29 @@ +module Struct.ServerReply exposing (Type(..)) + +-- Elm ------------------------------------------------------------------------- + +-- ------------------------------------------------------------------- +import Struct.BattleSummary + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +type Type = + Okay + | SetID String + | SetUsername String + | SetBattles + ( + (List Struct.BattleSummary.Type), + (List Struct.BattleSummary.Type), + (List Struct.BattleSummary.Type) + ) + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- diff --git a/src/popup/src/Update/AddPlayer.elm b/src/popup/src/Update/AddPlayer.elm new file mode 100644 index 0000000..ed9da4a --- /dev/null +++ b/src/popup/src/Update/AddPlayer.elm @@ -0,0 +1,24 @@ +module Update.AddPlayer exposing (apply_to) + +-- Elm ------------------------------------------------------------------------- +import Array + +-- Extension ------------------------------------------------------------------- +import Struct.Event +import Struct.Flags +import Struct.Model +import Struct.Player + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : Struct.Model.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type)) +apply_to model = + ( + {model | players = (Array.push (Struct.Player.default) model.players)}, + Cmd.none + ) diff --git a/src/popup/src/Update/HandleServerReply.elm b/src/popup/src/Update/HandleServerReply.elm new file mode 100644 index 0000000..b80c7b4 --- /dev/null +++ b/src/popup/src/Update/HandleServerReply.elm @@ -0,0 +1,119 @@ +module Update.HandleServerReply exposing (apply_to) + +-- Elm ------------------------------------------------------------------------- +import Array + +import Http + +-- Extension ------------------------------------------------------------------- +import Comm.GetBattles + +import Struct.BattleSummary +import Struct.Error +import Struct.Event +import Struct.Model +import Struct.Player +import Struct.ServerReply + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +handle_set_battles : ( + ( + (List Struct.BattleSummary.Type), + (List Struct.BattleSummary.Type), + (List Struct.BattleSummary.Type) + ) -> + (Struct.Model.Type, (List (Cmd Struct.Event.Type))) -> + (Struct.Model.Type, (List (Cmd Struct.Event.Type))) + ) +handle_set_battles battles current_state = + let + (model, cmds) = current_state + (campaigns, invasions, events) = battles + in + case (Array.get model.query_index model.players) of + Nothing -> current_state -- TODO: error + (Just player) -> + let + updated_player = + (Struct.Player.set_battles + campaigns + invasions + events + player + ) + updated_model = + {model | + players = + (Array.set + model.query_index + updated_player + model.players + ), + query_index = (model.query_index + 1), + notify = + ( + model.notify + || (Struct.Player.has_active_battles updated_player) + ) + } + in + case (Array.get updated_model.query_index model.players) of + Nothing -> ({updated_model| query_index = -1}, cmds) + + (Just next_player) -> + case (Comm.GetBattles.try updated_model next_player) of + Nothing -> ({updated_model| query_index = -1}, cmds) + (Just query) -> (updated_model, (query :: 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.Okay -> current_state + (Struct.ServerReply.SetID str) -> current_state -- TODO + (Struct.ServerReply.SetUsername str) -> current_state -- TODO + (Struct.ServerReply.SetBattles battles) -> + (handle_set_battles battles 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) + ) + ) diff --git a/src/popup/src/Update/RefreshBattles.elm b/src/popup/src/Update/RefreshBattles.elm new file mode 100644 index 0000000..2ff739f --- /dev/null +++ b/src/popup/src/Update/RefreshBattles.elm @@ -0,0 +1,28 @@ +module Update.RefreshBattles exposing (apply_to) + +-- Elm ------------------------------------------------------------------------- +import Array + +-- Extension ------------------------------------------------------------------- +import Comm.GetBattles + +import Struct.Event +import Struct.Flags +import Struct.Model + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : Struct.Model.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type)) +apply_to model = + case (Array.get 0 model.players) of + Nothing -> (model, Cmd.none) + (Just player) -> + case (Comm.GetBattles.try model player) of + -- TODO: Invalidate only this player, refresh the others. + Nothing -> (model, Cmd.none) + (Just cmd) -> ({model | query_index = 0}, cmd) diff --git a/src/popup/src/Update/StoreParams.elm b/src/popup/src/Update/StoreParams.elm new file mode 100644 index 0000000..f369be8 --- /dev/null +++ b/src/popup/src/Update/StoreParams.elm @@ -0,0 +1,38 @@ +module Update.StoreParams exposing (apply_to) + +-- Elm ------------------------------------------------------------------------- +import Array + +import Json.Encode + +-- Extension ------------------------------------------------------------------- +import Action.Ports + +import Struct.Event +import Struct.Flags +import Struct.Model +import Struct.Player + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +apply_to : Struct.Model.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type)) +apply_to model = + ( + model, + (Action.Ports.store_params + ( + (Struct.Flags.get_frequency model.flags), + (Json.Encode.encode + 0 + (Json.Encode.list + (List.map (Struct.Player.encode) (Array.toList model.players)) + ) + ) + ) + ) + ) diff --git a/src/popup/src/Util/Array.elm b/src/popup/src/Util/Array.elm new file mode 100644 index 0000000..9e57c18 --- /dev/null +++ b/src/popup/src/Util/Array.elm @@ -0,0 +1,34 @@ +module Util.Array exposing + ( + update, + update_unsafe, + filter_first + ) + +import Array + +update : ( + Int -> + ((Maybe t) -> (Maybe t)) -> + (Array.Array t) -> + (Array.Array t) + ) +update index fun array = + case (fun (Array.get index array)) of + Nothing -> array + (Just e) -> (Array.set index e array) + +update_unsafe : ( + Int -> + (t -> t) -> + (Array.Array t) -> + (Array.Array t) + ) +update_unsafe index fun array = + case (Array.get index array) of + Nothing -> array + (Just e) -> (Array.set index (fun e) array) + +filter_first : (t -> Bool) -> (Array.Array t) -> (Maybe t) +filter_first fun array = + (Array.get 0 (Array.filter fun array)) diff --git a/src/popup/src/Util/Html.elm b/src/popup/src/Util/Html.elm new file mode 100644 index 0000000..42eadba --- /dev/null +++ b/src/popup/src/Util/Html.elm @@ -0,0 +1,6 @@ +module Util.Html exposing (nothing) + +import Html + +nothing : (Html.Html a) +nothing = (Html.text "") diff --git a/src/popup/src/Util/List.elm b/src/popup/src/Util/List.elm new file mode 100644 index 0000000..1f914b1 --- /dev/null +++ b/src/popup/src/Util/List.elm @@ -0,0 +1,36 @@ +module Util.List exposing (..) + +import List + +pop : List a -> (Maybe (a, List a)) +pop l = + case + ((List.head l), (List.tail l)) + of + (Nothing, _) -> Nothing + (_ , Nothing) -> Nothing + ((Just head), (Just tail)) -> (Just (head, tail)) + +get_first : (a -> Bool) -> (List a) -> (Maybe a) +get_first fun list = + (List.head (List.filter fun list)) + +product_map : (a -> b -> c) -> (List a) -> (List b) -> (List c) +product_map product_fun list_a list_b = + (product_map_rec (product_fun) list_a list_b []) + +product_map_rec : (a -> b -> c) -> (List a) -> (List b) -> (List c) -> (List c) +product_map_rec product_fun list_a list_b result = + case (pop list_a) of + Nothing -> result + (Just (head, tail)) -> + (product_map_rec + (product_fun) + tail + list_b + (List.append + (List.map (product_fun head) list_b) + result + ) + ) + diff --git a/src/popup/src/View/Header.elm b/src/popup/src/View/Header.elm new file mode 100644 index 0000000..fd8e693 --- /dev/null +++ b/src/popup/src/View/Header.elm @@ -0,0 +1,79 @@ +module View.Header exposing (get_html) + +-- Elm ------------------------------------------------------------------------- +import Html +import Html.Attributes + +-- Map ------------------------------------------------------------------- +import Struct.Event + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +link_html : String -> String -> Bool -> (Html.Html Struct.Event.Type) +link_html src label is_active = + (Html.a + [ + (Html.Attributes.href src) + ] + [ + ( + if (is_active) + then (Html.text label) + else (Html.s [] [(Html.text label)]) + ) + ] + ) + +navigation_html : (Html.Html Struct.Event.Type) +navigation_html = + (Html.nav + [] + [ + (link_html "/about.html" "About" True), + (link_html "/news/" "News" False), + (link_html "/community/" "Community" False), + (link_html "/login/?action=disconnect" "Disconnect" True) + ] + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_html : (Html.Html Struct.Event.Type) +get_html = + (Html.header + [] + [ + (Html.div + [ + (Html.Attributes.class "main-server-logo") + ] + [ + (Html.a + [ + (Html.Attributes.href "http://127.0.0.1") + ] + [ + (Html.img + [ + (Html.Attributes.src "/asset/svg/to-logo-no-bg.svg") + ] + [ + ] + ) + ] + ) + ] + ), + (Html.div + [ + (Html.Attributes.class "main-server-version") + ] + [ + (Html.text "Latest Dev. Build (Mon, 10 Sep 2018 10:30:17 +0000)") + ] + ), + (navigation_html) + ] + ) diff --git a/src/popup/src/View/Player.elm b/src/popup/src/View/Player.elm new file mode 100644 index 0000000..07dc292 --- /dev/null +++ b/src/popup/src/View/Player.elm @@ -0,0 +1,97 @@ +module View.Player exposing (get_html) + +-- Elm ------------------------------------------------------------------------- +import Html +import Html.Attributes +-- import Html.Events + +-- Extension ------------------------------------------------------------------- +import Struct.BattleSummary +import Struct.Event +import Struct.Player + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_item_html : ( + String -> + String -> + Struct.BattleSummary.Type -> + (Html.Html Struct.Event.Type) + ) +get_item_html query_url additional_class item = + (Html.a + [ + (Html.Attributes.class additional_class), + (Html.Attributes.href + ( + query_url + ++ "/battle/?id=" + ++ (Struct.BattleSummary.get_id item) + ) + ) + ] + [ + (Html.div + [ + (Html.Attributes.class "battle-summary-name") + ] + [ + (Html.text (Struct.BattleSummary.get_name item)) + ] + ), + (Html.div + [ + (Html.Attributes.class "battle-summary-date") + ] + [ + (Html.text (Struct.BattleSummary.get_last_edit item)) + ] + ) + ] + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_html : Struct.Player.Type -> (Html.Html Struct.Event.Type) +get_html player = + let + query_url = (Struct.Player.get_query_url player) + in + (Html.div + [ + (Html.Attributes.class "player-summary") + ] + [ + (Html.div + [ + (Html.Attributes.class "player-summary-listing-header") + ] + [ + (Html.text (Struct.Player.get_username player)) + ] + ), + (Html.div + [ + (Html.Attributes.class "player-summary-listing-body") + ] + ( + (List.map + (get_item_html query_url "campaign-link") + (Struct.Player.get_campaigns player) + ) + ++ + (List.map + (get_item_html query_url "invasion-link") + (Struct.Player.get_invasions player) + ) + ++ + (List.map + (get_item_html query_url "event-link") + (Struct.Player.get_events player) + ) + ) + ) + ] + ) -- cgit v1.2.3-70-g09d2