works on admin page

src/Api.elm

@@ -6,19 +6,16 @@ module Api exposing
     , Item
     , Loot
     , Msg(..)
-    , Player
     , RequestData(..)
     , ToChest(..)
     , Update(..)
-    , Wealth
-    , blankPlayer
     , checkList
     , confirmAction
     , fetchClaimsOf
     , fetchLoot
-    , fetchPlayer
     )
 
+import Api.Player exposing (Player, Wealth)
 import Http
 import Json.Decode as D exposing (Decoder, field, int, string, succeed)
 import Json.Encode as E
@@ -57,29 +54,6 @@ type Msg
 -- MODELS
 ---
 -- Player
-
-
-type alias Player =
-    { id : Int
-    , name : String
-    , debt : Int
-    , wealth : Wealth
-    }
-
-
-blankPlayer =
-    Player 0 "Loot-a-lot" 0 (Wealth 0 0 0 0)
-
-
-type alias Wealth =
-    { cp : Int
-    , sp : Int
-    , gp : Int
-    , pp : Int
-    }
-
-
-
 -- Loot
 
 
@@ -137,37 +111,6 @@ fetchClaimsOf toMsg playerId =
 
 
 
--- PLAYERS
---
-
-
-fetchPlayer : (Result Http.Error Player -> msg) -> Int -> Cmd msg
-fetchPlayer toMsg id =
-    Http.get
-        { url = "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/"
-        , expect = Http.expectJson toMsg (valueDecoder playerDecoder)
-        }
-
-
-playerDecoder : Decoder Player
-playerDecoder =
-    D.map4 Player
-        (D.field "id" int)
-        (D.field "name" string)
-        (D.field "debt" int)
-        wealthDecoder
-
-
-wealthDecoder : Decoder Wealth
-wealthDecoder =
-    D.map4 Wealth
-        (D.field "cp" int)
-        (D.field "sp" int)
-        (D.field "gp" int)
-        (D.field "pp" int)
-
-
-
 -- LOOT
 -- Location of a loot
 
@@ -291,7 +234,7 @@ updatesDecoder =
     D.oneOf
         [ field "ItemRemoved" (itemDecoder |> D.andThen (\i -> succeed <| ItemRemoved i))
         , field "ItemAdded" (itemDecoder |> D.andThen (\i -> succeed <| ItemAdded i))
-        , field "Wealth" (wealthDecoder |> D.andThen (\i -> succeed <| WealthUpdated i))
+        , field "Wealth" (Api.Player.wealthDecoder |> D.andThen (\i -> succeed <| WealthUpdated i))
         , field "ClaimRemoved" (claimDecoder |> D.andThen (\i -> succeed <| ClaimRemoved i))
         , field "ClaimAdded" (claimDecoder |> D.andThen (\i -> succeed <| ClaimAdded i))
         ]

src/Api/Player.elm

@@ -0,0 +1,78 @@
+module Api.Player exposing (Player, Wealth, blankPlayer, get, list, wealthDecoder)
+
+import Http
+import Json.Decode as D exposing (Decoder, int, string)
+
+
+type alias Player =
+    { id : Int
+    , name : String
+    , debt : Int
+    , wealth : Wealth
+    }
+
+
+playerDecoder : Decoder Player
+playerDecoder =
+    D.map4 Player
+        (D.field "id" int)
+        (D.field "name" string)
+        (D.field "debt" int)
+        wealthDecoder
+
+
+type alias Wealth =
+    { cp : Int
+    , sp : Int
+    , gp : Int
+    , pp : Int
+    }
+
+
+wealthDecoder : Decoder Wealth
+wealthDecoder =
+    D.map4 Wealth
+        (D.field "cp" int)
+        (D.field "sp" int)
+        (D.field "gp" int)
+        (D.field "pp" int)
+
+
+
+-- PLAYERS
+
+
+blankPlayer =
+    Player 0 "Loot-a-lot" 0 (Wealth 0 0 0 0)
+
+
+get : (Result Http.Error Player -> msg) -> Int -> Cmd msg
+get toMsg id =
+    Http.get
+        { url = "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/"
+        , expect = Http.expectJson toMsg (valueDecoder playerDecoder)
+        }
+
+
+list : (List Player -> msg) -> Cmd msg
+list toMsg =
+    let
+        parseResponse : Result Http.Error (List Player) -> msg
+        parseResponse response =
+            case response of
+                Ok players ->
+                    toMsg players
+
+                Err e ->
+                    Debug.log ("Player's list fetch error : " ++ Debug.toString e) <|
+                        toMsg []
+    in
+    Http.get
+        { url = "http://localhost:8088/api/players/"
+        , expect = Http.expectJson parseResponse (valueDecoder <| D.list playerDecoder)
+        }
+
+
+valueDecoder : Decoder a -> Decoder a
+valueDecoder thenDecoder =
+    D.field "value" thenDecoder

