From a81d184af602bd8c4c65a7bd91e5036e63a3b600 Mon Sep 17 00:00:00 2001 From: Artus Date: Thu, 21 Nov 2019 15:57:01 +0100 Subject: [PATCH] works on admin page --- src/Api.elm | 61 +----------------------- src/Api/Player.elm | 78 +++++++++++++++++++++++++++++++ src/Main.elm | 62 ++++++++++++------------- src/Page/Admin.elm | 97 +++++++++++++++++++++++++++++++++++++-- src/Page/Chest.elm | 15 +++--- src/Page/Chest/Wealth.elm | 4 +- src/Route.elm | 39 ++++++++++++---- src/Session.elm | 16 ++++--- 8 files changed, 252 insertions(+), 120 deletions(-) create mode 100644 src/Api/Player.elm diff --git a/src/Api.elm b/src/Api.elm index 47bdeef..dbdced6 100644 --- a/src/Api.elm +++ b/src/Api.elm @@ -6,19 +6,16 @@ module Api exposing , Item , Loot , Msg(..) - , Player , RequestData(..) , ToChest(..) , Update(..) - , Wealth - , blankPlayer , checkList , confirmAction , fetchClaimsOf , fetchLoot - , fetchPlayer ) +import Api.Player exposing (Player, Wealth) import Http import Json.Decode as D exposing (Decoder, field, int, string, succeed) import Json.Encode as E @@ -57,29 +54,6 @@ type Msg -- MODELS --- -- Player - - -type alias Player = - { id : Int - , name : String - , debt : Int - , wealth : Wealth - } - - -blankPlayer = - Player 0 "Loot-a-lot" 0 (Wealth 0 0 0 0) - - -type alias Wealth = - { cp : Int - , sp : Int - , gp : Int - , pp : Int - } - - - -- Loot @@ -137,37 +111,6 @@ fetchClaimsOf toMsg playerId = --- PLAYERS --- - - -fetchPlayer : (Result Http.Error Player -> msg) -> Int -> Cmd msg -fetchPlayer toMsg id = - Http.get - { url = "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/" - , expect = Http.expectJson toMsg (valueDecoder playerDecoder) - } - - -playerDecoder : Decoder Player -playerDecoder = - D.map4 Player - (D.field "id" int) - (D.field "name" string) - (D.field "debt" int) - wealthDecoder - - -wealthDecoder : Decoder Wealth -wealthDecoder = - D.map4 Wealth - (D.field "cp" int) - (D.field "sp" int) - (D.field "gp" int) - (D.field "pp" int) - - - -- LOOT -- Location of a loot @@ -291,7 +234,7 @@ updatesDecoder = D.oneOf [ field "ItemRemoved" (itemDecoder |> D.andThen (\i -> succeed <| ItemRemoved i)) , field "ItemAdded" (itemDecoder |> D.andThen (\i -> succeed <| ItemAdded i)) - , field "Wealth" (wealthDecoder |> D.andThen (\i -> succeed <| WealthUpdated i)) + , field "Wealth" (Api.Player.wealthDecoder |> D.andThen (\i -> succeed <| WealthUpdated i)) , field "ClaimRemoved" (claimDecoder |> D.andThen (\i -> succeed <| ClaimRemoved i)) , field "ClaimAdded" (claimDecoder |> D.andThen (\i -> succeed <| ClaimAdded i)) ] diff --git a/src/Api/Player.elm b/src/Api/Player.elm new file mode 100644 index 0000000..710b99a --- /dev/null +++ b/src/Api/Player.elm @@ -0,0 +1,78 @@ +module Api.Player exposing (Player, Wealth, blankPlayer, get, list, wealthDecoder) + +import Http +import Json.Decode as D exposing (Decoder, int, string) + + +type alias Player = + { id : Int + , name : String + , debt : Int + , wealth : Wealth + } + + +playerDecoder : Decoder Player +playerDecoder = + D.map4 Player + (D.field "id" int) + (D.field "name" string) + (D.field "debt" int) + wealthDecoder + + +type alias Wealth = + { cp : Int + , sp : Int + , gp : Int + , pp : Int + } + + +wealthDecoder : Decoder Wealth +wealthDecoder = + D.map4 Wealth + (D.field "cp" int) + (D.field "sp" int) + (D.field "gp" int) + (D.field "pp" int) + + + +-- PLAYERS + + +blankPlayer = + Player 0 "Loot-a-lot" 0 (Wealth 0 0 0 0) + + +get : (Result Http.Error Player -> msg) -> Int -> Cmd msg +get toMsg id = + Http.get + { url = "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/" + , expect = Http.expectJson toMsg (valueDecoder playerDecoder) + } + + +list : (List Player -> msg) -> Cmd msg +list toMsg = + let + parseResponse : Result Http.Error (List Player) -> msg + parseResponse response = + case response of + Ok players -> + toMsg players + + Err e -> + Debug.log ("Player's list fetch error : " ++ Debug.toString e) <| + toMsg [] + in + Http.get + { url = "http://localhost:8088/api/players/" + , expect = Http.expectJson parseResponse (valueDecoder <| D.list playerDecoder) + } + + +valueDecoder : Decoder a -> Decoder a +valueDecoder thenDecoder = + D.field "value" thenDecoder diff --git a/src/Main.elm b/src/Main.elm index 69ca77c..93ff176 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -1,6 +1,5 @@ module Main exposing (..) -import Api exposing (Claim, Claims, Item, Loot, Player, Wealth) import Browser import Browser.Navigation as Nav import Html exposing (..) @@ -117,7 +116,7 @@ viewPage page = ( "Loot-a-lot", List.map (Html.map GotChestMsg) (Chest.view chest) ) Admin admin -> - ( "Administration", Admin.view admin ) + ( "Administration", List.map (Html.map GotAdminMsg) (Admin.view admin) ) About -> ( "A propos", [ p [] [ text "A propos" ] ] ) @@ -214,21 +213,8 @@ type Msg update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = - let - updateChest chestMsg = - case model.page of - Chest chest -> - let - ( newChest, cmd ) = - Chest.update chestMsg chest - in - ( setPage (Chest newChest) model, Cmd.map GotChestMsg cmd ) - - _ -> - ( model |> setPage About, Cmd.none ) - in - case msg of - SessionLoaded session -> + case ( msg, model.page ) of + ( SessionLoaded session, _ ) -> case session of Just logged -> let @@ -256,7 +242,7 @@ update msg model = Nothing -> ( model |> setPage About, Cmd.none ) - LinkClicked urlRequest -> + ( LinkClicked urlRequest, _ ) -> case model.page of Chest chestModel -> case urlRequest of @@ -269,26 +255,40 @@ update msg model = _ -> ( model, Cmd.none ) - UrlChanged url -> - let - route = - Route.fromUrl url - in - case route of - Just (Route.Home content) -> - updateChest (Chest.SetContent content) + ( UrlChanged url, page ) -> + -- Handle routing according to current page + case ( Route.fromUrl url, page ) of + ( Just (Route.Home content), Chest _ ) -> + update + (GotChestMsg <| Chest.SetContent content) + model + + ( Just (Route.Home MerchantLoot), Admin _ ) -> + ( model, Cmd.none ) _ -> ( model |> setPage About, Cmd.none ) - GotChestMsg chestMsg -> - updateChest chestMsg + ( SwitchMenuOpen, _ ) -> + ( { model | navbar = Navbar (not model.navbar.menuOpen) model.navbar.navKey }, Cmd.none ) - GotAdminMsg adminMsg -> + ( GotChestMsg chestMsg, Chest chest ) -> + Chest.update chestMsg chest + |> updatePage Chest GotChestMsg model + + ( GotAdminMsg adminMsg, Admin adminModel ) -> + Admin.update adminMsg adminModel + |> updatePage Admin GotAdminMsg model + + ( _, _ ) -> ( model, Cmd.none ) - SwitchMenuOpen -> - ( { model | navbar = Navbar (not model.navbar.menuOpen) model.navbar.navKey }, Cmd.none ) + +updatePage : (pageModel -> Page) -> (pageMsg -> Msg) -> Model -> ( pageModel, Cmd pageMsg ) -> ( Model, Cmd Msg ) +updatePage toModel toMsg model ( pageModel, pageCmd ) = + ( { model | page = toModel pageModel } + , Cmd.map toMsg pageCmd + ) diff --git a/src/Page/Admin.elm b/src/Page/Admin.elm index e10366b..a06f339 100644 --- a/src/Page/Admin.elm +++ b/src/Page/Admin.elm @@ -1,23 +1,110 @@ module Page.Admin exposing (..) +import Api.Player as Player exposing (Player, Wealth) import Browser.Navigation as Nav import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -type alias Model = - { navKey : Nav.Key +type alias NewPlayer = + { name : String + , wealth : Float } +type alias Model = + { navKey : Nav.Key + , players : List Player + , newPlayer : NewPlayer + } + + +init : Nav.Key -> ( Model, Cmd Msg ) init navKey = - ( { navKey = navKey }, Cmd.none ) + ( { navKey = navKey + , players = [] + , newPlayer = { name = "", wealth = 0.0 } + } + , Player.list GotPlayers + ) +view : Model -> List (Html Msg) view model = - [ p [ class "title" ] [ text "Administration" ] ] + [ p [ class "title" ] [ text "Administration" ] + , div [ class "section" ] + [ table [ class "table is-fullwidth is-striped" ] + [ thead [ class "table-header" ] + [ th [] [ text "Joueurs" ] ] + , tbody [] <| + editNewPlayer model.newPlayer + :: List.map viewPlayer model.players + ] + ] + , div [ class "section" ] + [ p [] [ text "Campagnes" ] ] + ] + + +viewPlayer : Player -> Html Msg +viewPlayer player = + tr [] [ td [] [ p [] [ text (player.name ++ " (" ++ String.fromInt player.id ++ ")") ] ] ] + + +editNewPlayer : NewPlayer -> Html Msg +editNewPlayer newPlayer = + tr [] + [ td [] + [ div [ class "field is-horizontal" ] + [ div [ class "field-body" ] + [ div [ class "field" ] + [ input + [ class "input" + , type_ "text" + , value newPlayer.name + , onInput NameChanged + ] + [] + ] + , div [ class "field" ] + [ input + [ class "input" + , type_ "text" + , value <| String.fromFloat newPlayer.wealth + , onInput WealthChanged + ] + [] + ] + ] + ] + ] + ] type Msg - = Nope + = GotPlayers (List Player) + | NameChanged String + | WealthChanged String + + +update msg model = + case msg of + GotPlayers players -> + ( Debug.log "GotPlayers" { model | players = players }, Cmd.none ) + + NameChanged newName -> + let + newPlayer = + model.newPlayer + in + ( { model | newPlayer = { newPlayer | name = newName } }, Cmd.none ) + + WealthChanged newWealth -> + let + newPlayer = + model.newPlayer + in + ( { model | newPlayer = { newPlayer | wealth = Maybe.withDefault 0.0 <| String.toFloat newWealth } } + , Cmd.none + ) diff --git a/src/Page/Chest.elm b/src/Page/Chest.elm index d991111..0ad52e0 100644 --- a/src/Page/Chest.elm +++ b/src/Page/Chest.elm @@ -10,6 +10,7 @@ import Api , RequestData(..) , confirmAction ) +import Api.Player exposing (Player, Wealth, blankPlayer) import Browser.Navigation as Nav import Dict exposing (Dict) import Html exposing (..) @@ -42,7 +43,7 @@ type alias State = -- , inventoryItems : Loot -- Fetched on init - , player : Api.Player + , player : Player , playerLoot : Loot , groupLoot : Loot , merchantLoot : Loot @@ -78,7 +79,7 @@ init navKey playerId = Nothing Nothing Nothing - Api.blankPlayer + blankPlayer [] [] [] @@ -88,11 +89,11 @@ init navKey playerId = Nothing "" (Wealth.init - Api.blankPlayer.wealth + blankPlayer.wealth ) [] , Cmd.batch - [ Api.fetchPlayer GotPlayer playerId + [ Api.Player.get GotPlayer playerId , Api.fetchClaimsOf GotClaims playerId , Api.fetchLoot GotLoot (Api.OfPlayer playerId) , Api.fetchLoot GotLoot Api.OfGroup @@ -129,7 +130,7 @@ viewNotification model = -- PLAYER BAR -viewPlayerBar : Api.Player -> List (Html Msg) -> Wealth.Model -> Html Msg +viewPlayerBar : Player -> List (Html Msg) -> Wealth.Model -> Html Msg viewPlayerBar player actionControls wealthModel = section [ class "hero is-dark is-bold" ] [ div [ class "hero-body" ] @@ -711,7 +712,7 @@ type Msg = ApiMsg Api.Msg | GotLoot Api.ToChest (HttpResult Loot) | GotClaims (HttpResult Claims) - | GotPlayer (HttpResult Api.Player) + | GotPlayer (HttpResult Player) -- Chest UI | ClearNotification | SetContent ChestContent @@ -1177,7 +1178,7 @@ applyUpdate u model = | player = { player | wealth = - Api.Wealth + Api.Player.Wealth (wealth.cp + diff.cp) (wealth.sp + diff.sp) (wealth.gp + diff.gp) diff --git a/src/Page/Chest/Wealth.elm b/src/Page/Chest/Wealth.elm index 6a2af38..e9a85ba 100644 --- a/src/Page/Chest/Wealth.elm +++ b/src/Page/Chest/Wealth.elm @@ -1,6 +1,6 @@ module Page.Chest.Wealth exposing (Model, Msg(..), editValue, init, update, view) -import Api +import Api.Player exposing (Wealth) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) @@ -45,7 +45,7 @@ viewUpdateWealth amount = ] -viewWealth : Api.Wealth -> List (Html Msg) +viewWealth : Wealth -> List (Html Msg) viewWealth wealth = [ showWealthField "pp" <| String.fromInt wealth.pp , showWealthField "gp" <| String.padLeft 2 '0' <| String.fromInt wealth.gp diff --git a/src/Route.elm b/src/Route.elm index 69ff14b..d892c26 100644 --- a/src/Route.elm +++ b/src/Route.elm @@ -1,32 +1,51 @@ -module Route exposing(..) +module Route exposing (..) import Url -import Url.Parser as P exposing (Parser, (), oneOf, s) +import Url.Parser as P exposing ((), Parser, oneOf, s) + + -- ROUTES + type ChestContent = PlayerLoot | MerchantLoot | GroupLoot | NewLoot + type Route = Home ChestContent | About - | Admin + + + +{- + We could flatten this : + + type Route + = Home -- Either PlayerChest or Admin depending on Session + | About + | Merchant + | GroupChest + | NewLoot + + + +-} parser : P.Parser (Route -> a) a parser = oneOf - [ P.map (Home PlayerLoot) P.top - , P.map (Home GroupLoot) (P.s "coffre") - , P.map (Home MerchantLoot) (P.s "marchand") - , P.map (Home NewLoot) (P.s "nouveau-tresor") - , P.map About (P.s "about") - , P.map Admin (P.s "admin") - ] + [ P.map (Home PlayerLoot) P.top + , P.map (Home GroupLoot) (P.s "coffre") + , P.map (Home MerchantLoot) (P.s "marchand") + , P.map (Home NewLoot) (P.s "nouveau-tresor") + , P.map About (P.s "about") + ] + fromUrl : Url.Url -> Maybe Route fromUrl url = diff --git a/src/Session.elm b/src/Session.elm index ea55f6b..7c0a055 100644 --- a/src/Session.elm +++ b/src/Session.elm @@ -21,13 +21,17 @@ init toMsg navKey = toSession response = case Debug.log "got session:" response of Ok value -> - case String.toInt value of - Just id -> - toMsg <| Just (Session navKey (Player id)) + if value == "admin" then + toMsg <| Just (Session navKey Admin) - Nothing -> - toMsg - Nothing + else + case String.toInt value of + Just id -> + toMsg <| Just (Session navKey (Player id)) + + Nothing -> + toMsg + Nothing Err _ -> toMsg Nothing