From 2aa0c12b6a193d16681a0179a067664390af7aee Mon Sep 17 00:00:00 2001 From: nsensfel Date: Fri, 14 Sep 2018 18:57:42 +0200 Subject: ... --- src/Comm/GetBattles.elm | 14 +++++---- src/Comm/Okay.elm | 6 ++-- src/Comm/Send.elm | 11 ++++--- src/Comm/SetBattles.elm | 51 +++++++++++++++++++++++++++++++++ src/Comm/SetPlayer.elm | 26 ----------------- src/ElmModule/Init.elm | 15 ++++++++-- src/ElmModule/Update.elm | 10 ++++++- src/ElmModule/View.elm | 34 +++++++++++++++++++--- src/Struct/Event.elm | 3 ++ src/Struct/Flags.elm | 18 ++++++++---- src/Struct/Model.elm | 12 ++++++-- src/Struct/Player.elm | 62 +++++++++++++++++++++++++++++----------- src/Struct/ServerReply.elm | 13 +++++++-- src/Update/AddPlayer.elm | 24 ++++++++++++++++ src/Update/HandleServerReply.elm | 61 +++++++++++++++++++++++++++++++++++++-- src/Update/RefreshBattles.elm | 28 ++++++++++++++++++ src/Update/StoreParams.elm | 18 ++++++++++-- src/View/Player.elm | 13 +++++---- 18 files changed, 333 insertions(+), 86 deletions(-) create mode 100644 src/Comm/SetBattles.elm delete mode 100644 src/Comm/SetPlayer.elm create mode 100644 src/Update/AddPlayer.elm create mode 100644 src/Update/RefreshBattles.elm (limited to 'src') diff --git a/src/Comm/GetBattles.elm b/src/Comm/GetBattles.elm index 59b8d1d..0956972 100644 --- a/src/Comm/GetBattles.elm +++ b/src/Comm/GetBattles.elm @@ -5,8 +5,10 @@ import Json.Encode -- Extension ------------------------------------------------------------------- import Comm.Send + import Struct.Event import Struct.Model +import Struct.Player -------------------------------------------------------------------------------- -- TYPES ------------------------------------------------------------------------ @@ -31,11 +33,13 @@ try_encoding player_id model = -------------------------------------------------------------------------------- -- EXPORTED -------------------------------------------------------------------- -------------------------------------------------------------------------------- -try : Struct.Model.Type -> String -> (Maybe (Cmd Struct.Event.Type)) -try model player_id = +try : Struct.Model.Type -> Struct.Player.Type -> (Maybe (Cmd Struct.Event.Type)) +try model player = (Comm.Send.try_sending model - -- FIXME: this is a param now... - Constants.IO.get_battles_handler - (try_encoding player_id) + ( + (Struct.Player.get_query_url player) + ++ "/handler/player/plr_get_battles" + ) + (try_encoding (Struct.Player.get_id player)) ) diff --git a/src/Comm/Okay.elm b/src/Comm/Okay.elm index ca7a2eb..9281558 100644 --- a/src/Comm/Okay.elm +++ b/src/Comm/Okay.elm @@ -1,4 +1,4 @@ -module Comm.Okay exposing (decode) +module Comm.Okay exposing (decoder) -- Elm ------------------------------------------------------------------------- import Json.Decode @@ -17,5 +17,5 @@ import Struct.ServerReply -------------------------------------------------------------------------------- -- EXPORTED -------------------------------------------------------------------- -------------------------------------------------------------------------------- -decode : (Json.Decode.Decoder Struct.ServerReply.Type) -decode = (Json.Decode.succeed Struct.ServerReply.Okay) +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 index dd9dc28..3fc30ae 100644 --- a/src/Comm/Send.elm +++ b/src/Comm/Send.elm @@ -24,8 +24,8 @@ import Struct.Model internal_decoder : String -> (Json.Decode.Decoder Struct.ServerReply.Type) internal_decoder reply_type = case reply_type of - "okay" -> (Comm.Okay.decode) - "set_battles" -> (Comm.SetBattles.decode) + "okay" -> (Comm.Okay.decoder) + "set_battles" -> (Comm.SetBattles.decoder) other -> (Json.Decode.fail ( @@ -35,15 +35,14 @@ internal_decoder reply_type = ) ) -decode : (Json.Decode.Decoder Struct.ServerReply.Type) -decode = +decoder : (Json.Decode.Decoder Struct.ServerReply.Type) +decoder = (Json.Decode.field "msg" Json.Decode.string) |> (Json.Decode.andThen (internal_decoder)) -------------------------------------------------------------------------------- -- EXPORTED -------------------------------------------------------------------- -------------------------------------------------------------------------------- --- TODO: turn this into a multi-server version. try_sending : ( Struct.Model.Type -> String -> @@ -59,7 +58,7 @@ try_sending model recipient try_encoding_fun = (Http.post recipient (Http.jsonBody serial) - (Json.Decode.list (decode)) + (Json.Decode.list (decoder)) ) ) ) diff --git a/src/Comm/SetBattles.elm b/src/Comm/SetBattles.elm new file mode 100644 index 0000000..0add112 --- /dev/null +++ b/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/Comm/SetPlayer.elm b/src/Comm/SetPlayer.elm deleted file mode 100644 index a595777..0000000 --- a/src/Comm/SetPlayer.elm +++ /dev/null @@ -1,26 +0,0 @@ -module Comm.SetPlayer exposing (decode) - --- Elm ------------------------------------------------------------------------- -import Json.Decode - --- Map ------------------------------------------------------------------------- -import Struct.Player -import Struct.ServerReply - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -internal_decoder : Struct.Player.Type -> Struct.ServerReply.Type -internal_decoder player = - (Struct.ServerReply.SetPlayer player) - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -decode : (Json.Decode.Decoder Struct.ServerReply.Type) -decode = - (Json.Decode.map (internal_decoder) (Struct.Player.decoder)) diff --git a/src/ElmModule/Init.elm b/src/ElmModule/Init.elm index ccb3595..65d31b7 100644 --- a/src/ElmModule/Init.elm +++ b/src/ElmModule/Init.elm @@ -1,8 +1,11 @@ module ElmModule.Init exposing (init) -- Elm ------------------------------------------------------------------------- +import Delay --- Main Menu ------------------------------------------------------------------- +import Time + +-- Extension ------------------------------------------------------------------- import Struct.Event import Struct.Flags import Struct.Model @@ -15,4 +18,12 @@ import Struct.Model -- EXPORTED -------------------------------------------------------------------- -------------------------------------------------------------------------------- init : Struct.Flags.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type)) -init flags = ((Struct.Model.new flags), Cmd.none) +init flags = + ( + (Struct.Model.new flags), + (Delay.after + (toFloat (Struct.Flags.get_frequency flags)) + (Time.minute) + Struct.Event.ShouldRefresh + ) + ) diff --git a/src/ElmModule/Update.elm b/src/ElmModule/Update.elm index fbe8dfe..9e162fe 100644 --- a/src/ElmModule/Update.elm +++ b/src/ElmModule/Update.elm @@ -6,7 +6,9 @@ module ElmModule.Update exposing (update) import Struct.Event import Struct.Model +import Update.AddPlayer import Update.HandleServerReply +import Update.RefreshBattles import Update.StoreParams -------------------------------------------------------------------------------- @@ -31,7 +33,13 @@ update event model = (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) -> (Update.StoreParams.apply_to model) + (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) -> ( diff --git a/src/ElmModule/View.elm b/src/ElmModule/View.elm index 3f0a16f..946bf8e 100644 --- a/src/ElmModule/View.elm +++ b/src/ElmModule/View.elm @@ -4,6 +4,7 @@ module ElmModule.View exposing (view) import Array import Html +import Html.Events import Html.Attributes -- Extension ------------------------------------------------------------------- @@ -27,7 +28,7 @@ view model = [ (Html.Attributes.class "fullscreen-module") ] - ( + [ ( case model.error of Nothing -> (Util.Html.nothing) @@ -38,8 +39,33 @@ view model = (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") + ] + ) + ] ) - :: - (List.map (View.Player.get_html) (Array.toList model.players)) - ) + ] ) diff --git a/src/Struct/Event.elm b/src/Struct/Event.elm index 68bca98..eafd812 100644 --- a/src/Struct/Event.elm +++ b/src/Struct/Event.elm @@ -13,10 +13,13 @@ import Struct.ServerReply 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 diff --git a/src/Struct/Flags.elm b/src/Struct/Flags.elm index d9d2dcd..e5a79f8 100644 --- a/src/Struct/Flags.elm +++ b/src/Struct/Flags.elm @@ -6,10 +6,10 @@ module Struct.Flags exposing ) -- Elm ------------------------------------------------------------------------- -import List +import Json.Decode --- Shared ---------------------------------------------------------------------- -import Util.List +-- Extension ------------------------------------------------------------------- +import Struct.Player -------------------------------------------------------------------------------- -- TYPES ----------------------------------------------------------------------- @@ -30,5 +30,13 @@ type alias Type = get_frequency : Type -> Int get_frequency flags = flags.frequency -get_players : Type -> String -get_players flags = flags.players +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 index 6d4a588..dca14c2 100644 --- a/src/Struct/Model.elm +++ b/src/Struct/Model.elm @@ -22,7 +22,9 @@ type alias Type = { flags: Struct.Flags.Type, error: (Maybe Struct.Error.Type), - players: (Array.Array Struct.Player.Type) + players: (Array.Array Struct.Player.Type), + query_index: Int, + notify: Bool } -------------------------------------------------------------------------------- @@ -37,13 +39,17 @@ new flags = { flags = flags, error = Nothing, - players = (Array.empty) + players = (Array.fromList (Struct.Flags.get_players flags)), + query_index = -1, + notify = False } reset : Type -> Type reset model = {model | - error = Nothing + error = Nothing, + notify = False, + query_index = -1 } invalidate : Struct.Error.Type -> Type -> Type diff --git a/src/Struct/Player.elm b/src/Struct/Player.elm index 6a81daf..1e8365a 100644 --- a/src/Struct/Player.elm +++ b/src/Struct/Player.elm @@ -1,24 +1,26 @@ module Struct.Player exposing ( Type, - get_ix, - set_ix, get_id, set_id, - get_url_prefix, - set_url_prefix, + get_query_url, + set_query_url, get_username, set_username, get_campaigns, get_invasions, get_events, set_battles, - has_active_battles + has_active_battles, + decoder, + encode, + default ) -- Elm ------------------------------------------------------------------------- import Json.Decode import Json.Decode.Pipeline +import Json.Encode -- Extension ------------------------------------------------------------------- import Struct.BattleSummary @@ -28,10 +30,9 @@ import Struct.BattleSummary -------------------------------------------------------------------------------- type alias Type = { - ix : Int, id : String, name : String, - url_prefix : String, + query_url : String, campaigns : (List Struct.BattleSummary.Type), invasions : (List Struct.BattleSummary.Type), events : (List Struct.BattleSummary.Type) @@ -44,12 +45,6 @@ type alias Type = -------------------------------------------------------------------------------- -- EXPORTED -------------------------------------------------------------------- -------------------------------------------------------------------------------- -get_ix : Type -> Int -get_ix t = t.ix - -set_ix : Int -> Type -> Type -set_ix val t = {t | ix = val} - get_id : Type -> String get_id t = t.id @@ -62,11 +57,11 @@ get_username t = t.name set_username : String -> Type -> Type set_username str t = {t | name = str} -get_url_prefix : Type -> String -get_url_prefix t = t.url_prefix +get_query_url : Type -> String +get_query_url t = t.query_url -set_url_prefix : String -> Type -> Type -set_url_prefix str t = {t | url_prefix = str} +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 @@ -103,3 +98,36 @@ has_active_battles t = ) > 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 index 65fc063..f0530d8 100644 --- a/src/Struct/ServerReply.elm +++ b/src/Struct/ServerReply.elm @@ -2,8 +2,8 @@ module Struct.ServerReply exposing (Type(..)) -- Elm ------------------------------------------------------------------------- --- Main Menu ------------------------------------------------------------------- -import Struct.Player +-- ------------------------------------------------------------------- +import Struct.BattleSummary -------------------------------------------------------------------------------- -- TYPES ----------------------------------------------------------------------- @@ -11,7 +11,14 @@ import Struct.Player type Type = Okay --- | SetBattles (List, List, List) + | SetID String + | SetUsername String + | SetBattles + ( + (List Struct.BattleSummary.Type), + (List Struct.BattleSummary.Type), + (List Struct.BattleSummary.Type) + ) -------------------------------------------------------------------------------- -- LOCAL ----------------------------------------------------------------------- diff --git a/src/Update/AddPlayer.elm b/src/Update/AddPlayer.elm new file mode 100644 index 0000000..ed9da4a --- /dev/null +++ b/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/Update/HandleServerReply.elm b/src/Update/HandleServerReply.elm index 271ecfb..b80c7b4 100644 --- a/src/Update/HandleServerReply.elm +++ b/src/Update/HandleServerReply.elm @@ -1,12 +1,14 @@ module Update.HandleServerReply exposing (apply_to) -- Elm ------------------------------------------------------------------------- +import Array + import Http --- Shared ---------------------------------------------------------------------- -import Struct.Flags +-- Extension ------------------------------------------------------------------- +import Comm.GetBattles --- Main Menu ------------------------------------------------------------------- +import Struct.BattleSummary import Struct.Error import Struct.Event import Struct.Model @@ -20,6 +22,55 @@ import Struct.ServerReply -------------------------------------------------------------------------------- -- 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))) -> @@ -28,6 +79,10 @@ apply_command : ( 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 -------------------------------------------------------------------- diff --git a/src/Update/RefreshBattles.elm b/src/Update/RefreshBattles.elm new file mode 100644 index 0000000..2ff739f --- /dev/null +++ b/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/Update/StoreParams.elm b/src/Update/StoreParams.elm index 3955ecd..f369be8 100644 --- a/src/Update/StoreParams.elm +++ b/src/Update/StoreParams.elm @@ -1,13 +1,17 @@ module Update.StoreParams exposing (apply_to) -- Elm ------------------------------------------------------------------------- +import Array --- Login ----------------------------------------------------------------------- +import Json.Encode + +-- Extension ------------------------------------------------------------------- import Action.Ports import Struct.Event import Struct.Flags import Struct.Model +import Struct.Player -------------------------------------------------------------------------------- -- LOCAL ----------------------------------------------------------------------- @@ -20,5 +24,15 @@ apply_to : Struct.Model.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type)) apply_to model = ( model, - (Action.Ports.store_params (5, "")) + (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/View/Player.elm b/src/View/Player.elm index 2e45463..07dc292 100644 --- a/src/View/Player.elm +++ b/src/View/Player.elm @@ -19,13 +19,14 @@ get_item_html : ( Struct.BattleSummary.Type -> (Html.Html Struct.Event.Type) ) -get_item_html url_prefix additional_class item = +get_item_html query_url additional_class item = (Html.a [ (Html.Attributes.class additional_class), (Html.Attributes.href ( - url_prefix + query_url + ++ "/battle/?id=" ++ (Struct.BattleSummary.get_id item) ) ) @@ -56,7 +57,7 @@ get_item_html url_prefix additional_class item = get_html : Struct.Player.Type -> (Html.Html Struct.Event.Type) get_html player = let - url_prefix = (Struct.Player.get_url_prefix player) + query_url = (Struct.Player.get_query_url player) in (Html.div [ @@ -77,17 +78,17 @@ get_html player = ] ( (List.map - (get_item_html url_prefix "campaign-link") + (get_item_html query_url "campaign-link") (Struct.Player.get_campaigns player) ) ++ (List.map - (get_item_html url_prefix "invasion-link") + (get_item_html query_url "invasion-link") (Struct.Player.get_invasions player) ) ++ (List.map - (get_item_html url_prefix "event-link") + (get_item_html query_url "event-link") (Struct.Player.get_events player) ) ) -- cgit v1.2.3-70-g09d2