From 976fbe6b4b43279cada425cd24acf4d8cf5ffecb Mon Sep 17 00:00:00 2001 From: Artus Date: Mon, 2 Dec 2019 15:58:26 +0100 Subject: [PATCH] adds claims for group chest view --- src/Api.elm | 58 +++++++++----------- src/Page.elm | 89 +++++++++++++++++++------------ src/Page/Chest.elm | 19 ++++--- src/Page/Chest.elm.old | 61 +-------------------- src/Page/Chest/Selection.elm | 13 ++++- src/Page/Dashboard.elm | 32 ++++++----- src/Page/GroupChest.elm | 100 ++++++++++++++++++++++++++--------- src/Page/Shop.elm | 12 ++--- src/Session.elm | 55 ++++++++++++++----- src/Table.elm | 2 +- 10 files changed, 249 insertions(+), 192 deletions(-) diff --git a/src/Api.elm b/src/Api.elm index 714e57b..2396df0 100644 --- a/src/Api.elm +++ b/src/Api.elm @@ -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) } diff --git a/src/Page.elm b/src/Page.elm index 32de1e2..b4a00f3 100644 --- a/src/Page.elm +++ b/src/Page.elm @@ -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 diff --git a/src/Page/Chest.elm b/src/Page/Chest.elm index 9e827c2..76c1a1f 100644 --- a/src/Page/Chest.elm +++ b/src/Page/Chest.elm @@ -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 -> diff --git a/src/Page/Chest.elm.old b/src/Page/Chest.elm.old index eed3302..4d811f7 100644 --- a/src/Page/Chest.elm.old +++ b/src/Page/Chest.elm.old @@ -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) -> diff --git a/src/Page/Chest/Selection.elm b/src/Page/Chest/Selection.elm index 8a27b49..6c95c2d 100644 --- a/src/Page/Chest/Selection.elm +++ b/src/Page/Chest/Selection.elm @@ -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 diff --git a/src/Page/Dashboard.elm b/src/Page/Dashboard.elm index d592424..8bc0efa 100644 --- a/src/Page/Dashboard.elm +++ b/src/Page/Dashboard.elm @@ -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 diff --git a/src/Page/GroupChest.elm b/src/Page/GroupChest.elm index 90654c7..96b3965 100644 --- a/src/Page/GroupChest.elm +++ b/src/Page/GroupChest.elm @@ -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 ) diff --git a/src/Page/Shop.elm b/src/Page/Shop.elm index b78ebb4..40bc805 100644 --- a/src/Page/Shop.elm +++ b/src/Page/Shop.elm @@ -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 ) diff --git a/src/Session.elm b/src/Session.elm index 8cadb90..ab48312 100644 --- a/src/Session.elm +++ b/src/Session.elm @@ -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) = diff --git a/src/Table.elm b/src/Table.elm index c29f7ea..75d1f8d 100644 --- a/src/Table.elm +++ b/src/Table.elm @@ -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 (..)