src/Main.elm

@@ -1,6 +1,5 @@
 module Main exposing (..)
 
-import Api exposing (Claim, Claims, Item, Loot, Player, Wealth)
 import Browser
 import Browser.Navigation as Nav
 import Html exposing (..)
@@ -117,7 +116,7 @@ viewPage page =
                     ( "Loot-a-lot", List.map (Html.map GotChestMsg) (Chest.view chest) )
 
                 Admin admin ->
-                    ( "Administration", Admin.view admin )
+                    ( "Administration", List.map (Html.map GotAdminMsg) (Admin.view admin) )
 
                 About ->
                     ( "A propos", [ p [] [ text "A propos" ] ] )
@@ -214,21 +213,8 @@ type Msg
 
 update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
-    let
+    case ( msg, model.page ) of
-        updateChest chestMsg =
+        ( SessionLoaded session, _ ) ->
-            case model.page of
-                Chest chest ->
-                    let
-                        ( newChest, cmd ) =
-                            Chest.update chestMsg chest
-                    in
-                    ( setPage (Chest newChest) model, Cmd.map GotChestMsg cmd )
-
-                _ ->
-                    ( model |> setPage About, Cmd.none )
-    in
-    case msg of
-        SessionLoaded session ->
             case session of
                 Just logged ->
                     let
@@ -256,7 +242,7 @@ update msg model =
                 Nothing ->
                     ( model |> setPage About, Cmd.none )
 
-        LinkClicked urlRequest ->
+        ( LinkClicked urlRequest, _ ) ->
             case model.page of
                 Chest chestModel ->
                     case urlRequest of
@@ -269,26 +255,40 @@ update msg model =
                 _ ->
                     ( model, Cmd.none )
 
-        UrlChanged url ->
+        ( UrlChanged url, page ) ->
-            let
+            -- Handle routing according to current page
-                route =
+            case ( Route.fromUrl url, page ) of
-                    Route.fromUrl url
+                ( Just (Route.Home content), Chest _ ) ->
-            in
+                    update
-            case route of
+                        (GotChestMsg <| Chest.SetContent content)
-                Just (Route.Home content) ->
+                        model
-                    updateChest (Chest.SetContent content)
+
+                ( Just (Route.Home MerchantLoot), Admin _ ) ->
+                    ( model, Cmd.none )
 
                 _ ->
                     ( model |> setPage About, Cmd.none )
 
-        GotChestMsg chestMsg ->
+        ( SwitchMenuOpen, _ ) ->
-            updateChest chestMsg
+            ( { model | navbar = Navbar (not model.navbar.menuOpen) model.navbar.navKey }, Cmd.none )
 
-        GotAdminMsg adminMsg ->
+        ( GotChestMsg chestMsg, Chest chest ) ->
+            Chest.update chestMsg chest
+                |> updatePage Chest GotChestMsg model
+
+        ( GotAdminMsg adminMsg, Admin adminModel ) ->
+            Admin.update adminMsg adminModel
+                |> updatePage Admin GotAdminMsg model
+
+        ( _, _ ) ->
             ( model, Cmd.none )
 
