works on parsing ApiResponse

src/Main.elm

@@ -9,7 +9,8 @@ import Html.Attributes exposing (..)
 import Html.Events exposing (..)
 import Svg.Attributes
 import Http
-import Json.Decode exposing (Decoder, field, list, string, int)
+import Json.Decode exposing (Decoder, field, list, string, int, succeed)
+import Json.Encode as E
 import Url.Parser as P exposing (Parser, (</>), oneOf, s)
 import Set exposing (Set)
 -- Main
@@ -155,14 +156,26 @@ valueDecoder thenDecoder =
 
 -- UPDATE
 
+type alias HttpResult a = (Result Http.Error a)
+
+type alias ApiResponse =
+    { value : Maybe String
+    , updates : Maybe (List DbUpdate)
+    , notification : Maybe String
+    , error : Maybe String
+    }
+
 type Msg
     = LinkClicked Browser.UrlRequest
     | UrlChanged Url.Url
     | PlayerChanged Int
-    | GotPlayer (Result Http.Error Player)
+    | GotPlayer (HttpResult Player)
-    | GotLoot ToChest (Result Http.Error Loot)
+    | GotLoot ToChest (HttpResult Loot)
     | LootViewItemSwitched Int
     | ModeSwitched (Maybe ViewMode)
+    | ConfirmAction
+    | UndoLastAction
+    | GotActionResult (HttpResult ApiResponse)
 
 update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
@@ -233,29 +246,137 @@ update msg model =
         ModeSwitched newMode ->
             let
                 state = model.state
