diff --git a/src/Main.elm b/src/Main.elm index 13f0a0a..cfb6744 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -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 diff --git a/src/Page.elm b/src/Page.elm index 4361ea9..32de1e2 100644 --- a/src/Page.elm +++ b/src/Page.elm @@ -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" <| - List.foldl applyUpdate (Session.user session) updates + 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 ) diff --git a/src/Page/Chest.elm b/src/Page/Chest.elm index 685bcdc..9e827c2 100644 --- a/src/Page/Chest.elm +++ b/src/Page/Chest.elm @@ -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 diff --git a/src/Page/Dashboard.elm b/src/Page/Dashboard.elm index 502294a..d592424 100644 --- a/src/Page/Dashboard.elm +++ b/src/Page/Dashboard.elm @@ -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 ) diff --git a/src/Page/GroupChest.elm b/src/Page/GroupChest.elm index f3082b1..90654c7 100644 --- a/src/Page/GroupChest.elm +++ b/src/Page/GroupChest.elm @@ -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 - Session.Admin -> - text "" + 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" ] + Session.Player p _ _ -> + if p.id == 0 then + text "" - else - button [ class "button" ] [ text "Demander" ] - , [ Table.view Table.name loot ] + else + 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 - GotLoot _ (Ok loot) -> - ( { model | state = View loot }, Cmd.none ) + Api apiMsg -> + ( model, Cmd.none ) - GotLoot _ (Err _) -> - ( { model | state = LoadError "Le chargement a échoué" }, 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 | loot = Loaded loot }, Cmd.none ) + + GotLoot _ (Err _) -> + ( { 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 + ) diff --git a/src/Session.elm b/src/Session.elm index 1d6ec8b..8cadb90 100644 --- a/src/Session.elm +++ b/src/Session.elm @@ -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