-        SwitchMenuOpen ->
+
-            ( { model | navbar = Navbar (not model.navbar.menuOpen) model.navbar.navKey }, Cmd.none )
+updatePage : (pageModel -> Page) -> (pageMsg -> Msg) -> Model -> ( pageModel, Cmd pageMsg ) -> ( Model, Cmd Msg )
+updatePage toModel toMsg model ( pageModel, pageCmd ) =
+    ( { model | page = toModel pageModel }
+    , Cmd.map toMsg pageCmd
+    )
 
 
 

src/Page/Admin.elm

@@ -1,23 +1,110 @@
 module Page.Admin exposing (..)
 
+import Api.Player as Player exposing (Player, Wealth)
 import Browser.Navigation as Nav
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
 
 
-type alias Model =
+type alias NewPlayer =
-    { navKey : Nav.Key
+    { name : String
+    , wealth : Float
     }
 
 
+type alias Model =
+    { navKey : Nav.Key
+    , players : List Player
+    , newPlayer : NewPlayer
+    }
+
+
+init : Nav.Key -> ( Model, Cmd Msg )
 init navKey =
-    ( { navKey = navKey }, Cmd.none )
+    ( { navKey = navKey
+      , players = []
+      , newPlayer = { name = "", wealth = 0.0 }
+      }
+    , Player.list GotPlayers
+    )
 
 
+view : Model -> List (Html Msg)
 view model =
-    [ p [ class "title" ] [ text "Administration" ] ]
+    [ p [ class "title" ] [ text "Administration" ]
+    , div [ class "section" ]
+        [ table [ class "table is-fullwidth is-striped" ]
+            [ thead [ class "table-header" ]
+                [ th [] [ text "Joueurs" ] ]
+            , tbody [] <|
+                editNewPlayer model.newPlayer
+                    :: List.map viewPlayer model.players
+            ]
+        ]
+    , div [ class "section" ]
+        [ p [] [ text "Campagnes" ] ]
+    ]
+
+
+viewPlayer : Player -> Html Msg
+viewPlayer player =
+    tr [] [ td [] [ p [] [ text (player.name ++ " (" ++ String.fromInt player.id ++ ")") ] ] ]
+
+
+editNewPlayer : NewPlayer -> 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
+                            ]
+                            []
+                        ]
+                    ]
+                ]
+            ]
+        ]
 
 
 type Msg
-    = Nope
+    = GotPlayers (List Player)
+    | NameChanged String
+    | WealthChanged String
+
+
+update msg model =
+    case msg of
+        GotPlayers players ->
+            ( Debug.log "GotPlayers" { model | players = players }, Cmd.none )
+
+        NameChanged newName ->
+            let
+                newPlayer =
+                    model.newPlayer
+            in
+            ( { model | newPlayer = { newPlayer | name = newName } }, Cmd.none )
+
+        WealthChanged newWealth ->
+            let
+                newPlayer =
+                    model.newPlayer
+            in
+            ( { model | newPlayer = { newPlayer | wealth = Maybe.withDefault 0.0 <| String.toFloat newWealth } }
+            , Cmd.none
+            )

src/Page/Chest.elm

@@ -10,6 +10,7 @@ import Api
         , RequestData(..)
         , confirmAction
         )
+import Api.Player exposing (Player, Wealth, blankPlayer)
 import Browser.Navigation as Nav
 import Dict exposing (Dict)
 import Html exposing (..)
@@ -42,7 +43,7 @@ type alias State =
 
     -- , inventoryItems : Loot
     -- Fetched on init
-    , player : Api.Player
+    , player : Player
     , playerLoot : Loot
     , groupLoot : Loot
     , merchantLoot : Loot
@@ -78,7 +79,7 @@ init navKey playerId =
             Nothing
             Nothing
             Nothing
-            Api.blankPlayer
+            blankPlayer
             []
             []
             []
