elm/lootalot-client
1
0
Fork 0
Code Issues 3 Pull Requests Releases Wiki Activity

puts group chest almost back up

Browse Source
This commit is contained in:
Arthur Gerbaud
2019-12-01 22:03:08 +01:00
parent 09bd6560cc
commit ecb0cc59a8
6 changed files with 253 additions and 65 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
src/Main.elm
View File

@@ -178,6 +178,13 @@ update msg model =
in
( model |> setPage shopPage, Cmd.map PageMsg cmd )
Just (Route.Home Route.GroupLoot) ->
let
( page, cmd ) =
Page.gotoGroupChest from
in
( model |> setPage page, Cmd.map PageMsg cmd )
{-
( Just route, Page.Admin admin ) ->
Admin.routeChanged route admin

63
src/Page.elm
View File

@@ -1,4 +1,4 @@
module Page exposing (Page(..), PageMsg, gotoHome, gotoShop, initHome, update, view)
module Page exposing (Page(..), PageMsg, gotoGroupChest, gotoHome, gotoShop, initHome, update, view)
import Api
import Api.Player
@@ -101,11 +101,11 @@ view page =
navLink "fas fa-gem"
in
[ navLink "fas fa-store-alt" "Marchand" "/marchand"
, if player.id == 0 then
linkWithGem "Nouveau loot" "/nouveau-tresor"
, if player.id /= 0 then
linkWithGem "Coffre de groupe" "/coffre"
else
linkWithGem "Coffre de groupe" "/coffre"
text ""
]
Session.Admin ->
@@ -118,6 +118,20 @@ view page =
, { title = navbarTitle, links = navbarLinks }
, [ div [ class "container" ] <|
viewSessionBar (maybeSession page) [ controls ]
:: (case Maybe.map Session.notification (maybeSession page) of
Just (Just notify) ->
div [ class "notification is-success" ] [ text notify ]
_ ->
text ""
)
:: (case Maybe.map Session.error (maybeSession page) of
Just (Just notify) ->
div [ class "notification is-danger" ] [ text notify ]
_ ->
text ""
)
:: content
]
)
@@ -131,10 +145,6 @@ viewSessionBar session controls =
[ text "" ]
Just (Session.Player player wealth _) ->
let
_ =
Debug.log "viewSessionBar wealth" player.wealth
in
Wealth.view player.wealth wealth
++ (if player.debt > 0 then
[ div [ class "level-item" ]
@@ -214,16 +224,12 @@ map func page =
update msg page =
case ( msg, page, maybeSession page ) of
( GotGroupChestMsg subMsg, GroupChest chest, _ ) ->
GroupChest.update subMsg chest
|> updatePage GroupChest GotGroupChestMsg
( GotGroupChestMsg _, _, _ ) ->
( page, Cmd.none )
-- Dashboard page
-- Capture API messages
( GotDashboardMsg (Dashboard.Api apiMsg), Dashboard home, _ ) ->
update (ApiMsg apiMsg) page
-- Relay others
( GotDashboardMsg subMsg, Dashboard home, _ ) ->
Dashboard.update subMsg home
|> updatePage Dashboard GotDashboardMsg
@@ -231,6 +237,18 @@ update msg page =
( GotDashboardMsg _, _, _ ) ->
( page, Cmd.none )
-- Group chest
( GotGroupChestMsg (GroupChest.Api apiMsg), GroupChest _, _ ) ->
update (ApiMsg apiMsg) page
( GotGroupChestMsg subMsg, GroupChest chest, _ ) ->
GroupChest.update subMsg chest
|> updatePage GroupChest GotGroupChestMsg
( GotGroupChestMsg _, _, _ ) ->
( page, Cmd.none )
-- Shop page
( GotShopMsg (Shop.Api apiMsg), Shop shop, _ ) ->
update (ApiMsg apiMsg) page
@@ -241,6 +259,7 @@ update msg page =
( GotShopMsg _, _, _ ) ->
( page, Cmd.none )
-- Wealth viewer/editor
( Wealth wealthMsg, _, Just session ) ->
let
wealthModel =
@@ -271,6 +290,7 @@ update msg page =
( Wealth wealthMsg, _, Nothing ) ->
( page, Cmd.none )
-- Handle API messages
( ApiMsg (Api.GotActionResult response), _, Just session ) ->
let
_ =
@@ -282,17 +302,12 @@ update msg page =
updates =
Maybe.withDefault [] result.updates
notification =
result.notification
errors =
Maybe.withDefault "" result.errors
newUser =
Debug.log "newUser" <|
updatedUser =
List.foldl applyUpdate (Session.user session) updates
in
( map (Session.updateUser newUser) page
( page
|> map (Session.updateUser updatedUser)
|> map (Session.updateNotifications ( result.notification, result.errors ))
, Cmd.none
)

21
src/Page/Chest.elm
View File

@@ -1,4 +1,4 @@
module Page.Chest exposing (Chest, Msg, confirmAdd, confirmBuy, confirmSell, init, initCreate, initSelection, update, view)
module Page.Chest exposing (Chest, Msg, confirmAdd, confirmBuy, confirmGrab, confirmSell, init, initCreate, initSelection, update, view)
import Api exposing (Item, Loot)
import Html exposing (..)
@@ -166,3 +166,22 @@ confirmAdd playerId sourceName model =
_ ->
Cmd.none
confirmGrab : Int -> Loot -> Chest -> Cmd Api.Msg
confirmGrab playerId loot model =
case model of
Selection chest ->
let
items =
Selection.selected chest loot
payload =
Api.GrabPayload items
in
Api.confirmAction
(String.fromInt playerId)
payload
_ ->
Cmd.none

19
src/Page/Dashboard.elm
View File

@@ -300,8 +300,23 @@ update msg model =
( Player (PlayerConfig session (Add Chest.initCreate)), Cmd.none )
IntoView ->
-- TODO: add the necessary test on group/player
( Player (PlayerConfig session (PlayerChest Chest.init)), Cmd.none )
let
userChest =
case Session.user session of
Session.Player player _ _ ->
if player.id == 0 then
GroupChest
else
PlayerChest
-- TODO: this seems not right
-- there should be a better way
-- to handle this
_ ->
PlayerChest
in
( Player (PlayerConfig session (userChest Chest.init)), Cmd.none )
_ ->
( model, Cmd.none )

113
src/Page/GroupChest.elm
View File

@@ -1,31 +1,48 @@
module Page.GroupChest exposing (..)
module Page.GroupChest exposing (Model, Msg(..), init, update, view)
import Api exposing (HttpResult, Loot)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Page.Chest as Chest exposing (Chest)
import Session exposing (Session)
import Table
type alias Model =
{ session : Session
, state : State
, loot : State
, mode : Mode
}
type Mode
= View Chest
| Grab Chest
mapChest fn mode =
case mode of
View chest ->
fn chest
Grab chest ->
fn chest
type State
= Loading
| LoadError String
| View Loot
| Loaded Loot
init session =
( Model session Loading, Api.fetchLoot GotLoot Api.OfGroup )
( Model session Loading (View Chest.init), Cmd.map Internal <| Api.fetchLoot GotLoot Api.OfGroup )
view : Model -> ( Html Msg, List (Html Msg) )
view model =
case model.state of
case model.loot of
Loading ->
( text ""
, [ p [ class "title" ] [ text "loading..." ] ]
@@ -36,29 +53,101 @@ view model =
, [ p [ class "has-text-danger" ] [ text <| "Error : " ++ error ] ]
)
View loot ->
( case Session.user model.session of
Loaded loot ->
( Html.map Internal <|
case model.mode of
View _ ->
case Session.user model.session of
Session.Admin ->
text ""
Session.Player p _ _ ->
if p.id == 0 then
button [ class "button" ] [ text "Vendre" ]
text ""
else
button [ class "button" ] [ text "Demander" ]
, [ Table.view Table.name loot ]
button [ class "button", onClick IntoGrab ] [ text "Demander" ]
Grab _ ->
case Session.user model.session of
Session.Admin ->
text ""
Session.Player p _ _ ->
if p.id == 0 then
text ""
else
button [ class "button", onClick ConfirmGrab ] [ text "Valider" ]
, [ mapChest (\c -> Chest.view c loot) model.mode
|> Html.map (Internal << GotChestMsg)
]
)
type Msg
= Api Api.Msg
| Internal InnerMsg
type InnerMsg
= GotLoot Api.ToChest (HttpResult Loot)
| GotChestMsg Chest.Msg
| IntoGrab
| IntoView
| ConfirmGrab
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Api apiMsg ->
( model, Cmd.none )
Internal ConfirmGrab ->
case ( Session.user model.session, model.loot, model.mode ) of
( Session.Player player _ _, Loaded loot, Grab chest ) ->
( { model | mode = View Chest.init }
, Chest.confirmGrab
player.id
loot
chest
|> Cmd.map Api
)
_ ->
( model, Cmd.none )
Internal innerMsg ->
(case innerMsg of
GotLoot _ (Ok loot) ->
( { model | state = View loot }, Cmd.none )
( { model | loot = Loaded loot }, Cmd.none )
GotLoot _ (Err _) ->
( { model | state = LoadError "Le chargement a échoué" }, Cmd.none )
( { model | loot = LoadError "Le chargement a échoué" }, Cmd.none )
GotChestMsg chestMsg ->
mapChest (Chest.update chestMsg) model.mode
|> updateChest model
IntoGrab ->
( { model | mode = Grab Chest.initSelection }, Cmd.none )
IntoView ->
( { model | mode = View Chest.init }, Cmd.none )
_ ->
( model, Cmd.none )
)
|> Tuple.mapSecond (Cmd.map Internal)
updateChest model ( chestModel, chestCmd ) =
( case model.mode of
View _ ->
{ model | mode = View chestModel }
Grab _ ->
{ model | mode = Grab chestModel }
, Cmd.map GotChestMsg chestCmd
)

79
src/Session.elm
View File

@@ -1,4 +1,4 @@
module Session exposing (Session, User(..), getSession, init, key, updateUser, updateWealth, user, wealth)
module Session exposing (Session, User(..), error, getSession, init, key, notification, updateNotifications, updateUser, updateWealth, user, wealth)
import Api exposing (Loot)
import Api.Player as Player exposing (Player)
@@ -14,8 +14,12 @@ type User
| Admin
type alias Notifications =
( Maybe String, Maybe String )
type Session
= Session Nav.Key User
= Session Nav.Key Notifications User
init : (Result String Session -> msg) -> Nav.Key -> Cmd msg
@@ -25,10 +29,17 @@ init toMsg navKey =
toSession result =
case result of
Ok ( player, loot ) ->
toMsg <| Ok (Session navKey (Player player Wealth.init loot))
toMsg <|
Ok
(Session
navKey
( Nothing, Nothing )
<|
Player player Wealth.init loot
)
Err error ->
toMsg <| Err error
Err e ->
toMsg <| Err e
in
Task.attempt toSession initFullSession
@@ -54,7 +65,7 @@ getSession r =
key : Session -> Nav.Key
key session =
let
(Session navKey _) =
(Session navKey _ _) =
session
in
navKey
@@ -63,12 +74,21 @@ key session =
user : Session -> User
user session =
let
(Session _ loggedUser) =
(Session _ _ loggedUser) =
session
in
loggedUser
updateUser : User -> Session -> Session
updateUser newUser model =
let
(Session navKey notifications _) =
model
in
Session navKey notifications newUser
wealth : Session -> Maybe Wealth.Model
wealth session =
case user session of
@@ -81,35 +101,58 @@ wealth session =
setWealth wealthModel session =
let
(Session navKey isUser) =
(Session navKey notifications isUser) =
session
in
case isUser of
Player p _ loot ->
Session navKey (Player p wealthModel loot)
Session navKey notifications (Player p wealthModel loot)
Admin ->
Session navKey Admin
Session navKey notifications Admin
updateWealth : Wealth.Model -> Session -> Session
updateWealth newWealthModel model =
let
(Session navKey loggedUser) =
(Session navKey notifications loggedUser) =
model
in
case loggedUser of
Player player _ loot ->
Session navKey (Player player newWealthModel loot)
Session navKey notifications (Player player newWealthModel loot)
Admin ->
Session navKey Admin
Session navKey notifications Admin
updateUser : User -> Session -> Session
updateUser newUser model =
notification session =
let
(Session navKey _) =
model
(Session _ ( maybeNotification, _ ) _) =
session
in
Session navKey newUser
maybeNotification
error session =
let
(Session _ ( _, maybeError ) _) =
session
in
maybeError
setError maybeError session =
let
(Session navKey ( maybeNotification, _ ) loggedUser) =
session
in
Session navKey ( maybeNotification, maybeError ) loggedUser
updateNotifications notifications session =
let
(Session navKey _ loggedUser) =
session
in
Session navKey notifications loggedUser