makes it compile as is

index.html

@@ -20,6 +20,7 @@
     <script>
         var app = Elm.Main.init({
             node: document.getElementById('app'),
+            flags: 0,
         });
     </script>
   </body>

src/Api.elm

@@ -1,15 +1,21 @@
-module Api exposing (..)
+module Api exposing (Update(..), Msg(..)
+        , HttpResult
+        , Player, Wealth, fetchPlayer, blankPlayer
+        , Item, Loot, fetchLoot
+        , Claim, Claims, fetchClaims
+        , ActionMode(..), confirmAction
+        )
 
 import Http
 import Json.Decode as D exposing (Decoder, field, int, string, succeed)
 import Json.Encode as E
-import Modes
 
 
 type alias HttpResult a =
     Result Http.Error a
 
 
+-- Format of the server's response
 type alias Response =
     { value : Maybe String
     , notification : Maybe String
@@ -27,8 +33,7 @@ type Update
 
 
 type Msg
-    = GotPlayer (HttpResult Player)
+    = GotActionResult (HttpResult Response)
-    | GotActionResult (HttpResult Response)
 
 
 
@@ -95,10 +100,10 @@ claimDecoder =
         (D.field "loot_id" int)
 
 
-fetchClaims : (Result Http.Error Claims -> msg) -> Cmd msg
+fetchClaims : (Result Http.Error Claims -> msg) -> Int -> Cmd msg
-fetchClaims toMsg =
+fetchClaims toMsg playerId =
     Http.get
-        { url = "http://localhost:8088/api/claims"
+        { url = "http://localhost:8088/api/claims" -- TODO: ++ playerId
         , expect =
             valueDecoder (D.list claimDecoder)
                 |> Http.expectJson toMsg
@@ -109,11 +114,12 @@ fetchClaims toMsg =
 --
 
 
-fetchPlayer : Int -> Cmd Msg
+
-fetchPlayer id =
+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 GotPlayer (valueDecoder playerDecoder)
+        , expect = Http.expectJson toMsg (valueDecoder playerDecoder)
         }
 
 
@@ -214,16 +220,23 @@ undoLastAction id =
         }
 
 
-buildPayload : Modes.Model -> List Item -> E.Value
+type ActionMode
+    = Sell
+    | Buy
+    | Grab
+    | Add
+    | NoMode
+
+buildPayload : ActionMode -> List Item -> E.Value
 buildPayload mode items =
     case mode of
-        Modes.Buy ->
+        Buy ->
             E.object
                 [ ( "items", items |> E.list (\i -> E.list identity [ E.int i.id, E.null ]) )
                 , ( "global_mod", E.null )
                 ]
 
-        Modes.Sell ->
+        Sell ->
             E.object
                 [ ( "items", items |> E.list (\i -> E.list identity [ E.int i.id, E.null ]) )
                 , ( "global_mod", E.null )
@@ -231,43 +244,43 @@ buildPayload mode items =
                 ]
 
         -- API expects the list of claimed loot ids
-        Modes.Grab ->
+        Grab ->
             items |> E.list (\i -> E.int i.id)
 
-        Modes.Add ->
+        Add ->
             E.object
                 [ ( "items", items |> E.list (\i -> E.int i.id) )
                 ]
 
-        Modes.None -> E.null
+        NoMode -> E.null
 
 
-sendRequest : Modes.Model -> String -> List Item -> Cmd Msg
+confirmAction : ActionMode -> String -> List Item -> Cmd Msg
-sendRequest mode id items =
+confirmAction mode id items =
     let
         ( endpoint, method ) =
             case mode of
-                Modes.Add ->
+                Add ->
                     ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
                     , "POST"
                     )
 
-                Modes.Buy ->
+                Buy ->
                     ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
                     , "PUT"
                     )
 
-                Modes.Sell ->
+                Sell ->
                     ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
                     , "DELETE"
                     )
 
-                Modes.Grab ->
+                Grab ->
                     ( "http://localhost:8088/api/players/" ++ id ++ "/claims"
                     , "POST"
                     )
                 -- TODO: ???
