restores Admin sessions

This commit is contained in:
2019-12-05 16:16:34 +01:00
parent ced3f5763c
commit 2ec3e28f59
7 changed files with 119 additions and 86 deletions

View File

@@ -16,6 +16,7 @@ module Api exposing
, getLoot , getLoot
, printError , printError
, replaceShopItems , replaceShopItems
, send
) )
import Api.Player exposing (Player, Wealth) import Api.Player exposing (Player, Wealth)

View File

@@ -90,7 +90,7 @@ view page =
Session.Player data -> Session.Player data ->
data.player.name data.player.name
Session.Admin -> Session.Admin _ ->
"Administration" "Administration"
Nothing -> Nothing ->
@@ -109,7 +109,7 @@ view page =
text "" text ""
] ]
Session.Admin -> Session.Admin _ ->
[ navLink "fas fa-store-alt" Route.Merchant page ] [ navLink "fas fa-store-alt" Route.Merchant page ]
Nothing -> Nothing ->
@@ -173,7 +173,7 @@ viewSessionBar session controls =
) )
|> List.map (Html.map Wealth) |> List.map (Html.map Wealth)
Just Session.Admin -> Just (Session.Admin _) ->
[ text "Admin" ] [ text "Admin" ]
notifications = notifications =
@@ -471,7 +471,7 @@ applyUpdate u user =
Api.ClaimRemoved claim -> Api.ClaimRemoved claim ->
Session.Player { data | claims = List.filter (\c -> c.id /= claim.id) data.claims } Session.Player { data | claims = List.filter (\c -> c.id /= claim.id) data.claims }
Session.Admin -> Session.Admin _ ->
user user

View File

@@ -211,6 +211,8 @@ updateChest toMsg toChest ( model, cmd ) =
-- Helpers
--
-- Api actions -- Api actions
-- --

View File

