extracts Chest module, pulling out Route and Utils

src/Chest.elm

@@ -0,0 +1,112 @@
+module Chest exposing (..)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (onCheck)
+import Set exposing (Set)
+
+import Route
+import Modes exposing (ViewMode)
+import Api exposing (Item)
+import Utils exposing (..)
+
+type alias Model =
+    { items: List Item
+    , selection : Maybe Selection
+    }
+
+type alias Selection = Set Int
+
+type Msg
+    = SetSelection (Maybe Selection)
+    | SwitchSelectionState Int
+
+init : Model
+init =
+    { items = []
+    , selection = Nothing
+    }
+
+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 )
+
+view : Maybe ViewMode -> Route.Route -> Model -> Html Msg
+view mode route model =
+    let
+        isSelected = itemInSelection model.selection
+        rowControls = case mode of
+            Just m ->
+                Just (rowControlsForMode isSelected m)
+            Nothing -> -- Claim controls for Group chest
+                case route of
+                        Route.GroupLoot -> Just (claimedItemRenderer isSelected)
+                        _ -> Nothing
+
+    in
+    table [ class "table is-fullwidth is-hoverable"]
+        [ thead [ class "table-header" ]
+                 [ th [] [ text "Nom" ] ]
+        , tbody [] <| List.map (viewItemTableRow isSelected rowControls) model.items
+        ]
+
+claimedItemRenderer isSelected item =
+    case isSelected item of
+        True ->  renderIcon "fas fa-praying-hands" "1x"
+        False -> text ""
+
+
+-- Renders controls for a specific mode
+rowControlsForMode : (Item -> Bool) -> ViewMode -> Item -> Html Msg
+rowControlsForMode isSelected mode item =
+    let
+        itemInfo = 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 !" ]
+    in
+    div [ class "level-right" ]
+        <| itemInfo
+        :: if Modes.canSelectIn mode 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 rowControls item =
+    tr  [ classList [ ("is-selected", isSelected item) ] ]
+        [ td []
+            [ label [ class "level checkbox" ]
+                  <| div [ class "level-left" ]
+                         [ p [class "level-item"] [ text item.name ]]
+                    :: case rowControls of
+                              Just render -> List.singleton (render item)
+                              Nothing -> []
+            ]
+        ]
+
+itemInSelection : Maybe Selection -> Item -> Bool
+itemInSelection selection item =
+    Maybe.map (Set.member item.id) selection
+        |> Maybe.withDefault False
+
+
+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

src/Main.elm

@@ -7,13 +7,15 @@ import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
 import Svg.Attributes
-import Url.Parser as P exposing (Parser, (</>), oneOf, s)
 import Set exposing (Set)
 import Json.Encode as E
 
 import Api exposing (Player, Loot, Wealth, Item, Claim, Claims)
 import Modes exposing (ViewMode)
-
+import Route exposing (..)
+import Chest
+import Chest exposing (Msg)
+import Utils exposing (..)
 -- Main
 
 main : Program () Model Msg
@@ -29,20 +31,19 @@ main =
 
 -- Model
 
-type alias Selection = Set Int
 
 type alias State =
     { navKey : Nav.Key
     , route : Route
     , error : String
     , menuOpen : Bool
-    , selection : Maybe Selection
     , activeMode : Maybe ViewMode
     }
 
 type alias Model =
     { state : State
     , player: Player
+    , chest : Chest.Model
     , claims : Claims
     , notification : Maybe String
     , loot: Maybe Loot
@@ -53,13 +54,14 @@ type alias Model =
 init : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )
 init flags url key =
     let
-        route = case P.parse routeParser url of
+        route = case routeParser url of
                     Just r -> r
                     Nothing -> PlayerChest
     in
         ( Model
-              (State key route "" False Nothing Nothing)
+              (State key route "" False Nothing)
               Api.blankPlayer
+              Chest.init
               []
               Nothing
               Nothing
@@ -89,8 +91,8 @@ type Msg
     = LinkClicked Browser.UrlRequest
     | UrlChanged Url.Url
     | ApiMsg Api.Msg
+    | ChestMsg Chest.Msg
     | PlayerChanged Int
-    | LootViewItemSwitched Int
     | ModeSwitched (Maybe ViewMode)
     | ConfirmAction
     | UndoLastAction
@@ -110,7 +112,7 @@ update msg model =
 
         UrlChanged url ->
             let
-                route = P.parse routeParser url
+                route = routeParser url
                 state = model.state
             in
                 case route of
@@ -128,6 +130,12 @@ update msg model =
         PlayerChanged newId ->
             ( { model | player = Api.blankPlayer }, initPlayer newId )
 
+        ChestMsg chestMsg ->
+            let
+                (chest, _) = Chest.update chestMsg model.chest
+            in
+                ( { model | chest = chest }, Cmd.none )
+
         ApiMsg apiMsg -> case apiMsg of
             Api.GotActionResult response ->
                 case response of
@@ -173,32 +181,28 @@ update msg model =
                         , Cmd.none
                         )
 
