moves Modes inside Chest module

src/Api.elm

@@ -432,9 +432,17 @@ getLoot id =
 
 
 getClaims id =
+    let
+        path =
+            if id == 0 then
+                "api/claims"
+
+            else
+                "api/players/" ++ String.fromInt id ++ "/claims"
+    in
     send
         { method = "GET"
-        , path = "api/players/" ++ String.fromInt id ++ "/claims"
+        , path = path
         , decoder = valueDecoder (D.list claimDecoder)
         }
 

src/Main.elm

@@ -7,10 +7,8 @@ import Html.Attributes exposing (..)
 import Html.Events exposing (..)
 import Json.Encode as E
 import Page exposing (Page)
-import Page.Chest as Chest exposing (Msg)
 import Route exposing (..)
 import Session exposing (..)
-import Set exposing (Set)
 import Svg.Attributes
 import Url
 import Utils exposing (..)
@@ -100,7 +98,7 @@ navLink icon linkText url =
 
 viewHeaderBar : String -> List (Html Msg) -> Navbar -> Html Msg
 viewHeaderBar navbarTitle navbarLinks navbar =
-    nav [ class "navbar", class "is-transparent" ]
+    nav [ class "navbar container is-transparent is-spaced " ]
         [ div [ class "navbar-brand" ]
             [ a [ class "navbar-item", href "/" ]
                 [ renderIcon { icon = "fab fa-d-and-d", size = "medium", ratio = "2x" }
@@ -164,21 +162,21 @@ update msg model =
         ( UrlChanged url, from ) ->
             -- Handle routing according to current page
             case Route.fromUrl url of
-                Just (Route.Home Route.MerchantLoot) ->
+                Just Route.Merchant ->
                     let
                         ( shopPage, cmd ) =
                             Page.gotoShop from
                     in
                     ( model |> setPage shopPage, Cmd.map PageMsg cmd )
 
-                Just (Route.Home Route.PlayerLoot) ->
+                Just Route.Home ->
                     let
                         ( shopPage, cmd ) =
                             Page.gotoHome from
                     in
                     ( model |> setPage shopPage, Cmd.map PageMsg cmd )
 
-                Just (Route.Home Route.GroupLoot) ->
+                Just Route.GroupChest ->
                     let
                         ( page, cmd ) =
                             Page.gotoGroupChest from

src/Page.elm

@@ -5,16 +5,17 @@ import Api.Player
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
-import Page.Dashboard as Dashboard
+import Page.Dashboard as Home
 import Page.GroupChest as GroupChest
 import Page.Shop as Shop
+import Route
 import Session exposing (Session)
 import Utils exposing (renderIcon)
 import Wealth
 
 
 type Page
-    = Dashboard Dashboard.Model
+    = Home Home.Model
     | GroupChest GroupChest.Model
     | Shop Shop.Model
     | About
@@ -25,14 +26,16 @@ init =
     Loading
 
 
-mapMsg toMsg =
+mapPageMsg toMsg ( controls, content ) =
-    List.map (Html.map toMsg)
+    ( Html.map toMsg controls
+    , List.map (Html.map toMsg) content
+    )
 
 
 maybeSession page =
     case page of
-        Dashboard model ->
+        Home model ->
-            Just <| Dashboard.getSession model
+            Just <| Home.getSession model
 
         GroupChest model ->
             Just <| Session.getSession model
@@ -48,35 +51,37 @@ view page =
     let
         ( title, ( controls, content ) ) =
             case page of
-                Dashboard home ->
+                Home home ->
                     ( "Lootalot"
-                    , Dashboard.view home
+                    , Home.view home
-                        |> Tuple.mapBoth
+                        |> mapPageMsg GotHomeMsg
-                            (Html.map GotDashboardMsg)
-                            (mapMsg GotDashboardMsg)
                     )
 
                 GroupChest chest ->
                     ( "Lootalot"
                     , GroupChest.view chest
-                        |> Tuple.mapBoth
+                        |> mapPageMsg GotGroupChestMsg
-                            (Html.map GotGroupChestMsg)
-                            (mapMsg GotGroupChestMsg)
                     )
 
                 Shop shop ->
                     ( "Marchand"
                     , Shop.view shop
-                        |> Tuple.mapBoth
+                        |> mapPageMsg GotShopMsg
-                            (Html.map GotShopMsg)
-                            (mapMsg GotShopMsg)
                     )
 
                 About ->
                     ( "Loot-a-lot", ( text "", [ p [] [ text "A propos" ] ] ) )
 
                 Loading ->
-                    ( "Loot-a-lot", ( text "", [ p [] [ text "Chargement" ] ] ) )
+                    ( "Loot-a-lot"
+                    , ( text ""
+                      , [ div [ class "hero" ]
+                            [ div [ class "hero-body" ]
+                                [ p [] [ text "Chargement" ] ]
+                            ]
+                        ]
+                      )
+                    )
 
         navbarTitle =
             case maybeSession page of
@@ -96,20 +101,16 @@ view page =
                 Just session ->
                     case Session.user session of
                         Session.Player data ->
-                            let
+                            [ navLink "fas fa-store-alt" Route.Merchant page
-                                linkWithGem =
-                                    navLink "fas fa-gem"
-                            in
-                            [ navLink "fas fa-store-alt" "Marchand" "/marchand"
                             , if data.player.id /= 0 then
-                                linkWithGem "Coffre de groupe" "/coffre"
+                                navLink "fas fa-gem" Route.GroupChest page
 
                               else
                                 text ""
                             ]
 
                         Session.Admin ->
-                            [ navLink "fas fa-store-alt" "Marchand" "/marchand" ]
+                            [ navLink "fas fa-store-alt" Route.Merchant page ]
 
                 Nothing ->
                     []
@@ -118,25 +119,44 @@ view page =
     , { title = navbarTitle, links = navbarLinks }
     , [ div [ class "container" ] <|
             viewSessionBar (maybeSession page) [ controls ]
-                :: (case Maybe.map Session.notification (maybeSession page) of
+                :: div [ class "section" ]
-                        Just (Just notify) ->
+                    [ case Maybe.map Session.notification (maybeSession page) of
-                            div [ class "notification is-success" ] [ text notify ]
+                        Just (Just t) ->
+                            viewNotification NotifySuccess t
 
                         _ ->
                             text ""
-                   )
+                    , case Maybe.map Session.error (maybeSession page) of
-                :: (case Maybe.map Session.error (maybeSession page) of
+                        Just (Just t) ->
-                        Just (Just notify) ->
+                            viewNotification NotifyError t
-                            div [ class "notification is-danger" ] [ text notify ]
 
                         _ ->
                             text ""
-                   )
+                    ]
                 :: content
       ]
     )
 
 
+type NotificationKind
+    = NotifySuccess
+    | NotifyError
+
+
+viewNotification kind content =
+    let
+        className =
+            case kind of
+                NotifySuccess ->
+                    "is-success"
+
+                NotifyError ->
+                    "is-danger"
+    in
+    div [ class ("notification " ++ className) ]
+        [ text content ]
+
+
 viewSessionBar session controls =
     let
         user =
@@ -149,8 +169,10 @@ viewSessionBar session controls =
                     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" ]
+                                    [ p [ class "has-text-right has-text-danger" ]
-                                        [ text ("Dette : " ++ String.fromInt data.player.debt ++ "po") ]
+                                        [ strong [ class "heading is-marginless has-text-danger" ] [ text "Dette" ]
+                                        , span [ class <| "is-size-4" ] [ text (String.fromInt data.player.debt ++ "po") ]
+                                        ]
                                     ]
                                 ]
 
@@ -179,10 +201,42 @@ renderLevel left right =
 -- PLAYER BAR
 
 
-navLink icon linkText url =
+navLink icon route page =
-    a [ class "navbar-item", href url ]
+    let
+        ( link, url ) =
+            case route of
+                Route.Merchant ->
+                    ( "Marchand", "/marchand" )
+
+                Route.GroupChest ->
+                    ( "Coffre de groupe", "/groupe" )
+
+                Route.Home ->
+                    ( "Home", "/" )
+
+                Route.About ->
+                    ( "About", "/" )
+
+        isActive =
+            case ( route, page ) of
+                ( Route.Merchant, Shop _ ) ->
+                    True
+
+                ( Route.GroupChest, GroupChest _ ) ->
+                    True
+
+                ( Route.Home, Home _ ) ->
+                    True
+
+                ( Route.About, About ) ->
+                    True
+
+                _ ->
+                    False
+    in
+    a [ class "navbar-item", classList [ ( "is-active", isActive ) ], href url ]
         [ renderIcon { icon = icon, ratio = "1x", size = "medium" }
-        , span [] [ text linkText ]
+        , span [] [ text link ]
         ]
 
 
@@ -194,7 +248,7 @@ navLink icon linkText url =
 type PageMsg
     = ApiMsg Api.Msg
     | GotGroupChestMsg GroupChest.Msg
-    | GotDashboardMsg Dashboard.Msg
+    | GotHomeMsg Home.Msg
     | GotShopMsg Shop.Msg
     | Wealth Wealth.Msg
 
@@ -210,8 +264,8 @@ map func page =
 
         Just session ->
             case page of
-                Dashboard model ->
+                Home model ->
-                    Dashboard <| Dashboard.updateSession model (func session)
+                    Home <| Home.updateSession model (func session)
 
                 GroupChest model ->
                     GroupChest { model | session = func session }
@@ -229,14 +283,14 @@ map func page =
 
 closeAction ( page, cmd ) =
     case page of
-        Dashboard home ->
+        Home from ->
-            ( page, cmd )
+            gotoHome page
 
-        GroupChest chest ->
+        GroupChest from ->
-            ( GroupChest (GroupChest.refresh chest), cmd )
+            gotoGroupChest page
 
-        Shop shop ->
+        Shop from ->
-            ( page, cmd )
+            gotoShop page
 
         _ ->
             ( page, cmd )
@@ -244,17 +298,18 @@ closeAction ( page, cmd ) =
 
 update msg page =
     case ( msg, page, maybeSession page ) of
-        -- Dashboard page
+        -- Home page
         -- Capture API messages
-        ( GotDashboardMsg (Dashboard.Api apiMsg), Dashboard home, _ ) ->
+        ( GotHomeMsg (Home.Api apiMsg), Home home, _ ) ->
             update (ApiMsg apiMsg) page
+                |> closeAction
 
         -- Relay others
-        ( GotDashboardMsg subMsg, Dashboard home, _ ) ->
+        ( GotHomeMsg subMsg, Home home, _ ) ->
-            Dashboard.update subMsg home
+            Home.update subMsg home
-                |> updatePage Dashboard GotDashboardMsg
+                |> updatePage Home GotHomeMsg
 
-        ( GotDashboardMsg _, _, _ ) ->
+        ( GotHomeMsg _, _, _ ) ->
             ( page, Cmd.none )
 
         -- Group chest
@@ -272,6 +327,7 @@ update msg page =
         -- Shop page
         ( GotShopMsg (Shop.Api apiMsg), Shop shop, _ ) ->
             update (ApiMsg apiMsg) page
+                |> closeAction
 
         ( GotShopMsg subMsg, Shop shop, _ ) ->
             Shop.update subMsg shop
@@ -417,8 +473,8 @@ applyUpdate u user =
 
 
 initHome session =
-    Dashboard.init session
+    Home.init session
-        |> updatePage Dashboard GotDashboardMsg
+        |> updatePage Home GotHomeMsg
 
 
 gotoHome page =
@@ -427,8 +483,8 @@ gotoHome page =
             ( page, Cmd.none )
 
         Just session ->
-            Dashboard.init session
+            Home.init session
-                |> updatePage Dashboard GotDashboardMsg
+                |> updatePage Home GotHomeMsg
 
 
 gotoShop page =

src/Page/Chest.elm

@@ -1,10 +1,11 @@
-module Page.Chest exposing (Chest, Msg, confirmAdd, confirmBuy, confirmGrab, confirmSell, init, initCreate, initSelection, show, update, view)
+module Page.Chest exposing (..)
 
-import Api exposing (Item, Loot)
+import Api exposing (Claims, Item, Loot)
 import Html exposing (..)
 import Page.Chest.NewFromInventory as NewFromInventory
 import Page.Chest.Selection as Selection
 import Table
+import Utils
 
 
 type alias RowRenderer msg =
@@ -27,21 +28,40 @@ type alias RowRenderer msg =
 
 
 type Chest
-    = View (Item -> Html Never)
+    = New NewFromInventory.Model
-    | Selection Selection.Model
+    | View (Item -> Html Never)
-    | Create NewFromInventory.Model
+    | Buy Selection.Model
+    | Sell Selection.Model
+    | Claim Selection.Model
+
+
+type IntoMode
+    = IntoView
+    | IntoViewWithClaims Claims
+    | IntoAdd
+    | IntoBuy
+    | IntoSell
+    | IntoClaim Claims
 
 
 
 {-
 
-   View : RowRenderer -> Chest.View
 
-   Selection : RowRenderer -> { confirm: Cmd msg, cancel: Cmd msg } -> Chest.Selection
+   Dashboard :
-
+     * ViewWithClaims (group)
-   NewFromInventory : RowRenderer -> { confirm: Cmd msg, cancel: Cmd msg } -> Chest.NewFromInventory
+     * View
+     * Add
+     * Sell
 
+   Shop :
+     * View
+     * Refresh
+     * Buy
 
+   GroupChest :
+     * ViewWithClaims
+     * Claim
 -}
 
 
@@ -49,19 +69,40 @@ init =
     View Table.name
 
 
-show : Table.ItemRenderer Item Never -> Chest
+intoMode : IntoMode -> Msg
-show renderItem =
+intoMode newMode =
+    IntoMode newMode
+
+
+new =
+    intoMode IntoAdd
+
+
+show =
+    intoMode IntoView
+
+
+showWithClaims claims =
+    intoMode (IntoViewWithClaims claims)
+
+
+buy =
+    intoMode IntoBuy
+
+
+sell =
+    intoMode IntoSell
+
+
+claim initialClaims =
+    intoMode (IntoClaim initialClaims)
+
+
+showWith : Table.ItemRenderer Item Never -> Chest
+showWith renderItem =
     View <| Table.renderRowLevel renderItem (\_ -> [])
 
 
-initCreate =
-    Create NewFromInventory.init
-
-
-initSelection maybeInitial =
-    Selection <| Selection.init maybeInitial
-
-
 view : Chest -> Loot -> Html Msg
 view model loot =
     case model of
@@ -69,31 +110,95 @@ view model loot =
             Table.view renderItem loot
                 |> Html.map GotViewMsg
 
-        Selection subModel ->
+        Buy subModel ->
             Selection.view subModel loot
                 |> Html.map GotSelectionMsg
 
-        Create subModel ->
+        Sell subModel ->
+            Selection.view subModel loot
+                |> Html.map GotSelectionMsg
+
+        New subModel ->
             NewFromInventory.view subModel
-                |> Html.map GotCreateMsg
+                |> Html.map GotNewMsg
+
+        Claim subModel ->
+            Selection.view subModel loot
+                |> Html.map GotSelectionMsg
 
 
 type Msg
-    = GotCreateMsg NewFromInventory.Msg
+    = GotNewMsg NewFromInventory.Msg
     | GotSelectionMsg Selection.Msg
     | GotViewMsg Never
+    | IntoMode IntoMode
 
 
 update : Msg -> Chest -> ( Chest, Cmd Msg )
 update msg model =
     case ( msg, model ) of
-        ( GotCreateMsg subMsg, Create subModel ) ->
+        ( GotNewMsg subMsg, New subModel ) ->
             NewFromInventory.update subMsg subModel
-                |> updateChest GotCreateMsg Create
+                |> updateChest GotNewMsg New
 
-        ( GotSelectionMsg subMsg, Selection subModel ) ->
+        ( GotNewMsg subMsg, _ ) ->
+            ( model, Cmd.none )
+
+        ( GotSelectionMsg subMsg, Buy subModel ) ->
             Selection.update subMsg subModel
-                |> updateChest GotSelectionMsg Selection
+                |> updateChest GotSelectionMsg Buy
+
+        ( GotSelectionMsg subMsg, Sell subModel ) ->
+            Selection.update subMsg subModel
+                |> updateChest GotSelectionMsg Sell
+
+        ( GotSelectionMsg subMsg, Claim subModel ) ->
+            Selection.update subMsg subModel
+                |> updateChest GotSelectionMsg Claim
+
+        ( GotSelectionMsg subMsg, _ ) ->
+            ( model, Cmd.none )
+
+        ( IntoMode newMode, _ ) ->
+            case newMode of
+                IntoView ->
+                    ( View Table.name, Cmd.none )
+
+                IntoViewWithClaims claims ->
+                    let
+                        isClaimed item =
+                            List.any (\claim_ -> claim_.loot_id == item.id) claims
+
+                        renderItem item =
+                            [ if isClaimed item then
+                                Utils.renderIcon
+                                    { icon = "fas fa-praying-hands"
+                                    , size = "small"
+                                    , ratio = "1x"
+                                    }
+
+                              else
+                                text ""
+                            , p [] [ text item.name ]
+                            ]
+                    in
+                    ( View <| Table.renderRowLevel renderItem (\_ -> []), Cmd.none )
+
+                IntoBuy ->
+                    ( Buy <| Selection.init Nothing True, Cmd.none )
+
+                IntoSell ->
+                    ( Sell <| Selection.init Nothing True, Cmd.none )
+
+                IntoClaim claims ->
+                    let
+                        initialSelection =
+                            List.map .loot_id claims
+                    in
+                    ( Claim <| Selection.init (Just initialSelection) False, Cmd.none )
+
+                IntoAdd ->
+                    ( New NewFromInventory.init, Cmd.none )
 
         _ ->
             ( model, Cmd.none )
@@ -113,7 +218,7 @@ updateChest toMsg toChest ( model, cmd ) =
 confirmBuy : Int -> Chest -> Loot -> Cmd Api.Msg
 confirmBuy playerId model loot =
     case model of
-        Selection chest ->
+        Buy chest ->
             let
                 items =
                     Selection.selected chest loot
@@ -135,7 +240,7 @@ confirmBuy playerId model loot =
 confirmSell : Int -> Chest -> Loot -> List Int -> Cmd Api.Msg
 confirmSell playerId model loot players =
     case model of
-        Selection chest ->
+        Sell chest ->
             let
                 items =
                     Selection.selected chest loot
@@ -157,7 +262,7 @@ confirmSell playerId model loot players =
 confirmAdd : Int -> String -> Chest -> Cmd Api.Msg
 confirmAdd playerId sourceName model =
     case model of
-        Create chest ->
+        New chest ->
             let
                 items =
                     NewFromInventory.allLoot chest
@@ -176,7 +281,7 @@ confirmAdd playerId sourceName model =
 confirmGrab : Int -> Loot -> Chest -> Cmd Api.Msg
 confirmGrab playerId loot model =
     case model of
-        Selection chest ->
+        Claim chest ->
             let
                 items =
                     Selection.selected chest loot

src/Page/Chest/Selection.elm

@@ -13,16 +13,17 @@ type alias Selection =
     Set Int
 
 
-type alias Data a =
+type Data a
-    Dict Int a
+    = NoData
+    | Data (Dict Int a)
 
 
 type Model
     = Model Selection (Data Int)
 
 
-init : Maybe (List Int) -> Model
+init : Maybe (List Int) -> Bool -> Model
-init maybeInitial =
+init maybeInitial hasData =
     Model
         (case maybeInitial of
             Just initial ->
@@ -31,7 +32,13 @@ init maybeInitial =
             Nothing ->
                 Set.empty
         )
-        Dict.empty
+        (case hasData of
+            True ->
+                Data Dict.empty
+
+            False ->
+                NoData
+        )
 
 
 view : Model -> Loot -> Html Msg
@@ -40,17 +47,35 @@ view (Model selection data) loot =
         isSelected =
             itemInSelection selection
 
-        renderItem item =
+        renderRight item =
+            case data of
+                Data inner ->
                     let
                         maybeMod =
-                    Dict.get item.id data
+                            Dict.get item.id inner
                     in
+                    renderItemWithPrice .base_price isSelected maybeMod item
+
+                NoData ->
+                    []
+    in
+    Table.view
+        (Table.renderSelectableRow
+            (\item -> [ p [] [ text item.name ] ])
+            renderRight
+            (\item _ -> SwitchSelectionState item.id)
+            isSelected
+        )
+        loot
+
+
+renderItemWithPrice toPrice isSelected maybeMod item =
     [ viewPriceWithModApplied
         (Maybe.map (\i -> toFloatingMod i) maybeMod)
         (toFloat item.base_price)
     , if isSelected item then
         viewPriceModifier item.id <|
-                    case Dict.get item.id data of
+            case maybeMod of
                 Just mod ->
                     String.fromInt mod
 
@@ -60,15 +85,6 @@ view (Model selection data) loot =
       else
         text ""
     ]
-    in
-    Table.view
-        (Table.renderSelectableRow
-            (\item -> [ p [] [ text item.name ] ])
-            (\item -> renderItem item)
-            (\item _ -> SwitchSelectionState item.id)
-            isSelected
-        )
-        loot
 
 
 toFloatingMod : Int -> Float
@@ -126,13 +142,18 @@ selected (Model selection data) loot =
 
 modifiers : Model -> Loot -> List (Maybe Float)
 modifiers (Model selection data) items =
+    case data of
+        Data inner ->
             List.map
                 (\item ->
-            Dict.get item.id data
+                    Dict.get item.id inner
                         |> Maybe.map (\i -> toFloatingMod i)
                 )
                 items
 
+        NoData ->
+            []
+
 
 itemInSelection : Selection -> Item -> Bool
 itemInSelection selection item =
@@ -166,7 +187,10 @@ update : Msg -> Model -> ( Model, Cmd Msg )
 update msg (Model selection data) =
     case msg of
         PriceModifierChanged id value ->
-            ( Model selection
+            ( Model selection <|
+                case data of
+                    Data inner ->
+                        Data
                             (Dict.insert
                                 id
                                 (case String.toInt value of
@@ -176,8 +200,11 @@ update msg (Model selection data) =
                                     Nothing ->
                                         0
                                 )
-                    data
+                                inner
                             )
+
+                    NoData ->
+                        data
             , Cmd.none
             )
 

src/Page/Dashboard.elm

@@ -39,20 +39,13 @@ type alias NewPlayerForm =
 
 
 type PlayerConfig
-    = PlayerConfig Session Mode
+    = PlayerConfig Session Chest
 
 
 type AdminConfig
     = AdminConfig Session (List Player) NewPlayerForm
 
 
-type Mode
-    = PlayerChest Chest
-    | GroupChest Chest
-    | Sell Chest
-    | Add Chest
-
-
 init : Session -> ( Model, Cmd Msg )
 init session =
     case Session.user session of
@@ -66,10 +59,11 @@ init session =
                 PlayerConfig session
                     (if data.player.id == 0 then
                         -- TODO: render claimed items
-                        GroupChest Chest.init
+                        Chest.update (Chest.showWithClaims data.claims) Chest.init
+                            |> Tuple.first
 
                      else
-                        PlayerChest Chest.init
+                        Chest.init
                     )
             , Cmd.none
             )
@@ -90,32 +84,37 @@ buttons bs =
 view : Model -> ( Html Msg, List (Html Msg) )
 view model =
     case model of
-        Player (PlayerConfig session mode) ->
+        Player (PlayerConfig session chest) ->
             case Session.user session of
                 Session.Player data ->
-                    Tuple.mapBoth
+                    let
-                        (Html.map PlayerViewer)
+                        toShow =
-                        (List.map (Html.map PlayerViewer))
+                            case data.player.id of
-                    <|
+                                0 ->
-                        case mode of
+                                    GotChestMsg <| Chest.showWithClaims data.claims
-                            PlayerChest chest ->
-                                ( modeButton "Vendre" IntoSell
-                                , [ Html.map GotChestMsg <| Chest.view chest data.loot ]
-                                )
 
-                            GroupChest chest ->
+                                _ ->
-                                ( buttons [ modeButton "Vendre" IntoSell, modeButton "Ajouter" IntoAdd ]
+                                    GotChestMsg Chest.show
-                                , [ Html.map GotChestMsg <| Chest.view chest data.loot ]
+                    in
-                                )
+                    ( Html.map PlayerViewer <|
+                        case chest of
+                            Chest.View _ ->
+                                case data.player.id of
+                                    0 ->
+                                        buttons [ modeButton "Vendre" (GotChestMsg Chest.sell), modeButton "Ajouter" (GotChestMsg Chest.new) ]
 
-                            Sell chest ->
+                                    _ ->
-                                ( buttons [ modeButton "Ok" ConfirmSell, modeButton "Annuler" IntoView ]
+                                        modeButton "Vendre" (GotChestMsg Chest.sell)
-                                , [ Html.map GotChestMsg <| Chest.view chest data.loot ]
-                                )
 
-                            Add chest ->
+                            Chest.Sell _ ->
-                                ( buttons [ modeButton "Ok" ConfirmAdd, modeButton "Annuler" IntoView ]
+                                buttons [ modeButton "Ok" ConfirmSell, modeButton "Annuler" toShow ]
-                                , [ Html.map GotChestMsg <| Chest.view chest [] ]
+
+                            Chest.New _ ->
+                                buttons [ modeButton "Ok" ConfirmAdd, modeButton "Annuler" toShow ]
+
+                            _ ->
+                                text ""
+                    , [ Html.map (PlayerViewer << GotChestMsg) <| Chest.view chest data.loot ]
                     )
 
                 _ ->
@@ -198,48 +197,8 @@ type AdminMsg
 
 type PlayerMsg
     = GotChestMsg Chest.Msg
-    | IntoSell
-    | IntoAdd
     | ConfirmSell
     | ConfirmAdd
-    | IntoView
-
-
-mapChest : (Chest -> a) -> Mode -> a
-mapChest fn mode =
-    case mode of
-        PlayerChest chest ->
-            fn chest
-
-        GroupChest chest ->
-            fn chest
-
-        Add chest ->
-            fn chest
-
-        Sell chest ->
-            fn chest
-
-
-updateChest : Model -> Chest -> Model
-updateChest model new =
-    case model of
-        Admin _ ->
-            model
-
-        Player (PlayerConfig s mode) ->
-            case mode of
-                PlayerChest _ ->
-                    Player (PlayerConfig s (PlayerChest new))
-
-                GroupChest _ ->
-                    Player (PlayerConfig s (GroupChest new))
-
-                Add _ ->
-                    Player (PlayerConfig s (Add new))
-
-                Sell _ ->
-                    Player (PlayerConfig s (Sell new))
 
 
 update msg model =
@@ -258,27 +217,23 @@ update msg model =
             )
                 |> Tuple.mapSecond (Cmd.map AdminViewer)
 
-        ( PlayerViewer ConfirmSell, Player (PlayerConfig session mode) ) ->
+        ( PlayerViewer ConfirmSell, Player (PlayerConfig session chest) ) ->
             ( model
             , Cmd.map Api <|
                 case Session.user session of
                     Session.Player data ->
                         -- TODO: handle list of players when Viewer is group
-                        mapChest
-                            (\chest ->
                         Chest.confirmSell
                             data.player.id
                             chest
                             data.loot
                             []
-                            )
-                            mode
 
                     _ ->
                         Cmd.none
             )
 
-        ( PlayerViewer ConfirmAdd, Player (PlayerConfig session mode) ) ->
+        ( PlayerViewer ConfirmAdd, Player (PlayerConfig session chest) ) ->
             ( model
             , Cmd.map Api <|
                 case Session.user session of
@@ -287,45 +242,23 @@ update msg model =
                             sourceName =
                                 "nouveau loot #1"
                         in
-                        mapChest (\chest -> Chest.confirmAdd 0 sourceName chest) mode
+                        Chest.confirmAdd
+                            0
+                            sourceName
+                            chest
 
                     _ ->
                         Cmd.none
             )
 
-        ( PlayerViewer aMsg, Player (PlayerConfig session mode) ) ->
+        ( PlayerViewer aMsg, Player (PlayerConfig session chest) ) ->
             (case aMsg of
                 GotChestMsg chestMsg ->
-                    mapChest (Chest.update chestMsg) mode
+                    Chest.update chestMsg chest
                         |> Tuple.mapBoth
-                            (updateChest model)
+                            (\chest_ -> Player (PlayerConfig session chest_))
                             (Cmd.map GotChestMsg)
 
-                IntoSell ->
-                    ( Player (PlayerConfig session (Sell <| Chest.initSelection Nothing)), Cmd.none )
-
-                IntoAdd ->
-                    ( Player (PlayerConfig session (Add Chest.initCreate)), Cmd.none )
-
-                IntoView ->
-                    let
-                        userChest =
-                            case Session.user session of
-                                Session.Player data ->
-                                    if data.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 )
             )

src/Page/GroupChest.elm

@@ -8,29 +8,16 @@ import Page.Chest as Chest exposing (Chest)
 import Session exposing (Session, User(..))
 import Set
 import Table
+import Utils exposing (renderIcon)
 
 
 type alias Model =
     { session : Session
     , loot : State
-    , mode : Mode
+    , chest : Chest
     }
 
 
-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
@@ -52,7 +39,13 @@ getClaimsFromSession session =
 
 
 init session =
-    ( Model session Loading (View <| showClaims (getClaimsFromSession session)), Cmd.map Internal <| Api.fetchLoot GotLoot Api.OfGroup )
+    ( Model session
+        Loading
+        (Tuple.first <|
+            Chest.update (Chest.showWithClaims <| getClaimsFromSession session) Chest.init
+        )
+    , Cmd.map Internal <| Api.fetchLoot GotLoot Api.OfGroup
+    )
 
 
 view : Model -> ( Html Msg, List (Html Msg) )
@@ -79,21 +72,21 @@ view model =
                             Session.Player data ->
                                 ( True, data.player.id == 0 )
                 in
-                case model.mode of
+                case ( model.chest, isPlayer && not isGroup ) of
-                    View _ ->
+                    ( Chest.View _, True ) ->
-                        if isPlayer && not isGroup then
+                        button
-                            button [ class "button", onClick IntoGrab ] [ text "Demander" ]
+                            [ class "button"
+                            , onClick
+                                (GotChestMsg <| Chest.showWithClaims (getClaimsFromSession model.session))
+                            ]
+                            [ text "Demander" ]
 
-                        else
+                    ( Chest.Claim _, True ) ->
-                            text ""
-
-                    Grab _ ->
-                        if isPlayer && not isGroup then
                         button [ class "button", onClick ConfirmGrab ] [ text "Valider" ]
 
-                        else
+                    ( _, _ ) ->
                         text ""
-            , [ mapChest (\c -> Chest.view c loot) model.mode
+            , [ Chest.view model.chest loot
                     |> Html.map (Internal << GotChestMsg)
               ]
             )
@@ -107,34 +100,11 @@ type Msg
 type InnerMsg
     = GotLoot Api.ToChest (HttpResult Loot)
     | GotChestMsg Chest.Msg
-    | IntoGrab
-    | IntoView
     | 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 (Internal <| GotChestMsg (Chest.intoMode (Chest.IntoViewWithClaims (getClaimsFromSession model.session)))) model
 
 
 update : Msg -> Model -> ( Model, Cmd Msg )
@@ -144,13 +114,13 @@ update msg model =
             ( model, Cmd.none )
 
         Internal ConfirmGrab ->
-            case ( Session.user model.session, model.loot, model.mode ) of
+            case ( Session.user model.session, model.loot, model.chest ) of
-                ( Session.Player data, Loaded loot, Grab chest ) ->
+                ( Session.Player data, Loaded loot, Chest.Claim _ ) ->
                     ( model
                     , Chest.confirmGrab
                         data.player.id
                         loot
-                        chest
+                        model.chest
                         |> Cmd.map Api
                     )
 
@@ -166,24 +136,9 @@ update msg model =
                     ( { model | loot = LoadError "Le chargement a échoué" }, Cmd.none )
 
                 GotChestMsg chestMsg ->
-                    mapChest (Chest.update chestMsg) model.mode
+                    Chest.update chestMsg model.chest
                         |> updateChest model
 
-                IntoGrab ->
-                    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 ->
-                    ( refresh model, Cmd.none )
-
                 _ ->
                     ( model, Cmd.none )
             )