-                Modes.None -> ("", "GET")
+                NoMode -> ("", "GET")
     in
     Http.request
         { method = method

src/Chest.elm

@@ -1,771 +0,0 @@
-module Chest exposing (..)
-
-import Api exposing (Claims, HttpResult, Item, Loot)
-import Html exposing (..)
-import Html.Attributes exposing (..)
-import Html.Events exposing (onCheck)
-import Route exposing (..)
-import Set exposing (Set)
-import Utils exposing (..)
-
-
-
--- MODEL
-
-
-type alias State =
-    { menuOpen : Bool
-    , mode : ActionMode
-    , error : Maybe String
-    , notification : Maybe String
-    }
-
-
-type alias Selection =
-    Set Int
-
-
-type ActionMode
-    = Sell
-    | Buy
-    | Grab
-    | Add
-    | NoMode
-
-
-type alias Model =
-    { state : State
-    , shown : Route.ChestContent
-    , playerLoot : Loot
-    , groupLoot : Loot
-    , merchantLoot : Loot
-    , newLoot : Loot
-    , selection : Maybe Selection
-    , claims : Claims
-    }
-
-
-init : Int -> ( Model, Cmd Msg )
-init playerId =
-    ( Model
-        (State False Modes.None Nothing Nothing)
-        []
-        []
-        []
-        []
-        Nothing
-        []
-    , Api.fetchClaims (GotClaims playerId)
-    )
-
-
-viewNotification : Maybe String -> Html Msg
-viewNotification notification =
-    case notification of
-        Just t ->
-            div [ class "notification is-success is-marginless" ]
-                [ button [ class "delete", onClick ClearNotification ] []
-                , text t
-                ]
-
-        Nothing ->
-            text ""
-
-
-
--- DEBUG SECTION
-
-
-viewDebugSection : Model -> Html Msg
-viewDebugSection model =
-    div [ class "panel is-danger" ]
-        [ p [ class "panel-heading" ] [ text "Debug" ]
-        , debugSwitchPlayers
-        , p [ class "panel-block has-text-danger" ] [ text <| Maybe.withDefault "" model.state.error ]
-        , p [ class "panel-block" ] [ text ("Route : " ++ Debug.toString model.route) ]
-        , p [ class "panel-block" ] [ text ("Active Mode : " ++ Debug.toString model.mode) ]
-        , p [ class "panel-block" ] [ text ("Selection : " ++ Debug.toString model.chest.selection) ]
-        , p [ class "panel-block" ] [ text ("Claims : " ++ Debug.toString model.chest.claims) ]
-        , p [] debugSandbox
-        ]
-
-
-stackedIcon name =
-    span [ class "icon is-medium" ]
-        [ span [ class "fa-stack" ]
-            [ i [ class "fas fa-circle fa-stack-2x" ] []
-            , i [ class (name ++ " fa-inverse fa-stack-1x") ] []
-            , text ""
-            ]
-        ]
-
-
-debugSandbox =
-    [ stackedIcon "fas fa-coins"
-    , stackedIcon "fab fa-d-and-d"
-    , stackedIcon "fas fa-praying-hands"
-    , stackedIcon "fas fa-gem"
-    , stackedIcon "fas fa-pen"
-    , stackedIcon "fas fa-percentage"
-    , stackedIcon "fas fa-store-alt"
-    , stackedIcon "fas fa-cart-plus"
-    , stackedIcon "fas fa-angry"
-    , stackedIcon "fas fa-plus"
-    , stackedIcon "fas fa-tools"
-    , stackedIcon "fas fa-search"
-    ]
-
-
-debugSwitchPlayers : Html Msg
-debugSwitchPlayers =
-    div [ class "panel-tabs" ]
-        [ a [ onClick (PlayerChanged 0) ] [ text "Groupe" ]
-        , a [ onClick (PlayerChanged 1) ] [ text "Lomion" ]
-        , a [ onClick (PlayerChanged 2) ] [ text "Fefi" ]
-        ]
-
-
-
--- HEADER SECTION
-
-
-viewHeaderBar : String -> Model -> Html Msg
-viewHeaderBar title model =
-    nav [ class "navbar container", class "is-info" ]
-        [ div [ class "navbar-brand" ]
-            [ a [ class "navbar-item", href "/" ]
-                [ renderIcon { icon = "fab fa-d-and-d", size = "medium", ratio = "2x" }
-                , span [] [ text model.player.name ]
-                ]
-            , a [ class "navbar-burger is-active" ]
-                [ span [ attribute "aria-hidden" "true" ] []
-                , span [ attribute "aria-hidden" "true" ] []
-                , span [ attribute "aria-hidden" "true" ] []
-                ]
-            ]
-        , div [ class "navbar-menu is-active" ]
-            [ div [ class "navbar-end" ]
-                [ a [ class "navbar-item", href "/marchand" ]
-                    [ renderIcon { icon = "fas fa-store-alt", ratio = "1x", size = "medium" }
-                    , span [] [ text "Marchand" ]
-                    ]
-                , a
-                    [ class "navbar-item"
-                    , href
-                        (if model.player.id == 0 then
-                            "/nouveau-tresor"
-
-                         else
-                            "/coffre"
-                        )
-                    ]
-                    [ renderIcon { icon = "fas fa-gem", ratio = "1x", size = "medium" }
-                    , span []
-                        [ text
-                            (if model.player.id == 0 then
-                                "Nouveau loot"
-
-                             else
-                                "Coffre de groupe"
-                            )
-                        ]
-                    ]
-                ]
-            ]
-        ]
-
-
-
--- PLAYER BAR
-
-
-viewPlayerBar : Player -> List (Html Msg) -> Html Msg
-viewPlayerBar player actionControls =
-    section [ class "level container is-mobile box" ]
-        [ div [ class "level-left" ]
-            ([ div [ class "level-item" ]
-                [ span [ class "icon is-large" ]
-                    [ i [ class "fas fa-2x fa-piggy-bank" ] [] ]
-                ]
-             ]
-                ++ viewWealth player.wealth
-                ++ (if player.debt > 0 then
-                        [ div [ class "level-item" ]
-                            [ p [ class "heading is-size-4 has-text-danger" ]
-                                [ text ("Dette : " ++ String.fromInt player.debt ++ "po") ]
-                            ]
-                        ]
-
-                    else
-                        []
-                   )
-            )
-        , div [ class "level-right" ] actionControls
-        ]
-
-
-viewWealth : Wealth -> List (Html Msg)
-viewWealth wealth =
-    [ showWealthField "pp" <| String.fromInt wealth.pp
-    , showWealthField "gp" <| String.padLeft 2 '0' <| String.fromInt wealth.gp
-    , showWealthField "sp" <| String.fromInt wealth.sp
-    , showWealthField "cp" <| String.fromInt wealth.cp
-    ]
-
-
-showWealthField : String -> String -> Html Msg
-showWealthField name value =
-    div [ class "level-item" ]
-        [ p [ class "has-text-right" ]
-            [ strong [ class "heading is-marginless" ] [ text name ]
-            , span [ class <| "is-size-4" ] [ text value ]
-            ]
-        ]
-
-
-
--- UPDATE
-
-
-initPlayer id =
-    Cmd.map ApiMsg <| Api.fetchPlayer id
-
-
-update : Msg -> Model -> ( Model, Cmd Msg )
-update msg model =
-    case msg of
-        PlayerChanged newId ->
-            let
-                ( chest, cmd ) =
-                    Chest.init newId
-            in
-            ( { model
-                | player = Api.blankPlayer
-                , route = PlayerChest
-                , chest = chest
-              }
-            , Cmd.batch
-                [ initPlayer newId
-                , Cmd.map ChestMsg cmd
-                ]
-            )
-
-        ApiMsg apiMsg ->
-            case apiMsg of
-                Api.GotActionResult response ->
-                    case response of
-                        Ok result ->
-                            let
-                                updates =
-                                    Maybe.withDefault [] result.updates
-
-                                notification =
-                                    result.notification
-
-                                errors =
-                                    Maybe.withDefault "" result.errors
-                            in
-                            List.foldl applyUpdate model updates
-                                |> setNotification notification
-                                |> setError errors
-                                |> update (ModeMsg (Modes.ModeSwitched Modes.None))
-
-                        Err r ->
-                            ( setError (Debug.toString r) model, Cmd.none )
-
-                Api.GotPlayer result ->
-                    case result of
-                        Ok player ->
-                            ( { model | player = player }
-                            , Cmd.none
-                            )
-
-                        Err error ->
-                            ( setError ("Fetching player... " ++ Debug.toString error) model
-                            , Cmd.none
-                            )
-
-        ModeMsg modeMsg ->
-            case modeMsg of
-                Modes.ModeSwitched newMode ->
-                    ( { model
-                        | mode = newMode
-                        , chest =
-                            let
-                                ( newChest, _ ) =
-                                    Chest.update
-                                        (Chest.SetSelection
-                                            (case newMode of
-                                                Modes.None ->
-                                                    Nothing
-
-                                                Modes.Grab ->
-                                                    -- Currently claimed object are initially selected
-                                                    Just (Set.fromList <| List.map (\c -> c.loot_id) model.chest.claims)
-
-                                                others ->
-                                                    Just Set.empty
-                                            )
-                                        )
-                                        model.chest
-                            in
-                            newChest
-                      }
-                    , Cmd.none
-                    )
-
-                Modes.ConfirmAction ->
-                    case model.mode of
-                        -- This should not happen, so we ignore it
-                        Modes.None ->
-                            ( model, Cmd.none )
-
-                        mode ->
-                            let
-                                items =
-                                    Chest.getSelected model.route model.chest
-                            in
-                            ( model
-                            , Cmd.map ApiMsg <|
-                                Api.sendRequest
-                                    mode
-                                    (String.fromInt model.player.id)
-                                    items
-                            )
-
-        ClearNotification ->
-            ( setNotification Nothing model, Cmd.none )
-
-
-setNotification : Maybe String -> Model -> Model
-setNotification notification model =
-    let
-        state =
-            model.state
-    in
-    { model
-        | state =
-            { state | notification = notification }
-    }
-
-
-setLoot : Loot -> Model -> Model
-setLoot items model =
-    let
-        chest =
-            model.chest
-    in
-    { model | chest = { chest | loot = items } }
-
-
-setClaims : Claims -> Model -> Model
-setClaims claims model =
-    let
-        chest =
-            model.chest
-    in
-    { model | chest = { chest | claims = claims } }
-
-
-
--- DbUpdates always refer to the active player's loot
-
-
-applyUpdate : Api.Update -> Model -> Model
-applyUpdate u model =
-    case u of
-        Api.ItemRemoved item ->
-            model
-                |> setLoot (List.filter (\i -> i.id /= item.id) model.chest.loot)
-
-        Api.ItemAdded item ->
-            model |> setLoot (item :: model.chest.loot)
-
-        Api.WealthUpdated diff ->
-            let
-                player =
-                    model.player
-
-                wealth =
-                    player.wealth
-            in
-            { model
-                | player =
-                    { player
-                        | wealth =
-                            Wealth
-                                (wealth.cp + diff.cp)
-                                (wealth.sp + diff.sp)
-                                (wealth.gp + diff.gp)
-                                (wealth.pp + diff.pp)
-                    }
-            }
-
-        Api.ClaimAdded claim ->
-            model |> setClaims (claim :: model.chest.claims)
-
-        Api.ClaimRemoved claim ->
-            model
-                |> setClaims (List.filter (\c -> c.id /= claim.id) model.chest.claims)
-
-
-
--- ERRORS
-
-
-setError : String -> Model -> Model
-setError error model =
-    let
-        state =
-            model.state
-    in
-    { model
-        | state =
-            { state | error = Just error }
-    }
-
-
-type ToChest
-    = OfPlayer Int
-    | OfGroup
-    | OfShop
-
-
-fetchLoot : ToChest -> Cmd Msg
-fetchLoot dest =
-    let
-        url =
-            case dest of
-                OfPlayer id ->
-                    "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/loot"
-
-                OfShop ->
-                    "http://localhost:8088/api/items"
-
-                OfGroup ->
-                    "http://localhost:8088/api/players/0/loot"
-    in
-    Api.fetchLoot url (GotLoot dest)
-
-
-
--- VIEW
-
-
-view : Modes.Model -> Route.Route -> Model -> Html Msg
-view mode route model =
-    let
-        renderControls =
-            Modes.viewControls model.mode model.route
-                |> List.map (Html.map ModeMsg)
-
-        ( header, shownItems ) =
-            case route of
-                Route.PlayerChest ->
-                    ( "Mon coffre", model.loot )
-
-                Route.GroupLoot ->
-                    ( "Coffre de groupe", model.groupLoot )
-
-                Route.Merchant ->
-                    ( "Marchand", model.merchantItems )
-
-                Route.NewLoot ->
-                    ( "Nouveau trésor :)", [] )
-
-        isSelected =
-            itemInSelection model.selection
-
-        rowRenderer =
-            case mode of
-                Modes.None ->
-                    case route of
-                        Route.GroupLoot ->
-                            let
-                                isClaimed =
-                                    itemInClaims model.claims
-                            in
-                            -- Claim controls for Group chest
-                            Just (claimedItemRenderer isClaimed)
-
-                        _ ->
-                            Nothing
-
-                activeMode ->
-                    Just (rowRendererForMode isSelected activeMode)
-    in
-    [ viewHeaderBar player.name model
-    , viewPlayerBar model.player renderControls
-    , main_
-        [ class "container" ]
-        [ viewNotification model.state.notification
-        , article
-            [ class "section" ]
-            [ div [ class "columns" ]
-                [ div [ class "column is-one-third" ] [ p [ class "title" ] [ text header ] ]
-                , div [ class "column" ] [ viewSearchBar ]
-                ]
-            , table [ class "table is-fullwidth is-striped is-hoverable" ]
-                [ thead [ class "table-header" ]
-                    [ th [] [ text "Nom" ] ]
-                , tbody [] <| List.map (viewItemTableRow isSelected rowRenderer) shownItems
-                ]
-            ]
-        ]
-    , hr [] []
-    , section [ class "container" ] [ viewDebugSection model ]
-    ]
-
-
-
--- Renderers
---
--- Item -> Html Msg
-
-
-claimedItemRenderer : (Item -> Bool) -> Item -> Html Msg
-claimedItemRenderer isClaimed item =
-    case isClaimed item of
-        True ->
-            renderIcon
-                { icon = "fas fa-praying-hands"
-                , size = "small"
-                , ratio = "1x"
-                }
-
-        False ->
-            text ""
-
-
-rowRendererForMode : (Item -> Bool) -> Modes.Model -> Item -> Html Msg
-rowRendererForMode isSelected mode item =
-    let
-        canSelect =
-            Modes.canSelectIn mode
-
-        renderInfo =
-            case mode of
-                Modes.Buy ->
-                    p [ class "level-item" ] [ text (String.fromInt item.base_price ++ "po") ]
-
-                Modes.Sell ->
-                    p [ class "level-item" ] [ text (String.fromFloat (toFloat item.base_price / 2) ++ "po") ]
-
-                Modes.Grab ->
-                    p [ class "level-item" ] [ text "Grab" ]
-
-                Modes.Add ->
-                    p [ class "level-item" ] [ text "New !" ]
-
-                Modes.None ->
-                    text ""
-    in
-    div [ class "level-right" ] <|
-        renderInfo
-            :: (if canSelect then
-                    [ input
-                        [ class "checkbox level-item"
-                        , type_ "checkbox"
-                        , checked <| isSelected item
-                        , onCheck (\v -> SwitchSelectionState item.id)
-                        ]
-                        []
-                    ]
-
-                else
-                    []
-               )
-
-
-viewItemTableRow : (Item -> Bool) -> Maybe (Item -> Html Msg) -> Item -> Html Msg
-viewItemTableRow isSelected rowRenderer item =
-    tr [ classList [ ( "is-selected", isSelected item ) ] ]
-        [ td []
-            [ label [ class "level checkbox" ] <|
-                div [ class "level-left" ]
-                    [ p [ class "level-item" ] [ text item.name ] ]
-                    :: (case rowRenderer of
-                            Just render ->
-                                List.singleton (render item)
-
-                            Nothing ->
-                                []
-                       )
-            ]
-        ]
-
-
-
--- Search Bar
-
-
-viewSearchBar : Html Msg
-viewSearchBar =
-    div [ class "field" ]
-        [ p [ class "control has-icons-left" ]
-            [ input [ class "input" ] []
-            , span [ class "icon is-left" ] [ i [ class "fas fa-search" ] [] ]
-            ]
-        ]
-
-
-
--- ACTION MODES
---
-
-
-canSelectIn : ActionMode -> Bool
-canSelectIn mode =
-    case mode of
-        Sell ->
-            True
-
-        Buy ->
-            True
-
-        Grab ->
-            True
-
-        Add ->
-            False
-
-        NoMode ->
-            False
-
-
-viewControls : ActionMode -> Route.Route -> List (Html Msg)
-viewControls mode route =
-    case mode of
-        None ->
-            case route of
-                Route.PlayerChest ->
-                    [ actionButton (ModeSwitched Sell) "Vendre" "coins" "danger" ]
-
-                Route.GroupLoot ->
-                    [ actionButton (ModeSwitched Grab) "Demander" "praying-hands" "primary" ]
-
-                Route.Merchant ->
-                    [ actionButton (ModeSwitched Buy) "Acheter" "coins" "success" ]
-
-                Route.NewLoot ->
-                    [ actionButton (ModeSwitched Add) "Nouveau loot" "plus" "primary" ]
-
-        m ->
-            [ actionButton ConfirmAction "Valider" "check" "primary"
-            , actionButton (ModeSwitched None) "Annuler" "times" "danger"
-            ]
-
-
-
--- UPDATE
-
-
-type Msg
-    = ApiMsg Api.Msg
-    | ModeMsg Modes.Msg
-    | PlayerChanged Int
-    | ClearNotification
-type Msg
-    = SetSelection (Maybe Selection)
-    | GotLoot ToChest (HttpResult Loot)
-    | GotClaims Int (HttpResult Claims)
-    | SwitchSelectionState Int
-    | ModeSwitched ActionMode
-    | ConfirmAction
-
-
-update : Msg -> Model -> ( Model, Cmd Msg )
-update msg model =
-    case msg of
-        SwitchSelectionState id ->
-            ( { model | selection = switchSelectionState id model.selection }, Cmd.none )
-
-        SetSelection new ->
-            ( { model | selection = new }, Cmd.none )
-
-        GotClaims id result ->
-            case result of
-                Ok claims ->
-                    ( { model
-                        | claims =
-                            List.filter
-                                (\c -> c.player_id == id)
-                                claims
-                      }
-                    , Cmd.none
-                    )
-
-                Err error ->
-                    ( model, Cmd.none )
-
-        GotLoot dest result ->
-            case result of
-                Ok loot ->
-                    ( case dest of
-                        OfPlayer _ ->
-                            { model | loot = loot }
-
-                        OfGroup ->
-                            { model | groupLoot = loot }
-
-                        OfShop ->
-                            { model | merchantItems = loot }
-                    , Cmd.none
-                    )
-
-                Err error ->
-                    ( model, Cmd.none )
-
-
-
--- Selection
--- Get list of selected items
-
-
-getSelected : Route -> Model -> Loot
-getSelected route model =
-    targetItemsFor route model
-        |> List.filter (itemInSelection model.selection)
-
-
-itemInSelection : Maybe Selection -> Item -> Bool
-itemInSelection selection item =
-    Maybe.map (Set.member item.id) selection
-        |> Maybe.withDefault False
-
-
-itemInClaims : Claims -> Item -> Bool
-itemInClaims claims item =
-    List.any (\c -> c.loot_id == item.id) claims
-
-
-switchSelectionState : Int -> Maybe Selection -> Maybe Selection
-switchSelectionState id selection =
-    case selection of
-        Just s ->
-            Just <|
-                case Set.member id s of
-                    True ->
-                        Set.remove id s
-
-                    False ->
-                        Set.insert id s
-
-        Nothing ->
-            Debug.log "ignore switchSelectionState" Nothing
-
-
-targetItemsFor : Route -> Model -> List Item
-targetItemsFor route model =
-    case route of
-        Route.NewLoot ->
-            model.newLoot
-
-        Route.Merchant ->
-            model.merchantItems
-
-        Route.PlayerChest ->
-            model.loot
-
-        Route.GroupLoot ->
-            model.groupLoot

src/Main.elm

@@ -3,7 +3,7 @@ module Main exposing (..)
 import Api exposing (Claim, Claims, Item, Loot, Player, Wealth)
 import Browser
 import Browser.Navigation as Nav
-import Chest exposing (Msg)
+import Page.Chest as Chest exposing (Msg)
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
@@ -19,7 +19,7 @@ import Session exposing (..)
 -- Main
 
 
-main : Program () Model Msg
+main : Program (Maybe Int) Model Msg
 main =
     Browser.application
         { init = init
@@ -36,7 +36,7 @@ main =
 
 type Model
     = Chest Chest.Model
-    | Admin Admin.Model
+--    | Admin Admin.Model
     | About
 
 -- This is not what we really want.
@@ -51,14 +51,14 @@ type Model
 --   - just loggend in -> See Loading page then Chest
 --   - coming back being still logged in -> See Chest (or same as above)
 init : Maybe Int -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )
-init flags url key =
+init flags _ key =
     case flags of
         Just id ->
             let
-                session =
+                session = Session.playerSession key id
-                    Session.LoggedIn key <| Session.User.Player id
+                (chest, cmd) = Chest.init session
             in
-            (Chest <| Chest.init id, Cmd.none)
+            (Chest chest, Cmd.map GotChestMsg cmd)
 
         Nothing ->
             (About, Cmd.none)
@@ -72,65 +72,66 @@ init flags url key =
 view : Model -> Browser.Document Msg
 view model =
     let
-        (title, body) =
+        (title, content) =
             case model of
                 Chest chest ->
-                    ("Loot-a-lot", Chest.view chest)
+                    ("Loot-a-lot", List.map (Html.map GotChestMsg) (Chest.view chest))
-                Admin session ->
+ --               Admin admin ->
-                    ("Administration", Admin.view session)
+ --                   ("Administration", Admin.view admin)
                 About ->
-                    ("A propos", p [] ["A propos"])
+                    ("A propos", [ p [] [text "A propos"] ])
     in
         { title = title
-        , body = body }
+        , body = content }
            
 
 type Msg
     = UrlChanged Url.Url
     | LinkClicked Browser.UrlRequest
     | GotChestMsg Chest.Msg
