| summaryrefslogtreecommitdiff |
diff options
Diffstat (limited to 'src/background')
29 files changed, 1347 insertions, 0 deletions
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) + ) + ) + ) + ] + ) |