cleans Actions API and modes

This commit is contained in:
2019-11-13 15:46:15 +01:00
parent ca1ff2c778
commit 18f661ddf3
2 changed files with 225 additions and 107 deletions

View File

@@ -1,10 +1,21 @@
module Api exposing (Update(..), Msg(..)
, HttpResult
, Player, Wealth, fetchPlayer, blankPlayer
, Item, Loot, fetchLoot
, Claim, Claims, fetchClaims
, ActionMode(..), confirmAction
)
module Api exposing
( ActionMode(..)
, Claim
, Claims
, HttpResult
, 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 =
case mode of
Buy ->
type RequestData
= SellPayload Loot (Maybe Float) (List Float) (List Int)
| 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
Grab ->
-- API expects the list of claimed items ids
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 : ActionMode -> String -> List Item -> Cmd Msg
confirmAction mode id items =
confirmAction : String -> RequestData -> Cmd Msg
confirmAction id data =
let
( endpoint, method ) =
case mode of
Add ->
case data of
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

View File

@@ -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
Add ->
viewAddLoot model
_ ->
text ""
, viewLoot header model.searchText rowRenderer canSelect isSelected <| shownItems model
_ ->
[ div [ class "columns" ]
[ div [ class "column is-one-third" ] [ p [ class "title" ] [ text header ] ]
, div [ class "column" ] [ viewSearchBar model.searchText ]
]
, viewLoot rowRenderer canSelect isSelected filteredItems
]
)
]
, 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 header searchText maybeRowRenderer canSelect isSelected items =
let
filteredItems =
List.filter
(\i -> String.toLower i.name |> String.contains (String.toLower searchText))
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
]
viewLoot : Maybe (Item -> Html Msg) -> Bool -> (Item -> Bool) -> Loot -> Html Msg
viewLoot maybeRowRenderer canSelect isSelected items =
table [ class "table is-fullwidth is-striped is-hoverable" ]
[ thead [ class "table-header" ]
[ th [] [ text "Nom" ] ]
, tbody [] <| List.map (viewItemTableRow isSelected canSelect maybeRowRenderer) items
]
@@ -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 } }
|> 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
)
)
( { entered | state = { state | mode = newMode } }
, Cmd.batch [ exit_cmd, enter_cmd ]
)
ConfirmAction ->
case model.state.mode of
-- This should not happen, so we ignore it
NoMode ->
( model, Cmd.none )
let
items =
getSelectedItems model
mode ->
let
items =
getSelected model.shown model
in
( model
, Cmd.map ApiMsg <|
maybeData =
case model.state.mode of
Add ->
Just <|
Api.AddPayload
(Maybe.withDefault
"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
getSelected content model =
selectContent content model
getSelectedItems : Model -> Loot
getSelectedItems 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 content model =
case content of
selectContent : Model -> List Item
selectContent model =
case model.shown of
NewLoot ->
model.state.newLoot