@@ -43,15 +43,15 @@ type PlayerConfig
type AdminConfig type AdminConfig
= AdminConfig Session (List Player) NewPlayerForm = AdminConfig Session (List Player) (Maybe NewPlayerForm)
init : Session -> ( Model, Cmd Msg ) init : Session -> ( Model, Cmd Msg )
init session = init session =
case Session.user session of case Session.user session of
Session.Admin -> Session.Admin data ->
( Admin <| AdminConfig session [] initForm ( Admin <| AdminConfig session data.players Nothing
, Player.list (AdminViewer << GotPlayers) , Cmd.none
) )
Session.Player data -> Session.Player data ->
@@ -69,10 +69,6 @@ init session =
) )
initForm =
NewPlayerForm "" 0.0
modeButton t msg = modeButton t msg =
button [ class "button", onClick msg ] [ text t ] button [ class "button", onClick msg ] [ text t ]
@@ -84,6 +80,7 @@ buttons bs =
view : Model -> ( Html Msg, List (Html Msg) ) view : Model -> ( Html Msg, List (Html Msg) )
view model = view model =
case model of case model of
-- PLAYER DASHBOARD
Player (PlayerConfig session chest) -> Player (PlayerConfig session chest) ->
case Session.user session of case Session.user session of
Session.Player data -> Session.Player data ->
@@ -124,21 +121,27 @@ view model =
in in
( text "", [] ) ( text "", [] )
Admin (AdminConfig session players newPlayer) -> -- ADMIN DASHBOARD
( text "" Admin (AdminConfig session players playerForm) ->
, [ div [ class "container" ] ( case playerForm of
[ p [ class "title" ] [ text "Administration" ] Nothing ->
, div [ class "section" ] modeButton "Ajouter un joueur" (AdminViewer EditPlayer)
[ table [ class "table is-fullwidth is-striped" ]
[ thead [ class "table-header" ] Just _ ->
[ th [] [ text "Joueurs" ] ] buttons [ modeButton "Ok" ConfirmNewPlayer, modeButton "Annuler" CloseEdit ]
, tbody [] <| |> Html.map AdminViewer
editNewPlayer newPlayer , [ div [ class "section" ]
:: List.map viewPlayer players [ case playerForm of
] Nothing ->
text ""
Just form ->
editNewPlayer form
, table [ class "table is-fullwidth is-striped" ]
[ thead [ class "table-header" ]
[ th [] [ text "Joueurs" ] ]
, tbody [] <| List.map viewPlayer players
] ]
, div [ class "section" ]
[ p [] [ text "Campagnes" ] ]
] ]
] ]
) )
@@ -151,28 +154,28 @@ viewPlayer player =
editNewPlayer : NewPlayerForm -> Html Msg editNewPlayer : NewPlayerForm -> Html Msg
editNewPlayer newPlayer = editNewPlayer newPlayer =
tr [] div [ class "box" ]
[ td [] [ div [ class "field is-horizontal" ]
[ div [ class "field is-horizontal" ] [ div [ class "field-body" ]
[ div [ class "field-body" ] [ div [ class "field" ]
[ div [ class "field" ] [ label [ class "label" ] [ text "Nom" ]
[ input , input
[ class "input" [ class "input"
, type_ "text" , type_ "text"
, value newPlayer.name , value newPlayer.name
, onInput <| NameChanged , onInput <| NameChanged
]
[]
] ]
, div [ class "field" ] []
[ input ]
[ class "input" , div [ class "field" ]
, type_ "text" [ label [ class "label" ] [ text "Argent de départ" ]
, value <| String.fromFloat newPlayer.wealth , input
, onInput <| WealthChanged [ class "input"
] , type_ "text"
[] , value <| String.fromFloat newPlayer.wealth
, onInput <| WealthChanged
] ]
[]
] ]
] ]
] ]
@@ -187,7 +190,9 @@ type Msg
type AdminMsg type AdminMsg
= GotPlayers (List Player) = EditPlayer
| CloseEdit
| ConfirmNewPlayer
| GotFormMsg FormMsg | GotFormMsg FormMsg
@@ -204,16 +209,25 @@ type PlayerMsg
update msg model = update msg model =
case ( msg, model ) of case ( msg, model ) of
( AdminViewer aMsg, Admin (AdminConfig session players form) ) -> ( AdminViewer aMsg, Admin (AdminConfig session players form) ) ->
(case aMsg of (case ( aMsg, form ) of
GotPlayers newPlayers -> ( EditPlayer, Nothing ) ->
( Admin (AdminConfig session newPlayers form) ( Admin (AdminConfig session players (Just <| NewPlayerForm "" 0.0))
, Cmd.none , Cmd.none
) )
GotFormMsg subMsg -> ( GotFormMsg subMsg, Just f ) ->
( Admin (AdminConfig session players (updateForm subMsg form)) ( Admin (AdminConfig session players <| Just (updateForm subMsg f))
, Cmd.none , Cmd.none
) )
( ConfirmNewPlayer, Just f ) ->
( model, Cmd.none )
( CloseEdit, _ ) ->
( Admin (AdminConfig session players Nothing), Cmd.none )
_ ->
( model, Cmd.none )
) )
|> Tuple.mapSecond (Cmd.map AdminViewer) |> Tuple.mapSecond (Cmd.map AdminViewer)

View File

@@ -34,7 +34,7 @@ getClaimsFromSession session =
else else
[] []
Session.Admin -> Session.Admin _ ->
[] []
@@ -66,7 +66,7 @@ view model =
let let
( isPlayer, isGroup ) = ( isPlayer, isGroup ) =
case Session.user model.session of case Session.user model.session of
Session.Admin -> Session.Admin _ ->
( False, False ) ( False, False )
Session.Player data -> Session.Player data ->

View File

@@ -6,7 +6,7 @@ import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (..) import Html.Events exposing (..)
import Page.Chest as Chest exposing (Chest) import Page.Chest as Chest exposing (Chest)
import Page.Chest.Selection as Selection import Page.Chest.NewFromInventory as NewChest
import Session exposing (Session, getSession) import Session exposing (Session, getSession)
import Set exposing (Set) import Set exposing (Set)
import Table import Table
@@ -62,7 +62,7 @@ view model =
controls = controls =
Html.map Internal <| Html.map Internal <|
case ( model.chest, Session.user model.session ) of case ( model.chest, Session.user model.session ) of
( Chest.View _, Session.Admin ) -> ( Chest.View _, Session.Admin _ ) ->
btn "Remplacer" (GotChestMsg Chest.new) btn "Remplacer" (GotChestMsg Chest.new)
( Chest.View _, Session.Player _ ) -> ( Chest.View _, Session.Player _ ) ->
@@ -71,7 +71,7 @@ view model =
( Chest.Buy _, Session.Player _ ) -> ( Chest.Buy _, Session.Player _ ) ->
buttons [ btn "Ok" ConfirmBuy, btn "Annuler" (GotChestMsg Chest.show) ] buttons [ btn "Ok" ConfirmBuy, btn "Annuler" (GotChestMsg Chest.show) ]
( Chest.New _, Session.Admin ) -> ( Chest.New _, Session.Admin _ ) ->
buttons [ btn "Ok" ConfirmRefresh, btn "Annuler" (GotChestMsg Chest.show) ] buttons [ btn "Ok" ConfirmRefresh, btn "Annuler" (GotChestMsg Chest.show) ]
_ -> _ ->
@@ -148,10 +148,15 @@ update msg model =
ConfirmRefresh -> ConfirmRefresh ->
case Session.user (getSession model) of case Session.user (getSession model) of
Session.Admin -> Session.Admin _ ->
let let
loot = loot =
[] case model.chest of
Chest.New chest ->
NewChest.allLoot chest
_ ->
[]
in in
( model, Api.replaceShopItems GotRefreshResult loot ) ( model, Api.replaceShopItems GotRefreshResult loot )

View File

@@ -16,7 +16,7 @@ type User
, loot : Loot , loot : Loot
, claims : Claims , claims : Claims
} }
| Admin | Admin { players : List Player }
type alias Notifications = type alias Notifications =
@@ -30,22 +30,16 @@ type Session
init : (Result String Session -> msg) -> Nav.Key -> Cmd msg init : (Result String Session -> msg) -> Nav.Key -> Cmd msg
init toMsg navKey = init toMsg navKey =
let let
toSession : Result String ( Player, Loot, Claims ) -> msg toSession : Result String User -> msg
toSession result = toSession result =
case result of case result of
Ok ( player, loot, claims ) -> Ok logged ->
toMsg <| toMsg <|
Ok Ok
(Session (Session
navKey navKey
( Nothing, Nothing ) ( Nothing, Nothing )
(Player logged
{ player = player
, wealth = Wealth.init
, loot = loot
, claims = claims
}
)
) )
Err e -> Err e ->
@@ -54,24 +48,41 @@ init toMsg navKey =
Task.attempt toSession initFullSession Task.attempt toSession initFullSession
initFullSession : Task String ( Player, Loot, Claims ) initFullSession : Task String User
initFullSession = initFullSession =
Api.fetchSession let
userDecoder =
D.oneOf
[ Player.playerDecoder |> D.andThen (\p -> D.succeed <| Player { player = p, wealth = Wealth.init, loot = [], claims = [] })
, D.list Player.playerDecoder |> D.andThen (\ps -> D.succeed <| Admin { players = ps })
]
in
Api.send { method = "GET", path = "session", decoder = userDecoder }
|> Task.andThen wrapLoot |> Task.andThen wrapLoot
|> Task.andThen wrapClaims |> Task.andThen wrapClaims
|> Task.mapError Api.printError |> Task.mapError Api.printError
wrapLoot : Player -> Task Http.Error ( Player, Loot ) wrapLoot : User -> Task Http.Error User
wrapLoot player = wrapLoot logged =
Api.getLoot player.id case logged of
|> Task.andThen (\loot -> Task.succeed ( player, loot )) Player data ->
Api.getLoot data.player.id
|> Task.andThen (\loot -> Task.succeed (Player { data | loot = loot }))
Admin _ ->
Task.succeed logged
wrapClaims : ( Player, Loot ) -> Task Http.Error ( Player, Loot, Claims ) wrapClaims : User -> Task Http.Error User
wrapClaims ( player, loot ) = wrapClaims logged =
Api.getClaims player.id case logged of
|> Task.andThen (\claims -> Task.succeed ( player, loot, claims )) Player data ->
Api.getClaims data.player.id
|> Task.andThen (\claims -> Task.succeed (Player { data | claims = claims }))
Admin _ ->
Task.succeed logged
getSession : { r | session : Session } -> Session getSession : { r | session : Session } -> Session
@@ -112,7 +123,7 @@ wealth session =
Player data -> Player data ->
Just data.wealth Just data.wealth
Admin -> Admin _ ->
Nothing Nothing
@@ -125,22 +136,22 @@ setWealth wealthModel session =
Player data -> Player data ->
Session navKey notifications (Player { data | wealth = wealthModel }) Session navKey notifications (Player { data | wealth = wealthModel })
Admin -> Admin _ ->
Session navKey notifications Admin session
updateWealth : Wealth.Model -> Session -> Session updateWealth : Wealth.Model -> Session -> Session
updateWealth newWealthModel model = updateWealth newWealthModel session =
let let
(Session navKey notifications loggedUser) = (Session navKey notifications loggedUser) =
model session
in in
case loggedUser of case loggedUser of
Player data -> Player data ->
Session navKey notifications (Player { data | wealth = newWealthModel }) Session navKey notifications (Player { data | wealth = newWealthModel })
Admin -> Admin _ ->
Session navKey notifications Admin session