works on admin page

This commit is contained in:
2019-11-21 15:57:01 +01:00
parent 75968f73c1
commit a81d184af6
8 changed files with 252 additions and 120 deletions

View File

@@ -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))
]

78
src/Api/Player.elm Normal file
View File

@@ -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

View File

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

View File

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

View File

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

View File

@@ -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

View File

@@ -1,20 +1,39 @@
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
@@ -25,9 +44,9 @@ parser =
, 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")
]
fromUrl : Url.Url -> Maybe Route
fromUrl url =
P.parse parser url

View File

@@ -21,6 +21,10 @@ init toMsg navKey =
toSession response =
case Debug.log "got session:" response of
Ok value ->
if value == "admin" then
toMsg <| Just (Session navKey Admin)
else
case String.toInt value of
Just id ->
toMsg <| Just (Session navKey (Player id))