-    | GotAdminMsg Admin.Msg
+--    | GotAdminMsg Admin.Msg
 
 
 update msg model =
+    let
+        updateChest chestMsg =
+            case model of
+                Chest chest ->
+                    let
+                        (newChest, cmd) =
+                            Chest.update chestMsg chest
+                    in
+                        (Chest newChest, Cmd.map GotChestMsg cmd)
+
+                _ -> (About, Cmd.none)
+
+    in
     case msg of
         LinkClicked urlRequest ->
+            case model of
+                Chest chestModel ->
                     case urlRequest of
                         Browser.Internal url ->
-                    ( model, Nav.pushUrl model.navKey (Url.toString url) )
+                            ( model, Nav.pushUrl chestModel.navKey (Url.toString url) )
 
                         Browser.External href ->
-                    ( setError ("External request '" ++ href ++ "'") model
+                            ( model, Cmd.none)
-                    , Cmd.none
+
-                    )
+                _ -> (model, Cmd.none)
 
         UrlChanged url ->
             let
                 route =
-                    routeParser url
+                    Route.fromUrl url
             in
             case route of
-                Just page ->
+                Just (Route.Home content) ->
-                    { model | route = page }
+                    updateChest (Chest.SetContent content)
-                        |> update
+                _ ->
-                            (case page of
+                    (About, Cmd.none)
-                                -- Directly enter add mode on NewLoot view
-                                NewLoot ->
-                                    ModeMsg (Modes.ModeSwitched Modes.Add)
-
-                                other ->
-                                    ModeMsg (Modes.ModeSwitched Modes.None)
-                            )
-
-                Nothing ->
-                    ( setError "Invalid route" model, Cmd.none )
 
         GotChestMsg chestMsg ->
