everything starts to connect, still a big mess though !!

src/Api.elm

@@ -13,6 +13,8 @@ module Api exposing
     , fetchClaimsOf
     , fetchLoot
     , fetchSession
+    , getLoot
+    , printError
     , replaceShopItems
     )
 
@@ -421,23 +423,25 @@ replaceShopItems toMsg loot =
         }
 
 
-
+fetchSession =
--- This is where the error happened
+    Http.task
+        { method = "GET"
+        , url = "http://localhost:8088/session"
+        , headers = []
+        , body = Http.emptyBody
+        , resolver = Http.stringResolver <| handleJsonResponse Api.Player.playerDecoder
+        , timeout = Nothing
+        }
 
 
-fetchSession toMsg =
+getLoot id =
-    let
+    Http.task
-        gotResponse r =
+        { method = "GET"
-            case Debug.log "got session:" r of
+        , url = "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/loot"
-                Ok player ->
+        , headers = []
-                    toMsg (Just player)
+        , body = Http.emptyBody
-
+        , resolver = Http.stringResolver <| handleJsonResponse (valueDecoder lootDecoder)
-                Err _ ->
+        , timeout = Nothing
-                    toMsg Nothing
-    in
-    Http.get
-        { url = "http://localhost:8088/session"
-        , expect = Http.expectJson gotResponse Api.Player.playerDecoder
         }
 
 
@@ -445,11 +449,44 @@ fetchSession toMsg =
 -- UTILS
 
 
+handleJsonResponse : Decoder a -> Http.Response String -> Result Http.Error a
+handleJsonResponse decoder response =
+    case response of
+        Http.BadUrl_ url ->
+            Err (Http.BadUrl url)
+
+        Http.Timeout_ ->
+            Err Http.Timeout
+
+        Http.BadStatus_ { statusCode } _ ->
+            Err (Http.BadStatus statusCode)
+
+        Http.NetworkError_ ->
+            Err Http.NetworkError
+
+        Http.GoodStatus_ _ body ->
+            case D.decodeString decoder body of
+                Err _ ->
+                    Err (Http.BadBody body)
+
+                Ok result ->
+                    Ok result
+
+
 printError : Http.Error -> String
 printError error =
     case error of
         Http.NetworkError ->
-            "Le serveur ne répond pas"
+            "Le réseau ne fonctionne pas"
 
-        _ ->
+        Http.Timeout ->
-            "Erreur inconnue"
+            "Le serveur ne réponse pas (timeout)"
+
+        Http.BadUrl url ->
+            "La resource " ++ url ++ "n'existe pas"
+
+        Http.BadStatus statusCode ->
+            "Le serveur a renvoyé une erreur (" ++ String.fromInt statusCode ++ ")"
+
+        Http.BadBody body ->
+            "La réponse n'a pas pu être lue : " ++ body

src/Main.elm

@@ -7,7 +7,6 @@ import Html.Attributes exposing (..)
 import Html.Events exposing (..)
 import Json.Encode as E
 import Page exposing (Page)
-import Page.Admin as Admin
 import Page.Chest as Chest exposing (Msg)
 import Route exposing (..)
 import Session exposing (..)
@@ -130,7 +129,7 @@ viewHeaderBar navbarTitle navbarLinks navbar =
 type Msg
     = UrlChanged Url.Url
     | LinkClicked Browser.UrlRequest
-    | SessionLoaded (Maybe Session)
+    | SessionLoaded (Result String Session)
     | PageMsg Page.PageMsg
     | SwitchMenuOpen
 
@@ -140,14 +139,18 @@ update msg model =
     case ( msg, model.page ) of
         ( SessionLoaded session, _ ) ->
             case session of
-                Just logged ->
+                Ok logged ->
                     let
                         ( page, cmd ) =
                             Page.initHome logged
                     in
                     ( model |> setPage page, Cmd.map PageMsg cmd )
 
-                Nothing ->
+                Err error ->
+                    let
+                        _ =
+                            Debug.log "SessionLoaded Error" error
+                    in
                     ( model |> setPage Page.About, Cmd.none )
 
         ( LinkClicked urlRequest, _ ) ->

src/Page.elm

@@ -5,7 +5,6 @@ import Api.Player
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
-import Page.Admin as Admin
 import Page.Dashboard as Dashboard
 import Page.GroupChest as GroupChest
 import Page.Shop as Shop
@@ -33,7 +32,7 @@ mapMsg toMsg =
 maybeSession page =
     case page of
         Dashboard model ->
-            Just <| Session.getSession model
+            Just <| Dashboard.getSession model
 
         GroupChest model ->
             Just <| Session.getSession model
@@ -83,7 +82,7 @@ view page =
             case maybeSession page of
                 Just session ->
                     case Session.user session of
-                        Session.Player player _ ->
+                        Session.Player player _ _ ->
                             player.name
 
                         Session.Admin ->
@@ -96,7 +95,7 @@ view page =
             case maybeSession page of
                 Just session ->
                     case Session.user session of
-                        Session.Player player _ ->
+                        Session.Player player _ _ ->
                             let
                                 linkWithGem =
                                     navLink "fas fa-gem"
@@ -131,7 +130,7 @@ viewSessionBar session controls =
                 Nothing ->
                     [ text "" ]
 
-                Just (Session.Player player wealth) ->
+                Just (Session.Player player wealth _) ->
                     let
                         _ =
                             Debug.log "viewSessionBar wealth" player.wealth
@@ -179,8 +178,6 @@ navLink icon linkText url =
 
 -- UPDATE
 --
--- Note : All pages 'update' function
---        shall return (subMode, Cmd Api.Msg)
 
 
 type PageMsg
@@ -203,7 +200,7 @@ map func page =
         Just session ->
             case page of
                 Dashboard model ->
-                    Dashboard { model | session = func session }
+                    Dashboard <| Dashboard.updateSession model (func session)
 
                 GroupChest model ->
                     GroupChest { model | session = func session }
@@ -224,6 +221,9 @@ update msg page =
         ( GotGroupChestMsg _, _, _ ) ->
             ( page, Cmd.none )
 
+        ( GotDashboardMsg (Dashboard.Api apiMsg), Dashboard home, _ ) ->
+            update (ApiMsg apiMsg) page
+
         ( GotDashboardMsg subMsg, Dashboard home, _ ) ->
             Dashboard.update subMsg home
                 |> updatePage Dashboard GotDashboardMsg
@@ -231,6 +231,9 @@ update msg page =
         ( GotDashboardMsg _, _, _ ) ->
             ( page, Cmd.none )
 
+        ( GotShopMsg (Shop.Api apiMsg), Shop shop, _ ) ->
+            update (ApiMsg apiMsg) page
+
         ( GotShopMsg subMsg, Shop shop, _ ) ->
             Shop.update subMsg shop
                 |> updatePage Shop GotShopMsg
@@ -244,7 +247,7 @@ update msg page =
                     Session.wealth session
             in
             case Session.user session of
-                Session.Player player aModel ->
+                Session.Player player aModel _ ->
                     let
                         ( newWealth, maybeEdit ) =
                             Wealth.update wealthMsg aModel
@@ -328,15 +331,16 @@ applyUpdate u user =
     in
     {- Note: DbUpdates always refer to the active player -}
     case user of
-        Session.Player player wealthModel ->
+        Session.Player player wealthModel loot ->
             case u of
                 Api.ItemRemoved item ->
-                    --List.filter (\i -> i.id /= item.id) model.state.playerLoot
+                    Session.Player player wealthModel <|
-                    user
+                        List.filter
+                            (\i -> i.id /= item.id)
+                            loot
 
                 Api.ItemAdded item ->
-                    --{ model | state = { state | playerLoot = item :: model.state.playerLoot } }
+                    Session.Player player wealthModel (item :: loot)
-                    user
 
                 Api.WealthUpdated diff ->
                     let
@@ -356,6 +360,7 @@ applyUpdate u user =
                                     (wealth.pp + diff.pp)
                         }
                         wealthModel