-        LootViewItemSwitched id ->
-            let
-                state = model.state
-            in
-            ( { model | state =
-                    { state | selection = Debug.log "new selection"
-                                <| switchSelectionState id state.selection }}
-            , Cmd.none )
-
         ModeSwitched newMode ->
             let
                 state = model.state
             in
             ( { model | state =
-                    { state | activeMode = newMode
-                            , selection =
-                                case newMode of
-                                    Nothing ->
-                                        Nothing
+                      { state | activeMode = newMode }
+                      , chest =
+                          let
+                              (newChest, _) = Chest.update (Chest.SetSelection
+                                    (case newMode of
+                                        Nothing ->
+                                            Nothing
 
-                                    Just Modes.Grab -> -- Currently claimed object are initially selected
-                                        Just ( Set.fromList <| List.map (\c -> c.loot_id) model.claims)
+                                        Just Modes.Grab -> -- Currently claimed object are initially selected
+                                            Just ( Set.fromList <| List.map (\c -> c.loot_id) model.claims)
 
-                                    Just others ->
-                                        Just Set.empty
-                    }}
+                                        Just others ->
+                                            Just Set.empty
+                                        ))
+                                    model.chest
+                          in newChest
+                    }
             , Cmd.none )
 
         ConfirmAction ->
@@ -208,7 +212,7 @@ update msg model =
 
                 Just mode ->
                     let items = targetItemsFor mode model
-                                |> List.filter (itemInSelection model.state.selection)
+                                |> List.filter (Chest.itemInSelection model.chest.selection)
                     in
                     ( model
                     , Cmd.map ApiMsg
@@ -274,15 +278,6 @@ setError error model =
 
 -- STATE Utils
 
-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
-
 -- SUBSCRIPTIONS
 --
 subscriptions : Model -> Sub Msg
@@ -335,33 +330,28 @@ view model =
             Header controls are inserted in the PlayerBar
             and rowControls to the right side of every item rows
         -}
-        (headerControls, rowControls) =
+        headerControls =
             case model.state.activeMode of
-                Just mode ->
-                    ( controlsWhenModeActive mode, Just (rowControlsForMode mode isSelected))
+                Just mode -> controlsWhenModeActive mode
                 Nothing -> -- Buttons to enter mode
