diff --git a/src/Api.elm b/src/Api.elm index 5c358f2..21b82e9 100644 --- a/src/Api.elm +++ b/src/Api.elm @@ -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 diff --git a/src/Page/Chest.elm b/src/Page/Chest.elm index 358b712..98a875b 100644 --- a/src/Page/Chest.elm +++ b/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 - 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