-
-                (nextMode, cmd) =
-                    case newMode of
-                        Nothing -> -- Cancel action
-                            (Nothing, Cmd.none)
-                        new ->
-                            case new of
-                                Just Confirm ->
-                                    -- Confirm action and exit
-                                    (Nothing, Cmd.none)
-                                other ->
-                                    -- Enter mode
-                                    (new, Cmd.none)
-
             in
             ( { model | state =
-                    { state | activeMode = nextMode
+                    { state | activeMode = newMode
-                            , selection = case nextMode of
+                            , selection = case newMode of
                                             Nothing -> Nothing
                                             Just Grab -> Just (Set.fromList [34, 38])
                                             Just others -> Just Set.empty
                     }}
-            , cmd)
+            , Cmd.none )
+
+        ConfirmAction ->
+            let
+                currentMode = model.state.activeMode
+            in
+                (model, sendRequest currentMode model)
+
+        UndoLastAction ->
+            let playerId = String.fromInt model.player.id
+            in
+            (model, Http.request
+            { url = "http://localhost:8088/api/players/" ++ playerId ++"/events/last"
+            , method = "DELETE"
+            , headers = []
+            , body = Http.emptyBody
+            , expect = Http.expectJson GotActionResult apiResponseDecoder
+            , timeout = Nothing
+            , tracker = Nothing
+            })
+
+        GotActionResult response ->
+            case response of
+                Ok r -> (setError (Debug.toString r) model, Cmd.none)
+                Err r -> (setError (Debug.toString r) model, Cmd.none)
+
+targetItemsFor : ViewMode -> Model -> List Item
+targetItemsFor mode model =
+    case mode of
+        Add -> []
+        Buy -> Maybe.withDefault [] model.merchantItems
+        Sell ->Maybe.withDefault [] model.loot
+        Grab -> Maybe.withDefault [] model.groupLoot
+
+buildPayload : ViewMode -> Model -> E.Value
+buildPayload mode model =
+    let
+        items = targetItemsFor mode model
+                |> List.filter (itemInSelection model.state.selection)
+    in
+        case mode of
+            Buy -> E.object
+                   [ ( "items", items |> E.list (\i -> E.list identity [E.int i.id, E.null]))
+                   , ("global_mod", E.null )
+                   ]
+            Sell -> E.object
+                   [ ( "items", items |> E.list (\i -> E.list identity [E.int i.id, E.null]))
+                   , ("global_mod", E.null )
+                   ]
+            Grab ->  E.object
+                   [ ( "items", items |> E.list (\i -> E.int i.id))
+                   , ("global_mod", E.null )
+                   ]
+            Add -> E.object
+                   [ ( "items", items |> E.list (\i -> E.int i.id))
+                   , ("global_mod", E.null )
+                   ]
+
+type DbUpdate
+    = ItemRemoved Item
+    | ItemAdded Item
+    | WealthUpdated Wealth
+    | ClaimAdded ()
+    | ClaimRemoved ()
+
+-- TODO: update server to produce better json
+--       like an object with list of updates of the same type
+--       { ItemRemoved : [..], Wealth : [ .. ], .. }
+updatesDecoder : Decoder DbUpdate
+updatesDecoder =
+    -- We expect one update but do not know it's kind
+            Json.Decode.oneOf
+                [ (field "ItemRemoved" (itemDecoder |> Json.Decode.andThen (\i -> succeed <| ItemRemoved i)))
+                , (field "ItemAdded" (itemDecoder |> Json.Decode.andThen (\i -> succeed <| ItemAdded i)))
+                , (field "Wealth" (wealthDecoder |> Json.Decode.andThen (\i -> succeed <| WealthUpdated i)))
+                , (field "ClaimRemoved" (succeed () |> Json.Decode.andThen (\i -> succeed <| ClaimRemoved i)))
+                , (field "ClaimAdded" (succeed () |> Json.Decode.andThen (\i -> succeed <| ClaimAdded i)))
+                ]
+
+
+apiResponseDecoder : Decoder ApiResponse
+apiResponseDecoder =
+    Json.Decode.map4 ApiResponse
+        (Json.Decode.maybe (field "value" string))
+        (Json.Decode.maybe (field "updates" (Json.Decode.list updatesDecoder)))
+        (Json.Decode.maybe (field "notification" string))
+        (Json.Decode.maybe (field "error" string))
+
+
+sendRequest : Maybe ViewMode -> Model -> Cmd Msg
+sendRequest activeMode model =
+    case activeMode of
+        Nothing -> Cmd.none
+        Just mode ->
+            let
+                (endpoint, method) = case mode of
+                    Add ->
+                        ( "http://localhost:8088/api/players/" ++ (String.fromInt model.player.id) ++ "/loot"
+                        , "POST"
+                        )
+                    Buy ->
+                        ( "http://localhost:8088/api/players/" ++ (String.fromInt model.player.id) ++ "/loot"
+                        , "PUT"
+                        )
+                    Sell ->
+                        ( "http://localhost:8088/api/players/" ++ (String.fromInt model.player.id) ++ "/loot"
+                        , "DELETE"
+                        )
+                    Grab ->
+                        ( "http://"
+                        , "POST")
+            in
+            Http.request
+                { method = method
+                , headers = []
+                , url = endpoint
+                , body = Http.jsonBody <| buildPayload mode model
+                , expect = Http.expectJson GotActionResult apiResponseDecoder
+                , timeout = Nothing
+                , tracker = Nothing
+                }
+
+
 
 -- ERRORS
 
@@ -301,11 +422,18 @@ type ViewMode
     | Buy
     | Grab
     | Add
-    | Confirm -- Confirm action and exit mode
 
-actionButton mode t icon color =
+canSelectIn : ViewMode -> Bool
+canSelectIn mode =
+    case mode of
+        Sell -> True
+        Buy -> True
+        Grab -> True
+        Add -> False
+
+actionButton msg t icon color =
     button [ class <| "button is-" ++ color
-           , onClick (ModeSwitched mode) ]
+           , onClick msg ]
         [ span [ class "icon" ] [ i [ Svg.Attributes.class <| "fas fa-" ++ icon ] [] ]
         , p [] [text t]
         ]
@@ -313,6 +441,7 @@ actionButton mode t icon color =
 view : Model -> Browser.Document Msg
 view model =
     let
+        -- What do we show inside the chest ?
         (header, shownLoot) =
             case model.state.route of
                 PlayerChest ->