-            let
+            updateChest chestMsg
-                ( chest, cmd ) =
-                    Chest.update chestMsg model.chest
-            in
-            ( Chest chest, Cmd.map GotChestMsg cmd )
 
 -- STATE Utils
 -- SUBSCRIPTIONS

src/Page/Chest.elm

@@ -1,6 +1,710 @@
 module Page.Chest exposing (..)
 
--- Put the rest of Chest here
+import Browser.Navigation as Nav
 
-init =
+import Api exposing (ActionMode(..), confirmAction, HttpResult
-    ()
+                    , Wealth, Claims
+                    , Item, Loot)
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (onCheck, onClick)
+import Route exposing (ChestContent(..))
+import Set exposing (Set)
+import Utils exposing (..)
+import Session exposing (Session(..))
+
+
+-- MODEL
+
+
+type alias State =
+    { menuOpen : Bool
+    , mode : ActionMode
+    , error : Maybe String
+    , notification : Maybe String
+    -- Fetched on init
+    , player : Api.Player
+    , playerLoot : Loot
+    , groupLoot : Loot
+    , merchantLoot : Loot
+    , newLoot : Loot
+    }
+
+
+type alias Selection =
+    Set Int
+
+
+type alias Model =
+    { navKey : Nav.Key
+    , state : State
+    , shown : Route.ChestContent
+    , selection : Maybe Selection
+    , claims : Claims
+    }
+
+init (Player navKey playerId) =
+    ( Model
+        navKey
+        (State False NoMode Nothing Nothing Api.blankPlayer [] [] [] [])
+        Route.PlayerLoot
+        Nothing
+        []
+    , Cmd.batch
+        [ Api.fetchPlayer GotPlayer playerId
+        , Api.fetchClaims GotClaims playerId
+        , fetchLoot (OfPlayer playerId)
+        , fetchLoot (OfGroup)
+        , fetchLoot (OfShop)
+        ]
+    )
+
+
+viewNotification : Maybe String -> Html Msg
+viewNotification notification =
+    case notification of
+        Just t ->
+            div [ class "notification is-success is-marginless" ]
+                [ button [ class "delete", onClick ClearNotification ] []
+                , text t
+                ]
+
+        Nothing ->
+            text ""
+
+
+
+-- DEBUG SECTION
+
+
+viewDebugSection : Model -> Html Msg
+viewDebugSection model =
+    div [ class "panel is-danger" ]
+        [ p [ class "panel-heading" ] [ text "Debug" ]
+        , p [ class "panel-block has-text-danger" ] [ text <| Maybe.withDefault "" model.state.error ]
+        , p [ class "panel-block" ] [ text ("Shown content : " ++ Debug.toString model.shown) ]
+        , p [ class "panel-block" ] [ text ("Active Mode : " ++ Debug.toString model.state.mode) ]
+        , p [ class "panel-block" ] [ text ("Selection : " ++ Debug.toString model.selection) ]
+        , p [ class "panel-block" ] [ text ("Claims : " ++ Debug.toString model.claims) ]
+        , p [] debugSandbox
+        ]
+
+
+stackedIcon name =
+    span [ class "icon is-medium" ]
+        [ span [ class "fa-stack" ]
+            [ i [ class "fas fa-circle fa-stack-2x" ] []
+            , i [ class (name ++ " fa-inverse fa-stack-1x") ] []
+            , text ""
+            ]
+        ]
+
+
+
+debugSandbox =
+    [ stackedIcon "fas fa-coins"
+    , stackedIcon "fab fa-d-and-d"
+    , stackedIcon "fas fa-praying-hands"
+    , stackedIcon "fas fa-gem"
+    , stackedIcon "fas fa-pen"
+    , stackedIcon "fas fa-percentage"
+    , stackedIcon "fas fa-store-alt"
+    , stackedIcon "fas fa-cart-plus"
+    , stackedIcon "fas fa-angry"
+    , stackedIcon "fas fa-plus"
+    , stackedIcon "fas fa-tools"
+    , stackedIcon "fas fa-search"
+    ]
+
+
+
+-- HEADER SECTION
+
+
+viewHeaderBar : String -> Model -> Html Msg
+viewHeaderBar title model =
+    nav [ class "navbar container", class "is-info" ]
+        [ div [ class "navbar-brand" ]
+            [ a [ class "navbar-item", href "/" ]
+                [ renderIcon { icon = "fab fa-d-and-d", size = "medium", ratio = "2x" }
+                , span [] [ text model.state.player.name ]
+                ]
+            , a [ class "navbar-burger is-active" ]
+                [ span [ attribute "aria-hidden" "true" ] []
+                , span [ attribute "aria-hidden" "true" ] []
+                , span [ attribute "aria-hidden" "true" ] []
+                ]
+            ]
+        , div [ class "navbar-menu is-active" ]
+            [ div [ class "navbar-end" ]
+                [ a [ class "navbar-item", href "/marchand" ]
+                    [ renderIcon { icon = "fas fa-store-alt", ratio = "1x", size = "medium" }
+                    , span [] [ text "Marchand" ]
+                    ]
+                , a
+                    [ class "navbar-item"
+                    , href
+                        (if model.state.player.id == 0 then
+                            "/nouveau-tresor"
+
+                         else
+                            "/coffre"
+                        )
+                    ]
+                    [ renderIcon { icon = "fas fa-gem", ratio = "1x", size = "medium" }
+                    , span []
+                        [ text
+                            (if model.state.player.id == 0 then
+                                "Nouveau loot"
+
+                             else
+                                "Coffre de groupe"
+                            )
+                        ]
+                    ]
+                ]
+            ]
+        ]
+
+
+
+-- PLAYER BAR
+
+
+viewPlayerBar : Api.Player -> List (Html Msg) -> Html Msg
+viewPlayerBar player actionControls =
+    section [ class "level container is-mobile box" ]
+        [ div [ class "level-left" ]
+            ([ div [ class "level-item" ]
+                [ span [ class "icon is-large" ]
+                    [ i [ class "fas fa-2x fa-piggy-bank" ] [] ]
+                ]
+             ]
+                ++ viewWealth player.wealth
+                ++ (if player.debt > 0 then
+                        [ div [ class "level-item" ]
+                            [ p [ class "heading is-size-4 has-text-danger" ]
+                                [ text ("Dette : " ++ String.fromInt player.debt ++ "po") ]
+                            ]
+                        ]
+
+                    else
+                        []
+                   )
+            )
+        , div [ class "level-right" ] actionControls
+        ]
+
+
+viewWealth : Wealth -> List (Html Msg)
+viewWealth wealth =
+    [ showWealthField "pp" <| String.fromInt wealth.pp
+    , showWealthField "gp" <| String.padLeft 2 '0' <| String.fromInt wealth.gp
+    , showWealthField "sp" <| String.fromInt wealth.sp
+    , showWealthField "cp" <| String.fromInt wealth.cp
+    ]
+
+
+showWealthField : String -> String -> Html Msg
+showWealthField name value =
+    div [ class "level-item" ]
+        [ p [ class "has-text-right" ]
+            [ strong [ class "heading is-marginless" ] [ text name ]
+            , span [ class <| "is-size-4" ] [ text value ]
+            ]
+        ]
+
+
+
+
+-- VIEW
+
+
+view : Model -> List (Html Msg)
+view model =
+    let
+        renderControls =
+            viewControls model.state.mode model.shown
+
+        header =
+            case model.shown of
+                PlayerLoot ->
+                    "Mon coffre"
+
+                GroupLoot ->
+                    "Coffre de groupe"
+
+                MerchantLoot ->
+                    "Marchand"
+
+                NewLoot ->
+                    "Nouveau trésor :)"
+
+        shownItems =
+            selectContent model.shown
+
+        isSelected =
+            itemInSelection model.selection
+
+        rowRenderer =
+            case model.state.mode of
+                NoMode ->
+                    case model.shown of
+                        GroupLoot ->
+                            let
+                                isClaimed =
+                                    itemInClaims model.claims
+                            in
+                            -- Claim controls for Group chest
+                            Just (claimedItemRenderer isClaimed)
+
+                        _ ->
+                            Nothing
+
+                activeMode ->
+                    Just (rowRendererForMode isSelected activeMode)
+    in
+    [ viewHeaderBar model.state.player.name model
+    , viewPlayerBar model.state.player renderControls
+    , main_
+        [ class "container" ]
+        [ viewNotification model.state.notification
+        , article
+            [ class "section" ]
+            [ div [ class "columns" ]
+                [ div [ class "column is-one-third" ] [ p [ class "title" ] [ text header ] ]
+                , div [ class "column" ] [ viewSearchBar ]
+                ]
+            , table [ class "table is-fullwidth is-striped is-hoverable" ]
+                [ thead [ class "table-header" ]
+                    [ th [] [ text "Nom" ] ]
+                , tbody [] <| List.map (viewItemTableRow isSelected rowRenderer) <| shownItems model
+                ]
+            ]
+        ]
+    , hr [] []
+    , section [ class "container" ] [ viewDebugSection model ]
+    ]
+
+
+
+-- Renderers
+--
+-- Item -> Html Msg
+
+
+claimedItemRenderer : (Item -> Bool) -> Item -> Html Msg
+claimedItemRenderer isClaimed item =
+    case isClaimed item of
+        True ->
+            renderIcon
+                { icon = "fas fa-praying-hands"
+                , size = "small"
+                , ratio = "1x"
+                }
+
+        False ->
+            text ""
+
+
+rowRendererForMode : (Item -> Bool) -> ActionMode -> Item -> Html Msg
+rowRendererForMode isSelected mode item =
+    let
+        canSelect =
+            canSelectIn mode
+
+        renderInfo =
+            case mode of
+                Buy ->
+                    p [ class "level-item" ] [ text (String.fromInt item.base_price ++ "po") ]
+
+                Sell ->
+                    p [ class "level-item" ] [ text (String.fromFloat (toFloat item.base_price / 2) ++ "po") ]
+
+                Grab ->
+                    p [ class "level-item" ] [ text "Grab" ]
+
+                Add ->
+                    p [ class "level-item" ] [ text "New !" ]
+
+                NoMode ->
+                    text ""
+    in
+    div [ class "level-right" ] <|
+        renderInfo
+            :: (if canSelect then
+                    [ input
+                        [ class "checkbox level-item"
+                        , type_ "checkbox"
+                        , checked <| isSelected item
+                        , onCheck (\v -> SwitchSelectionState item.id)
+                        ]
+                        []
+                    ]
+
+                else
+                    []
+               )
+
+
+viewItemTableRow : (Item -> Bool) -> Maybe (Item -> Html Msg) -> Item -> Html Msg
+viewItemTableRow isSelected rowRenderer item =
+    tr [ classList [ ( "is-selected", isSelected item ) ] ]
+        [ td []
+            [ label [ class "level checkbox" ] <|
+                div [ class "level-left" ]
+                    [ p [ class "level-item" ] [ text item.name ] ]
+                    :: (case rowRenderer of
+                            Just render ->
+                                List.singleton (render item)
+
+                            Nothing ->
+                                []
+                       )
+            ]
+        ]
+
+
+
+-- Search Bar
+
+
+viewSearchBar : Html Msg
+viewSearchBar =
+    div [ class "field" ]
+        [ p [ class "control has-icons-left" ]
+            [ input [ class "input" ] []
+            , span [ class "icon is-left" ] [ i [ class "fas fa-search" ] [] ]
+            ]
+        ]
+
+
+
+-- ACTION MODES
+--
+
+
+canSelectIn : ActionMode -> Bool
+canSelectIn mode =
+    case mode of
+        Sell ->
+            True
+
+        Buy ->
+            True
+
+        Grab ->
+            True
+
+        Add ->
+            False
+
+        NoMode ->
+            False
+
+
+viewControls : ActionMode -> ChestContent -> List (Html Msg)
+viewControls mode content =
+    case mode of
+        NoMode  ->
+            case content of
+                PlayerLoot ->
+                    [ actionButton (ModeSwitched Sell) "Vendre" "coins" "danger" ]
+
+                GroupLoot ->
+                    [ actionButton (ModeSwitched Grab) "Demander" "praying-hands" "primary" ]
+
+                MerchantLoot ->
+                    [ actionButton (ModeSwitched Buy) "Acheter" "coins" "success" ]
+
+                NewLoot ->
+                    [ actionButton (ModeSwitched Add) "Nouveau loot" "plus" "primary" ]
+
+        m ->
+            [ actionButton ConfirmAction "Valider" "check" "primary"
+            , actionButton (ModeSwitched NoMode) "Annuler" "times" "danger"
+            ]
+
+
+
+-- UPDATE
+
+
+type Msg
+    = ApiMsg Api.Msg
+    | ClearNotification
+    | SetContent (ChestContent)
+    | SetSelection (Maybe Selection)
+    | GotLoot ToChest (HttpResult Loot)
+    | GotClaims (HttpResult Claims)
+    | GotPlayer (HttpResult Api.Player)
+    | SwitchSelectionState Int
+    | ModeSwitched ActionMode
+    | ConfirmAction
+
+
+-- UPDATE
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        ApiMsg apiMsg ->
+            case apiMsg of
+                Api.GotActionResult response ->
+                    case response of
+                        Ok result ->
+                            let
+                                updates =
+                                    Maybe.withDefault [] result.updates
+
+                                notification =
+                                    result.notification
+
+                                errors =
+                                    Maybe.withDefault "" result.errors
+                            in
+                            List.foldl applyUpdate model updates
+                                |> setNotification notification
+                                |> setError errors
+                                |> update (ModeSwitched NoMode)
+
+                        Err r ->
+                            ( setError (Debug.toString r) model, Cmd.none )
+
+        SetContent content ->
+            ( { model | shown = content }, Cmd.none )
+
+        GotPlayer result ->
+                    case result of
+                        Ok player ->
+                            let
+                                state = model.state
+                            in
+                            ( { model | state = { state | player = player }} , Cmd.none)
+
+                        Err error ->
+                            ( setError ("Fetching player... " ++ Debug.toString error) model
+                            , Cmd.none
+                            )
+
+        ModeSwitched newMode ->
+            let state = model.state in
+            { model | state = { state | mode = newMode }}
+                  |> update
+                            (SetSelection
+                                    (case newMode of
+                                        NoMode ->
+                                            Nothing
+
+                                        Grab ->
+                                            -- Currently claimed object are initially selected
+                                            Just (Set.fromList <| List.map (\c -> c.loot_id) model.claims)
+
+                                        others ->
+                                            Just Set.empty
+                                    )
+                                )
+
+
+        ConfirmAction ->
+            case model.state.mode of
+                -- This should not happen, so we ignore it
+                NoMode ->
+                    ( model, Cmd.none )
+
+                mode ->
+                    let
+                        items =
+                            getSelected model.shown model
+                    in
+                    ( model
+                    , Cmd.map ApiMsg <|
+                        Api.confirmAction
+                            mode
+                            (String.fromInt model.state.player.id)
+                            items
+                    )
+
+        ClearNotification ->
+            ( setNotification Nothing model, Cmd.none )
+
+        SwitchSelectionState id ->
+            ( { model | selection = switchSelectionState id model.selection }, Cmd.none )
+
+        SetSelection new ->
+            ( { model | selection = new }, Cmd.none )
+
+        GotClaims (Ok claims )->
+            ( { model | claims = claims } , Cmd.none )
+
+        GotClaims (Err error) ->
+            ( setError (Debug.toString error) model, Cmd.none )
+
+        GotLoot dest (Ok loot) ->
+            (
+               let
+                   state = model.state
+               in
+                   case dest of
+                        OfPlayer _ ->
+                            { model | state = { state | playerLoot = loot }}
+
+                        OfGroup ->
+                            { model | state = { state | groupLoot = loot }}
+
+                        OfShop ->
+                            { model | state = { state | merchantLoot = loot }}
+                    , Cmd.none
+                    )
+
+        GotLoot _ (Err error) ->
+                    ( setError (Debug.toString error) model, Cmd.none )
+
+
+setNotification : Maybe String -> Model -> Model
+setNotification notification model =
+    let
+        state =
+            model.state
+    in
+    { model
+        | state =
+            { state | notification = notification }
+    }
+
+-- ERRORS
+
+
+setError : String -> Model -> Model
+setError error model =
+    let
+        state =
+            model.state
+    in
+    { model
+        | state =
+            { state | error = Just error }
+    }
+
+
+
+-- DbUpdates always refer to the active player's loot
+
+
+applyUpdate : Api.Update -> Model -> Model
+applyUpdate u model =
+    let
+        state = model.state
+    in
+    case u of
+        Api.ItemRemoved item ->
+            { model | state = { state | playerLoot =
+                List.filter (\i -> i.id /= item.id) model.state.playerLoot }}
+
+        Api.ItemAdded item ->
+            { model | state = { state | playerLoot = (item :: model.state.playerLoot) }}
+
+        Api.WealthUpdated diff ->
+            let
+                player =
+                    model.state.player
+
+                wealth =
+                    player.wealth
+            in
+            { model | state = { state
+                | player =
+                    { player
+                        | wealth =
+                            Wealth
+                                (wealth.cp + diff.cp)
+                                (wealth.sp + diff.sp)
+                                (wealth.gp + diff.gp)
+                                (wealth.pp + diff.pp)
+                    }
+            }}
+
+        Api.ClaimAdded claim ->
+            { model | claims = (claim :: model.claims) }
+
+        Api.ClaimRemoved claim ->
+            { model | claims = List.filter (\c -> c.id /= claim.id) model.claims }
+
+
+
+type ToChest
+    = OfPlayer Int
+    | OfGroup
+    | OfShop
+
+
+fetchLoot : ToChest -> Cmd Msg
+fetchLoot dest =
+    let
+        url =
+            case dest of
+                OfPlayer id ->
+                    "http://localhost:8088/api/players/" ++ String.fromInt id ++ "/loot"
+
+                OfShop ->
+                    "http://localhost:8088/api/items"
+
+                OfGroup ->
+                    "http://localhost:8088/api/players/0/loot"
+    in
+    Api.fetchLoot url (GotLoot dest)
+
+
+
+-- Selection
+-- Get list of selected items
+
+
+getSelected : ChestContent -> Model -> Loot
+getSelected content model =
+    selectContent content model
+        |> List.filter (itemInSelection model.selection)
+
+
+itemInSelection : Maybe Selection -> Item -> Bool
+itemInSelection selection item =
+    Maybe.map (Set.member item.id) selection
+        |> Maybe.withDefault False
+
+
+itemInClaims : Claims -> Item -> Bool
+itemInClaims claims item =
+    List.any (\c -> c.loot_id == item.id) claims
+
+
+switchSelectionState : Int -> Maybe Selection -> Maybe Selection
+switchSelectionState id selection =
+    case selection of
+        Just s ->
+            Just <|
+                case Set.member id s of
+                    True ->
+                        Set.remove id s
+
+                    False ->
+                        Set.insert id s
+
+        Nothing ->
+            Debug.log "ignore switchSelectionState" Nothing
+
+
+selectContent : ChestContent -> Model -> List Item
+selectContent content model =
+    case content of
+        NewLoot ->
+            model.state.newLoot
+
+        MerchantLoot ->
+            model.state.merchantLoot
+
+        PlayerLoot ->
+            model.state.playerLoot
+
+        GroupLoot ->
+            model.state.groupLoot

src/Session.elm

@@ -1,12 +1,13 @@
-module Session exposing (..)
+module Session exposing (Session(..), playerSession)
 
 import Browser.Navigation as Nav
+import Api
 
-type User
+type Session
-    = Player Int
+    = Player Nav.Key Int
-    | Admin
+--    | Admin Nav.Key
 
-type Model
+
-    = LoggedIn Nav.Key User
+playerSession navKey playerId =
-    | LoggedOut Nav.Key
+    Player navKey playerId