cleans Actions API and modes

src/Api.elm

@@ -1,10 +1,21 @@
-module Api exposing (Update(..), Msg(..)
+module Api exposing
-        , HttpResult
+    ( ActionMode(..)
-        , Player, Wealth, fetchPlayer, blankPlayer
+    , Claim
-        , Item, Loot, fetchLoot
+    , Claims
-        , Claim, Claims, fetchClaims
+    , HttpResult
-        , ActionMode(..), confirmAction
+    , Item
-        )
+    , Loot
+    , Msg(..)
+    , Player
+    , RequestData(..)
+    , Update(..)
+    , Wealth
+    , blankPlayer
+    , confirmAction
+    , fetchClaims
+    , fetchLoot
+    , fetchPlayer
+    )
 
 import Http
 import Json.Decode as D exposing (Decoder, field, int, string, succeed)
@@ -15,7 +26,10 @@ type alias HttpResult a =
     Result Http.Error a
 
 
+
 -- Format of the server's response
+
+
 type alias Response =
     { value : Maybe String
     , notification : Maybe String
@@ -110,11 +124,11 @@ fetchClaims toMsg playerId =
         }
 
 
+
 -- PLAYERS
 --
 
 
-
 fetchPlayer : (Result Http.Error Player -> msg) -> Int -> Cmd msg
 fetchPlayer toMsg id =
     Http.get
@@ -153,6 +167,14 @@ itemDecoder =
         (D.field "base_price" int)
 
 
+itemEncoder item =
+    E.object
+        [ ( "id", E.int item.id )
+        , ( "name", E.string item.name )
+        , ( "base_price", E.int item.base_price )
+        ]
+
+
 lootDecoder : Decoder Loot
 lootDecoder =
     D.list itemDecoder
@@ -168,10 +190,6 @@ fetchLoot url toMsg =
 
 
 -- CLAIMS
-
-
-
-
 -- API Response
 --
 
@@ -220,73 +238,86 @@ undoLastAction id =
         }
 
 
+
+{- ACTIONS
+
+   Actions that can be taken on a selection of items
+
+-}
+
+
 type ActionMode
-    = Sell
+    = View
+    | Sell
     | Buy
     | Grab
     | Add
-    | NoMode
 
-buildPayload : ActionMode -> List Item -> E.Value
+
-buildPayload mode items =
+type RequestData
-    case mode of
+    = SellPayload Loot (Maybe Float) (List Float) (List Int)
-        Buy ->
+    | BuyPayload Loot (Maybe Float) (List Float)
+    | GrabPayload Loot
+    | AddPayload String Loot
+
+
+buildPayload : RequestData -> E.Value
+buildPayload data =
+    case data of
+        BuyPayload items _ _ ->
             E.object
                 [ ( "items", items |> E.list (\i -> E.list identity [ E.int i.id, E.null ]) )
                 , ( "global_mod", E.null )
                 ]
 
-        Sell ->
+        SellPayload items _ _ _ ->
             E.object
                 [ ( "items", items |> E.list (\i -> E.list identity [ E.int i.id, E.null ]) )
                 , ( "global_mod", E.null )
                 , ( "players", E.null )
                 ]
 
-        -- API expects the list of claimed loot ids
+        -- API expects the list of claimed items ids
-        Grab ->
+        GrabPayload items ->
             items |> E.list (\i -> E.int i.id)
 
-        Add ->
+        AddPayload sourceName items ->
             E.object
-                [ ( "items", items |> E.list (\i -> E.int i.id) )
+                [ ( "items", items |> E.list itemEncoder )
+                , ( "source_name", E.string sourceName )
                 ]
 
-        NoMode -> E.null
 
-
+confirmAction : String -> RequestData -> Cmd Msg
-confirmAction : ActionMode -> String -> List Item -> Cmd Msg
+confirmAction id data =
-confirmAction mode id items =
     let
         ( endpoint, method ) =
-            case mode of
+            case data of
-                Add ->
+                AddPayload _ _ ->
                     ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
                     , "POST"
                     )
 