@@ -88,11 +89,11 @@ init navKey playerId =
         Nothing
         ""
         (Wealth.init
-            Api.blankPlayer.wealth
+            blankPlayer.wealth
         )
         []
     , Cmd.batch
-        [ Api.fetchPlayer GotPlayer playerId
+        [ Api.Player.get GotPlayer playerId
         , Api.fetchClaimsOf GotClaims playerId
         , Api.fetchLoot GotLoot (Api.OfPlayer playerId)
         , Api.fetchLoot GotLoot Api.OfGroup
@@ -129,7 +130,7 @@ viewNotification model =
 -- PLAYER BAR
 
 
-viewPlayerBar : Api.Player -> List (Html Msg) -> Wealth.Model -> Html Msg
+viewPlayerBar : Player -> List (Html Msg) -> Wealth.Model -> Html Msg
 viewPlayerBar player actionControls wealthModel =
     section [ class "hero is-dark is-bold" ]
         [ div [ class "hero-body" ]
@@ -711,7 +712,7 @@ type Msg
     = ApiMsg Api.Msg
     | GotLoot Api.ToChest (HttpResult Loot)
     | GotClaims (HttpResult Claims)
-    | GotPlayer (HttpResult Api.Player)
+    | GotPlayer (HttpResult Player)
       -- Chest UI
     | ClearNotification
     | SetContent ChestContent
@@ -1177,7 +1178,7 @@ applyUpdate u model =
                         | player =
                             { player
                                 | wealth =
-                                    Api.Wealth
+                                    Api.Player.Wealth
                                         (wealth.cp + diff.cp)
                                         (wealth.sp + diff.sp)
                                         (wealth.gp + diff.gp)

src/Page/Chest/Wealth.elm

@@ -1,6 +1,6 @@
 module Page.Chest.Wealth exposing (Model, Msg(..), editValue, init, update, view)
 
-import Api
+import Api.Player exposing (Wealth)
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
@@ -45,7 +45,7 @@ viewUpdateWealth amount =
     ]
 
 
-viewWealth : Api.Wealth -> List (Html Msg)
+viewWealth : Wealth -> List (Html Msg)
 viewWealth wealth =
     [ showWealthField "pp" <| String.fromInt wealth.pp
     , showWealthField "gp" <| String.padLeft 2 '0' <| String.fromInt wealth.gp

src/Route.elm

@@ -1,20 +1,39 @@
-module Route exposing(..)
+module Route exposing (..)
 
 import Url
-import Url.Parser as P exposing (Parser, (</>), oneOf, s)
+import Url.Parser as P exposing ((</>), Parser, oneOf, s)
+
+
 
 -- ROUTES
 
+
 type ChestContent
     = PlayerLoot
     | MerchantLoot
     | GroupLoot
     | NewLoot
 
+
 type Route
     = Home ChestContent
     | About
-    | Admin
+
+
+
+{-
+   We could flatten this :
+
+   type Route
+     = Home  -- Either PlayerChest or Admin depending on Session
+     | About
+     | Merchant
+     | GroupChest
+     | NewLoot
+
+
+
+-}
 
 
 parser : P.Parser (Route -> a) a
@@ -25,9 +44,9 @@ parser =
         , P.map (Home MerchantLoot) (P.s "marchand")
         , P.map (Home NewLoot) (P.s "nouveau-tresor")
         , P.map About (P.s "about")
-            , P.map Admin (P.s "admin")
         ]
 
+
 fromUrl : Url.Url -> Maybe Route
 fromUrl url =
     P.parse parser url

src/Session.elm

@@ -21,6 +21,10 @@ init toMsg navKey =
         toSession response =
             case Debug.log "got session:" response of
                 Ok value ->
+                    if value == "admin" then
+                        toMsg <| Just (Session navKey Admin)
+
+                    else
                         case String.toInt value of
                             Just id ->
                                 toMsg <| Just (Session navKey (Player id))