-                    ( actionButton UndoLastAction "Annuler action" "backspace" "danger"
-                      :: controlsWhenRoute model.state.route
-                    -- Claim controls for Group chest
-                    , case model.state.route of
-                        GroupLoot -> Just (renderIfClaimed <| itemInClaims model.claims)
-                        _ -> Nothing
-                    )
-
-        -- TODO: should we extract the Maybe conversion
-        --       and represent cannotSelect with Nothing ??
-        isSelected =
-            itemInSelection model.state.selection
+                    actionButton UndoLastAction "Annuler action" "backspace" "danger"
+                 :: controlsWhenRoute model.state.route
     in
     { title = "Loot-a-lot in ELM"
     , body =
         [ viewHeaderBar model
         , viewPlayerBar model.player model.notification headerControls
-        , article [class "section container"]
-                  [ p [class "heading"] [text header]
-                  , viewSearchBar
-                  , viewChest isSelected rowControls shownLoot
-                  ]
+        , article
+            [ class "section container" ]
+            [ viewNotification model.notification
+            , p [class "heading"] [text header]
+            , viewSearchBar
+            , Chest.view
+                model.state.activeMode
+                model.state.route
+                model.chest
+            |> Html.map ChestMsg
+            ]
         , hr [] []
         , section [class "container"] [viewDebugSection model]
         ]
@@ -377,64 +367,10 @@ viewNotification notification =
 
 -- LOOT Views
 
-itemInSelection : Maybe Selection -> Item -> Bool
-itemInSelection selection item =
-    Maybe.map (Set.member item.id) selection
-        |> Maybe.withDefault False
-
 itemInClaims : List Claim -> Item -> Bool
 itemInClaims claims item =
     List.any (\c -> c.loot_id == item.id) claims
 
-renderIfClaimed : (Item -> Bool) -> Item -> Html Msg
-renderIfClaimed isClaimed item =
-    case isClaimed item of
-        True ->  renderIcon "fas fa-praying-hands" "1x"
-        False -> text ""
-
-viewChest : (Item -> Bool) -> Maybe (Item -> Html Msg) -> Loot -> Html Msg
-viewChest isSelected rowControls items =
-    table [ class "table is-fullwidth is-hoverable"]
-        [ thead [ class "table-header" ]
-                 [ th [] [ text "Nom" ] ]
-        , tbody [] <| List.map (viewItemTableRow isSelected rowControls) items
-        ]
-
--- Renders controls for a specific mode
-rowControlsForMode : ViewMode -> (Item -> Bool) -> Item -> Html Msg
-rowControlsForMode mode isSelected item =
-    let
-        itemInfo = 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 !" ]
-    in
-    div [ class "level-right" ]
-        <| itemInfo
-        :: if Modes.canSelectIn mode then
-             [input [ class "checkbox level-item"
-                   , type_ "checkbox"
-                   , checked <| isSelected item
-                   , onCheck (\v -> LootViewItemSwitched item.id)
-                   ] [] ]
-         else
-             []
-
-
-viewItemTableRow : (Item -> Bool) -> Maybe (Item -> Html Msg) -> Item -> Html Msg
-viewItemTableRow isSelected rowControls item =
-    tr  [ classList [ ("is-selected", isSelected item) ] ]
-        [ td []
-            [ label [ class "level checkbox" ]
-                  <| div [ class "level-left" ]
-                         [ p [class "level-item"] [ text item.name ]]
-                    :: case rowControls of
-                              Just render -> List.singleton (render item)
-                              Nothing -> []
-            ]
-        ]
-
 -- DEBUG SECTION
 
 viewDebugSection : Model -> Html Msg
@@ -445,7 +381,7 @@ viewDebugSection model =
         , p [class "panel-block has-text-danger"] [text model.state.error]
         , p [class "panel-block"] [text ("Route : " ++ Debug.toString model.state.route)]
         , p [class "panel-block"] [text ("Active Mode : " ++ Debug.toString model.state.activeMode)]
-        , p [class "panel-block"] [text ("Selection : " ++ Debug.toString model.state.selection)]
+        , p [class "panel-block"] [text ("Selection : " ++ Debug.toString model.chest.selection)]
         , p [class "panel-block"] [text ("Claims : " ++ Debug.toString model.claims)]
         , p []  debugSandbox
         ]
@@ -483,10 +419,6 @@ debugSwitchPlayers =
         ]
 
 
-renderIcon name size =
-    span [ class <| "icon is-medium"]
-         [ i [ class <| name ++ " fa-" ++ size] [] ]
-
 
 -- HEADER SECTION
 
@@ -572,23 +504,3 @@ showWealthField name value =
 viewSearchBar : Html Msg
 viewSearchBar =
     input [class "input"] []
-
----
--- ROUTES
----
-
-type Route
-    = PlayerChest
-    | Merchant
-    | GroupLoot
-    | NewLoot
-
-routeParser : Parser (Route -> a) a
-routeParser =
-    oneOf
-        [ P.map GroupLoot (P.s "coffre")
-        , P.map PlayerChest P.top
-        , P.map Merchant (P.s "marchand")
-        , P.map NewLoot (P.s "nouveau-tresor")
-        ]
-

src/Route.elm

@@ -0,0 +1,25 @@
+module Route exposing(..)
+
+import Url
+import Url.Parser as P exposing (Parser, (</>), oneOf, s)
+---
+-- ROUTES
+---
+
+type Route
+    = PlayerChest
+    | Merchant
+    | GroupLoot
+    | NewLoot
+
+routeParser : Url.Url -> Maybe Route
+routeParser url =
+    P.parse
+        (oneOf
+            [ P.map GroupLoot (P.s "coffre")
+            , P.map PlayerChest P.top
+            , P.map Merchant (P.s "marchand")
+            , P.map NewLoot (P.s "nouveau-tresor")
+            ]
+        )
+        url

src/Utils.elm

@@ -0,0 +1,8 @@
+module Utils exposing (renderIcon)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+
+renderIcon name size =
+    span [ class <| "icon is-medium"]
+         [ i [ class <| name ++ " fa-" ++ size] [] ]