-                Buy ->
+                BuyPayload _ _ _ ->
                     ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
                     , "PUT"
                     )
 
-                Sell ->
+                SellPayload _ _ _ _ ->
                     ( "http://localhost:8088/api/players/" ++ id ++ "/loot"
                     , "DELETE"
                     )
 
-                Grab ->
+                GrabPayload _ ->
                     ( "http://localhost:8088/api/players/" ++ id ++ "/claims"
                     , "POST"
                     )
-                -- TODO: ???
-                NoMode -> ("", "GET")
     in
     Http.request
         { method = method
         , headers = []
         , url = endpoint
-        , body = Http.jsonBody <| buildPayload mode items
+        , body = Http.jsonBody <| buildPayload data
         , expect = Http.expectJson GotActionResult apiResponseDecoder
         , timeout = Nothing
         , tracker = Nothing

src/Page/Chest.elm

@@ -7,6 +7,7 @@ import Api
         , HttpResult
         , Item
         , Loot
+        , RequestData(..)
         , Wealth
         , confirmAction
         )
@@ -29,8 +30,11 @@ type alias State =
     , mode : ActionMode
     , error : Maybe String
     , notification : Maybe String
+
+    -- AddLoot
     , autoComplete : Loot
     , newItem : Maybe Item
+    , sourceName : Maybe String
 
     -- Fetched on init
     , player : Api.Player
