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.gotoHome logged
+                            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, _ ) ->
@@ -158,20 +161,22 @@ update msg model =
                 Browser.External href ->
                     ( model, Cmd.none )
 
-        ( UrlChanged url, page ) ->
+        ( UrlChanged url, from ) ->
             -- Handle routing according to current page
-            case ( Route.fromUrl url, page ) of
+            case Route.fromUrl url of
-                ( Just (Route.Home Route.MerchantLoot), Page.Admin admin ) ->
+                Just (Route.Home Route.MerchantLoot) ->
                     let
                         ( shopPage, cmd ) =
-                            Page.gotoShop (Admin.getSession admin)
+                            Page.gotoShop from
                     in
                     ( model |> setPage shopPage, Cmd.map PageMsg cmd )
 
-                ( Just (Route.Home content), Page.Chest chest ) ->
+                Just (Route.Home Route.PlayerLoot) ->
-                    ( model |> setPage (Page.Chest (Chest.setContent content chest))
+                    let
-                    , Cmd.none
+                        ( shopPage, cmd ) =
-                    )
+                            Page.gotoHome from
+                    in
+                    ( model |> setPage shopPage, Cmd.map PageMsg cmd )
 
                 {-
                    ( Just route, Page.Admin admin ) ->

src/Page.elm

@@ -1,39 +1,26 @@
-module Page exposing (Page(..), PageMsg, gotoHome, gotoShop, update, view)
+module Page exposing (Page(..), PageMsg, gotoHome, gotoShop, initHome, update, view)
 
+import Api
+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.Chest as Chest
+import Page.GroupChest as GroupChest
-import Page.Chest.Wealth as Wealth
 import Page.Shop as Shop
 import Session exposing (Session)
 import Utils exposing (renderIcon)
+import Wealth
 
 
 type Page
-    = Chest Chest.Model
+    = Dashboard Dashboard.Model
-    | Admin Admin.Model
+    | GroupChest GroupChest.Model
     | Shop Shop.Model
     | About
     | Loading
 
 
-
-{-
-
-   type Page
-     = Dashboard Session
-     | GroupChest Session
-     | Shop Shop.Model
-     | NewLoot Session
-     | About
-     | Loading
-
-
--}
-
-
 init =
     Loading
 
@@ -42,29 +29,40 @@ mapMsg toMsg =
     List.map (Html.map toMsg)
 
 
+maybeSession page =
+    case page of
+        Dashboard model ->
+            Just <| Dashboard.getSession model
+
+        GroupChest model ->
+            Just <| Session.getSession model
+
+        Shop model ->
+            Just <| Session.getSession model
+
+        _ ->
+            Nothing
+
+
 view page =
     let
-        maybeSession =
-            case page of
-                Chest model ->
-                    Just <| Session.getSession model
-
-                Admin model ->
-                    Just <| Admin.getSession model
-
-                Shop model ->
-                    Just <| Session.getSession model
-
-                _ ->
-                    Nothing
-
         ( title, ( controls, content ) ) =
             case page of
-                Chest chest ->
+                Dashboard home ->
-                    ( "Lootalot", ( text "", mapMsg GotChestMsg <| Chest.view chest ) )
+                    ( "Lootalot"
+                    , Dashboard.view home
+                        |> Tuple.mapBoth
+                            (Html.map GotDashboardMsg)
+                            (mapMsg GotDashboardMsg)
+                    )
 
-                Admin admin ->
+                GroupChest chest ->
-                    ( "Administration", ( text "", mapMsg GotAdminMsg <| Admin.view admin ) )
+                    ( "Lootalot"
+                    , GroupChest.view chest
+                        |> Tuple.mapBoth
+                            (Html.map GotGroupChestMsg)
+                            (mapMsg GotGroupChestMsg)
+                    )
 
                 Shop shop ->
                     ( "Marchand"
@@ -81,10 +79,10 @@ view page =
                     ( "Loot-a-lot", ( text "", [ p [] [ text "Chargement" ] ] ) )
 
         navbarTitle =
-            case maybeSession of
+            case maybeSession page of
                 Just session ->
                     case Session.user session of
-                        Session.Player player _ ->
+                        Session.Player player _ _ ->
                             player.name
 
                         Session.Admin ->
@@ -94,10 +92,10 @@ view page =
                     "Loot-a-lot"
 
         navbarLinks =
-            case maybeSession of
+            case maybeSession page of
                 Just session ->
                     case Session.user session of
-                        Session.Player player _ ->
+                        Session.Player player _ _ ->
                             let
                                 linkWithGem =
                                     navLink "fas fa-gem"
@@ -119,20 +117,24 @@ view page =
     ( title
     , { title = navbarTitle, links = navbarLinks }
     , [ div [ class "container" ] <|
-            viewSessionBar maybeSession [ controls ]
+            viewSessionBar (maybeSession page) [ controls ]
                 :: content
       ]
     )
 
 
-viewSessionBar maybeSession controls =
+viewSessionBar session controls =
     let
         user =
-            case Maybe.map Session.user maybeSession of
+            case Maybe.map Session.user session of
                 Nothing ->
                     [ text "" ]
 
-                Just (Session.Player player wealth) ->
+                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" ]
@@ -179,27 +181,136 @@ navLink icon linkText url =
 
 
 type PageMsg
-    = GotChestMsg Chest.Msg
+    = ApiMsg Api.Msg
-    | GotAdminMsg Admin.Msg
+    | GotGroupChestMsg GroupChest.Msg
+    | GotDashboardMsg Dashboard.Msg
     | GotShopMsg Shop.Msg
     | Wealth Wealth.Msg
 
 
+
+-- Maps the page session to a function, if any
+
+
+map func page =
+    case maybeSession page of
+        Nothing ->
+            page
+
+        Just session ->
+            case page of
+                Dashboard model ->
+                    Dashboard <| Dashboard.updateSession model (func session)
+
+                GroupChest model ->
+                    GroupChest { model | session = func session }
+
+                Shop model ->
+                    Shop { model | session = func session }
+
+                _ ->
+                    page
+
+
 update msg page =
-    case ( msg, page ) of
+    case ( msg, page, maybeSession page ) of
-        ( GotChestMsg subMsg, Chest chest ) ->
+        ( GotGroupChestMsg subMsg, GroupChest chest, _ ) ->
-            Chest.update subMsg chest
+            GroupChest.update subMsg chest
-                |> updatePage Chest GotChestMsg
+                |> updatePage GroupChest GotGroupChestMsg
 
-        ( GotAdminMsg subMsg, Admin admin ) ->
+        ( GotGroupChestMsg _, _, _ ) ->
-            Admin.update subMsg admin
+            ( page, Cmd.none )
-                |> updatePage Admin GotAdminMsg
 
-        ( GotShopMsg subMsg, Shop shop ) ->
+        ( GotDashboardMsg (Dashboard.Api apiMsg), Dashboard home, _ ) ->
+            update (ApiMsg apiMsg) page
+
+        ( GotDashboardMsg subMsg, Dashboard home, _ ) ->
+            Dashboard.update subMsg home
+                |> updatePage Dashboard GotDashboardMsg
+
+        ( 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
 
-        _ ->
+        ( GotShopMsg _, _, _ ) ->
+            ( page, Cmd.none )
+
+        ( Wealth wealthMsg, _, Just session ) ->
+            let
+                wealthModel =
+                    Session.wealth session
+            in
+            case Session.user session of
+                Session.Player player aModel _ ->
+                    let
+                        ( newWealth, maybeEdit ) =
+                            Wealth.update wealthMsg aModel
+                    in
+                    ( map (Session.updateWealth newWealth) page
+                    , case maybeEdit of
+                        Just amount ->
+                            Api.confirmAction
+                                (String.fromInt (.id player))
+                                (Api.WealthPayload amount)
+                                |> Cmd.map ApiMsg
+
+                        Nothing ->
+                            Cmd.none
+                    )
+
+                _ ->
+                    Debug.log "not a player but updates wealth"
+                        ( page, Cmd.none )
+
+        ( Wealth wealthMsg, _, Nothing ) ->
+            ( page, Cmd.none )
+
+        ( ApiMsg (Api.GotActionResult response), _, Just session ) ->
+            let
+                _ =
+                    Debug.log "got api response" response
+            in
+            case response of
+                Ok result ->
+                    let
+                        updates =
+                            Maybe.withDefault [] result.updates
+
+                        notification =
+                            result.notification
+
+                        errors =
+                            Maybe.withDefault "" result.errors
+
+                        newUser =
+                            Debug.log "newUser" <|
+                                List.foldl applyUpdate (Session.user session) updates
+                    in
+                    ( map (Session.updateUser newUser) page
+                    , Cmd.none
+                    )
+
+                -- |> setNotification notification
+                -- |> setError errors
+                -- |> update (ModeSwitched View)
+                Err r ->
+                    let
+                        _ =
+                            Debug.log "ERR: ActionResult:" r
+                    in
+                    ( page, Cmd.none )
+
+        ( ApiMsg apiMsg, _, Nothing ) ->
+            let
+                _ =
+                    Debug.log "rogue api msg !" apiMsg
+            in
             ( page, Cmd.none )
 
 
@@ -209,28 +320,97 @@ updatePage toPage toMsg ( subModel, subMsg ) =
     )
 
 
+applyUpdate : Api.Update -> Session.User -> Session.User
+applyUpdate u user =
+    let
+        _ =
+            Debug.log "applyUpdate" u
+
+        _ =
+            Debug.log "on" user
+    in
+    {- Note: DbUpdates always refer to the active player -}
+    case user of
+        Session.Player player wealthModel loot ->
+            case u of
+                Api.ItemRemoved item ->
+                    Session.Player player wealthModel <|
+                        List.filter
+                            (\i -> i.id /= item.id)
+                            loot
+
+                Api.ItemAdded item ->
+                    Session.Player player wealthModel (item :: loot)
+
+                Api.WealthUpdated diff ->
+                    let
+                        wealth =
+                            player.wealth
+
+                        _ =
+                            Debug.log "updatePlayerWealth" diff
+                    in
+                    Session.Player
+                        { player
+                            | wealth =
+                                Api.Player.Wealth
+                                    (wealth.cp + diff.cp)
+                                    (wealth.sp + diff.sp)
+                                    (wealth.gp + diff.gp)
+                                    (wealth.pp + diff.pp)
+                        }
+                        wealthModel
+                        loot
+
+                Api.ClaimAdded claim ->
+                    -- { model | claims = claim :: model.claims }
+                    user
+
+                Api.ClaimRemoved claim ->
+                    -- { model | claims = List.filter (\c -> c.id /= claim.id) model.claims }
+                    user
+
+        Session.Admin ->
+            user
+
+
 
 -- CHANGE ROUTE
 
 
-gotoHome session =
+initHome session =
-    case Session.user session of
+    Dashboard.init session
-        Session.Player _ _ ->
+        |> updatePage Dashboard GotDashboardMsg
-            Chest.init session
-                |> updatePage Chest GotChestMsg
-
-        Session.Admin ->
-            Admin.init session
-                |> updatePage Admin GotAdminMsg
 
 
-gotoShop session =
+gotoHome page =
-    Shop.init session
+    case maybeSession page of
-        |> updatePage Shop GotShopMsg
+        Nothing ->
+            ( page, Cmd.none )
+
+        Just session ->
+            Dashboard.init session
+                |> updatePage Dashboard GotDashboardMsg
 
 
-gotoGroupChest session =
+gotoShop page =
-    ()
+    case maybeSession page of
+        Nothing ->
+            ( page, Cmd.none )
+
+        Just session ->
+            Shop.init session
+                |> updatePage Shop GotShopMsg
+
+
+gotoGroupChest page =
+    case maybeSession page of
+        Nothing ->
+            ( page, Cmd.none )
+
+        Just session ->
+            GroupChest.init session
+                |> updatePage GroupChest GotGroupChestMsg
 
 
 gotoInventory session =

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/NewFromInventory.elm

@@ -7,11 +7,6 @@ import Html.Events exposing (..)
 import Table
 
 
-type ExitStatus
-    = Confirmed Loot
-    | Canceled
-
-
 type alias Model =
     { itemList : String
     , invalidItems : Loot
@@ -27,30 +22,10 @@ init =
         []
 
 
-view : Model -> ( Html Msg, List (Html Msg) )
+view : Model -> Html Msg
 view model =
-    let
+    article []
-        allLootValid =
+        [ div [ class "section" ]
-            if List.length model.invalidItems + List.length model.validItems == 0 then
-                False
-
-            else
-                List.all itemIsValid model.invalidItems
-    in
-    ( div [ class "buttons" ]
-        [ button
-            [ class "button"
-            , disabled <| not allLootValid
-            , onClick ConfirmClicked
-            ]
-            [ text "Ok" ]
-        , button
-            [ class "button"
-            , onClick CancelClicked
-            ]
-            [ text "Annuler" ]
-        ]
-    , [ div [ class "section" ]
             [ textarea
                 [ class "textarea"
                 , value model.itemList
@@ -64,10 +39,20 @@ view model =
                 ]
                 [ text "Mettre dans le coffre" ]
             ]
-      , div [ class "section" ]
+        , div [ class "section" ]
-            [ model.validItems ++ model.invalidItems |> Table.view viewOrEditRenderer ]
+            [ model.validItems
-      ]
+                ++ model.invalidItems
-    )
+                |> Table.view (Table.renderRowLevel viewOrEditRenderer (\i -> []))
+            ]
+        ]
+
+
+allValid model =
+    if List.length model.invalidItems + List.length model.validItems == 0 then
+        False
+
+    else
+        List.all itemIsValid model.invalidItems
 
 
 itemIsValid item =
@@ -111,7 +96,7 @@ viewOrEditRenderer item =
         ]
 
     else
-        Table.name item
+        [ p [] [ text <| .name item ] ]
 
 
 type Msg
@@ -120,24 +105,20 @@ type Msg
     | InvalidItemNameChanged Int String
     | InvalidItemPriceChanged Int String
     | GotCheckedItems Loot (Maybe String)
-    | ConfirmClicked
-    | CancelClicked
 
 
-update : Msg -> Model -> ( Model, Cmd Msg, Maybe ExitStatus )
+update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
     case msg of
         ItemListInput newList ->
             ( { model | itemList = newList }
             , Cmd.none
-            , Nothing
             )
 
         ItemListSend ->
             ( { model | itemList = "" }
             , Api.checkList GotCheckedItems <|
                 String.split "\n" model.itemList
-            , Nothing
             )
 
         GotCheckedItems valid errors ->
@@ -163,7 +144,6 @@ update msg model =
                 , validItems = valid ++ model.validItems
               }
             , Cmd.none
-            , Nothing
             )
 
         InvalidItemNameChanged id newName ->