@@ -323,21 +452,39 @@ view model =
                     ("Marchand", Maybe.withDefault [] model.merchantItems)
                 NewLoot ->
                     ("Nouveau trésor :)", [] )
-        actionControls =
+
+        {- Dynamic renderes to allow the use of ViewMode
+
+            ActionControls is inserted in the PlayerBar's right
+            and rowControls are inserted, to the right of every item rows
+        -}
+        (actionControls, rowControls) =
             case model.state.activeMode of
                 Just mode -> -- When a mode is active
-                    [ div [ class "buttons has-addons"]
+                    ( [ div [ class "buttons has-addons"]
-                          [ actionButton (Just Confirm) "Valider" "plus" "primary"
+                          [ actionButton (ConfirmAction) "Valider" "success" "primary"
-                          , actionButton Nothing "Annuler" "times" "danger"
+                          , actionButton (ModeSwitched Nothing) "Annuler" "times" "danger"
                           ]
-                    ]
+                      ]
-                Nothing ->  -- Buttons to enter mode
+                    , Just (rowControlsForMode mode isSelected)
-                    case model.state.route of
+                    )
-                        PlayerChest -> [actionButton (Just Sell) "Vendre" "coins" "danger"]
+                Nothing -> -- Buttons to enter mode
-                        GroupLoot -> [actionButton (Just Grab) "Demander" "coins" "primary"]
+                    ( actionButton UndoLastAction "Annuler action" "delete" "danger"
-                        Merchant -> [actionButton (Just Buy) "Acheter" "coins" "success"]
+                      :: case model.state.route of
-                        NewLoot -> [actionButton (Just Add) "Nouveau loot" "plus" "primary"]
+                        PlayerChest -> [actionButton (ModeSwitched (Just Sell)) "Vendre" "coins" "danger"]
+                        GroupLoot -> [actionButton (ModeSwitched (Just Grab)) "Demander" "coins" "primary"]
+                        Merchant -> [actionButton (ModeSwitched (Just Buy)) "Acheter" "coins" "success"]
+                        NewLoot -> [actionButton (ModeSwitched (Just Add)) "Nouveau loot" "plus" "primary"]
+                    -- Claim controls for Group chest
+                    , case model.state.route of
+                        GroupLoot -> Just renderId
+                        _ -> Nothing
+                    )
 
+        -- TODO: should we extract the Maybe conversion
+        --       and represent cannotSelect with Nothing ??
+        isSelected =
+            itemInSelection model.state.selection
     in
     { title = "Loot-a-lot in ELM"
     , body =
@@ -346,7 +493,7 @@ view model =
         , article [class "section container"]
                   [ p [class "heading"] [text header]
                   , viewSearchBar
-                  , viewChest shownLoot model
+                  , viewChest isSelected rowControls shownLoot
                   ]
         , hr [] []
         , section [class "container"] [viewDebugSection model]
@@ -355,60 +502,38 @@ view model =
 
 -- LOOT Views
 
-isSelected : Maybe Selection -> Item -> Bool
+itemInSelection : Maybe Selection -> Item -> Bool
-isSelected selection item =
+itemInSelection selection item =
-    case selection of
+    Maybe.map (Set.member item.id) selection
-        Just s ->
+        |> Maybe.withDefault False
-            Set.member item.id s
-        Nothing ->
-            False
 
-renderName item =
+renderId item =
-   p [] [text item.name]
+   p [] [text <| String.fromInt item.id]
 
-viewChest : Loot -> Model -> Html Msg
+viewChest : (Item -> Bool) -> Maybe (Item -> Html Msg) -> Loot -> Html Msg
-viewChest items model =
+viewChest isSelected rowControls items =
-    let
+    table [ class "table is-fullwidth is-hoverable"]
-        -- If a mode is active, render its controls
+        [ thead [ class "table-header" ]
-        -- Otherwise, controls may be rendered depending on current route
-        rowControls = case model.state.activeMode of
-            Just mode -> Just (rowModeControlsRenderer mode)
-            Nothing ->
-                case model.state.route of
-                    GroupLoot -> Just renderName
-                    others -> Nothing
-    in
-    table [ class "table is-fullwidth is-striped is-light"]
-        <| thead [ class "table-header" ]
                  [ th [] [ text "Nom" ] ]
-        :: List.map (viewItemTableRow (isSelected model.state.selection) rowControls) items
+        , tbody [] <| List.map (viewItemTableRow isSelected rowControls) items
+        ]
 
 -- Renders controls for a specific mode
-rowModeControlsRenderer : ViewMode -> Item -> Html Msg
+rowControlsForMode : ViewMode -> (Item -> Bool) -> Item -> Html Msg
-rowModeControlsRenderer mode item =
+rowControlsForMode mode isSelected item =
     let
-        (itemInfo, canSelect) = case mode of
+        itemInfo = case mode of
-            Buy ->
+            Buy -> p [class "level-item"] [ text (String.fromInt item.base_price ++ "po")]
-                ( 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")]
-                , True )
+            Grab -> p [class "level-item"] [ text "Grab" ]
-            Sell ->
+            Add -> p [class "level-item"] [ text "New !" ]
-                ( p [class "level-item"] [ text (String.fromFloat (toFloat item.base_price / 2) ++ "po")]
-                , True )
-            Grab ->
-                ( p [class "level-item"] [ text "Grab" ]
-                , True )
-            Add ->
-                ( p [class "level-item"] [ text "New !" ]
-                , False )
-            Confirm ->
-                (text ""
-                , False )
     in
     div [ class "level-right" ]
         <| itemInfo
-        :: if canSelect then
+        :: if canSelectIn mode then
              [input [ class "checkbox level-item"
                    , type_ "checkbox"
+                   , checked <| isSelected item
                    , onCheck (\v -> LootViewItemSwitched item.id)
                    ] [] ]
          else
@@ -416,8 +541,8 @@ rowModeControlsRenderer mode item =
 
 
 viewItemTableRow : (Item -> Bool) -> Maybe (Item -> Html Msg) -> Item -> Html Msg
-viewItemTableRow selected rowControls item =
+viewItemTableRow isSelected rowControls item =
-    tr  [ classList [ ("is-selected", selected item) ] ]
+    tr  [ classList [ ("is-selected", isSelected item) ] ]
         [ td []
             [ label [ class "level checkbox" ]
                   <| div [ class "level-left" ]
@@ -527,7 +652,7 @@ viewPlayerBar player actionControls =
                     [ span [ class "icon is-large" ]
                             [ i [ class "fas fa-2x fa-piggy-bank" ] [] ]]
                 ]
-                ++ (showWealth player.wealth)
+                ++ (viewWealth player.wealth)
                 ++ (if player.debt > 0 then
                         [div [class "level-item"]
                             [p [class "heading is-size-4 has-text-danger"]
@@ -541,19 +666,20 @@ viewPlayerBar player actionControls =
         ]
 
 
-showWealth : Wealth -> List (Html Msg)
+viewWealth : Wealth -> List (Html Msg)
-showWealth wealth =
+viewWealth wealth =
-    [ showWealthField "pp" wealth.pp
+    [ showWealthField "pp" <| String.fromInt wealth.pp
-    , showWealthField "gp" wealth.gp
+    , showWealthField "gp" <| String.padLeft 2 '0' <| String.fromInt wealth.gp
-    , showWealthField "sp" wealth.sp
+    , showWealthField "sp" <| String.fromInt wealth.sp
-    , showWealthField "cp" wealth.cp
+    , showWealthField "cp" <| String.fromInt wealth.cp
     ]
 
-showWealthField : String -> Int -> Html Msg
+showWealthField : String -> String -> Html Msg
 showWealthField name value =
     div [ class "level-item" ]
-        [ p [ class "is-size-4"] [text (String.fromInt value)]
+        [ p [class "has-text-right"] [ strong [ class "heading is-marginless"] [text name]
-        , p [class "heading"] [text name]
+               , span [ class <| "is-size-4" ] [ text value ]
+               ]
         ]
 
 -- Search Bar