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

adds claims for group chest view

Browse Source
This commit is contained in:
Arthur Gerbaud
2019-12-02 15:58:26 +01:00
parent ecb0cc59a8
commit 976fbe6b4b
10 changed files with 249 additions and 192 deletions
Download Patch File Download Diff File Expand all files Collapse all files

58
src/Api.elm
View File

@@ -10,9 +10,9 @@ module Api exposing
, Update(..)
, checkList
, confirmAction
, fetchClaimsOf
, fetchLoot
, fetchSession
, getClaims
, getLoot
, printError
, replaceShopItems
@@ -22,6 +22,7 @@ import Api.Player exposing (Player, Wealth)
import Http
import Json.Decode as D exposing (Decoder, field, int, string, succeed)
import Json.Encode as E
import Task exposing (Task)
type alias HttpResult a =
@@ -82,12 +83,15 @@ itemEncoder item =
]
-- LOOT
type alias Loot =
List Item
-- LOOT
-- Location of a loot
@@ -144,26 +148,6 @@ claimDecoder =
(D.field "loot_id" int)
fetchClaimsOf : (Result Http.Error Claims -> msg) -> Int -> Cmd msg
fetchClaimsOf toMsg playerId =
let
url =
case playerId of
-- The 'group' need to see all claims
0 ->
"http://localhost:8088/api/claims"
id ->
"http://localhost:8088/api/players/" ++ String.fromInt playerId ++ "/claims"
in
Http.get
{ url = url
, expect =
valueDecoder (D.list claimDecoder)
|> Http.expectJson toMsg
}
-- Retrieves items from a list of names
@@ -423,25 +407,35 @@ replaceShopItems toMsg loot =
}
fetchSession =
send : { method : String, path : String, decoder : Decoder a } -> Task Http.Error a
send { method, path, decoder } =
Http.task
{ method = "GET"
, url = "http://localhost:8088/session"
{ method = method
, url = "http://localhost:8088/" ++ path
, headers = []
, body = Http.emptyBody
, resolver = Http.stringResolver <| handleJsonResponse Api.Player.playerDecoder
, resolver = Http.stringResolver <| handleJsonResponse decoder
, timeout = Nothing
}
fetchSession =
send { method = "GET", path = "session", decoder = Api.Player.playerDecoder }
getLoot id =
Http.task
send
{ method = "GET"
, url = "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/loot"
, headers = []
, body = Http.emptyBody
, resolver = Http.stringResolver <| handleJsonResponse (valueDecoder lootDecoder)
, timeout = Nothing
, path = "api/players/" ++ String.fromInt id ++ "/loot"
, decoder = valueDecoder lootDecoder
}
getClaims id =
send
{ method = "GET"
, path = "api/players/" ++ String.fromInt id ++ "/claims"
, decoder = valueDecoder (D.list claimDecoder)
}

89
src/Page.elm
View File

@@ -82,8 +82,8 @@ view page =
case maybeSession page of
Just session ->
case Session.user session of
Session.Player player _ _ ->
player.name
Session.Player data ->
data.player.name
Session.Admin ->
"Administration"
@@ -95,13 +95,13 @@ view page =
case maybeSession page of
Just session ->
case Session.user session of
Session.Player player _ _ ->
Session.Player data ->
let
linkWithGem =
navLink "fas fa-gem"
in
[ navLink "fas fa-store-alt" "Marchand" "/marchand"
, if player.id /= 0 then
, if data.player.id /= 0 then
linkWithGem "Coffre de groupe" "/coffre"
else
@@ -144,12 +144,13 @@ viewSessionBar session controls =
Nothing ->
[ text "" ]
Just (Session.Player player wealth _) ->
Wealth.view player.wealth wealth
++ (if player.debt > 0 then
Just (Session.Player data) ->
-- TODO: Urgh ! When will this Wealth.Model move out of session !
Wealth.view data.player.wealth data.wealth
++ (if data.player.debt > 0 then
[ div [ class "level-item" ]
[ p [ class "heading is-size-4 has-text-danger" ]
[ text ("Dette : " ++ String.fromInt player.debt ++ "po") ]
[ text ("Dette : " ++ String.fromInt data.player.debt ++ "po") ]
]
]
@@ -222,6 +223,25 @@ map func page =
page
-- Restores the page after an action has be resolved (either success or error)
closeAction ( page, cmd ) =
case page of
Dashboard home ->
( page, cmd )
GroupChest chest ->
( GroupChest (GroupChest.refresh chest), cmd )
Shop shop ->
( page, cmd )
_ ->
( page, cmd )
update msg page =
case ( msg, page, maybeSession page ) of
-- Dashboard page
@@ -240,6 +260,7 @@ update msg page =
-- Group chest
( GotGroupChestMsg (GroupChest.Api apiMsg), GroupChest _, _ ) ->
update (ApiMsg apiMsg) page
|> closeAction
( GotGroupChestMsg subMsg, GroupChest chest, _ ) ->
GroupChest.update subMsg chest
@@ -266,16 +287,16 @@ update msg page =
Session.wealth session
in
case Session.user session of
Session.Player player aModel _ ->
Session.Player data ->
let
( newWealth, maybeEdit ) =
Wealth.update wealthMsg aModel
Wealth.update wealthMsg data.wealth
in
( map (Session.updateWealth newWealth) page
, case maybeEdit of
Just amount ->
Api.confirmAction
(String.fromInt (.id player))
(String.fromInt (.id data.player))
(Api.WealthPayload amount)
|> Cmd.map ApiMsg
@@ -346,44 +367,46 @@ applyUpdate u user =
in
{- Note: DbUpdates always refer to the active player -}
case user of
Session.Player player wealthModel loot ->
Session.Player data ->
case u of
Api.ItemRemoved item ->
Session.Player player wealthModel <|
List.filter
(\i -> i.id /= item.id)
loot
Session.Player
{ data
| loot =
List.filter
(\i -> i.id /= item.id)
data.loot
}
Api.ItemAdded item ->
Session.Player player wealthModel (item :: loot)
Session.Player { data | loot = item :: data.loot }
Api.WealthUpdated diff ->
let
player =
data.player
wealth =
player.wealth
_ =
Debug.log "updatePlayerWealth" diff
in
Session.Player
{ player
| wealth =
Api.Player.Wealth
(wealth.cp + diff.cp)
(wealth.sp + diff.sp)
(wealth.gp + diff.gp)
(wealth.pp + diff.pp)
{ data
| player =
{ player
| wealth =
Api.Player.Wealth
(wealth.cp + diff.cp)
(wealth.sp + diff.sp)
(wealth.gp + diff.gp)
(wealth.pp + diff.pp)
}
}
wealthModel
loot
Api.ClaimAdded claim ->
-- { model | claims = claim :: model.claims }
user
Session.Player { data | claims = claim :: data.claims }
Api.ClaimRemoved claim ->
-- { model | claims = List.filter (\c -> c.id /= claim.id) model.claims }
user
Session.Player { data | claims = List.filter (\c -> c.id /= claim.id) data.claims }
Session.Admin ->
user

19
src/Page/Chest.elm
View File

@@ -1,4 +1,4 @@
module Page.Chest exposing (Chest, Msg, confirmAdd, confirmBuy, confirmGrab, confirmSell, init, initCreate, initSelection, update, view)
module Page.Chest exposing (Chest, Msg, confirmAdd, confirmBuy, confirmGrab, confirmSell, init, initCreate, initSelection, show, update, view)
import Api exposing (Item, Loot)
import Html exposing (..)
@@ -27,7 +27,7 @@ type alias RowRenderer msg =
type Chest
= View
= View (Item -> Html Never)
| Selection Selection.Model
| Create NewFromInventory.Model
@@ -46,22 +46,27 @@ type Chest
init =
View
View Table.name
show : Table.ItemRenderer Item Never -> Chest
show renderItem =
View <| Table.renderRowLevel renderItem (\_ -> [])
initCreate =
Create NewFromInventory.init
initSelection =
Selection Selection.init
initSelection maybeInitial =
Selection <| Selection.init maybeInitial
view : Chest -> Loot -> Html Msg
view model loot =
case model of
View ->
Table.view Table.name loot
View renderItem ->
Table.view renderItem loot
|> Html.map GotViewMsg
Selection subModel ->

61
src/Page/Chest.elm.old
View File

@@ -1076,66 +1076,7 @@ update msg model =
Just <|
Api.AddPayload
(Maybe.withDefault
"nouveau loot"
model.state.sourceName
)
(selectContent model)
Buy ->
let
modList =
List.map
(\item ->
Dict.get item.id model.state.priceModifiers
|> Maybe.map (\i -> toFloatingMod i)
)
items
in
Just <| Api.BuyPayload items Nothing modList
Sell ->
let
modList =
List.map
(\item ->
Dict.get item.id model.state.priceModifiers
|> Maybe.map (\i -> toFloatingMod i)
)
items
in
Just <| Api.SellPayload items Nothing modList []
Grab ->
Just <| Api.GrabPayload items
View ->
Nothing
in
( model
, case maybeData of
Just data ->
Cmd.map ApiMsg <|
Api.confirmAction
(String.fromInt model.state.player.id)
data
Nothing ->
Cmd.none
)
ClearNotification ->
( setNotification Nothing model, Cmd.none )
SwitchSelectionState id ->
( { model | selection = switchSelectionState id model.selection }, Cmd.none )
SetSelection new ->
( { model | selection = new }, Cmd.none )
SearchTextChanged search ->
( { model | searchText = search }, Cmd.none )
GotClaims (Ok claims) ->
Claims (Ok claims) ->
( { model | claims = claims }, Cmd.none )
GotClaims (Err error) ->

13
src/Page/Chest/Selection.elm
View File

@@ -21,8 +21,17 @@ type Model
= Model Selection (Data Int)
init =
Model Set.empty Dict.empty
init : Maybe (List Int) -> Model
init maybeInitial =
Model
(case maybeInitial of
Just initial ->
Set.fromList initial
Nothing ->
Set.empty
)
Dict.empty
view : Model -> Loot -> Html Msg

32
src/Page/Dashboard.elm
View File

@@ -61,10 +61,10 @@ init session =
, Player.list (AdminViewer << GotPlayers)
)
Session.Player player wealth loot ->
Session.Player data ->
( Player <|
PlayerConfig session
(if player.id == 0 then
(if data.player.id == 0 then
-- TODO: render claimed items
GroupChest Chest.init
@@ -92,7 +92,7 @@ view model =
case model of
Player (PlayerConfig session mode) ->
case Session.user session of
Session.Player player _ loot ->
Session.Player data ->
Tuple.mapBoth
(Html.map PlayerViewer)
(List.map (Html.map PlayerViewer))
@@ -100,17 +100,17 @@ view model =
case mode of
PlayerChest chest ->
( modeButton "Vendre" IntoSell
, [ Html.map GotChestMsg <| Chest.view chest loot ]
, [ Html.map GotChestMsg <| Chest.view chest data.loot ]
)
GroupChest chest ->
( buttons [ modeButton "Vendre" IntoSell, modeButton "Ajouter" IntoAdd ]
, [ Html.map GotChestMsg <| Chest.view chest loot ]
, [ Html.map GotChestMsg <| Chest.view chest data.loot ]
)
Sell chest ->
( buttons [ modeButton "Ok" ConfirmSell, modeButton "Annuler" IntoView ]
, [ Html.map GotChestMsg <| Chest.view chest loot ]
, [ Html.map GotChestMsg <| Chest.view chest data.loot ]
)
Add chest ->
@@ -262,9 +262,17 @@ update msg model =
( model
, Cmd.map Api <|
case Session.user session of
Session.Player player _ loot ->
Session.Player data ->
-- TODO: handle list of players when Viewer is group
mapChest (\chest -> Chest.confirmSell player.id chest loot []) mode
mapChest
(\chest ->
Chest.confirmSell
data.player.id
chest
data.loot
[]
)
mode
_ ->
Cmd.none
@@ -274,7 +282,7 @@ update msg model =
( model
, Cmd.map Api <|
case Session.user session of
Session.Player player _ _ ->
Session.Player _ ->
let
sourceName =
"nouveau loot #1"
@@ -294,7 +302,7 @@ update msg model =
(Cmd.map GotChestMsg)
IntoSell ->
( Player (PlayerConfig session (Sell Chest.initSelection)), Cmd.none )
( Player (PlayerConfig session (Sell <| Chest.initSelection Nothing)), Cmd.none )
IntoAdd ->
( Player (PlayerConfig session (Add Chest.initCreate)), Cmd.none )
@@ -303,8 +311,8 @@ update msg model =
let
userChest =
case Session.user session of
Session.Player player _ _ ->
if player.id == 0 then
Session.Player data ->
if data.player.id == 0 then
GroupChest
else

100
src/Page/GroupChest.elm
View File

@@ -1,11 +1,12 @@
module Page.GroupChest exposing (Model, Msg(..), init, update, view)
module Page.GroupChest exposing (Model, Msg(..), init, refresh, 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 Session exposing (Session, User(..))
import Set
import Table
@@ -36,8 +37,22 @@ type State
| Loaded Loot
getClaimsFromSession session =
case Session.user session of
Session.Player data ->
if data.player.id /= 0 then
data.claims
-- TODO: The group and admin case should be impossible !
else
[]
Session.Admin ->
[]
init session =
( Model session Loading (View Chest.init), Cmd.map Internal <| Api.fetchLoot GotLoot Api.OfGroup )
( Model session Loading (View <| showClaims (getClaimsFromSession session)), Cmd.map Internal <| Api.fetchLoot GotLoot Api.OfGroup )
view : Model -> ( Html Msg, List (Html Msg) )
@@ -55,30 +70,29 @@ view model =
Loaded loot ->
( Html.map Internal <|
let
( isPlayer, isGroup ) =
case Session.user model.session of
Session.Admin ->
( False, False )
Session.Player data ->
( True, data.player.id == 0 )
in
case model.mode of
View _ ->
case Session.user model.session of
Session.Admin ->
text ""
if isPlayer && not isGroup then
button [ class "button", onClick IntoGrab ] [ text "Demander" ]
Session.Player p _ _ ->
if p.id == 0 then
text ""
else
button [ class "button", onClick IntoGrab ] [ text "Demander" ]
else
text ""
Grab _ ->
case Session.user model.session of
Session.Admin ->
text ""
if isPlayer && not isGroup then
button [ class "button", onClick ConfirmGrab ] [ text "Valider" ]
Session.Player p _ _ ->
if p.id == 0 then
text ""
else
button [ class "button", onClick ConfirmGrab ] [ text "Valider" ]
else
text ""
, [ mapChest (\c -> Chest.view c loot) model.mode
|> Html.map (Internal << GotChestMsg)
]
@@ -98,6 +112,31 @@ type InnerMsg
| ConfirmGrab
showClaims claims =
let
itemClaimed item =
List.any (\c -> c.loot_id == item.id) claims
in
Chest.show
(\item ->
[ p []
[ text <|
(if itemClaimed item then
"C"
else
""
)
++ item.name
]
]
)
refresh model =
{ model | mode = View <| showClaims (getClaimsFromSession model.session) }
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
@@ -106,10 +145,10 @@ update msg model =
Internal ConfirmGrab ->
case ( Session.user model.session, model.loot, model.mode ) of
( Session.Player player _ _, Loaded loot, Grab chest ) ->
( { model | mode = View Chest.init }
( Session.Player data, Loaded loot, Grab chest ) ->
( model
, Chest.confirmGrab
player.id
data.player.id
loot
chest
|> Cmd.map Api
@@ -131,10 +170,19 @@ update msg model =
|> updateChest model
IntoGrab ->
( { model | mode = Grab Chest.initSelection }, Cmd.none )
let
claimedIds =
case Session.user model.session of
Player data ->
List.map .loot_id data.claims
Admin ->
[]
in
( { model | mode = Grab <| Chest.initSelection (Just claimedIds) }, Cmd.none )
IntoView ->
( { model | mode = View Chest.init }, Cmd.none )
( refresh model, Cmd.none )
_ ->
( model, Cmd.none )

12
src/Page/Shop.elm
View File

@@ -82,10 +82,10 @@ view model =
( View chest, Session.Admin ) ->
btn "Remplacer" (Internal IntoRefresh)
( View chest, Session.Player _ _ _ ) ->
( View chest, Session.Player _ ) ->
btn "Acheter" (Internal IntoBuy)
( Buy chest, Session.Player p _ _ ) ->
( Buy chest, Session.Player _ ) ->
buttons [ btn "Ok" (Internal ConfirmBuy), btn "Annuler" (Internal IntoView) ]
( Refresh chest, Session.Admin ) ->
@@ -146,10 +146,10 @@ update msg model =
case msg of
Internal ConfirmBuy ->
case ( Session.user (getSession model), model.loot, model.chest ) of
( Session.Player player _ _, Loaded loot, Buy chest ) ->
( Session.Player data, Loaded loot, Buy chest ) ->
( model
, Chest.confirmBuy
player.id
data.player.id
chest
loot
|> Cmd.map Api
@@ -209,8 +209,8 @@ update msg model =
-- Buy mode
IntoBuy ->
case Session.user (getSession model) of
Session.Player _ _ _ ->
( { model | chest = Buy Chest.initSelection }, Cmd.none )
Session.Player _ ->
( { model | chest = Buy <| Chest.initSelection Nothing }, Cmd.none )
_ ->
( model, Cmd.none )

55
src/Session.elm
View File

@@ -1,6 +1,6 @@
module Session exposing (Session, User(..), error, getSession, init, key, notification, updateNotifications, updateUser, updateWealth, user, wealth)
import Api exposing (Loot)
import Api exposing (Claims, Loot)
import Api.Player as Player exposing (Player)
import Browser.Navigation as Nav
import Http
@@ -10,7 +10,12 @@ import Wealth
type User
= Player Player Wealth.Model Loot
= Player
{ player : Player
, wealth : Wealth.Model
, loot : Loot
, claims : Claims
}
| Admin
@@ -25,17 +30,22 @@ type Session
init : (Result String Session -> msg) -> Nav.Key -> Cmd msg
init toMsg navKey =
let
toSession : Result String ( Player, Loot ) -> msg
toSession : Result String ( Player, Loot, Claims ) -> msg
toSession result =
case result of
Ok ( player, loot ) ->
Ok ( player, loot, claims ) ->
toMsg <|
Ok
(Session
navKey
( Nothing, Nothing )
<|
Player player Wealth.init loot
(Player
{ player = player
, wealth = Wealth.init
, loot = loot
, claims = claims
}
)
)
Err e ->
@@ -44,10 +54,11 @@ init toMsg navKey =
Task.attempt toSession initFullSession
initFullSession : Task String ( Player, Loot )
initFullSession : Task String ( Player, Loot, Claims )
initFullSession =
Api.fetchSession
|> Task.andThen wrapLoot
|> Task.andThen wrapClaims
|> Task.mapError Api.printError
@@ -57,6 +68,12 @@ wrapLoot player =
|> Task.andThen (\loot -> Task.succeed ( player, loot ))
wrapClaims : ( Player, Loot ) -> Task Http.Error ( Player, Loot, Claims )
wrapClaims ( player, loot ) =
Api.getClaims player.id
|> Task.andThen (\claims -> Task.succeed ( player, loot, claims ))
getSession : { r | session : Session } -> Session
getSession r =
.session r
@@ -92,8 +109,8 @@ updateUser newUser model =
wealth : Session -> Maybe Wealth.Model
wealth session =
case user session of
Player _ model _ ->
Just model
Player data ->
Just data.wealth
Admin ->
Nothing
@@ -105,8 +122,8 @@ setWealth wealthModel session =
session
in
case isUser of
Player p _ loot ->
Session navKey notifications (Player p wealthModel loot)
Player data ->
Session navKey notifications (Player { data | wealth = wealthModel })
Admin ->
Session navKey notifications Admin
@@ -119,13 +136,18 @@ updateWealth newWealthModel model =
model
in
case loggedUser of
Player player _ loot ->
Session navKey notifications (Player player newWealthModel loot)
Player data ->
Session navKey notifications (Player { data | wealth = newWealthModel })
Admin ->
Session navKey notifications Admin
-- Retrieve the notification or Nothing
notification : Session -> Maybe String
notification session =
let
(Session _ ( maybeNotification, _ ) _) =
@@ -134,6 +156,11 @@ notification session =
maybeNotification
-- Retrieve the error or Nothing
error : Session -> Maybe String
error session =
let
(Session _ ( _, maybeError ) _) =
@@ -142,6 +169,7 @@ error session =
maybeError
setError : Maybe String -> Session -> Session
setError maybeError session =
let
(Session navKey ( maybeNotification, _ ) loggedUser) =
@@ -150,6 +178,7 @@ setError maybeError session =
Session navKey ( maybeNotification, maybeError ) loggedUser
updateNotifications : Notifications -> Session -> Session
updateNotifications notifications session =
let
(Session navKey _ loggedUser) =

2
src/Table.elm
View File

@@ -1,4 +1,4 @@
module Table exposing (name, renderRowLevel, renderSelectableRow, view)
module Table exposing (ItemRenderer, name, renderRowLevel, renderSelectableRow, view)
import Html exposing (..)
import Html.Attributes exposing (..)