impls Item and Wealth updates
This commit is contained in:
98
src/Main.elm
98
src/Main.elm
@@ -160,9 +160,9 @@ type alias HttpResult a = (Result Http.Error a)
|
||||
|
||||
type alias ApiResponse =
|
||||
{ value : Maybe String
|
||||
, updates : Maybe (List DbUpdate)
|
||||
, notification : Maybe String
|
||||
, error : Maybe String
|
||||
, updates : Maybe (List DbUpdate)
|
||||
, errors : Maybe String
|
||||
}
|
||||
|
||||
type Msg
|
||||
@@ -184,10 +184,9 @@ update msg model =
|
||||
case urlRequest of
|
||||
Browser.Internal url ->
|
||||
( model, Nav.pushUrl model.state.navKey (Url.toString url) )
|
||||
--( model, Cmd.none )
|
||||
|
||||
Browser.External href ->
|
||||
( setError ("Invalid request '" ++ href ++ "'") model
|
||||
( setError ("External request '" ++ href ++ "'") model
|
||||
, Cmd.none )
|
||||
|
||||
UrlChanged url ->
|
||||
@@ -240,7 +239,8 @@ update msg model =
|
||||
state = model.state
|
||||
in
|
||||
( { model | state =
|
||||
{ state | selection = Debug.log "new selection" (switchSelectionState id state.selection) }}
|
||||
{ state | selection = Debug.log "new selection"
|
||||
<| switchSelectionState id state.selection }}
|
||||
, Cmd.none )
|
||||
|
||||
ModeSwitched newMode ->
|
||||
@@ -277,9 +277,15 @@ update msg model =
|
||||
|
||||
GotActionResult response ->
|
||||
case response of
|
||||
Ok r -> (setError (Debug.toString r) model, Cmd.none)
|
||||
Ok result ->
|
||||
let
|
||||
updates = Maybe.withDefault [] result.updates
|
||||
in
|
||||
List.foldl applyUpdate model updates
|
||||
|> update (ModeSwitched Nothing)
|
||||
Err r -> (setError (Debug.toString r) model, Cmd.none)
|
||||
|
||||
|
||||
targetItemsFor : ViewMode -> Model -> List Item
|
||||
targetItemsFor mode model =
|
||||
case mode of
|
||||
@@ -319,6 +325,30 @@ type DbUpdate
|
||||
| ClaimAdded ()
|
||||
| ClaimRemoved ()
|
||||
|
||||
-- DbUpdates always refer to the active player's loot
|
||||
applyUpdate : DbUpdate -> Model -> Model
|
||||
applyUpdate u model =
|
||||
case u of
|
||||
ItemRemoved item -> { model | loot = Just
|
||||
<| List.filter (\i -> i.id /= item.id)
|
||||
<| Maybe.withDefault [] model.loot }
|
||||
ItemAdded item -> { model | loot = Just
|
||||
<| item :: Maybe.withDefault [] model.loot }
|
||||
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)
|
||||
)}}
|
||||
ClaimAdded _ -> model
|
||||
ClaimRemoved _ -> model
|
||||
|
||||
-- TODO: update server to produce better json
|
||||
-- like an object with list of updates of the same type
|
||||
-- { ItemRemoved : [..], Wealth : [ .. ], .. }
|
||||
@@ -338,9 +368,9 @@ 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))
|
||||
(Json.Decode.maybe (field "updates" (Json.Decode.list updatesDecoder)))
|
||||
(Json.Decode.maybe (field "errors" string))
|
||||
|
||||
|
||||
sendRequest : Maybe ViewMode -> Model -> Cmd Msg
|
||||
@@ -363,7 +393,7 @@ sendRequest activeMode model =
|
||||
, "DELETE"
|
||||
)
|
||||
Grab ->
|
||||
( "http://"
|
||||
( "http://localhost:8088/api/players/" ++ (String.fromInt model.player.id) ++ "/claims"
|
||||
, "POST")
|
||||
in
|
||||
Http.request
|
||||
@@ -401,9 +431,9 @@ 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)
|
||||
Just <| case Set.member id s of
|
||||
True -> Set.remove id s
|
||||
False -> Set.insert id s
|
||||
Nothing -> Debug.log "ignore switchSelectionState" Nothing
|
||||
|
||||
-- SUBSCRIPTIONS
|
||||
@@ -432,12 +462,26 @@ canSelectIn mode =
|
||||
Add -> False
|
||||
|
||||
actionButton msg t icon color =
|
||||
button [ class <| "button is-" ++ color
|
||||
button [ class <| "button level-item is-" ++ color
|
||||
, onClick msg ]
|
||||
[ span [ class "icon" ] [ i [ Svg.Attributes.class <| "fas fa-" ++ icon ] [] ]
|
||||
, p [] [text t]
|
||||
]
|
||||
|
||||
controlsWhenModeActive : ViewMode -> List (Html Msg)
|
||||
controlsWhenModeActive mode =
|
||||
[ actionButton (ConfirmAction) "Valider" "check" "primary"
|
||||
, actionButton (ModeSwitched Nothing) "Annuler" "times" "danger"
|
||||
]
|
||||
|
||||
controlsWhenRoute : Route -> List (Html Msg)
|
||||
controlsWhenRoute route =
|
||||
case route of
|
||||
PlayerChest -> [actionButton (ModeSwitched (Just Sell)) "Vendre" "coins" "danger"]
|
||||
GroupLoot -> [actionButton (ModeSwitched (Just Grab)) "Demander" "praying-hands" "primary"]
|
||||
Merchant -> [actionButton (ModeSwitched (Just Buy)) "Acheter" "coins" "success"]
|
||||
NewLoot -> [actionButton (ModeSwitched (Just Add)) "Nouveau loot" "plus" "primary"]
|
||||
|
||||
view : Model -> Browser.Document Msg
|
||||
view model =
|
||||
let
|
||||
@@ -453,28 +497,18 @@ view model =
|
||||
NewLoot ->
|
||||
("Nouveau trésor :)", [] )
|
||||
|
||||
{- Dynamic renderes to allow the use of ViewMode
|
||||
{- Dynamic renderers for ViewMode
|
||||
|
||||
ActionControls is inserted in the PlayerBar's right
|
||||
and rowControls are inserted, to the right of every item rows
|
||||
Header controls are inserted in the PlayerBar
|
||||
and rowControls to the right side of every item rows
|
||||
-}
|
||||
(actionControls, rowControls) =
|
||||
(headerControls, rowControls) =
|
||||
case model.state.activeMode of
|
||||
Just mode -> -- When a mode is active
|
||||
( [ div [ class "buttons has-addons"]
|
||||
[ actionButton (ConfirmAction) "Valider" "success" "primary"
|
||||
, actionButton (ModeSwitched Nothing) "Annuler" "times" "danger"
|
||||
]
|
||||
]
|
||||
, Just (rowControlsForMode mode isSelected)
|
||||
)
|
||||
Just mode ->
|
||||
( controlsWhenModeActive mode, Just (rowControlsForMode mode isSelected))
|
||||
Nothing -> -- Buttons to enter mode
|
||||
( actionButton UndoLastAction "Annuler action" "delete" "danger"
|
||||
:: case model.state.route of
|
||||
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"]
|
||||
( actionButton UndoLastAction "Annuler action" "backspace" "danger"
|
||||
:: controlsWhenRoute model.state.route
|
||||
-- Claim controls for Group chest
|
||||
, case model.state.route of
|
||||
GroupLoot -> Just renderId
|
||||
@@ -489,7 +523,7 @@ view model =
|
||||
{ title = "Loot-a-lot in ELM"
|
||||
, body =
|
||||
[ viewHeaderBar model
|
||||
, viewPlayerBar model.player actionControls
|
||||
, viewPlayerBar model.player headerControls
|
||||
, article [class "section container"]
|
||||
[ p [class "heading"] [text header]
|
||||
, viewSearchBar
|
||||
|
||||
Reference in New Issue
Block a user