@@ -191,11 +146,6 @@ update msg model =
 
 
 updateChest model ( chestModel, chestCmd ) =
-    ( case model.mode of
+    ( { model | chest = chestModel }
-        View _ ->
-            { model | mode = View chestModel }
-
-        Grab _ ->
-            { model | mode = Grab chestModel }
     , Cmd.map GotChestMsg chestCmd
     )

src/Page/Shop.elm

@@ -15,7 +15,7 @@ import Table
 type alias Model =
     { session : Session
     , loot : Status Loot
-    , chest : Mode
+    , chest : Chest
     }
 
 
@@ -25,26 +25,8 @@ type Status a
     | Loaded a
 
 
-type Mode
-    = View Chest
-    | Buy Chest
-    | Refresh Chest
-
-
-getChest mode =
-    case mode of
-        View c ->
-            c
-
-        Buy c ->
-            c
-
-        Refresh c ->
-            c
-
-
 init session =
-    ( Model session Loading <| View Chest.init, fetchShopItems )
+    ( Model session Loading Chest.init, fetchShopItems )
 
 
 fetchShopItems =
@@ -52,12 +34,12 @@ fetchShopItems =
         |> Cmd.map Internal
 
 
-btn : String -> Msg -> Html Msg
+btn : String -> msg -> Html msg
 btn t msg =
     button [ class "button", onClick msg ] [ text t ]
 
 
-buttons : List (Html Msg) -> Html Msg
+buttons : List (Html msg) -> Html msg
 buttons bs =
     div [ class "buttons" ] bs
 
@@ -78,24 +60,25 @@ view model =
         Loaded loot ->
             let
                 controls =
+                    Html.map Internal <|
                         case ( model.chest, Session.user model.session ) of
-                        ( View chest, Session.Admin ) ->
+                            ( Chest.View _, Session.Admin ) ->
-                            btn "Remplacer" (Internal IntoRefresh)
+                                btn "Remplacer" (GotChestMsg Chest.new)
 
-                        ( View chest, Session.Player _ ) ->
+                            ( Chest.View _, Session.Player _ ) ->
-                            btn "Acheter" (Internal IntoBuy)
+                                btn "Acheter" (GotChestMsg Chest.buy)
 
-                        ( Buy chest, Session.Player _ ) ->
+                            ( Chest.Buy _, Session.Player _ ) ->
-                            buttons [ btn "Ok" (Internal ConfirmBuy), btn "Annuler" (Internal IntoView) ]
+                                buttons [ btn "Ok" ConfirmBuy, btn "Annuler" (GotChestMsg Chest.show) ]
 
-                        ( Refresh chest, Session.Admin ) ->
+                            ( Chest.New _, Session.Admin ) ->
-                            buttons [ btn "Ok" (Internal ConfirmRefresh), btn "Annuler" (Internal IntoView) ]
+                                buttons [ btn "Ok" ConfirmRefresh, btn "Annuler" (GotChestMsg Chest.show) ]
 
                             _ ->
                                 text ""
             in
             ( controls
-            , [ Chest.view (getChest model.chest) loot |> Html.map (Internal << GotChestMsg) ]
+            , [ Chest.view model.chest loot |> Html.map (Internal << GotChestMsg) ]
             )
 
 
@@ -110,31 +93,13 @@ type Msg
 
 type ShopMsg
     = GotLoot Api.ToChest (HttpResult Loot)
-    | IntoRefresh
     | ConfirmRefresh
     | GotRefreshResult (Maybe ())
-    | IntoBuy
     | ConfirmBuy
     | GotBuyResult
-    | IntoView
     | GotChestMsg Chest.Msg
 
 
-updateChest model chest =
-    { model
-        | chest =
-            case model.chest of
-                Buy _ ->
-                    Buy chest
-
-                Refresh _ ->
-                    Refresh chest
-
-                View _ ->
-                    View chest
-    }
-
-
 
 -- GotRefreshResult (Maybe ())
 --| GotBuyMsg Selection.Msg
@@ -146,11 +111,11 @@ update msg model =
     case msg of
         Internal ConfirmBuy ->
             case ( Session.user (getSession model), model.loot, model.chest ) of
-                ( Session.Player data, Loaded loot, Buy chest ) ->
+                ( Session.Player data, Loaded loot, Chest.Buy _ ) ->
                     ( model
                     , Chest.confirmBuy
                         data.player.id
-                        chest
+                        model.chest
                         loot
                         |> Cmd.map Api
                     )
@@ -181,15 +146,6 @@ update msg model =
                                 Err e ->
                                     ( { model | loot = LoadError <| Debug.toString e }, Cmd.none )
 
-                        -- Refresh mode
-                        IntoRefresh ->
-                            case Session.user (getSession model) of
-                                Session.Admin ->
-                                    ( { model | chest = Refresh Chest.initCreate }, Cmd.none )
-
-                                _ ->
-                                    ( model, Cmd.none )
-
                         ConfirmRefresh ->
                             case Session.user (getSession model) of
                                 Session.Admin ->
@@ -206,22 +162,10 @@ update msg model =
                                     in
                                     ( model, Cmd.none )
 
-                        -- Buy mode
-                        IntoBuy ->
-                            case Session.user (getSession model) of
-                                Session.Player _ ->
-                                    ( { model | chest = Buy <| Chest.initSelection Nothing }, Cmd.none )
-
-                                _ ->
-                                    ( model, Cmd.none )
-
-                        IntoView ->
-                            ( { model | chest = View Chest.init }, Cmd.none )
-
                         GotChestMsg subMsg ->
-                            Chest.update subMsg (getChest model.chest)
+                            Chest.update subMsg model.chest
                                 |> Tuple.mapBoth
-                                    (updateChest model)
+                                    (\c -> { model | chest = c })
                                     (Cmd.map GotChestMsg)
 
                         _ ->

src/Route.elm

@@ -8,41 +8,19 @@ import Url.Parser as P exposing ((</>), Parser, oneOf, s)
 -- ROUTES
 
 
-type ChestContent
-    = PlayerLoot
-    | MerchantLoot
-    | GroupLoot
-    | NewLoot
-
-
 type Route
-    = Home ChestContent
-    | About
-
-
-
-{-
-   We could flatten this :
-
-   type Route
     = Home -- Either PlayerChest or Admin depending on Session
     | About
     | Merchant
     | GroupChest
-     | NewLoot
-
-
-
--}
 
 
 parser : P.Parser (Route -> a) a
 parser =
     oneOf
-        [ P.map (Home PlayerLoot) P.top
+        [ P.map Home P.top
-        , P.map (Home GroupLoot) (P.s "coffre")
+        , P.map GroupChest (P.s "groupe")
-        , P.map (Home MerchantLoot) (P.s "marchand")
+        , P.map Merchant (P.s "marchand")
-        , P.map (Home NewLoot) (P.s "nouveau-tresor")
         , P.map About (P.s "about")
         ]
 

src/Wealth.elm

@@ -15,11 +15,10 @@ init =
     View
 
 
+view : Wealth -> Model -> List (Html Msg)
 view wealth model =
     div [ class "level-item" ]
-        [ span [ class "icon is-large" ] [ i [ class "fas fa-2x fa-piggy-bank" ] [] ]
+        [ span [ class "icon is-large" ] [ i [ class "fas fa-2x fa-piggy-bank" ] [] ] ]
-        , span [ class "icon", onClick StartEdit ] [ i [ class "fas fa-tools" ] [] ]
-        ]
         :: (case model of
                 View ->
                     viewWealth wealth
@@ -27,6 +26,7 @@ view wealth model =
                 Edit amount ->
                     viewUpdateWealth amount
            )
+        ++ [ span [ class "icon", onClick StartEdit ] [ i [ class "fas fa-tools" ] [] ] ]
 
 
 viewUpdateWealth amount =