@@ -173,7 +153,6 @@ update msg model =
                         |> editItem (\item -> { item | name = newName }) id
               }
             , Cmd.none
-            , Nothing
             )
 
         InvalidItemPriceChanged id newPrice ->
@@ -186,15 +165,8 @@ update msg model =
                     model.invalidItems |> editItem (\item -> { item | base_price = price }) id
               }
             , Cmd.none
-            , Nothing
             )
 
-        ConfirmClicked ->
-            ( model, Cmd.none, Just (Confirmed <| allLoot model) )
-
-        CancelClicked ->
-            ( model, Cmd.none, Just Canceled )
-
 
 allLoot model =
     model.invalidItems ++ model.validItems

src/Page/Chest/Selection.elm

@@ -0,0 +1,176 @@
+module Page.Chest.Selection exposing (Model, Msg, init, modifiers, selected, update, view)
+
+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 alias Selection =
+    Set Int
+
+
+type alias Data a =
+    Dict Int a
+
+
+type Model
+    = Model Selection (Data Int)
+
+
+init =
+    Model Set.empty Dict.empty
+
+
+view : Model -> Loot -> Html Msg
+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.renderSelectableRow
+            (\item -> [ p [] [ text item.name ] ])
+            (\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
+    = SwitchSelectionState Int
+    | PriceModifierChanged Int String
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg (Model selection data) =
+    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

@@ -0,0 +1,335 @@
+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 (..)
+import Page.Chest as Chest exposing (Chest)
+import Session exposing (Session)
+
+
+getSession model =
+    case model of
+        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
+    = PlayerChest Chest
+    | GroupChest Chest
+    | Sell Chest
+    | Add Chest
+
+
+init : Session -> ( Model, Cmd Msg )
+init session =
+    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 model of
+        Player (PlayerConfig session mode) ->
+            case Session.user session of
+                Session.Player player _ loot ->
+                    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 ]
+                                )
+
+                            GroupChest chest ->
+                                ( 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" ] ]
+                    ]
+              ]
+            )
+
+
+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
+    = 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,8 +41,8 @@ view model =
                 Session.Admin ->
                     text ""
 