@@ -58,7 +62,20 @@ type alias Model =
 init (Player navKey playerId) =
     ( Model
         navKey
-        (State False NoMode Nothing Nothing [] Nothing Api.blankPlayer [] [] [] [])
+        (State
+            False
+            View
+            Nothing
+            Nothing
+            []
+            Nothing
+            Nothing
+            Api.blankPlayer
+            []
+            []
+            []
+            []
+        )
         Route.PlayerLoot
         Nothing
         ""
@@ -259,7 +276,7 @@ view model =
                     "Nouveau trésor :)"
 
         shownItems =
-            selectContent model.shown
+            selectContent model
 
         isSelected =
             itemInSelection model.selection
@@ -269,7 +286,7 @@ view model =
 
         rowRenderer =
             case model.state.mode of
-                NoMode ->
+                View ->
                     case model.shown of
                         GroupLoot ->
                             let
@@ -284,21 +301,33 @@ view model =
 
                 activeMode ->
                     Just (rowRendererForMode activeMode)
+
+        filteredItems =
+            shownItems
+                |> List.filter
+                    (\i -> String.toLower i.name |> String.contains (String.toLower model.searchText))
     in
     [ viewHeaderBar "Mon coffre" model
     , viewPlayerBar model.state.player renderControls
     , main_
         [ class "container" ]
         [ viewNotification model.state.notification
+        , article
+            [ class "section" ]
+            (case model.state.mode of
+                Add ->
+                    [ viewAddLoot model
+                    , viewLoot rowRenderer canSelect isSelected shownItems
+                    ]
 
-        -- TODO: viewAddLoot when in Add mode
+                _ ->
-        , case model.state.mode of
+                    [ div [ class "columns" ]
-            Add ->
+                        [ div [ class "column is-one-third" ] [ p [ class "title" ] [ text header ] ]
-                viewAddLoot model
+                        , div [ class "column" ] [ viewSearchBar model.searchText ]
-
+                        ]
-            _ ->
+                    , viewLoot rowRenderer canSelect isSelected filteredItems
-                text ""
+                    ]
-        , viewLoot header model.searchText rowRenderer canSelect isSelected <| shownItems model
+            )
         ]
     , hr [] []
     , section [ class "container" ] [ viewDebugSection model ]
@@ -334,25 +363,12 @@ view model =
 -- VIEW LOOT
 
 
-viewLoot : String -> String -> Maybe (Item -> Html Msg) -> Bool -> (Item -> Bool) -> Loot -> Html Msg
+viewLoot : Maybe (Item -> Html Msg) -> Bool -> (Item -> Bool) -> Loot -> Html Msg
-viewLoot header searchText maybeRowRenderer canSelect isSelected items =
+viewLoot maybeRowRenderer canSelect isSelected items =
-    let
+    table [ class "table is-fullwidth is-striped is-hoverable" ]
-        filteredItems =
+        [ thead [ class "table-header" ]
-            List.filter
+            [ th [] [ text "Nom" ] ]
-                (\i -> String.toLower i.name |> String.contains (String.toLower searchText))
+        , tbody [] <| List.map (viewItemTableRow isSelected canSelect maybeRowRenderer) items
-                items
-    in
-    article
-        [ class "section" ]
-        [ div [ class "columns" ]
-            [ div [ class "column is-one-third" ] [ p [ class "title" ] [ text header ] ]
-            , div [ class "column" ] [ viewSearchBar searchText ]
-            ]
-        , table [ class "table is-fullwidth is-striped is-hoverable" ]
-            [ thead [ class "table-header" ]
-                [ th [] [ text "Nom" ] ]
-            , tbody [] <| List.map (viewItemTableRow isSelected canSelect maybeRowRenderer) filteredItems
-            ]
         ]
 
 
@@ -406,9 +422,9 @@ rowRendererForMode mode item =
             p [ class "level-item" ] [ text "Grab" ]
 
         Add ->
-            p [ class "level-item" ] [ text "New !" ]
+            p [ class "level-item" ] [ text <| "Valeur : " ++ String.fromInt item.base_price ++ "po" ]
 
-        NoMode ->
+        View ->
             text ""
 
 
@@ -514,6 +530,14 @@ viewAddLoot model =
                 Nothing ->
                     Item 0 "" 0
 
+        sourceName =
+            case model.state.sourceName of
+                Just name ->
+                    name
+
+                Nothing ->
+                    ""
+
         itemIsValid =
             if nameValid && priceValid then
                 True
@@ -540,6 +564,9 @@ viewAddLoot model =
                         [ input
                             [ class "input"
                             , type_ "text"
+                            , name "source"
+                            , value sourceName
+                            , onInput SourceNameChanged
                             ]
                             []
                         ]
@@ -644,14 +671,14 @@ canSelectIn mode =
         Add ->
             False
 
-        NoMode ->
+        View ->
             False
 
 
 viewControls : ActionMode -> ChestContent -> List (Html Msg)
 viewControls mode content =
     case mode of
-        NoMode ->
+        View ->
             case content of
                 PlayerLoot ->
                     [ actionButton (ModeSwitched Sell) "Vendre" "coins" "danger" ]
@@ -667,7 +694,7 @@ viewControls mode content =
 
         m ->
             [ actionButton ConfirmAction "Valider" "check" "primary"
-            , actionButton (ModeSwitched NoMode) "Annuler" "times" "danger"
+            , actionButton (ModeSwitched View) "Annuler" "times" "danger"
             ]
 
 
@@ -686,10 +713,13 @@ type Msg
     | GotPlayer (HttpResult Api.Player)
     | SwitchSelectionState Int
     | ModeSwitched ActionMode
+    | OnModeEnter ActionMode
+    | OnModeExit ActionMode
     | ConfirmAction
     | NewItemAdded Item
     | NewItemNameChanged String
     | NewItemPriceChanged String
+    | SourceNameChanged String
     | SetNewItem Item
 
 
@@ -715,6 +745,15 @@ update msg model =
             in
             ( { model | state = { state | newItem = Just item } }, Cmd.none )
 
+        SourceNameChanged name ->
+            let
+                state =
+                    model.state
+            in
+            ( { model | state = { state | sourceName = Just name } }
+            , Cmd.none
+            )
+
         NewItemPriceChanged price ->
             case String.toInt price of
                 Just newPrice ->
@@ -769,13 +808,20 @@ update msg model =
                             List.foldl applyUpdate model updates
                                 |> setNotification notification
                                 |> setError errors
-                                |> update (ModeSwitched NoMode)
+                                |> update (ModeSwitched View)
 
                         Err r ->
                             ( setError (Debug.toString r) model, Cmd.none )
 
         SetContent content ->
-            ( { model | shown = content }, Cmd.none )
+            if content == NewLoot then
+                { model | shown = content }
+                    |> update (ModeSwitched Add)
+
+            else
+                ( { model | shown = content }
+                , Cmd.none
+                )
 
         GotPlayer result ->
             case result of
@@ -791,45 +837,86 @@ update msg model =
                     , Cmd.none
                     )
 
+        OnModeEnter mode ->
+            update
+                (SetSelection
+                    (case ( mode, canSelectIn mode ) of
+                        ( _, False ) ->
+                            Nothing
+
+                        -- Currently claimed object are initially selected
+                        ( Grab, _ ) ->
+                            Just (Set.fromList <| List.map (\c -> c.loot_id) model.claims)
+
+                        ( _, True ) ->
+                            Just Set.empty
+                    )
+                )
+                model
+
+        OnModeExit mode ->
+            if mode == Add then
+                -- Redirect to PlayerLoot view
+                ( model, Nav.pushUrl model.navKey "/" )
+
+            else
+                ( model, Cmd.none )
+
         ModeSwitched newMode ->
             let
                 state =
                     model.state
+
+                -- We chain exit old mode and enter new mode updates
+                ( exit, exit_cmd ) =
+                    update (OnModeExit model.state.mode) model
+
+                ( entered, enter_cmd ) =
+                    update (OnModeEnter newMode) exit
             in
-            { model | state = { state | mode = newMode } }
+            ( { entered | state = { state | mode = newMode } }
-                |> update
+            , Cmd.batch [ exit_cmd, enter_cmd ]
-                    (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
+            let
-                -- This should not happen, so we ignore it
+                items =
-                NoMode ->
+                    getSelectedItems model
-                    ( model, Cmd.none )
 
-                mode ->
+                maybeData =
-                    let
+                    case model.state.mode of
-                        items =
+                        Add ->
-                            getSelected model.shown model
+                            Just <|
-                    in
+                                Api.AddPayload
-                    ( model
+                                    (Maybe.withDefault
-                    , Cmd.map ApiMsg <|
+                                        "nouveau loot"
+                                        model.state.sourceName
+                                    )
+                                    (selectContent model)
+
+                        Buy ->
+                            Just <| Api.BuyPayload items Nothing []
+
+                        Sell ->
+                            Just <| Api.SellPayload items Nothing [] []
+
+                        Grab ->
+                            Just <| Api.GrabPayload items
+
+                        View ->
+                            Nothing
+            in
+            ( model
+            , case maybeData of
+                Just data ->
+                    Cmd.map ApiMsg <|
                         Api.confirmAction
-                            mode
                             (String.fromInt model.state.player.id)
-                            items
+                            data
-                    )
+
+                Nothing ->
+                    Cmd.none
+            )
 
         ClearNotification ->
             ( setNotification Nothing model, Cmd.none )
@@ -976,9 +1063,9 @@ fetchLoot dest =
 -- Get list of selected items
 
 
-getSelected : ChestContent -> Model -> Loot
+getSelectedItems : Model -> Loot
-getSelected content model =
+getSelectedItems model =
-    selectContent content model
+    selectContent model
         |> List.filter (itemInSelection model.selection)
 
 
@@ -1009,9 +1096,9 @@ switchSelectionState id selection =
             Debug.log "ignore switchSelectionState" Nothing
 
 
-selectContent : ChestContent -> Model -> List Item
+selectContent : Model -> List Item
-selectContent content model =
+selectContent model =
-    case content of
+    case model.shown of
         NewLoot ->
             model.state.newLoot