adds replaceShop from items

This commit is contained in:
2019-11-26 21:15:16 +01:00
parent a81d184af6
commit 89b22bb07d
8 changed files with 731 additions and 140 deletions

View File

@@ -1,6 +1,5 @@
module Api exposing
( ActionMode(..)
, Claim
( Claim
, Claims
, HttpResult
, Item
@@ -13,6 +12,7 @@ module Api exposing
, confirmAction
, fetchClaimsOf
, fetchLoot
, replaceShopItems
)
import Api.Player exposing (Player, Wealth)
@@ -57,10 +57,6 @@ type Msg
-- Loot
type alias Loot =
List Item
type alias Item =
{ id : Int
, name : String
@@ -68,6 +64,61 @@ type alias Item =
}
itemDecoder =
D.map3 Item
(D.field "id" int)
(D.field "name" string)
(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 )
]
type alias Loot =
List Item
-- LOOT
-- Location of a loot
lootDecoder : Decoder Loot
lootDecoder =
D.list itemDecoder
type ToChest
= OfPlayer Int
| OfGroup
| OfShop
fetchLoot : (ToChest -> Result Http.Error Loot -> msg) -> ToChest -> Cmd msg
fetchLoot toMsg dest =
let
url =
case dest of
OfPlayer id ->
"http://localhost:8088/api/players/" ++ String.fromInt id ++ "/loot"
OfShop ->
"http://localhost:8088/api/shop"
OfGroup ->
"http://localhost:8088/api/players/0/loot"
in
Http.get
{ url = url
, expect = Http.expectJson (toMsg dest) (valueDecoder lootDecoder)
}
-- Claims
@@ -111,57 +162,6 @@ fetchClaimsOf toMsg playerId =
-- LOOT
-- Location of a loot
itemDecoder =
D.map3 Item
(D.field "id" int)
(D.field "name" string)
(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
type ToChest
= OfPlayer Int
| OfGroup
| OfShop
fetchLoot : (ToChest -> Result Http.Error Loot -> msg) -> ToChest -> Cmd msg
fetchLoot toMsg dest =
let
url =
case dest of
OfPlayer id ->
"http://localhost:8088/api/players/" ++ String.fromInt id ++ "/loot"
OfShop ->
"http://localhost:8088/api/shop"
OfGroup ->
"http://localhost:8088/api/players/0/loot"
in
Http.get
{ url = url
, expect = Http.expectJson (toMsg dest) (valueDecoder lootDecoder)
}
-- Retrieves items from a list of names
@@ -264,14 +264,6 @@ apiResponseDecoder toValue =
-}
type ActionMode
= View
| Sell
| Buy
| Grab
| Add
type RequestData
= SellPayload Loot (Maybe Float) (List (Maybe Float)) (List Int)
| BuyPayload Loot (Maybe Float) (List (Maybe Float))
@@ -398,6 +390,37 @@ undoLastAction id =
-- ADMIN
--
replaceShopItems : (Maybe () -> msg) -> Loot -> Cmd msg
replaceShopItems toMsg loot =
let
data =
E.list itemEncoder loot
gotResponse : HttpResult (Response ()) -> msg
gotResponse response =
case response of
Ok apiResponse ->
toMsg apiResponse.value
Err error ->
toMsg Nothing
in
Http.request
{ url = "http://localhost:8088/api/shop"
, method = "POST"
, headers = []
, body = Http.jsonBody data
, expect = Http.expectJson gotResponse (apiResponseDecoder <| D.succeed ())
, timeout = Nothing
, tracker = Nothing
}
-- UTILS

View File