+                        loot
 
                 Api.ClaimAdded claim ->
                     -- { model | claims = claim :: model.claims }

src/Page/Admin.elm.old

@@ -1,4 +1,4 @@
-module Page.Admin exposing (Model, Msg, getSession, init, routeChanged, update, view)
+module Page.Admin exposing (Model)
 
 import Api exposing (Loot)
 import Api.Player as Player exposing (Player, Wealth)

src/Page/Chest.elm

@@ -1,4 +1,4 @@
-module Page.Chest exposing (Chest, Msg, init, initCreate, initSelection, update, view)
+module Page.Chest exposing (Chest, Msg, confirmAdd, confirmBuy, confirmSell, init, initCreate, initSelection, update, view)
 
 import Api exposing (Item, Loot)
 import Html exposing (..)
@@ -11,12 +11,40 @@ type alias RowRenderer msg =
     Item -> List (Html msg)
 
 
+
+{-
+
+   A chest is a component that acts on a list of items (loot)
+
+   It can render it's content as a table.
+
+   It does not hold any loot itself, it is given in view only !
+
+
+   type Chest
+       = Chest (RowRenderer Never)
+-}
+
+
 type Chest
     = View
     | Selection Selection.Model
     | Create NewFromInventory.Model
 
 
+
+{-
+
+   View : RowRenderer -> Chest.View
+
+   Selection : RowRenderer -> { confirm: Cmd msg, cancel: Cmd msg } -> Chest.Selection
+
+   NewFromInventory : RowRenderer -> { confirm: Cmd msg, cancel: Cmd msg } -> Chest.NewFromInventory
+
+
+-}
+
+
 init =
     View
 
