adds replaceShop from items
This commit is contained in:
153
src/Api.elm
153
src/Api.elm
@@ -1,6 +1,5 @@
|
|||||||
module Api exposing
|
module Api exposing
|
||||||
( ActionMode(..)
|
( Claim
|
||||||
, Claim
|
|
||||||
, Claims
|
, Claims
|
||||||
, HttpResult
|
, HttpResult
|
||||||
, Item
|
, Item
|
||||||
@@ -13,6 +12,7 @@ module Api exposing
|
|||||||
, confirmAction
|
, confirmAction
|
||||||
, fetchClaimsOf
|
, fetchClaimsOf
|
||||||
, fetchLoot
|
, fetchLoot
|
||||||
|
, replaceShopItems
|
||||||
)
|
)
|
||||||
|
|
||||||
import Api.Player exposing (Player, Wealth)
|
import Api.Player exposing (Player, Wealth)
|
||||||
@@ -57,10 +57,6 @@ type Msg
|
|||||||
-- Loot
|
-- Loot
|
||||||
|
|
||||||
|
|
||||||
type alias Loot =
|
|
||||||
List Item
|
|
||||||
|
|
||||||
|
|
||||||
type alias Item =
|
type alias Item =
|
||||||
{ id : Int
|
{ id : Int
|
||||||
, name : String
|
, 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
|
-- 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
|
-- Retrieves items from a list of names
|
||||||
|
|
||||||
|
|
||||||
@@ -264,14 +264,6 @@ apiResponseDecoder toValue =
|
|||||||
-}
|
-}
|
||||||
|
|
||||||
|
|
||||||
type ActionMode
|
|
||||||
= View
|
|
||||||
| Sell
|
|
||||||
| Buy
|
|
||||||
| Grab
|
|
||||||
| Add
|
|
||||||
|
|
||||||
|
|
||||||
type RequestData
|
type RequestData
|
||||||
= SellPayload Loot (Maybe Float) (List (Maybe Float)) (List Int)
|
= SellPayload Loot (Maybe Float) (List (Maybe Float)) (List Int)
|
||||||
| BuyPayload Loot (Maybe Float) (List (Maybe Float))
|
| 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
|
-- UTILS
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
54
src/Main.elm
54
src/Main.elm
@@ -59,6 +59,21 @@ type Page
|
|||||||
| Loading
|
| Loading
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{-
|
||||||
|
|
||||||
|
type Page
|
||||||
|
= Dashboard Session
|
||||||
|
| GroupChest Session
|
||||||
|
| Shop Shop.Model
|
||||||
|
| NewLoot Session
|
||||||
|
| About
|
||||||
|
| Loading
|
||||||
|
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
|
||||||
type alias HasPage r =
|
type alias HasPage r =
|
||||||
{ r | page : Page }
|
{ r | page : Page }
|
||||||
|
|
||||||
@@ -153,6 +168,9 @@ viewPage page =
|
|||||||
linkWithGem "Coffre de groupe" "/coffre"
|
linkWithGem "Coffre de groupe" "/coffre"
|
||||||
]
|
]
|
||||||
|
|
||||||
|
Admin _ ->
|
||||||
|
[ navLink "fas fa-store-alt" "Marchand" "/marchand" ]
|
||||||
|
|
||||||
_ ->
|
_ ->
|
||||||
[]
|
[]
|
||||||
in
|
in
|
||||||
@@ -202,9 +220,9 @@ type Msg
|
|||||||
= UrlChanged Url.Url
|
= UrlChanged Url.Url
|
||||||
| LinkClicked Browser.UrlRequest
|
| LinkClicked Browser.UrlRequest
|
||||||
| SessionLoaded (Maybe Session)
|
| SessionLoaded (Maybe Session)
|
||||||
| SwitchMenuOpen
|
|
||||||
| GotChestMsg Chest.Msg
|
| GotChestMsg Chest.Msg
|
||||||
| GotAdminMsg Admin.Msg
|
| GotAdminMsg Admin.Msg
|
||||||
|
| SwitchMenuOpen
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -226,25 +244,17 @@ update msg model =
|
|||||||
in
|
in
|
||||||
case user of
|
case user of
|
||||||
Session.Player playerId ->
|
Session.Player playerId ->
|
||||||
let
|
updatePage Chest GotChestMsg model <|
|
||||||
( chest, cmd ) =
|
|
||||||
Chest.init navKey playerId
|
Chest.init navKey playerId
|
||||||
in
|
|
||||||
( model |> setPage (Chest chest), Cmd.map GotChestMsg cmd )
|
|
||||||
|
|
||||||
Session.Admin ->
|
Session.Admin ->
|
||||||
let
|
updatePage Admin GotAdminMsg model <|
|
||||||
( admin, cmd ) =
|
Admin.init logged
|
||||||
Admin.init navKey
|
|
||||||
in
|
|
||||||
( model |> setPage (Admin admin), Cmd.map GotAdminMsg cmd )
|
|
||||||
|
|
||||||
Nothing ->
|
Nothing ->
|
||||||
( model |> setPage About, Cmd.none )
|
( model |> setPage About, Cmd.none )
|
||||||
|
|
||||||
( LinkClicked urlRequest, _ ) ->
|
( LinkClicked urlRequest, _ ) ->
|
||||||
case model.page of
|
|
||||||
Chest chestModel ->
|
|
||||||
case urlRequest of
|
case urlRequest of
|
||||||
Browser.Internal url ->
|
Browser.Internal url ->
|
||||||
( model, Nav.pushUrl model.navbar.navKey (Url.toString url) )
|
( model, Nav.pushUrl model.navbar.navKey (Url.toString url) )
|
||||||
@@ -252,19 +262,17 @@ update msg model =
|
|||||||
Browser.External href ->
|
Browser.External href ->
|
||||||
( model, Cmd.none )
|
( model, Cmd.none )
|
||||||
|
|
||||||
_ ->
|
|
||||||
( model, Cmd.none )
|
|
||||||
|
|
||||||
( UrlChanged url, page ) ->
|
( UrlChanged url, page ) ->
|
||||||
-- Handle routing according to current page
|
-- Handle routing according to current page
|
||||||
case ( Route.fromUrl url, page ) of
|
case ( Route.fromUrl url, page ) of
|
||||||
( Just (Route.Home content), Chest _ ) ->
|
( Just (Route.Home content), Chest chest ) ->
|
||||||
update
|
( model |> setPage (Chest (Chest.setContent content chest))
|
||||||
(GotChestMsg <| Chest.SetContent content)
|
, Cmd.none
|
||||||
model
|
)
|
||||||
|
|
||||||
( Just (Route.Home MerchantLoot), Admin _ ) ->
|
( Just route, Admin admin ) ->
|
||||||
( model, Cmd.none )
|
Admin.routeChanged route admin
|
||||||
|
|> updatePage Admin GotAdminMsg model
|
||||||
|
|
||||||
_ ->
|
_ ->
|
||||||
( model |> setPage About, Cmd.none )
|
( 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 : (pageModel -> Page) -> (pageMsg -> Msg) -> Model -> ( pageModel, Cmd pageMsg ) -> ( Model, Cmd Msg )
|
||||||
updatePage toModel toMsg model ( pageModel, pageCmd ) =
|
updatePage toPage toMsg model ( pageModel, pageCmd ) =
|
||||||
( { model | page = toModel pageModel }
|
( { model | page = toPage pageModel }
|
||||||
, Cmd.map toMsg pageCmd
|
, Cmd.map toMsg pageCmd
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|||||||
@@ -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 Api.Player as Player exposing (Player, Wealth)
|
||||||
import Browser.Navigation as Nav
|
import Browser.Navigation as Nav
|
||||||
import Html exposing (..)
|
import Html exposing (..)
|
||||||
import Html.Attributes exposing (..)
|
import Html.Attributes exposing (..)
|
||||||
import Html.Events 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
|
{ name : String
|
||||||
, wealth : Float
|
, wealth : Float
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
type alias Model =
|
type alias Status =
|
||||||
{ navKey : Nav.Key
|
{ session : Session
|
||||||
, players : List Player
|
, players : List Player
|
||||||
, newPlayer : NewPlayer
|
, newPlayer : NewPlayerForm
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
init : Nav.Key -> ( Model, Cmd Msg )
|
type Model
|
||||||
init navKey =
|
= Dashboard Status
|
||||||
( { navKey = navKey
|
| MerchantLoot Shop.Model
|
||||||
, players = []
|
|
||||||
, newPlayer = { name = "", wealth = 0.0 }
|
|
||||||
}
|
init : Session -> ( Model, Cmd Msg )
|
||||||
|
init session =
|
||||||
|
( Dashboard (Status session [] (NewPlayerForm "" 0.0))
|
||||||
, Player.list GotPlayers
|
, Player.list GotPlayers
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
view : Model -> List (Html Msg)
|
view : Model -> List (Html Msg)
|
||||||
view model =
|
view model =
|
||||||
|
case model of
|
||||||
|
Dashboard config ->
|
||||||
|
[ div [ class "container" ]
|
||||||
[ p [ class "title" ] [ text "Administration" ]
|
[ p [ class "title" ] [ text "Administration" ]
|
||||||
, div [ class "section" ]
|
, div [ class "section" ]
|
||||||
[ table [ class "table is-fullwidth is-striped" ]
|
[ table [ class "table is-fullwidth is-striped" ]
|
||||||
[ thead [ class "table-header" ]
|
[ thead [ class "table-header" ]
|
||||||
[ th [] [ text "Joueurs" ] ]
|
[ th [] [ text "Joueurs" ] ]
|
||||||
, tbody [] <|
|
, tbody [] <|
|
||||||
editNewPlayer model.newPlayer
|
editNewPlayer config.newPlayer
|
||||||
:: List.map viewPlayer model.players
|
:: List.map viewPlayer config.players
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
, div [ class "section" ]
|
, div [ class "section" ]
|
||||||
[ p [] [ text "Campagnes" ] ]
|
[ 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
|
viewPlayer : Player -> Html Msg
|
||||||
@@ -52,7 +77,7 @@ viewPlayer player =
|
|||||||
tr [] [ td [] [ p [] [ text (player.name ++ " (" ++ String.fromInt player.id ++ ")") ] ] ]
|
tr [] [ td [] [ p [] [ text (player.name ++ " (" ++ String.fromInt player.id ++ ")") ] ] ]
|
||||||
|
|
||||||
|
|
||||||
editNewPlayer : NewPlayer -> Html Msg
|
editNewPlayer : NewPlayerForm -> Html Msg
|
||||||
editNewPlayer newPlayer =
|
editNewPlayer newPlayer =
|
||||||
tr []
|
tr []
|
||||||
[ td []
|
[ td []
|
||||||
@@ -63,7 +88,7 @@ editNewPlayer newPlayer =
|
|||||||
[ class "input"
|
[ class "input"
|
||||||
, type_ "text"
|
, type_ "text"
|
||||||
, value newPlayer.name
|
, value newPlayer.name
|
||||||
, onInput NameChanged
|
, onInput <| GotFormMsg << NameChanged
|
||||||
]
|
]
|
||||||
[]
|
[]
|
||||||
]
|
]
|
||||||
@@ -72,7 +97,7 @@ editNewPlayer newPlayer =
|
|||||||
[ class "input"
|
[ class "input"
|
||||||
, type_ "text"
|
, type_ "text"
|
||||||
, value <| String.fromFloat newPlayer.wealth
|
, value <| String.fromFloat newPlayer.wealth
|
||||||
, onInput WealthChanged
|
, onInput <| GotFormMsg << WealthChanged
|
||||||
]
|
]
|
||||||
[]
|
[]
|
||||||
]
|
]
|
||||||
@@ -84,27 +109,64 @@ editNewPlayer newPlayer =
|
|||||||
|
|
||||||
type Msg
|
type Msg
|
||||||
= GotPlayers (List Player)
|
= GotPlayers (List Player)
|
||||||
| NameChanged String
|
| GotFormMsg FormMsg
|
||||||
|
| ShopMsg Shop.Msg
|
||||||
|
|
||||||
|
|
||||||
|
type FormMsg
|
||||||
|
= NameChanged String
|
||||||
| WealthChanged String
|
| WealthChanged String
|
||||||
|
|
||||||
|
|
||||||
update msg model =
|
updateForm : FormMsg -> NewPlayerForm -> NewPlayerForm
|
||||||
|
updateForm msg form =
|
||||||
case msg of
|
case msg of
|
||||||
GotPlayers players ->
|
|
||||||
( Debug.log "GotPlayers" { model | players = players }, Cmd.none )
|
|
||||||
|
|
||||||
NameChanged newName ->
|
NameChanged newName ->
|
||||||
let
|
{ form | name = newName }
|
||||||
newPlayer =
|
|
||||||
model.newPlayer
|
|
||||||
in
|
|
||||||
( { model | newPlayer = { newPlayer | name = newName } }, Cmd.none )
|
|
||||||
|
|
||||||
WealthChanged newWealth ->
|
WealthChanged newWealth ->
|
||||||
let
|
{ form | wealth = Maybe.withDefault 0.0 <| String.toFloat newWealth }
|
||||||
newPlayer =
|
|
||||||
model.newPlayer
|
|
||||||
in
|
routeChanged : Route.Route -> Model -> ( Model, Cmd Msg )
|
||||||
( { model | newPlayer = { newPlayer | wealth = Maybe.withDefault 0.0 <| String.toFloat newWealth } }
|
routeChanged route model =
|
||||||
, Cmd.none
|
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 )
|
||||||
|
|||||||
@@ -1,9 +1,8 @@
|
|||||||
module Page.Chest exposing (..)
|
module Page.Chest exposing (Model, Msg, init, setContent, update, view)
|
||||||
|
|
||||||
import Api
|
import Api
|
||||||
exposing
|
exposing
|
||||||
( ActionMode(..)
|
( Claims
|
||||||
, Claims
|
|
||||||
, HttpResult
|
, HttpResult
|
||||||
, Item
|
, Item
|
||||||
, Loot
|
, Loot
|
||||||
@@ -22,8 +21,132 @@ import Set exposing (Set)
|
|||||||
import Utils exposing (..)
|
import Utils exposing (..)
|
||||||
|
|
||||||
|
|
||||||
|
setContent : ChestContent -> Model -> Model
|
||||||
|
setContent content model =
|
||||||
|
update (SetContent content) model
|
||||||
|
|> Tuple.first
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- MODEL
|
-- 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 =
|
type alias State =
|
||||||
@@ -31,6 +154,7 @@ type alias State =
|
|||||||
, error : Maybe String
|
, error : Maybe String
|
||||||
, notification : Maybe String
|
, notification : Maybe String
|
||||||
|
|
||||||
|
-- Chest state
|
||||||
-- Buy/Sell loot
|
-- Buy/Sell loot
|
||||||
, priceModifiers : Dict Int Int
|
, priceModifiers : Dict Int Int
|
||||||
|
|
||||||
@@ -58,9 +182,13 @@ type alias Selection =
|
|||||||
type alias Model =
|
type alias Model =
|
||||||
{ navKey : Nav.Key
|
{ navKey : Nav.Key
|
||||||
, state : State
|
, state : State
|
||||||
|
|
||||||
|
-- Chest
|
||||||
, shown : Route.ChestContent
|
, shown : Route.ChestContent
|
||||||
, selection : Maybe Selection
|
, selection : Maybe Selection
|
||||||
, searchText : String
|
, searchText : String
|
||||||
|
|
||||||
|
-- Others
|
||||||
, wealth : Wealth.Model
|
, wealth : Wealth.Model
|
||||||
, claims : Claims
|
, claims : Claims
|
||||||
}
|
}
|
||||||
|
|||||||
213
src/Page/Chest/NewFromInventory.elm
Normal file
213
src/Page/Chest/NewFromInventory.elm
Normal 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
128
src/Page/Shop.elm
Normal 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 )
|
||||||
@@ -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 Browser.Navigation as Nav
|
||||||
import Http
|
import Http
|
||||||
@@ -42,6 +42,11 @@ init toMsg navKey =
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
getSession : { r | session : Session } -> Session
|
||||||
|
getSession r =
|
||||||
|
.session r
|
||||||
|
|
||||||
|
|
||||||
key : Session -> Nav.Key
|
key : Session -> Nav.Key
|
||||||
key session =
|
key session =
|
||||||
let
|
let
|
||||||
|
|||||||
24
src/Table.elm
Normal file
24
src/Table.elm
Normal 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 ] ]
|
||||||
Reference in New Issue
Block a user