@@ -59,6 +59,21 @@ type Page
| Loading
{-
type Page
= Dashboard Session
| GroupChest Session
| Shop Shop.Model
| NewLoot Session
| About
| Loading
-}
type alias HasPage r =
{ r | page : Page }
@@ -153,6 +168,9 @@ viewPage page =
linkWithGem "Coffre de groupe" "/coffre"
]
Admin _ ->
[ navLink "fas fa-store-alt" "Marchand" "/marchand" ]
_ ->
[]
in
@@ -202,9 +220,9 @@ type Msg
= UrlChanged Url.Url
| LinkClicked Browser.UrlRequest
| SessionLoaded (Maybe Session)
| SwitchMenuOpen
| GotChestMsg Chest.Msg
| GotAdminMsg Admin.Msg
| SwitchMenuOpen
@@ -226,25 +244,17 @@ update msg model =
in
case user of
Session.Player playerId ->
let
( chest, cmd ) =
updatePage Chest GotChestMsg model <|
Chest.init navKey playerId
in
( model |> setPage (Chest chest), Cmd.map GotChestMsg cmd )
Session.Admin ->
let
( admin, cmd ) =
Admin.init navKey
in
( model |> setPage (Admin admin), Cmd.map GotAdminMsg cmd )
updatePage Admin GotAdminMsg model <|
Admin.init logged
Nothing ->
( model |> setPage About, Cmd.none )
( LinkClicked urlRequest, _ ) ->
case model.page of
Chest chestModel ->
case urlRequest of
Browser.Internal url ->
( model, Nav.pushUrl model.navbar.navKey (Url.toString url) )
@@ -252,19 +262,17 @@ update msg model =
Browser.External href ->
( model, Cmd.none )
_ ->
( model, Cmd.none )
( UrlChanged url, page ) ->
-- Handle routing according to current page
case ( Route.fromUrl url, page ) of
( Just (Route.Home content), Chest _ ) ->
update
(GotChestMsg <| Chest.SetContent content)
model
( Just (Route.Home content), Chest chest ) ->
( model |> setPage (Chest (Chest.setContent content chest))
, Cmd.none
)
( Just (Route.Home MerchantLoot), Admin _ ) ->
( model, Cmd.none )
( Just route, Admin admin ) ->
Admin.routeChanged route admin
|> updatePage Admin GotAdminMsg model
_ ->
( model |> setPage About, Cmd.none )
@@ -285,8 +293,8 @@ update msg model =
updatePage : (pageModel -> Page) -> (pageMsg -> Msg) -> Model -> ( pageModel, Cmd pageMsg ) -> ( Model, Cmd Msg )
updatePage toModel toMsg model ( pageModel, pageCmd ) =
( { model | page = toModel pageModel }
updatePage toPage toMsg model ( pageModel, pageCmd ) =
( { model | page = toPage pageModel }
, Cmd.map toMsg pageCmd
)

View File

@@ -1,50 +1,75 @@
module Page.Admin exposing (..)
module Page.Admin exposing (Model, Msg, init, routeChanged, update, view)
import Api exposing (Loot)
import Api.Player as Player exposing (Player, Wealth)
import Browser.Navigation as Nav
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Page.Shop as Shop
import Route exposing (Route)
import Session exposing (Session, getSession)
type alias NewPlayer =
type alias NewPlayerForm =
{ name : String
, wealth : Float
}
type alias Model =
{ navKey : Nav.Key
type alias Status =
{ session : Session
, players : List Player
, newPlayer : NewPlayer
, newPlayer : NewPlayerForm
}
init : Nav.Key -> ( Model, Cmd Msg )
init navKey =
( { navKey = navKey
, players = []
, newPlayer = { name = "", wealth = 0.0 }
}
type Model
= Dashboard Status
| MerchantLoot Shop.Model
init : Session -> ( Model, Cmd Msg )
init session =
( Dashboard (Status session [] (NewPlayerForm "" 0.0))
, Player.list GotPlayers
)
view : Model -> List (Html Msg)
view model =
case model of
Dashboard config ->
[ div [ class "container" ]
[ p [ class "title" ] [ text "Administration" ]
, div [ class "section" ]
[ table [ class "table is-fullwidth is-striped" ]
[ thead [ class "table-header" ]
[ th [] [ text "Joueurs" ] ]
, tbody [] <|
editNewPlayer model.newPlayer
:: List.map viewPlayer model.players
editNewPlayer config.newPlayer
:: List.map viewPlayer config.players
]
]
, div [ class "section" ]
[ p [] [ text "Campagnes" ] ]
]
]
MerchantLoot shop ->
let
toShopMsg =
Html.map ShopMsg
( controls, viewShop ) =
Shop.view shop
|> Tuple.mapBoth toShopMsg (List.map toShopMsg)
in
[ div [ class "container" ] <|
p [ class "title" ] [ text "Marchand" ]
:: controls
:: viewShop
]
viewPlayer : Player -> Html Msg
@@ -52,7 +77,7 @@ viewPlayer player =
tr [] [ td [] [ p [] [ text (player.name ++ " (" ++ String.fromInt player.id ++ ")") ] ] ]
editNewPlayer : NewPlayer -> Html Msg
editNewPlayer : NewPlayerForm -> Html Msg
editNewPlayer newPlayer =
tr []
[ td []
@@ -63,7 +88,7 @@ editNewPlayer newPlayer =
[ class "input"
, type_ "text"
, value newPlayer.name
, onInput NameChanged
, onInput <| GotFormMsg << NameChanged
]
[]
]
@@ -72,7 +97,7 @@ editNewPlayer newPlayer =
[ class "input"
, type_ "text"
, value <| String.fromFloat newPlayer.wealth
, onInput WealthChanged
, onInput <| GotFormMsg << WealthChanged
]
[]
]
@@ -84,27 +109,64 @@ editNewPlayer newPlayer =
type Msg
= GotPlayers (List Player)
| NameChanged String
| GotFormMsg FormMsg
| ShopMsg Shop.Msg
type FormMsg
= NameChanged String
| WealthChanged String
update msg model =
updateForm : FormMsg -> NewPlayerForm -> NewPlayerForm
updateForm msg form =
case msg of
GotPlayers players ->
( Debug.log "GotPlayers" { model | players = players }, Cmd.none )
NameChanged newName ->
let
newPlayer =
model.newPlayer
in
( { model | newPlayer = { newPlayer | name = newName } }, Cmd.none )
{ form | name = newName }
WealthChanged newWealth ->
let
newPlayer =
model.newPlayer
in
( { model | newPlayer = { newPlayer | wealth = Maybe.withDefault 0.0 <| String.toFloat newWealth } }
, Cmd.none
)
{ form | wealth = Maybe.withDefault 0.0 <| String.toFloat newWealth }
routeChanged : Route.Route -> Model -> ( Model, Cmd Msg )
routeChanged route model =
case model of
Dashboard config ->
case route of
Route.Home Route.MerchantLoot ->
Tuple.mapBoth
MerchantLoot
(Cmd.map ShopMsg)
(config.session |> Shop.init)
_ ->
( model, Cmd.none )
MerchantLoot shop ->
case route of
Route.Home Route.PlayerLoot ->
init shop.session
_ ->
( model, Cmd.none )
update msg model =
case ( msg, model ) of
( GotPlayers players, Dashboard config ) ->
( Dashboard { config | players = players }, Cmd.none )
( GotFormMsg formMsg, Dashboard config ) ->
( Dashboard { config | newPlayer = updateForm formMsg config.newPlayer }, Cmd.none )
( _, Dashboard _ ) ->
( model, Cmd.none )
( ShopMsg shopMsg, MerchantLoot shopModel ) ->
Shop.update shopMsg shopModel
|> Tuple.mapBoth
MerchantLoot
(Cmd.map ShopMsg)
( _, MerchantLoot _ ) ->
( model, Cmd.none )

View File

@@ -1,9 +1,8 @@
module Page.Chest exposing (..)
module Page.Chest exposing (Model, Msg, init, setContent, update, view)
import Api
exposing
( ActionMode(..)
, Claims
( Claims
, HttpResult
, Item
, Loot
@@ -22,8 +21,132 @@ import Set exposing (Set)
import Utils exposing (..)
setContent : ChestContent -> Model -> Model
setContent content model =
update (SetContent content) model
|> Tuple.first
-- MODEL
{-
type alias ViewConfig =
{ filterText : String
}
type alias Selection data =
{ selection : Set Int -- Set of selected items
, selectionData : Dict Int data -- Data associated by id
}
type alias AddConfig =
{ showModal : Bool
, autoComplete : Loot
, newItem : Maybe Item
, sourceName : Maybe String
, itemList : Maybe (List String)
}
type ChestMsg
= ConfirmAction
| CancelAction
| EnterMode ActionMode
| ViewMsg
| SelectionMsg
| AddMsg
type Content
= PlayerLoot Int
| GroupLoot
| MerchantShop
| Inventory
type Context
= View String
| Sell (Selection Int)
| Buy (Selection Int)
| Grab (Selection ())
| Add AddConfig
type Chest
= Chest Context Loot
type Chest
= View ViewConfig Loot
| Sell Selection Loot
| Buy Selection Loot
| Grab Selection Loot
| Add AddConfig Loot
type alias Cache =
{ playerLoot : ...
, ...
, claims : Claims
}
-- Leading to new model
type alias Model =
{ navKey: Nav.Key
, error : Maybe String
, notification : Maybe String
, player : Player
, wealth : Wealth.Model
, cache : Cache
, chest : Chest
}
-- Hence,
type ViewMsg
= SetContent ChestContent
| SearchTextChanged String
type AddMsg
= NewItemAdded Item
| NewItemNameChanged String
| NewItemPriceChanged String
| SourceNameChanged String
| SetNewItem Item
| OpenModal
| FromListChanged String
| FromListConfirmed
| NewItemsFromList Loot (Maybe String)
type SelectionMsg
= SetSelection (Maybe Selection)
| SwitchSelectionState Int
-- Buy/Sell modes
| PriceModifierChanged Int String
| WealthMsg Wealth.Msg
type Msg
= ApiMsg Api.Msg
| GotLoot Api.ToChest (HttpResult Loot)
| GotClaims (HttpResult Claims)
| GotPlayer (HttpResult Player)
| ClearNotification
| GotChestMsg ChestMsg
-}
type ActionMode
= View
| Sell
| Buy
| Grab
| Add
type alias State =
@@ -31,6 +154,7 @@ type alias State =
, error : Maybe String
, notification : Maybe String
-- Chest state
-- Buy/Sell loot
, priceModifiers : Dict Int Int
@@ -58,9 +182,13 @@ type alias Selection =
type alias Model =
{ navKey : Nav.Key
, state : State
-- Chest
, shown : Route.ChestContent
, selection : Maybe Selection
, searchText : String
-- Others
, wealth : Wealth.Model
, claims : Claims
}

View File

@@ -0,0 +1,213 @@
module Page.Chest.NewFromInventory exposing (..)
import Api exposing (Item, Loot)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Table
type ExitStatus
= Confirmed Loot
| Canceled
type alias Model =
{ itemList : String
, invalidItems : Loot
, validItems : Loot
}
init : Model
init =
Model
""
[]
[]
view : Model -> ( Html Msg, List (Html Msg) )
view model =
let
allLootValid =
if List.length model.invalidItems + List.length model.validItems == 0 then
False
else
List.all itemIsValid model.invalidItems
in
( div [ class "buttons" ]
[ button
[ class "button"
, disabled <| not allLootValid
, onClick ConfirmClicked
]
[ text "Ok" ]
, button
[ class "button"
, onClick CancelClicked
]
[ text "Annuler" ]
]
, [ div [ class "section" ]
[ textarea
[ class "textarea"
, value model.itemList
, onInput ItemListInput
, placeholder "Coller une liste d'objets"
]
[]
, button
[ class "button is-primary is-fullwidth"
, onClick ItemListSend
]
[ text "Mettre dans le coffre" ]
]
, div [ class "section" ]
[ model.validItems ++ model.invalidItems |> Table.view viewOrEditRenderer ]
]
)
itemIsValid item =
item.name /= "" && item.base_price > 0
-- We fill id with a negative value (nether used by db)
-- to indicate an item that needs to be edited
viewOrEditRenderer item =
if item.id <= 0 then
let
nameValid =
item.name /= ""
priceValid =
item.base_price > 0
in
[ div [ class "field is-grouped" ]
[ div [ class "control" ]
[ input
[ class "input is-small "
, type_ "text"
, value item.name
, onInput <| InvalidItemNameChanged item.id
]
[]
]
, div [ class "control" ]
[ input
[ class "input is-small "
, type_ "text"
, value <| String.fromInt item.base_price
, onInput <| InvalidItemPriceChanged item.id
]
[]
]
]
]
else
Table.name item
type Msg
= ItemListInput String
| ItemListSend
| InvalidItemNameChanged Int String
| InvalidItemPriceChanged Int String
| GotCheckedItems Loot (Maybe String)
| ConfirmClicked
| CancelClicked
update : Msg -> Model -> ( Model, Cmd Msg, Maybe ExitStatus )
update msg model =
case msg of
ItemListInput newList ->
( { model | itemList = newList }
, Cmd.none
, Nothing
)
ItemListSend ->
( { model | itemList = "" }
, Api.checkList GotCheckedItems <|
String.split "\n" model.itemList
, Nothing
)
GotCheckedItems valid errors ->
let
-- We tranform errors into invalid items.
newInvalidItems =
model.invalidItems
++ (case errors of
Just items ->
String.split "," (String.trim items)
|> List.filter (\name -> name /= "")
|> List.map (\name -> Item 0 name 0)
Nothing ->
[]
)
-- We need to recalculate all invalid negative ids
-- to avoid conflicts if it's used more than once
|> List.indexedMap (\idx item -> { item | id = -idx })
in
( { model
| invalidItems = newInvalidItems
, validItems = valid ++ model.validItems
}
, Cmd.none
, Nothing
)
InvalidItemNameChanged id newName ->
( { model
| invalidItems =
model.invalidItems
|> editItem (\item -> { item | name = newName }) id
}
, Cmd.none
, Nothing
)
InvalidItemPriceChanged id newPrice ->
let
price =
Maybe.withDefault 0 <| String.toInt newPrice
in
( { model
| invalidItems =
model.invalidItems |> editItem (\item -> { item | base_price = price }) id
}
, Cmd.none
, Nothing
)
ConfirmClicked ->
( model, Cmd.none, Just (Confirmed <| allLoot model) )
CancelClicked ->
( model, Cmd.none, Just Canceled )
allLoot model =
model.invalidItems ++ model.validItems
editItem : (Item -> Item) -> Int -> Loot -> Loot
editItem editor targetId items =
List.map
(\item ->
if item.id == targetId then
editor item
else
item
)
items

128
src/Page/Shop.elm Normal file
View File

@@ -0,0 +1,128 @@
module Page.Shop exposing (Model, Msg, init, update, view)
import Api exposing (Item, Loot)
import Dict exposing (Dict)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Http
import Page.Chest.NewFromInventory as NewChest
import Session exposing (Session, getSession)
import Set exposing (Set)
import Table
type alias Model =
{ session : Session
, state : State
}
type State
= Loading
| LoadError String
| View Loot
| Refresh NewChest.Model
| Sending
init session =
( Model session Loading, fetchShopItems )
fetchShopItems =
Api.fetchLoot GotLoot Api.OfShop
view : Model -> ( Html Msg, List (Html Msg) )
view model =
case model.state of
Loading ->
( text "", [ p [ class "title" ] [ text "loading..." ] ] )
LoadError error ->
( text "", [ p [ class "has-text-danger" ] [ text <| "Error : " ++ error ] ] )
View loot ->
( case Session.user model.session of
Session.Admin ->
button [ class "button", onClick IntoRefresh ] [ text "Remplacer" ]
Session.Player _ ->
button [ class "button" ] [ text "Acheter" ]
, [ Table.view Table.name loot ]
)
Refresh chest ->
let
( controls, content ) =
NewChest.view chest
toMsg =
Html.map GotChestMsg
in
( toMsg controls
, List.map toMsg content
)
Sending ->
( text "", [ p [] [ text "En attente du serveur..." ] ] )
type Msg
= GotLoot Api.ToChest (Result Http.Error Loot)
| IntoRefresh
| GotChestMsg NewChest.Msg
| GotRefreshResult (Maybe ())
| IntoBuy
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case ( msg, model.state ) of
( GotLoot Api.OfShop response, Loading ) ->
case response of
Ok loot ->
( { model | state = View loot }, Cmd.none )
-- TODO: handle error
Err e ->
( { model | state = LoadError <| Debug.toString e }, Cmd.none )
( IntoRefresh, View _ ) ->
case Session.user (getSession model) of
Session.Admin ->
( { model | state = Refresh NewChest.init }, Cmd.none )
_ ->
( model, Cmd.none )
( GotChestMsg chestMsg, Refresh chest ) ->
let
( newState, cmd, exit ) =
NewChest.update chestMsg chest
in
case exit of
Just status ->
case status of
NewChest.Confirmed loot ->
( model, Api.replaceShopItems GotRefreshResult loot )
NewChest.Canceled ->
init <| getSession model
Nothing ->
( { model | state = Refresh newState }, Cmd.map GotChestMsg cmd )
( GotRefreshResult result, _ ) ->
case result of
Just _ ->
init <| getSession model
Nothing ->
( { model | state = LoadError "L'ajout a échoué. Vous devez recommencer :'( " }
, Cmd.none
)
_ ->
( model, Cmd.none )

View File

@@ -1,4 +1,4 @@
module Session exposing (Session, User(..), init, key, user)
module Session exposing (Session, User(..), getSession, init, key, user)
import Browser.Navigation as Nav
import Http
@@ -42,6 +42,11 @@ init toMsg navKey =
}
getSession : { r | session : Session } -> Session
getSession r =
.session r
key : Session -> Nav.Key
key session =
let

24
src/Table.elm Normal file
View File

@@ -0,0 +1,24 @@
module Table exposing (name, view)
import Html exposing (..)
import Html.Attributes exposing (..)
type alias RowRenderer a msg =
a -> List (Html msg)
view : RowRenderer a msg -> List a -> Html msg
view rowRenderer content =
table [ class "table is-fullwidth" ]
[ thead [ class "table-header" ]
[ th [] [ text "Nom" ] ]
, tbody [] <|
List.map
(\i -> tr [] [ td [] <| rowRenderer i ])
content
]
name item =
[ p [] [ text item.name ] ]