@@ -70,3 +98,71 @@ updateChest toMsg toChest ( model, cmd ) =
     ( toChest model
     , Cmd.map toMsg cmd
     )
+
+
+
+-- Api actions
+--
+
+
+confirmBuy : Int -> Chest -> Loot -> Cmd Api.Msg
+confirmBuy playerId model loot =
+    case model of
+        Selection chest ->
+            let
+                items =
+                    Selection.selected chest loot
+
+                priceMods =
+                    Selection.modifiers chest items
+
+                payload =
+                    Api.BuyPayload items Nothing priceMods
+            in
+            Api.confirmAction
+                (String.fromInt playerId)
+                payload
+
+        _ ->
+            Cmd.none
+
+
+confirmSell : Int -> Chest -> Loot -> List Int -> Cmd Api.Msg
+confirmSell playerId model loot players =
+    case model of
+        Selection chest ->
+            let
+                items =
+                    Selection.selected chest loot
+
+                priceMods =
+                    Selection.modifiers chest items
+
+                payload =
+                    Api.SellPayload items Nothing priceMods players
+            in
+            Api.confirmAction
+                (String.fromInt playerId)
+                payload
+
+        _ ->
+            Cmd.none
+
+
+confirmAdd : Int -> String -> Chest -> Cmd Api.Msg
+confirmAdd playerId sourceName model =
+    case model of
+        Create chest ->
+            let
+                items =
+                    NewFromInventory.allLoot chest
+
+                payload =
+                    Api.AddPayload sourceName items
+            in
+            Api.confirmAction
+                (String.fromInt playerId)
+                payload
+
+        _ ->
+            Cmd.none

src/Page/Chest/Selection.elm

@@ -1,37 +1,176 @@
-module Page.Chest.Selection exposing (Model, Msg, init, update, view)
+module Page.Chest.Selection exposing (Model, Msg, init, modifiers, selected, update, view)
 
-import Api exposing (Loot)
+import Api exposing (Item, Loot)
+import Dict exposing (Dict)
 import Html exposing (..)
 import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Set exposing (Set)
 import Table
 
 
-type Selection
+type alias Selection =
-    = Selection
+    Set Int
+
+
+type alias Data a =
+    Dict Int a
 
 
 type Model
-    = Model Selection
+    = Model Selection (Data Int)
 
 
 init =
-    Model Selection
+    Model Set.empty Dict.empty
 
 
 view : Model -> Loot -> Html Msg
-view model loot =
+view (Model selection data) loot =
+    let
+        isSelected =
+            itemInSelection selection
+
+        renderItem item =
+            let
+                maybeMod =
+                    Dict.get item.id data
+            in
+            [ 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
+                        Just mod ->
+                            String.fromInt mod
+
+                        Nothing ->
+                            "0"
+
+              else
+                text ""
+            ]
+    in
     Table.view
