makes filter search case insensitive

Refactors to improve scalability

css/lootalot.css

@@ -1,9 +1,11 @@
 @charset "UTF-8";
-.navbar.is-spaced a.navbar-item.is-active {
+/*
-  border-bottom: 1px solid #2e3440;
+ .navbar.is-spaced a.navbar-item.is-active {
-  border-radius: 0;
+    border-bottom: 1px solid $dark;
+    border-radius: 0;
 }
 
+/*/
 .hero.is-dark.is-bold {
   background-image: linear-gradient(280deg, #191c22 0%, #2e3440 71%, #3b4252 100%) !important;
 }

sass/lootalot.scss

@@ -30,11 +30,14 @@ $notification-padding: 0.8rem 2.5rem 0.8rem 1rem;
 
 //$box-radius: 0 0 2rem 2rem;
 
-.navbar.is-spaced a.navbar-item.is-active {
+/*
+ .navbar.is-spaced a.navbar-item.is-active {
     border-bottom: 1px solid $dark;
     border-radius: 0;
 }
 
+/*/
+
 .hero.is-dark.is-bold {
     background-image: linear-gradient(280deg, darken($dark, 10) 0%, $dark 71%, $dark-bis 100%) !important;
 }

src/Api.elm

@@ -8,6 +8,7 @@ module Api exposing
     , RequestData(..)
     , ToChest(..)
     , Update(..)
+    , adminAddPlayer
     , checkList
     , confirmAction
     , fetchLoot
@@ -92,10 +93,6 @@ type alias Loot =
     List Item
 
 
-
--- Location of a loot
-
-
 lootDecoder : Decoder Loot
 lootDecoder =
     D.list itemDecoder
@@ -107,23 +104,23 @@ type ToChest
     | OfShop
 
 
-fetchLoot : (ToChest -> Result Http.Error Loot -> msg) -> ToChest -> Cmd msg
+fetchLoot : (Result Http.Error Loot -> msg) -> ToChest -> Cmd msg
 fetchLoot toMsg dest =
     let
         url =
             case dest of
                 OfPlayer id ->
-                    "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/loot"
+                    "api/players/" ++ String.fromInt id ++ "/loot"
 
                 OfShop ->
-                    "http://localhost:8088/api/shop"
+                    "api/shop"
 
                 OfGroup ->
-                    "http://localhost:8088/api/players/0/loot"
+                    "api/players/0/loot"
     in
     Http.get
         { url = url
-        , expect = Http.expectJson (toMsg dest) (valueDecoder lootDecoder)
+        , expect = Http.expectJson toMsg (valueDecoder lootDecoder)
         }
 
 
@@ -139,14 +136,16 @@ type alias Claim =
     { id : Int
     , player_id : Int
     , loot_id : Int
+    , conflicts : Bool
     }
 
 
 claimDecoder =
-    D.map3 Claim
+    D.map4 Claim
         (D.field "id" int)
         (D.field "player_id" int)
         (D.field "loot_id" int)
+        (D.succeed False)
 
 
 
@@ -187,7 +186,7 @@ checkList toMsg itemList =
                     toMsg [] <| Just (printError e)
     in
     Http.post
-        { url = "http://localhost:8088/api/items"
+        { url = "api/items"
         , body =
             E.list (\t -> E.string t) itemList
                 |> Http.jsonBody
@@ -244,6 +243,10 @@ apiResponseDecoder toValue =
         (D.maybe (field "errors" string))
 
 
+emptyResponse =
+    apiResponseDecoder (D.succeed ())
+
+
 
 {- ACTIONS
 
@@ -330,27 +333,27 @@ confirmAction id data =
         ( endpoint, method ) =
             case data of
                 AddPayload _ _ ->
-                    ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
+                    ( "api/players/" ++ id ++ "/loot"
                     , "POST"
                     )
 
                 BuyPayload _ _ _ ->
-                    ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
+                    ( "api/players/" ++ id ++ "/loot"
                     , "PUT"
                     )
 
                 SellPayload _ _ _ _ ->
-                    ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
+                    ( "api/players/" ++ id ++ "/loot"
                     , "DELETE"
                     )
 
                 GrabPayload _ ->
-                    ( "http://localhost:8088/api/players/" ++ id ++ "/claims"
+                    ( "api/players/" ++ id ++ "/claims"
                     , "POST"
                     )
 
                 WealthPayload _ ->
-                    ( "http://localhost:8088/api/players/" ++ id ++ "/wealth"
+                    ( "api/players/" ++ id ++ "/wealth"
                     , "PUT"
                     )
     in
@@ -367,7 +370,7 @@ confirmAction id data =
 
 undoLastAction id =
     Http.request
-        { url = "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/events/last"
+        { url = "api/players/" ++ String.fromInt id ++ "/events/last"
         , method = "DELETE"
         , headers = []
         , body = Http.emptyBody
@@ -398,11 +401,11 @@ replaceShopItems toMsg loot =
                     toMsg Nothing
     in
     Http.request
-        { url = "http://localhost:8088/api/shop"
+        { url = "api/shop"
         , method = "POST"
         , headers = []
         , body = Http.jsonBody data
-        , expect = Http.expectJson gotResponse (apiResponseDecoder <| D.succeed ())
+        , expect = Http.expectJson gotResponse emptyResponse
         , timeout = Nothing
         , tracker = Nothing
         }
@@ -412,7 +415,7 @@ send : { method : String, path : String, decoder : Decoder a } -> Task Http.Erro
 send { method, path, decoder } =
     Http.task
         { method = method
-        , url = "http://localhost:8088/" ++ path
+        , url = path
         , headers = []
         , body = Http.emptyBody
         , resolver = Http.stringResolver <| handleJsonResponse decoder
@@ -432,20 +435,85 @@ getLoot id =
         }
 
 
-getClaims id =
-    let
-        path =
-            if id == 0 then
-                "api/claims"
 
-            else
+-- Updates the conflicts field on every claims
-                "api/players/" ++ String.fromInt id ++ "/claims"
+
-    in
+
+groupByLoot : List Claims -> Claims -> List Claims
+groupByLoot acc claims =
+    case claims of
+        last :: [] ->
+            groupByLoot ([ last ] :: acc) []
+
+        first :: rest ->
+            let
+                ( newGroup, left ) =
+                    List.partition (\c -> c.loot_id == first.loot_id) rest
+            in
+            groupByLoot ((first :: newGroup) :: acc) left
+
+        [] ->
+            acc
+
+
+updateConflicts : Claims -> Claims
+updateConflicts claims =
+    groupByLoot [] claims
+        |> List.concatMap
+            (\group ->
+                let
+                    _ =
+                        Debug.log "updating group" group
+                in
+                case group of
+                    [] ->
+                        []
+
+                    [ c ] ->
+                        [ { c | conflicts = False } ]
+
+                    xs ->
+                        List.map (\c -> { c | conflicts = True }) xs
+            )
+
+
+parseClaims : Int -> Claims -> Task x Claims
+parseClaims id claims =
+    -- Filter claims relevant to player
+    Task.succeed <|
+        List.filter (\claim -> id == 0 || claim.player_id == id) <|
+            updateConflicts claims
+
+
+getClaims : Int -> Task Http.Error Claims
+getClaims id =
     send
         { method = "GET"
-        , path = path
+        , path = "api/claims"
         , decoder = valueDecoder (D.list claimDecoder)
         }
+        |> Task.andThen (parseClaims id)
+
+
+
+-- ADMIN
+--
+
+
+adminAddPlayer : { d | name : String, wealth : Float } -> Cmd Msg
+adminAddPlayer data =
+    let
+        json =
+            E.object
+                [ ( "name", E.string data.name )
+                , ( "wealth", E.float data.wealth )
+                ]
+    in
+    Http.post
+        { url = "api/players/"
+        , body = Http.jsonBody json
+        , expect = Http.expectJson GotActionResult emptyResponse
+        }
 
 
 

src/Api/Player.elm

@@ -49,7 +49,7 @@ blankPlayer =
 get : (Result Http.Error Player -> msg) -> Int -> Cmd msg
 get toMsg id =
     Http.get
-        { url = "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/"
+        { url = "api/players/" ++ String.fromInt id ++ "/"
         , expect = Http.expectJson toMsg (valueDecoder playerDecoder)
         }
 
@@ -64,11 +64,14 @@ list toMsg =
                     toMsg players
 
                 Err e ->
-                    Debug.log ("Player's list fetch error : " ++ Debug.toString e) <|
+                    let
-                        toMsg []
+                        _ =
+                            Debug.log "Player's list fetch error" (Debug.toString e)
+                    in
+                    toMsg []
     in
     Http.get
-        { url = "http://localhost:8088/api/players/"
+        { url = "api/players/"
         , expect = Http.expectJson parseResponse (valueDecoder <| D.list playerDecoder)
         }
 

src/Bulma.elm

@@ -88,9 +88,23 @@ levelItem =
 
 
 
+-- INPUTS
+--
+
+
+inputField : String -> (String -> msg) -> Html msg
+inputField val toMsg =
+    input [ class "input", value val, onInput toMsg ] []
+
+
+
 -- COLORS
 --
 
 
 isInfo =
     class "is-info"
+
+
+isError =
+    class "is-error"

src/Chest.elm

@@ -29,10 +29,10 @@ type alias RowRenderer msg =
 
 type Chest
     = New NewFromInventory.Model
-    | View (Item -> Html Never)
+    | View FilterText (Item -> Html Never)
-    | Buy Selection.Model
+    | Buy FilterText Selection.Model
-    | Sell Selection.Model
+    | Sell FilterText Selection.Model
-    | Claim Selection.Model
+    | Claim FilterText Selection.Model
 
 
 type IntoMode
@@ -44,6 +44,10 @@ type IntoMode
     | IntoClaim Claims
 
 
+type alias FilterText =
+    String
+
+
 
 {-
 
@@ -66,7 +70,7 @@ type IntoMode
 
 
 init =
-    View Table.name
+    View "" Table.name
 
 
 intoMode : IntoMode -> Msg
@@ -100,31 +104,51 @@ claim initialClaims =
 
 showWith : Table.ItemRenderer Item Never -> Chest
 showWith renderItem =
-    View <| Table.renderRowLevel renderItem (\_ -> [])
+    View "" <| Table.renderRowLevel renderItem (\_ -> [])
 
 
 view : Chest -> Loot -> Html Msg
 view model loot =
+    let
+        filterLoot txt ls =
+            List.filter (\i -> String.contains (String.toLower txt) (String.toLower i.name)) ls
+    in
     case model of
-        View renderItem ->
+        View filterText renderItem ->
-            Table.view renderItem loot
+            div []
-                |> Html.map GotViewMsg
+                [ viewFilterInput filterText
+                , Table.view renderItem (filterLoot filterText loot)
+                    |> Html.map GotViewMsg
+                ]
 
-        Buy subModel ->
+        Buy filterText subModel ->
-            Selection.view subModel loot
+            div []
-                |> Html.map GotSelectionMsg
+                [ viewFilterInput filterText
+                , Selection.view subModel (filterLoot filterText loot)
+                    |> Html.map GotSelectionMsg
+                ]
 
-        Sell subModel ->
+        Sell filterText subModel ->
-            Selection.view subModel loot
+            div []
-                |> Html.map GotSelectionMsg
+                [ viewFilterInput filterText
+                , Selection.view subModel (filterLoot filterText loot)
+                    |> Html.map GotSelectionMsg
+                ]
 
         New subModel ->
             NewFromInventory.view subModel
                 |> Html.map GotNewMsg
 
-        Claim subModel ->
+        Claim filterText subModel ->
-            Selection.view subModel loot
+            div []
-                |> Html.map GotSelectionMsg
+                [ viewFilterInput filterText
+                , Selection.view subModel (filterLoot filterText loot)
+                    |> Html.map GotSelectionMsg
+                ]
+
+
+viewFilterInput filterText =
+    B.inputField filterText FilterTextChanged
 
 
 type Msg
@@ -132,11 +156,15 @@ type Msg
     | GotSelectionMsg Selection.Msg
     | GotViewMsg Never
     | IntoMode IntoMode
+    | FilterTextChanged String
 
 
 update : Msg -> Chest -> ( Chest, Cmd Msg )
 update msg model =
     case ( msg, model ) of
+        ( FilterTextChanged newText, m ) ->
+            ( updateFilterText newText m, Cmd.none )
+
         ( GotNewMsg subMsg, New subModel ) ->
             NewFromInventory.update subMsg subModel
                 |> updateChest GotNewMsg New
@@ -144,17 +172,17 @@ update msg model =
         ( GotNewMsg subMsg, _ ) ->
             ( model, Cmd.none )
 
-        ( GotSelectionMsg subMsg, Buy subModel ) ->
+        ( GotSelectionMsg subMsg, Buy f subModel ) ->
             Selection.update subMsg subModel
-                |> updateChest GotSelectionMsg Buy
+                |> updateChest GotSelectionMsg (Buy f)
 
-        ( GotSelectionMsg subMsg, Sell subModel ) ->
+        ( GotSelectionMsg subMsg, Sell f subModel ) ->
             Selection.update subMsg subModel
-                |> updateChest GotSelectionMsg Sell
+                |> updateChest GotSelectionMsg (Sell f)
 
-        ( GotSelectionMsg subMsg, Claim subModel ) ->
+        ( GotSelectionMsg subMsg, Claim f subModel ) ->
             Selection.update subMsg subModel
-                |> updateChest GotSelectionMsg Claim
+                |> updateChest GotSelectionMsg (Claim f)
 
         ( GotSelectionMsg subMsg, _ ) ->
             ( model, Cmd.none )
@@ -162,43 +190,59 @@ update msg model =
         ( IntoMode newMode, _ ) ->
             case newMode of
                 IntoView ->
-                    ( View Table.name, Cmd.none )
+                    ( View "" Table.name, Cmd.none )
 
                 IntoViewWithClaims claims ->
                     let
                         isClaimed item =
-                            List.any (\claim_ -> claim_.loot_id == item.id) claims
+                            case List.filter (\c -> c.loot_id == item.id) claims of
+                                [ c ] ->
+                                    Just c
+
+                                [] ->
+                                    Nothing
+
+                                _ ->
+                                    Debug.log "Warning ! Duplicated claim found" Nothing
 
                         renderItem item =
                             [ p [ B.levelItem ] [ text item.name ]
-                            , if isClaimed item then
+                            , case isClaimed item of
-                                B.tag [ B.levelItem, B.isInfo ]
+                                Just c ->
-                                    [ B.icon
+                                    B.tag
-                                        { icon = "fas fa-praying-hands"
+                                        [ B.levelItem
-                                        , size = Just "is-small"
+                                        , if c.conflicts then
-                                        , ratio = Just "fa-1x"
+                                            B.isError
-                                        }
-                                    , text "time left..."
-                                    ]
 
-                              else
+                                          else
-                                text ""
+                                            B.isInfo
+                                        ]
+                                        [ B.icon
+                                            { icon = "fas fa-praying-hands"
+                                            , size = Just "is-small"
+                                            , ratio = Just "fa-1x"
+                                            }
+                                        , p [] [ text "en attente..." ]
+                                        ]
+
+                                Nothing ->
+                                    text ""
                             ]
                     in
-                    ( View <| Table.renderRowLevel renderItem (\_ -> []), Cmd.none )
+                    ( View "" <| Table.renderRowLevel renderItem (\_ -> []), Cmd.none )
 
                 IntoBuy ->
-                    ( Buy <| Selection.init Nothing (Just .base_price), Cmd.none )
+                    ( Buy "" <| Selection.init Nothing (Just .base_price), Cmd.none )
 
                 IntoSell ->
-                    ( Sell <| Selection.init Nothing (Just (\i -> i.base_price // 2)), Cmd.none )
+                    ( Sell "" <| Selection.init Nothing (Just (\i -> i.base_price // 2)), Cmd.none )
 
                 IntoClaim claims ->
                     let
                         initialSelection =
                             List.map .loot_id claims
                     in
-                    ( Claim <| Selection.init (Just initialSelection) Nothing, Cmd.none )
+                    ( Claim "" <| Selection.init (Just initialSelection) Nothing, Cmd.none )
 
                 IntoAdd ->
                     ( New NewFromInventory.init, Cmd.none )
@@ -213,6 +257,24 @@ updateChest toMsg toChest ( model, cmd ) =
     )
 
 
+updateFilterText txt model =
+    case model of
+        New _ ->
+            model
+
+        View _ a ->
+            View txt a
+
+        Buy _ a ->
+            Buy txt a
+
+        Sell _ a ->
+            Sell txt a
+
+        Claim _ a ->
+            Claim txt a
+
+
 
 -- Helpers
 --
@@ -223,7 +285,7 @@ updateChest toMsg toChest ( model, cmd ) =
 confirmBuy : Int -> Chest -> Loot -> Cmd Api.Msg
 confirmBuy playerId model loot =
     case model of
-        Buy chest ->
+        Buy _ chest ->
             let
                 items =
                     Selection.selected chest loot
@@ -245,7 +307,7 @@ confirmBuy playerId model loot =
 confirmSell : Int -> Chest -> Loot -> List Int -> Cmd Api.Msg
 confirmSell playerId model loot players =
     case model of
-        Sell chest ->
+        Sell _ chest ->
             let
                 items =
                     Selection.selected chest loot
@@ -286,7 +348,7 @@ confirmAdd playerId sourceName model =
 confirmGrab : Int -> Loot -> Chest -> Cmd Api.Msg
 confirmGrab playerId loot model =
     case model of
-        Claim chest ->
+        Claim _ chest ->
             let
                 items =
                     Selection.selected chest loot

src/Main.elm

@@ -60,7 +60,11 @@ setPage page model =
 
 
 init : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )
-init _ _ key =
+init _ url key =
+    let
+        _ =
+            Debug.log "init with url" (Debug.toString url)
+    in
     ( { navbar = initNavbar key
       , page = Page.Loading
       }
@@ -165,6 +169,10 @@ update msg model =
         ( LinkClicked urlRequest, _ ) ->
             case urlRequest of
                 Browser.Internal url ->
+                    let
+                        _ =
+                            Debug.log "internal url request" (Debug.toString url)
+                    in
                     ( model, Nav.pushUrl model.navbar.navKey (Url.toString url) )
 
                 Browser.External href ->

src/Page.elm

@@ -10,7 +10,7 @@ import Page.Dashboard as Home
 import Page.GroupChest as GroupChest
 import Page.Shop as Shop
 import Process
-import Route
+import Route exposing (toHref)
 import Session exposing (Session)
 import Task
 import Wealth
@@ -216,19 +216,19 @@ renderLevel left right =
 
 navLink icon route page =
     let
-        ( link, url ) =
+        linkText =
             case route of
                 Route.Merchant ->
-                    ( "Marchand", "/marchand" )
+                    "Marchand"
 
                 Route.GroupChest ->
-                    ( "Coffre de groupe", "/groupe" )
+                    "Coffre de groupe"
 
                 Route.Home ->
-                    ( "Accueil", "/" )
+                    "Accueil"
 
                 Route.About ->
-                    ( "About", "/" )
+                    "About"
 
         isActive =
             case ( route, page ) of
@@ -247,9 +247,9 @@ navLink icon route page =
                 _ ->
                     False
     in
-    a [ class "navbar-item", classList [ ( "is-active", isActive ) ], href url ]
+    a [ class "navbar-item", classList [ ( "is-active", isActive ) ], href (toHref route) ]
         [ B.icon { icon = icon, ratio = Just "fa-1x", size = Just "is-medium" }
-        , span [] [ text link ]
+        , span [] [ text linkText ]
         ]
 
 

src/Page/Dashboard.elm

@@ -109,7 +109,7 @@ view model =
                     in
                     ( Html.map PlayerViewer <|
                         case config.chest of
-                            Chest.View _ ->
+                            Chest.View _ _ ->
                                 case data.player.id of
                                     0 ->
                                         B.buttons
@@ -135,7 +135,7 @@ view model =
                                             , color = "is-primary"
                                             }
 
-                            Chest.Sell selection ->
+                            Chest.Sell _ selection ->
                                 let
                                     sellText =
                                         case Selection.totalSelectedPrice selection data.loot of
@@ -177,7 +177,7 @@ view model =
                                         []
                                     ]
 
-                            ( Chest.Sell _, True ) ->
+                            ( Chest.Sell _ _, True ) ->
                                 selectPlayers config.extra.players
 
                             _ ->
@@ -303,28 +303,35 @@ type PlayerMsg
 
 update msg model =
     case ( msg, model ) of
-        ( AdminViewer aMsg, Admin config ) ->
+        ( AdminViewer ConfirmNewPlayer, Admin config ) ->
-            (case ( aMsg, config.playerForm ) of
+            ( Admin { config | playerForm = Nothing }
-                ( EditPlayer, Nothing ) ->
+            , case config.playerForm of
-                    ( Admin { config | playerForm = Just <| NewPlayerForm "" 0.0 }
+                Just form ->
-                    , Cmd.none
+                    Cmd.map Api <|
-                    )
+                        Api.adminAddPlayer form
 
-                ( GotFormMsg subMsg, Just f ) ->
+                Nothing ->
-                    ( Admin { config | playerForm = Just (updateForm subMsg f) }
+                    Cmd.none
-                    , Cmd.none
-                    )
-
-                ( ConfirmNewPlayer, Just f ) ->
-                    ( model, Cmd.none )
-
-                ( CloseEdit, _ ) ->
-                    ( Admin { config | playerForm = Nothing }, Cmd.none )
-
-                _ ->
-                    ( model, Cmd.none )
             )
-                |> Tuple.mapSecond (Cmd.map AdminViewer)
+
+        ( AdminViewer aMsg, Admin config ) ->
+            Tuple.mapSecond (Cmd.map AdminViewer) <|
+                case ( aMsg, config.playerForm ) of
+                    ( EditPlayer, Nothing ) ->
+                        ( Admin { config | playerForm = Just <| NewPlayerForm "" 0.0 }
+                        , Cmd.none
+                        )
+
+                    ( GotFormMsg subMsg, Just f ) ->
+                        ( Admin { config | playerForm = Just (updateForm subMsg f) }
+                        , Cmd.none
+                        )
+
+                    ( CloseEdit, _ ) ->
+                        ( Admin { config | playerForm = Nothing }, Cmd.none )
+
+                    _ ->
+                        ( model, Cmd.none )
 
         ( PlayerViewer ConfirmSell, Player config ) ->
             ( model

src/Page/GroupChest.elm

@@ -71,12 +71,12 @@ view model =
                                 ( True, data.player.id == 0 )
                 in
                 case ( model.chest, isPlayer && not isGroup ) of
-                    ( Chest.View _, True ) ->
+                    ( Chest.View _ _, True ) ->
                         B.btn
                             (GotChestMsg <| Chest.claim (getClaimsFromSession model.session))
                             { text = "Demander", icon = "fas fa-praying-hands", color = "is-primary" }
 
-                    ( Chest.Claim _, True ) ->
+                    ( Chest.Claim _ _, True ) ->
                         B.confirmButtons ConfirmGrab (GotChestMsg Chest.show)
 
                     ( _, _ ) ->
@@ -93,7 +93,7 @@ type Msg
 
 
 type InnerMsg
-    = GotLoot Api.ToChest (HttpResult Loot)
+    = GotLoot (HttpResult Loot)
     | GotChestMsg Chest.Msg
     | ConfirmGrab
 
@@ -106,7 +106,7 @@ update msg model =
 
         Internal ConfirmGrab ->
             case ( Session.user model.session, model.loot, model.chest ) of
-                ( Player data, Loaded loot, Chest.Claim _ ) ->
+                ( Player data, Loaded loot, Chest.Claim _ _ ) ->
                     ( model
                     , Chest.confirmGrab
                         data.player.id
@@ -121,11 +121,11 @@ update msg model =
         Internal innerMsg ->
             Tuple.mapSecond (Cmd.map Internal) <|
                 case innerMsg of
-                    GotLoot _ (Ok loot) ->
+                    GotLoot (Ok loot) ->
                         ( { model | loot = Loaded loot }, Cmd.none )
 
-                    GotLoot _ (Err _) ->
+                    GotLoot (Err e) ->
-                        ( { model | loot = LoadError "Le chargement a échoué" }, Cmd.none )
+                        ( { model | loot = LoadError <| Debug.toString e }, Cmd.none )
 
                     GotChestMsg chestMsg ->
                         Chest.update chestMsg model.chest

src/Page/Shop.elm

@@ -47,13 +47,13 @@ view model =
         Loaded loot ->
             ( Html.map Internal <|
                 case ( model.chest, Session.user model.session ) of
-                    ( Chest.View _, Session.Admin _ ) ->
+                    ( Chest.View _ _, Session.Admin _ ) ->
                         B.btn (GotChestMsg Chest.new) { text = "Remplacer", icon = "fas fa-sync-alt", color = "is-primary" }
 
-                    ( Chest.View _, Session.Player _ ) ->
+                    ( Chest.View _ _, Session.Player _ ) ->
                         B.btn (GotChestMsg Chest.buy) { text = "Acheter", icon = "fas fa-coins", color = "is-primary" }
 
-                    ( Chest.Buy _, Session.Player _ ) ->
+                    ( Chest.Buy _ _, Session.Player _ ) ->
                         B.confirmButtons ConfirmBuy (GotChestMsg Chest.show)
 
                     ( Chest.New _, Session.Admin _ ) ->
@@ -78,7 +78,7 @@ type Msg
 
 
 type ShopMsg
-    = GotLoot Api.ToChest (HttpResult Loot)
+    = GotLoot (HttpResult Loot)
     | ConfirmRefresh
     | GotRefreshResult (Maybe ())
     | ConfirmBuy
@@ -97,7 +97,7 @@ update msg model =
     case msg of
         Internal ConfirmBuy ->
             case ( Session.user (getSession model), model.loot, model.chest ) of
-                ( Session.Player data, Loaded loot, Chest.Buy _ ) ->
+                ( Session.Player data, Loaded loot, Chest.Buy _ _ ) ->
                     ( model
                     , Chest.confirmBuy
                         data.player.id
@@ -120,49 +120,46 @@ update msg model =
                     )
 
         Internal shopMsg ->
-            let
+            Tuple.mapSecond (Cmd.map Internal) <|
-                ( nModel, cmd ) =
+                case shopMsg of
-                    case shopMsg of
+                    GotLoot response ->
-                        GotLoot Api.OfShop response ->
+                        case response of
-                            case response of
+                            Ok loot ->
-                                Ok loot ->
+                                ( { model | loot = Loaded loot }, Cmd.none )
-                                    ( { model | loot = Loaded loot }, Cmd.none )
 
-                                -- TODO: handle error
+                            -- TODO: handle error
-                                Err e ->
+                            Err e ->
-                                    ( { model | loot = LoadError <| Debug.toString e }, Cmd.none )
+                                ( { model | loot = LoadError <| Debug.toString e }, Cmd.none )
 
-                        ConfirmRefresh ->
+                    ConfirmRefresh ->
-                            case Session.user (getSession model) of
+                        case Session.user (getSession model) of
-                                Session.Admin _ ->
+                            Session.Admin _ ->
-                                    let
+                                let
-                                        loot =
+                                    loot =
-                                            case model.chest of
+                                        case model.chest of
-                                                Chest.New chest ->
+                                            Chest.New chest ->
-                                                    NewChest.allLoot chest
+                                                NewChest.allLoot chest
 
-                                                _ ->
+                                            _ ->
-                                                    []
+                                                []
-                                    in
+                                in
-                                    ( model, Api.replaceShopItems GotRefreshResult loot )
+                                ( model, Api.replaceShopItems GotRefreshResult loot )
 
-                                _ ->
+                            _ ->
-                                    let
+                                let
-                                        _ =
+                                    _ =
-                                            Debug.log "Forbidden action ! (is not admin)" ()
+                                        Debug.log "Forbidden action ! (is not admin)" ()
-                                    in
+                                in
-                                    ( model, Cmd.none )
+                                ( model, Cmd.none )
 
-                        GotChestMsg subMsg ->
+                    GotChestMsg subMsg ->
-                            Chest.update subMsg model.chest
+                        Chest.update subMsg model.chest
-                                |> Tuple.mapBoth
+                            |> Tuple.mapBoth
-                                    (\c -> { model | chest = c })
+                                (\c -> { model | chest = c })
-                                    (Cmd.map GotChestMsg)
+                                (Cmd.map GotChestMsg)
 
-                        _ ->
+                    _ ->
-                            ( model, Cmd.none )
+                        ( model, Cmd.none )
-            in
-            ( nModel, Cmd.map Internal cmd )
 
         _ ->
             ( model, Cmd.none )

src/Route.elm

@@ -5,6 +5,18 @@ import Url.Parser as P exposing ((</>), Parser, oneOf, s)
 
 
 
+-- Name of the application, prepended to it's actual root
+
+
+scriptName =
+    "lootalot"
+
+
+root =
+    P.s scriptName
+
+
+
 -- ROUTES
 
 
@@ -18,13 +30,32 @@ type Route
 parser : P.Parser (Route -> a) a
 parser =
     oneOf
-        [ P.map Home P.top
+        [ P.map Home root
-        , P.map GroupChest (P.s "groupe")
+        , P.map GroupChest (root </> P.s "groupe")
-        , P.map Merchant (P.s "marchand")
+        , P.map Merchant (root </> P.s "marchand")
-        , P.map About (P.s "about")
+        , P.map About (root </> P.s "about")
         ]
 
 
 fromUrl : Url.Url -> Maybe Route
 fromUrl url =
     P.parse parser url
+
+
+toHref : Route -> String
+toHref route =
+    "/"
+        ++ scriptName
+        ++ (case route of
+                Home ->
+                    "/"
+
+                About ->
+                    "/"
+
+                Merchant ->
+                    "/marchand"
+
+                GroupChest ->
+                    "/groupe"
+           )

src/Table.elm

@@ -16,8 +16,7 @@ type alias ItemRenderer a msg =
 view : RowRenderer a msg -> List a -> Html msg
 view rowRenderer content =
     table [ class "table is-fullwidth" ]
-        [ thead [ class "table-header" ]
+        [ thead [] [ th [] [ text "Nom" ] ]
-            [ th [] [ text "Nom" ] ]
         , tbody [] <|
             List.map
                 rowRenderer