-                Session.Player id ->
+                Session.Player p _ _ ->
-                    if id == 0 then
+                    if p.id == 0 then
                         button [ class "button" ] [ text "Vendre" ]
 
                     else

src/Page/Shop.elm

@@ -1,11 +1,12 @@
-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)
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
-import Page.Chest.NewFromInventory as NewChest
+import Page.Chest as Chest exposing (Chest)
+import Page.Chest.Selection as Selection
 import Session exposing (Session, getSession)
 import Set exposing (Set)
 import Table
@@ -13,115 +14,220 @@ import Table
 
 type alias Model =
     { session : Session
-    , state : State
+    , loot : Status Loot
+    , chest : Mode
     }
 
 
-type State
+type Status a
     = Loading
     | LoadError String
-    | View Loot
+    | Loaded a
-    | Refresh NewChest.Model
+
-    | Sending
+
+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, fetchShopItems )
+    ( 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) )
 view model =
-    case model.state of
+    case model.loot of
         Loading ->
-            ( text "", [ p [ class "title" ] [ text "loading..." ] ] )
+            ( text ""
+            , [ p [ class "title" ] [ text "loading..." ] ]
+            )
 
         LoadError error ->
-            ( text "", [ p [ class "has-text-danger" ] [ text <| "Error : " ++ error ] ] )
+            ( text ""
-
+            , [ p [ class "has-text-danger" ] [ text <| "Error : " ++ error ] ]
-        View loot ->
-            ( case Session.user model.session of
-                Session.Admin ->
-                    button [ class "button", onClick IntoRefresh ] [ text "Remplacer" ]
-
-                Session.Player _ _ ->
-                    button [ class "button" ] [ text "Acheter" ]
-            , [ Table.view Table.name loot ]
             )
 
-        Refresh chest ->
+        Loaded loot ->
             let
-                ( controls, content ) =
+                controls =
-                    NewChest.view chest
+                    case ( model.chest, Session.user model.session ) of
+                        ( View chest, Session.Admin ) ->
+                            btn "Remplacer" (Internal IntoRefresh)
 
-                toMsg =
+                        ( View chest, Session.Player _ _ _ ) ->
-                    Html.map GotChestMsg
+                            btn "Acheter" (Internal IntoBuy)
+
+                        ( Buy chest, Session.Player p _ _ ) ->
+                            buttons [ btn "Ok" (Internal ConfirmBuy), btn "Annuler" (Internal IntoView) ]
+
+                        ( Refresh chest, Session.Admin ) ->
+                            buttons [ btn "Ok" (Internal ConfirmRefresh), btn "Annuler" (Internal IntoView) ]
+
+                        _ ->
+                            text ""
             in
-            ( toMsg controls
+            ( controls
-            , List.map toMsg content
+            , [ Chest.view (getChest model.chest) loot |> Html.map (Internal << GotChestMsg) ]
             )
 
-        Sending ->
+
-            ( text "", [ p [] [ text "En attente du serveur..." ] ] )
+
+-- Api msg are not handled by the page
 
 
 type Msg
+    = Api Api.Msg
+    | Internal ShopMsg
+
+
+type ShopMsg
     = GotLoot Api.ToChest (HttpResult Loot)
     | IntoRefresh
-    | GotChestMsg NewChest.Msg
+    | 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
+--| GotBuyResult (Maybe ())
 
 
 update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
-    case ( msg, model.state ) of
+    case msg of
-        ( GotLoot Api.OfShop response, Loading ) ->
+        Internal ConfirmBuy ->
-            case response of
+            case ( Session.user (getSession model), model.loot, model.chest ) of
-                Ok loot ->
+                ( Session.Player player _ _, Loaded loot, Buy chest ) ->
-                    ( { model | state = View loot }, Cmd.none )
+                    ( model
-
+                    , Chest.confirmBuy
-                -- TODO: handle error
+                        player.id
-                Err e ->
+                        chest
-                    ( { model | state = LoadError <| Debug.toString e }, Cmd.none )
+                        loot
-
+                        |> Cmd.map Api
-        ( IntoRefresh, View _ ) ->
+                    )
-            case Session.user (getSession model) of
-                Session.Admin ->
-                    ( { model | state = Refresh NewChest.init }, Cmd.none )
 
                 _ ->
                     ( model, Cmd.none )
 
-        ( GotChestMsg chestMsg, Refresh chest ) ->
+        Internal (GotRefreshResult result) ->
-            let
-                ( newState, cmd, exit ) =
-                    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 :'( " }
+                    ( { 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 ->
+                                    ( { model | loot = Loaded loot }, Cmd.none )
+
+                                -- TODO: handle error
+                                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 ->
+                                    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 _ _ _ ->
+                                    ( { 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)
+
+                        _ ->
+                            ( model, Cmd.none )
+            in
+            ( nModel, Cmd.map Internal cmd )
+
         _ ->
             ( model, Cmd.none )

src/Session.elm

@@ -1,15 +1,16 @@
-module Session exposing (Session, User(..), getSession, init, key, user)
+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 Page.Chest.Wealth as Wealth
+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
@@ -53,3 +67,49 @@ user session =
             session
     in
     loggedUser
+
+
+wealth : Session -> Maybe Wealth.Model
+wealth session =
+    case user session of
+        Player _ model _ ->
+            Just model
+
+        Admin ->
+            Nothing
+
+
+setWealth wealthModel session =
+    let
+        (Session navKey isUser) =
+            session
+    in
+    case isUser of
+        Player p _ loot ->
+            Session navKey (Player p wealthModel loot)
+
+        Admin ->
+            Session navKey Admin
+
+
+updateWealth : Wealth.Model -> Session -> Session
+updateWealth newWealthModel model =
+    let
+        (Session navKey loggedUser) =
+            model
+    in
+    case loggedUser of
+        Player player _ loot ->
+            Session navKey (Player player newWealthModel loot)
+
+        Admin ->
+            Session navKey Admin
+
+
+updateUser : User -> Session -> Session
+updateUser newUser model =
+    let
+        (Session navKey _) =
+            model
+    in
+    Session navKey newUser

src/Table.elm

@@ -1,10 +1,15 @@
-module Table exposing (name, view)
+module Table exposing (name, renderRowLevel, renderSelectableRow, view)
 
 import Html exposing (..)
 import Html.Attributes exposing (..)
+import Html.Events exposing (..)
 
 
 type alias RowRenderer a msg =
+    a -> Html msg
+
+
+type alias ItemRenderer a msg =
     a -> List (Html msg)
 
 
@@ -15,10 +20,40 @@ view rowRenderer content =
             [ th [] [ text "Nom" ] ]
         , tbody [] <|
             List.map
-                (\i -> tr [] [ td [] <| rowRenderer i ])
+                rowRenderer
                 content
         ]
 
 
-name item =
+renderSelectableRow : ItemRenderer a msg -> ItemRenderer a msg -> (a -> Bool -> msg) -> (a -> Bool) -> RowRenderer a msg
-    [ p [] [ text item.name ] ]
+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 []
+        [ td [ class "level" ]
+            [ div [ class "level-left" ] <| left item
+            , div [ class "level-right" ] <| right item
+            ]
+        ]
+
+
+name =
+    renderRowLevel (\item -> [ p [] [ text item.name ] ]) (\item -> [])

src/Wealth.elm

@@ -1,4 +1,4 @@
-module Page.Chest.Wealth exposing (Model, Msg(..), editValue, init, update, view)
+module Wealth exposing (Model, Msg(..), editValue, init, update, view)
 
 import Api.Player exposing (Wealth)
 import Html exposing (..)
@@ -71,20 +71,22 @@ type Msg
     | ConfirmEdit
 
 
-update : Msg -> Model -> Model
+update : Msg -> Model -> ( Model, Maybe Float )
 update msg model =
     case msg of
         StartEdit ->
-            Edit "0.0"
+            ( Edit "0.0", Nothing )
 
         QuitEdit ->
-            View
+            ( View, Nothing )
 
         AmountChanged newAmount ->
-            Edit <| String.replace "," "." newAmount
+            ( Edit <| String.replace "," "." newAmount
+            , Nothing
+            )
 
-        _ ->
+        ConfirmEdit ->
-            View
+            ( View, editValue model )