-        (Table.renderRowLevel
+        (Table.renderSelectableRow
-            (\item -> [ p [] [ text <| item.name ++ "selectable" ] ])
+            (\item -> [ p [] [ text item.name ] ])
-            (\item -> [ input [ type_ "checkbox" ] [] ])
+            (\item -> renderItem item)
+            (\item _ -> SwitchSelectionState item.id)
+            isSelected
         )
         loot
 
 
+toFloatingMod : Int -> Float
+toFloatingMod percent =
+    (100 + Debug.log "toFloat" (toFloat percent)) / 100
+
+
+
+-- Renderers : Item -> Html Msg
+
+
+viewPriceWithModApplied : Maybe Float -> Float -> Html Msg
+viewPriceWithModApplied maybeMod basePrice =
+    case maybeMod of
+        Just mod ->
+            p [ class "level-item has-text-weight-bold" ]
+                [ (Debug.log "withMod" (String.fromFloat (basePrice * mod)) ++ "po")
+                    |> text
+                ]
+
+        Nothing ->
+            p [ class "level-item" ] [ (String.fromFloat basePrice ++ "po") |> text ]
+
+
+viewPriceModifier : Int -> String -> Html Msg
+viewPriceModifier id modValue =
+    div [ class "level-item field has-addons" ]
+        [ div [ class "control has-icons-left" ]
+            [ input
+                [ type_ "number"
+                , value modValue
+                , class "input is-small"
+                , size 3
+                , style "width" "6em"
+                , Html.Attributes.min "-50"
+                , Html.Attributes.max "50"
+                , step "5"
+                , onInput (PriceModifierChanged id)
+                ]
+                []
+            , span [ class "icon is-left" ] [ i [ class "fas fa-percent" ] [] ]
+            ]
+        ]
+
+
+
+-- Selection
+-- Get list of selected items
+
+
+selected : Model -> Loot -> Loot
+selected (Model selection data) loot =
+    List.filter (itemInSelection selection) loot
+
+
+modifiers : Model -> Loot -> List (Maybe Float)
+modifiers (Model selection data) items =
+    List.map
+        (\item ->
+            Dict.get item.id data
+                |> Maybe.map (\i -> toFloatingMod i)
+        )
+        items
+
+
+itemInSelection : Selection -> Item -> Bool
+itemInSelection selection item =
+    Set.member item.id selection
+
+
+
+{-
+   itemInClaims : Claims -> Item -> Bool
+   itemInClaims claims item =
+       List.any (\c -> c.loot_id == item.id) claims
+-}
+
+
+switchSelectionState : Int -> Selection -> Selection
+switchSelectionState id selection =
+    case Set.member id selection of
+        True ->
+            Set.remove id selection
+
+        False ->
+            Set.insert id selection
+
+
 type Msg
-    = Msg
+    = SwitchSelectionState Int
+    | PriceModifierChanged Int String
 
 
 update : Msg -> Model -> ( Model, Cmd Msg )
-update msg model =
+update msg (Model selection data) =
-    ( model, Cmd.none )
+    case msg of
+        PriceModifierChanged id value ->
+            ( Model selection
+                (Dict.insert
+                    id
+                    (case String.toInt value of
+                        Just i ->
+                            i
+
+                        Nothing ->
+                            0
+                    )
+                    data
+                )
+            , Cmd.none
+            )
+
+        SwitchSelectionState id ->
+            ( Model (switchSelectionState id selection) data, Cmd.none )

src/Page/Dashboard.elm

@@ -1,5 +1,7 @@
-module Page.Dashboard exposing (Model, Msg, init, update, view)
+module Page.Dashboard exposing (Model, Msg(..), getSession, init, update, updateSession, view)
 
+import Api
+import Api.Player as Player exposing (Player, Wealth)
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
@@ -7,43 +9,327 @@ import Page.Chest as Chest exposing (Chest)
 import Session exposing (Session)
 
 
-type alias Model =
+getSession model =
-    { session : Session
+    case model of
-    , chest : Mode
+        Admin (AdminConfig session _ _) ->
+            session
+
+        Player (PlayerConfig session _) ->
+            session
+
+
+updateSession model session =
+    case model of
+        Admin (AdminConfig _ a b) ->
+            Admin (AdminConfig session a b)
+
+        Player (PlayerConfig _ a) ->
+            Player (PlayerConfig session a)
+
+
+type Model
+    = Admin AdminConfig
+    | Player PlayerConfig
+
+
+type alias NewPlayerForm =
+    { name : String
+    , wealth : Float
     }
 
 
+type PlayerConfig
+    = PlayerConfig Session Mode
+
+
+type AdminConfig
+    = AdminConfig Session (List Player) NewPlayerForm
+
+
 type Mode
-    = View Chest
+    = PlayerChest Chest
+    | GroupChest Chest
+    | Sell Chest
+    | Add Chest
 
 
 init : Session -> ( Model, Cmd Msg )
 init session =
-    ( Model session (View Chest.init)
+    case Session.user session of
+        Session.Admin ->
+            ( Admin <| AdminConfig session [] initForm
+            , Player.list (AdminViewer << GotPlayers)
+            )
+
+        Session.Player player wealth loot ->
+            ( Player <|
+                PlayerConfig session
+                    (if player.id == 0 then
+                        -- TODO: render claimed items
+                        GroupChest Chest.init
+
+                     else
+                        PlayerChest Chest.init
+                    )
             , Cmd.none
             )
 
 
+initForm =
+    NewPlayerForm "" 0.0
+
+
+modeButton t msg =
+    button [ class "button", onClick msg ] [ text t ]
+
+
+buttons bs =
+    div [ class "buttons" ] bs
+
+
 view : Model -> ( Html Msg, List (Html Msg) )
 view model =
-    case Session.user model.session of
+    case model of
-        Session.Player player _ ->
+        Player (PlayerConfig session mode) ->
-            ( text ""
+            case Session.user session of
-            , [ if player.id == 0 then
+                Session.Player player _ loot ->
-                    p [] [ text "Groupe" ]
+                    Tuple.mapBoth
+                        (Html.map PlayerViewer)
+                        (List.map (Html.map PlayerViewer))
+                    <|
+                        case mode of
+                            PlayerChest chest ->
+                                ( modeButton "Vendre" IntoSell
+                                , [ Html.map GotChestMsg <| Chest.view chest loot ]
+                                )
 
-                else
+                            GroupChest chest ->
-                    p [] [ text "Joueur" ]
+                                ( buttons [ modeButton "Vendre" IntoSell, modeButton "Ajouter" IntoAdd ]
+                                , [ Html.map GotChestMsg <| Chest.view chest loot ]
+                                )
+
+                            Sell chest ->
+                                ( buttons [ modeButton "Ok" ConfirmSell, modeButton "Annuler" IntoView ]
+                                , [ Html.map GotChestMsg <| Chest.view chest loot ]
+                                )
+
+                            Add chest ->
+                                ( buttons [ modeButton "Ok" ConfirmAdd, modeButton "Annuler" IntoView ]
+                                , [ Html.map GotChestMsg <| Chest.view chest [] ]
+                                )
+
+                _ ->
+                    let
+                        _ =
+                            Debug.log "Admin in PlayerDashboard !!" ()
+                    in
+                    ( text "", [] )
+
+        Admin (AdminConfig session players newPlayer) ->
+            ( text ""
+            , [ div [ class "container" ]
+                    [ p [ class "title" ] [ text "Administration" ]
+                    , div [ class "section" ]
+                        [ table [ class "table is-fullwidth is-striped" ]
+                            [ thead [ class "table-header" ]
+                                [ th [] [ text "Joueurs" ] ]
+                            , tbody [] <|
+                                editNewPlayer newPlayer
+                                    :: List.map viewPlayer players
+                            ]
+                        ]
+                    , div [ class "section" ]
+                        [ p [] [ text "Campagnes" ] ]
+                    ]
               ]
             )
 
-        Session.Admin ->
+
-            ( text "", [ p [] [ text "Joueur" ] ] )
+viewPlayer : Player -> Html Msg
+viewPlayer player =
+    tr [] [ td [] [ p [] [ text (player.name ++ " (" ++ String.fromInt player.id ++ ")") ] ] ]
+
+
+editNewPlayer : NewPlayerForm -> Html Msg
+editNewPlayer newPlayer =
+    tr []
+        [ td []
+            [ div [ class "field is-horizontal" ]
+                [ div [ class "field-body" ]
+                    [ div [ class "field" ]
+                        [ input
+                            [ class "input"
+                            , type_ "text"
+                            , value newPlayer.name
+                            , onInput <| NameChanged
+                            ]
+                            []
+                        ]
+                    , div [ class "field" ]
+                        [ input
+                            [ class "input"
+                            , type_ "text"
+                            , value <| String.fromFloat newPlayer.wealth
+                            , onInput <| WealthChanged
+                            ]
+                            []
+                        ]
+                    ]
+                ]
+            ]
+        ]
+        |> Html.map (AdminViewer << GotFormMsg)
 
 
 type Msg
-    = Msg
+    = Api Api.Msg
+    | AdminViewer AdminMsg
+    | PlayerViewer PlayerMsg
+
+
+type AdminMsg
+    = GotPlayers (List Player)
+    | GotFormMsg FormMsg
+
+
+
+-- Player
+
+
+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 =
+    case ( msg, model ) of
+        ( AdminViewer aMsg, Admin (AdminConfig session players form) ) ->
+            (case aMsg of
+                GotPlayers newPlayers ->
+                    ( Admin (AdminConfig session newPlayers form)
+                    , Cmd.none
+                    )
+
+                GotFormMsg subMsg ->
+                    ( Admin (AdminConfig session players (updateForm subMsg form))
+                    , Cmd.none
+                    )
+            )
+                |> Tuple.mapSecond (Cmd.map AdminViewer)
+
+        ( PlayerViewer ConfirmSell, Player (PlayerConfig session mode) ) ->
+            ( model
+            , Cmd.map Api <|
+                case Session.user session of
+                    Session.Player player _ loot ->
+                        -- TODO: handle list of players when Viewer is group
+                        mapChest (\chest -> Chest.confirmSell player.id chest loot []) mode
+
+                    _ ->
+                        Cmd.none
+            )
+
+        ( PlayerViewer ConfirmAdd, Player (PlayerConfig session mode) ) ->
+            ( model
+            , Cmd.map Api <|
+                case Session.user session of
+                    Session.Player player _ _ ->
+                        let
+                            sourceName =
+                                "nouveau loot #1"
+                        in
+                        mapChest (\chest -> Chest.confirmAdd 0 sourceName chest) mode
+
+                    _ ->
+                        Cmd.none
+            )
+
+        ( PlayerViewer aMsg, Player (PlayerConfig session mode) ) ->
+            (case aMsg of
+                GotChestMsg chestMsg ->
+                    mapChest (Chest.update chestMsg) mode
+                        |> Tuple.mapBoth
+                            (updateChest model)
+                            (Cmd.map GotChestMsg)
+
+                IntoSell ->
+                    ( Player (PlayerConfig session (Sell Chest.initSelection)), Cmd.none )
+
+                IntoAdd ->
+                    ( 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 )
+
+                _ ->
                     ( model, Cmd.none )
+            )
+                |> Tuple.mapSecond (Cmd.map PlayerViewer)
+
+        ( _, _ ) ->
+            let
+                _ =
+                    Debug.log "unhandled msg" msg
+            in
+            ( model, Cmd.none )
+
+
+
+-- Player form
+
+
+type FormMsg
+    = NameChanged String
+    | WealthChanged String
+
+
+updateForm : FormMsg -> NewPlayerForm -> NewPlayerForm
+updateForm msg form =
+    case msg of
+        NameChanged newName ->
+            { form | name = newName }
+
+        WealthChanged newWealth ->
+            { form | wealth = Maybe.withDefault 0.0 <| String.toFloat newWealth }

src/Page/GroupChest.elm

@@ -41,7 +41,7 @@ view model =
                 Session.Admin ->
                     text ""
 
-                Session.Player p _ ->
+                Session.Player p _ _ ->
                     if p.id == 0 then
                         button [ class "button" ] [ text "Vendre" ]
 

src/Page/Shop.elm

@@ -1,4 +1,4 @@
-module Page.Shop exposing (Model, Msg, init, update, view)
+module Page.Shop exposing (Model, Msg(..), init, update, view)
 
 import Api exposing (HttpResult, Item, Loot)
 import Dict exposing (Dict)
@@ -6,7 +6,6 @@ import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
 import Page.Chest as Chest exposing (Chest)
-import Page.Chest.NewFromInventory as NewChest
 import Page.Chest.Selection as Selection
 import Session exposing (Session, getSession)
 import Set exposing (Set)
@@ -44,21 +43,23 @@ getChest mode =
             c
 
 
-
-{-
-   | View Loot
-   | Refresh NewChest.Model
-   | Buy Selection.Model
-   | Sending
--}
-
-
 init session =
     ( Model session Loading <| View Chest.init, fetchShopItems )
 
 
 fetchShopItems =
     Api.fetchLoot GotLoot Api.OfShop
+        |> Cmd.map Internal
+
+
+btn : String -> Msg -> Html Msg
+btn t msg =
+    button [ class "button", onClick msg ] [ text t ]
+
+
+buttons : List (Html Msg) -> Html Msg
+buttons bs =
+    div [ class "buttons" ] bs
 
 
 view : Model -> ( Html Msg, List (Html Msg) )
@@ -77,61 +78,45 @@ view model =
         Loaded loot ->
             let
                 controls =
-                    case model.chest of
+                    case ( model.chest, Session.user model.session ) of
-                        View chest ->
+                        ( View chest, Session.Admin ) ->
-                            case Session.user model.session of
+                            btn "Remplacer" (Internal IntoRefresh)
-                                Session.Admin ->
-                                    button [ class "button", onClick IntoRefresh ] [ text "Remplacer" ]
 
-                                Session.Player _ _ ->
+                        ( View chest, Session.Player _ _ _ ) ->
-                                    button [ class "button" ] [ text "Acheter" ]
+                            btn "Acheter" (Internal IntoBuy)
 
-                        Buy chest ->
+                        ( Buy chest, Session.Player p _ _ ) ->
-                            text ""
+                            buttons [ btn "Ok" (Internal ConfirmBuy), btn "Annuler" (Internal IntoView) ]
 
-                        Refresh chest ->
+                        ( Refresh chest, Session.Admin ) ->
+                            buttons [ btn "Ok" (Internal ConfirmRefresh), btn "Annuler" (Internal IntoView) ]
+
+                        _ ->
                             text ""
             in
             ( controls
-            , [ Chest.view (getChest model.chest) loot |> Html.map GotChestMsg ]
+            , [ Chest.view (getChest model.chest) loot |> Html.map (Internal << GotChestMsg) ]
             )
 
 
 
-{-
+-- Api msg are not handled by the page
-   Buy selection ->
-       let
-           ( controls, content ) =
-               Selection.view selection
-
-           toMsg =
-               Html.map GotBuyMsg
-       in
-       ( toMsg controls
-       , List.map toMsg content
-       )
-
-   Refresh chest ->
-       let
-           ( controls, content ) =
-               NewChest.view chest
-
-           toMsg =
-               Html.map GotChestMsg
-       in
-       ( toMsg controls
-       , List.map toMsg content
-       )
-
-   Sending ->
-       ( text "", [ p [] [ text "En attente du serveur..." ] ] )
--}
 
 
 type Msg
+    = Api Api.Msg
+    | Internal ShopMsg
+
+
+type ShopMsg
     = GotLoot Api.ToChest (HttpResult Loot)
     | IntoRefresh
+    | ConfirmRefresh
+    | GotRefreshResult (Maybe ())
     | IntoBuy
+    | ConfirmBuy
+    | GotBuyResult
+    | IntoView
     | GotChestMsg Chest.Msg
 
 
@@ -159,6 +144,34 @@ updateChest model chest =
 update : Msg -> Model -> ( Model, Cmd Msg )
 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 ) ->
+                    ( model
+                    , Chest.confirmBuy
+                        player.id
+                        chest
+                        loot
+                        |> Cmd.map Api
+                    )
+
+                _ ->
+                    ( model, Cmd.none )
+
+        Internal (GotRefreshResult result) ->
+            case result of
+                Just _ ->
+                    init <| getSession model
+
+                Nothing ->
+                    ( { model | loot = LoadError "L'ajout a échoué. Vous devez recommencer :'( " }
+                    , Cmd.none
+                    )
+
+        Internal shopMsg ->
+            let
+                ( nModel, cmd ) =
+                    case shopMsg of
                         GotLoot Api.OfShop response ->
                             case response of
                                 Ok loot ->
@@ -177,54 +190,44 @@ update msg model =
                                 _ ->
                                     ( model, Cmd.none )
 
+                        ConfirmRefresh ->
+                            case Session.user (getSession model) of
+                                Session.Admin ->
+                                    let
+                                        loot =
+                                            []
+                                    in
+                                    ( model, Api.replaceShopItems GotRefreshResult loot )
+
+                                _ ->
+                                    let
+                                        _ =
+                                            Debug.log "Forbidden action ! (is not admin)" ()
+                                    in
+                                    ( model, Cmd.none )
+
                         -- Buy mode
                         IntoBuy ->
                             case Session.user (getSession model) of
-                Session.Player _ _ ->
+                                Session.Player _ _ _ ->
                                     ( { model | chest = Buy Chest.initSelection }, Cmd.none )
 
                                 _ ->
                                     ( model, Cmd.none )
 
+                        IntoView ->
+                            ( { model | chest = View Chest.init }, Cmd.none )
+
                         GotChestMsg subMsg ->
                             Chest.update subMsg (getChest model.chest)
                                 |> Tuple.mapBoth
                                     (updateChest model)
                                     (Cmd.map GotChestMsg)
 
-        {-
+                        _ ->
-           (GotChestMsg chestMsg, Refresh chest ) ->
+                            ( model, Cmd.none )
-               let
+            in
-                   ( newState, cmd, exit ) =
+            ( nModel, Cmd.map Internal cmd )
-                       NewChest.update chestMsg chest
+
-               in
-               case exit of
-                   Just status ->
-                       case status of
-                           NewChest.Confirmed loot ->
-                               ( model, Api.replaceShopItems GotRefreshResult loot )
-
-                           NewChest.Canceled ->
-                               init <| getSession model
-
-                   Nothing ->
-                       ( { model | state = Refresh newState }, Cmd.map GotChestMsg cmd )
-
-           ( GotRefreshResult result, _ ) ->
-               case result of
-                   Just _ ->
-                       init <| getSession model
-
-                   Nothing ->
-                       ( { model | state = LoadError "L'ajout a échoué. Vous devez recommencer :'( " }
-                       , Cmd.none
-                       )
-
-           ( GotBuyMsg subMsg, Buy subModel ) ->
-               Selection.update subMsg subModel
-                   |> Tuple.mapBoth
-                       (\m -> { model | state = Buy m })
-                       (\c -> Cmd.map GotBuyMsg c)
-        -}
         _ ->
             ( model, Cmd.none )

src/Session.elm

@@ -1,15 +1,16 @@
 module Session exposing (Session, User(..), getSession, init, key, updateUser, updateWealth, user, wealth)
 
-import Api
+import Api exposing (Loot)
 import Api.Player as Player exposing (Player)
 import Browser.Navigation as Nav
 import Http
 import Json.Decode as D
+import Task exposing (Task)
 import Wealth
 
 
 type User
-    = Player Player Wealth.Model
+    = Player Player Wealth.Model Loot
     | Admin
 
 
@@ -17,19 +18,32 @@ type Session
     = Session Nav.Key User
 
 
-init : (Maybe Session -> msg) -> Nav.Key -> Cmd msg
+init : (Result String Session -> msg) -> Nav.Key -> Cmd msg
 init toMsg navKey =
     let
-        toSession : Maybe Player -> msg
+        toSession : Result String ( Player, Loot ) -> msg
-        toSession response =
+        toSession result =
-            case response of
+            case result of
-                Just player ->
+                Ok ( player, loot ) ->
-                    toMsg <| Just (Session navKey (Player player Wealth.init))
+                    toMsg <| Ok (Session navKey (Player player Wealth.init loot))
 
-                Nothing ->
+                Err error ->
-                    toMsg Nothing
+                    toMsg <| Err error
     in
-    Api.fetchSession toSession
+    Task.attempt toSession initFullSession
+
+
+initFullSession : Task String ( Player, Loot )
+initFullSession =
+    Api.fetchSession
+        |> Task.andThen wrapLoot
+        |> Task.mapError Api.printError
+
+
+wrapLoot : Player -> Task Http.Error ( Player, Loot )
+wrapLoot player =
+    Api.getLoot player.id
+        |> Task.andThen (\loot -> Task.succeed ( player, loot ))
 
 
 getSession : { r | session : Session } -> Session
@@ -58,7 +72,7 @@ user session =
 wealth : Session -> Maybe Wealth.Model
 wealth session =
     case user session of
-        Player _ model ->
+        Player _ model _ ->
             Just model
 
         Admin ->
@@ -71,8 +85,8 @@ setWealth wealthModel session =
             session
     in
     case isUser of
-        Player p _ ->
+        Player p _ loot ->
-            Session navKey (Player p wealthModel)
+            Session navKey (Player p wealthModel loot)
 
         Admin ->
             Session navKey Admin
@@ -85,8 +99,8 @@ updateWealth newWealthModel model =
             model
     in
     case loggedUser of
-        Player player _ ->
+        Player player _ loot ->
-            Session navKey (Player player newWealthModel)
+            Session navKey (Player player newWealthModel loot)
 
         Admin ->
             Session navKey Admin

src/Table.elm

@@ -1,7 +1,8 @@
-module Table exposing (name, renderRowLevel, view)
+module Table exposing (name, renderRowLevel, renderSelectableRow, view)
 
 import Html exposing (..)
 import Html.Attributes exposing (..)
+import Html.Events exposing (..)
 
 
 type alias RowRenderer a msg =
@@ -24,6 +25,26 @@ view rowRenderer content =
         ]
 
 
+renderSelectableRow : ItemRenderer a msg -> ItemRenderer a msg -> (a -> Bool -> msg) -> (a -> Bool) -> RowRenderer a msg
+renderSelectableRow left right onCheckMsg isSelected item =
+    tr []
+        [ td []
+            [ label [ class "level checkbox" ]
+                [ div [ class "level-left" ] <| left item
+                , div [ class "level-right" ] <|
+                    input
+                        [ class "checkbox level-item"
+                        , type_ "checkbox"
+                        , checked <| isSelected item
+                        , onCheck <| onCheckMsg item
+                        ]
+                        []
+                        :: right item
+                ]
+            ]
+        ]
+
+
 renderRowLevel : ItemRenderer a msg -> ItemRenderer a msg -> RowRenderer a msg
 renderRowLevel left right item =
     tr []