elm/lootalot-client
1
0
Fork 0
Code Issues 3 Pull Requests Releases Wiki Activity

adds filter text input, add player for admin

Browse Source
This commit is contained in:
Arthur Gerbaud
2019-12-18 15:27:13 +01:00
parent 1636248686
commit 90bad7e481
6 changed files with 193 additions and 111 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
src/Api.elm
View File

@@ -8,6 +8,7 @@ module Api exposing
, RequestData(..) , RequestData(..)
, ToChest(..) , ToChest(..)
, Update(..) , Update(..)
, adminAddPlayer
, checkList , checkList
, confirmAction , confirmAction
, fetchLoot , fetchLoot
@@ -92,10 +93,6 @@ type alias Loot =
List Item List Item
-- Location of a loot
lootDecoder : Decoder Loot lootDecoder : Decoder Loot
lootDecoder = lootDecoder =
D.list itemDecoder D.list itemDecoder
@@ -107,7 +104,7 @@ type ToChest
| OfShop | OfShop
fetchLoot : (ToChest -> Result Http.Error Loot -> msg) -> ToChest -> Cmd msg fetchLoot : (Result Http.Error Loot -> msg) -> ToChest -> Cmd msg
fetchLoot toMsg dest = fetchLoot toMsg dest =
let let
url = url =
@@ -123,7 +120,7 @@ fetchLoot toMsg dest =
in in
Http.get Http.get
{ url = url { url = url
, expect = Http.expectJson (toMsg dest) (valueDecoder lootDecoder) , expect = Http.expectJson toMsg (valueDecoder lootDecoder)
} }
@@ -246,6 +243,10 @@ apiResponseDecoder toValue =
(D.maybe (field "errors" string)) (D.maybe (field "errors" string))
emptyResponse =
apiResponseDecoder (D.succeed ())
{- ACTIONS {- ACTIONS
@@ -404,7 +405,7 @@ replaceShopItems toMsg loot =
, method = "POST" , method = "POST"
, headers = [] , headers = []
, body = Http.jsonBody data , body = Http.jsonBody data
, expect = Http.expectJson gotResponse (apiResponseDecoder <| D.succeed ()) , expect = Http.expectJson gotResponse emptyResponse
, timeout = Nothing , timeout = Nothing
, tracker = Nothing , tracker = Nothing
} }
@@ -495,6 +496,27 @@ getClaims id =
-- ADMIN
--
adminAddPlayer : { d | name : String, wealth : Float } -> Cmd Msg
adminAddPlayer data =
let
json =
E.object
[ ( "name", E.string data.name )
, ( "wealth", E.float data.wealth )
]
in
Http.post
{ url = "api/players/"
, body = Http.jsonBody json
, expect = Http.expectJson GotActionResult emptyResponse
}
-- UTILS -- UTILS

10
src/Bulma.elm
View File

@@ -88,6 +88,16 @@ levelItem =
-- INPUTS
--
inputField : String -> (String -> msg) -> Html msg
inputField val toMsg =
input [ class "input", value val, onInput toMsg ] []
-- COLORS -- COLORS
-- --

110
src/Chest.elm
View File

@@ -29,10 +29,10 @@ type alias RowRenderer msg =
type Chest type Chest
= New NewFromInventory.Model = New NewFromInventory.Model
| View (Item -> Html Never) | View FilterText (Item -> Html Never)
| Buy Selection.Model | Buy FilterText Selection.Model
| Sell Selection.Model | Sell FilterText Selection.Model
| Claim Selection.Model | Claim FilterText Selection.Model
type IntoMode type IntoMode
@@ -44,6 +44,10 @@ type IntoMode
| IntoClaim Claims | IntoClaim Claims
type alias FilterText =
String
{- {-
@@ -66,7 +70,7 @@ type IntoMode
init = init =
View Table.name View "" Table.name
intoMode : IntoMode -> Msg intoMode : IntoMode -> Msg
@@ -100,31 +104,51 @@ claim initialClaims =
showWith : Table.ItemRenderer Item Never -> Chest showWith : Table.ItemRenderer Item Never -> Chest
showWith renderItem = showWith renderItem =
View <| Table.renderRowLevel renderItem (\_ -> []) View "" <| Table.renderRowLevel renderItem (\_ -> [])
view : Chest -> Loot -> Html Msg view : Chest -> Loot -> Html Msg
view model loot = view model loot =
let
filterLoot txt ls =
List.filter (\i -> String.contains txt i.name) ls
in
case model of case model of
View renderItem -> View filterText renderItem ->
Table.view renderItem loot div []
|> Html.map GotViewMsg [ viewFilterInput filterText
, Table.view renderItem (filterLoot filterText loot)
|> Html.map GotViewMsg
]
Buy subModel -> Buy filterText subModel ->
Selection.view subModel loot div []
|> Html.map GotSelectionMsg [ viewFilterInput filterText
, Selection.view subModel (filterLoot filterText loot)
|> Html.map GotSelectionMsg
]
Sell subModel -> Sell filterText subModel ->
Selection.view subModel loot div []
|> Html.map GotSelectionMsg [ viewFilterInput filterText
, Selection.view subModel (filterLoot filterText loot)
|> Html.map GotSelectionMsg
]
New subModel -> New subModel ->
NewFromInventory.view subModel NewFromInventory.view subModel
|> Html.map GotNewMsg |> Html.map GotNewMsg
Claim subModel -> Claim filterText subModel ->
Selection.view subModel loot div []
|> Html.map GotSelectionMsg [ viewFilterInput filterText
, Selection.view subModel (filterLoot filterText loot)
|> Html.map GotSelectionMsg
]
viewFilterInput filterText =
B.inputField filterText FilterTextChanged
type Msg type Msg
@@ -132,11 +156,15 @@ type Msg
| GotSelectionMsg Selection.Msg | GotSelectionMsg Selection.Msg
| GotViewMsg Never | GotViewMsg Never
| IntoMode IntoMode | IntoMode IntoMode
| FilterTextChanged String
update : Msg -> Chest -> ( Chest, Cmd Msg ) update : Msg -> Chest -> ( Chest, Cmd Msg )
update msg model = update msg model =
case ( msg, model ) of case ( msg, model ) of
( FilterTextChanged newText, m ) ->
( updateFilterText newText m, Cmd.none )
( GotNewMsg subMsg, New subModel ) -> ( GotNewMsg subMsg, New subModel ) ->
NewFromInventory.update subMsg subModel NewFromInventory.update subMsg subModel
|> updateChest GotNewMsg New |> updateChest GotNewMsg New
@@ -144,17 +172,17 @@ update msg model =
( GotNewMsg subMsg, _ ) -> ( GotNewMsg subMsg, _ ) ->
( model, Cmd.none ) ( model, Cmd.none )
( GotSelectionMsg subMsg, Buy subModel ) -> ( GotSelectionMsg subMsg, Buy f subModel ) ->
Selection.update subMsg subModel Selection.update subMsg subModel
|> updateChest GotSelectionMsg Buy |> updateChest GotSelectionMsg (Buy f)
( GotSelectionMsg subMsg, Sell subModel ) -> ( GotSelectionMsg subMsg, Sell f subModel ) ->
Selection.update subMsg subModel Selection.update subMsg subModel
|> updateChest GotSelectionMsg Sell |> updateChest GotSelectionMsg (Sell f)
( GotSelectionMsg subMsg, Claim subModel ) -> ( GotSelectionMsg subMsg, Claim f subModel ) ->
Selection.update subMsg subModel Selection.update subMsg subModel
|> updateChest GotSelectionMsg Claim |> updateChest GotSelectionMsg (Claim f)
( GotSelectionMsg subMsg, _ ) -> ( GotSelectionMsg subMsg, _ ) ->
( model, Cmd.none ) ( model, Cmd.none )
@@ -162,7 +190,7 @@ update msg model =
( IntoMode newMode, _ ) -> ( IntoMode newMode, _ ) ->
case newMode of case newMode of
IntoView -> IntoView ->
( View Table.name, Cmd.none ) ( View "" Table.name, Cmd.none )
IntoViewWithClaims claims -> IntoViewWithClaims claims ->
let let
@@ -201,20 +229,20 @@ update msg model =
text "" text ""
] ]
in in
( View <| Table.renderRowLevel renderItem (\_ -> []), Cmd.none ) ( View "" <| Table.renderRowLevel renderItem (\_ -> []), Cmd.none )
IntoBuy -> IntoBuy ->
( Buy <| Selection.init Nothing (Just .base_price), Cmd.none ) ( Buy "" <| Selection.init Nothing (Just .base_price), Cmd.none )
IntoSell -> IntoSell ->
( Sell <| Selection.init Nothing (Just (\i -> i.base_price // 2)), Cmd.none ) ( Sell "" <| Selection.init Nothing (Just (\i -> i.base_price // 2)), Cmd.none )
IntoClaim claims -> IntoClaim claims ->
let let
initialSelection = initialSelection =
List.map .loot_id claims List.map .loot_id claims
in in
( Claim <| Selection.init (Just initialSelection) Nothing, Cmd.none ) ( Claim "" <| Selection.init (Just initialSelection) Nothing, Cmd.none )
IntoAdd -> IntoAdd ->
( New NewFromInventory.init, Cmd.none ) ( New NewFromInventory.init, Cmd.none )
@@ -229,6 +257,24 @@ updateChest toMsg toChest ( model, cmd ) =
) )
updateFilterText txt model =
case model of
New _ ->
model
View _ a ->
View txt a
Buy _ a ->
Buy txt a
Sell _ a ->
Sell txt a
Claim _ a ->
Claim txt a
-- Helpers -- Helpers
-- --
@@ -239,7 +285,7 @@ updateChest toMsg toChest ( model, cmd ) =
confirmBuy : Int -> Chest -> Loot -> Cmd Api.Msg confirmBuy : Int -> Chest -> Loot -> Cmd Api.Msg
confirmBuy playerId model loot = confirmBuy playerId model loot =
case model of case model of
Buy chest -> Buy _ chest ->
let let
items = items =
Selection.selected chest loot Selection.selected chest loot
@@ -261,7 +307,7 @@ confirmBuy playerId model loot =
confirmSell : Int -> Chest -> Loot -> List Int -> Cmd Api.Msg confirmSell : Int -> Chest -> Loot -> List Int -> Cmd Api.Msg
confirmSell playerId model loot players = confirmSell playerId model loot players =
case model of case model of
Sell chest -> Sell _ chest ->
let let
items = items =
Selection.selected chest loot Selection.selected chest loot
@@ -302,7 +348,7 @@ confirmAdd playerId sourceName model =
confirmGrab : Int -> Loot -> Chest -> Cmd Api.Msg confirmGrab : Int -> Loot -> Chest -> Cmd Api.Msg
confirmGrab playerId loot model = confirmGrab playerId loot model =
case model of case model of
Claim chest -> Claim _ chest ->
let let
items = items =
Selection.selected chest loot Selection.selected chest loot

53
src/Page/Dashboard.elm
View File

@@ -109,7 +109,7 @@ view model =
in in
( Html.map PlayerViewer <| ( Html.map PlayerViewer <|
case config.chest of case config.chest of
Chest.View _ -> Chest.View _ _ ->
case data.player.id of case data.player.id of
0 -> 0 ->
B.buttons B.buttons
@@ -135,7 +135,7 @@ view model =
, color = "is-primary" , color = "is-primary"
} }
Chest.Sell selection -> Chest.Sell _ selection ->
let let
sellText = sellText =
case Selection.totalSelectedPrice selection data.loot of case Selection.totalSelectedPrice selection data.loot of
@@ -177,7 +177,7 @@ view model =
[] []
] ]
( Chest.Sell _, True ) -> ( Chest.Sell _ _, True ) ->
selectPlayers config.extra.players selectPlayers config.extra.players
_ -> _ ->
@@ -303,28 +303,35 @@ type PlayerMsg
update msg model = update msg model =
case ( msg, model ) of case ( msg, model ) of
( AdminViewer aMsg, Admin config ) -> ( AdminViewer ConfirmNewPlayer, Admin config ) ->
(case ( aMsg, config.playerForm ) of ( Admin { config | playerForm = Nothing }
( EditPlayer, Nothing ) -> , case config.playerForm of
( Admin { config | playerForm = Just <| NewPlayerForm "" 0.0 } Just form ->
, Cmd.none Cmd.map Api <|
) Api.adminAddPlayer form
( GotFormMsg subMsg, Just f ) -> Nothing ->
( Admin { config | playerForm = Just (updateForm subMsg f) } Cmd.none
, Cmd.none
)
( ConfirmNewPlayer, Just f ) ->
( model, Cmd.none )
( CloseEdit, _ ) ->
( Admin { config | playerForm = Nothing }, Cmd.none )
_ ->
( model, Cmd.none )
) )
|> Tuple.mapSecond (Cmd.map AdminViewer)
( AdminViewer aMsg, Admin config ) ->
Tuple.mapSecond (Cmd.map AdminViewer) <|
case ( aMsg, config.playerForm ) of
( EditPlayer, Nothing ) ->
( Admin { config | playerForm = Just <| NewPlayerForm "" 0.0 }
, Cmd.none
)
( GotFormMsg subMsg, Just f ) ->
( Admin { config | playerForm = Just (updateForm subMsg f) }
, Cmd.none
)
( CloseEdit, _ ) ->
( Admin { config | playerForm = Nothing }, Cmd.none )
_ ->
( model, Cmd.none )
( PlayerViewer ConfirmSell, Player config ) -> ( PlayerViewer ConfirmSell, Player config ) ->
( model ( model

14
src/Page/GroupChest.elm
View File

@@ -71,12 +71,12 @@ view model =
( True, data.player.id == 0 ) ( True, data.player.id == 0 )
in in
case ( model.chest, isPlayer && not isGroup ) of case ( model.chest, isPlayer && not isGroup ) of
( Chest.View _, True ) -> ( Chest.View _ _, True ) ->
B.btn B.btn
(GotChestMsg <| Chest.claim (getClaimsFromSession model.session)) (GotChestMsg <| Chest.claim (getClaimsFromSession model.session))
{ text = "Demander", icon = "fas fa-praying-hands", color = "is-primary" } { text = "Demander", icon = "fas fa-praying-hands", color = "is-primary" }
( Chest.Claim _, True ) -> ( Chest.Claim _ _, True ) ->
B.confirmButtons ConfirmGrab (GotChestMsg Chest.show) B.confirmButtons ConfirmGrab (GotChestMsg Chest.show)
( _, _ ) -> ( _, _ ) ->
@@ -93,7 +93,7 @@ type Msg
type InnerMsg type InnerMsg
= GotLoot Api.ToChest (HttpResult Loot) = GotLoot (HttpResult Loot)
| GotChestMsg Chest.Msg | GotChestMsg Chest.Msg
| ConfirmGrab | ConfirmGrab
@@ -106,7 +106,7 @@ update msg model =
Internal ConfirmGrab -> Internal ConfirmGrab ->
case ( Session.user model.session, model.loot, model.chest ) of case ( Session.user model.session, model.loot, model.chest ) of
( Player data, Loaded loot, Chest.Claim _ ) -> ( Player data, Loaded loot, Chest.Claim _ _ ) ->
( model ( model
, Chest.confirmGrab , Chest.confirmGrab
data.player.id data.player.id
@@ -121,11 +121,11 @@ update msg model =
Internal innerMsg -> Internal innerMsg ->
Tuple.mapSecond (Cmd.map Internal) <| Tuple.mapSecond (Cmd.map Internal) <|
case innerMsg of case innerMsg of
GotLoot _ (Ok loot) -> GotLoot (Ok loot) ->
( { model | loot = Loaded loot }, Cmd.none ) ( { model | loot = Loaded loot }, Cmd.none )
GotLoot _ (Err _) -> GotLoot (Err e) ->
( { model | loot = LoadError "Le chargement a échoué" }, Cmd.none ) ( { model | loot = LoadError <| Debug.toString e }, Cmd.none )
GotChestMsg chestMsg -> GotChestMsg chestMsg ->
Chest.update chestMsg model.chest Chest.update chestMsg model.chest

81
src/Page/Shop.elm
View File

@@ -47,13 +47,13 @@ view model =
Loaded loot -> Loaded loot ->
( Html.map Internal <| ( Html.map Internal <|
case ( model.chest, Session.user model.session ) of case ( model.chest, Session.user model.session ) of
( Chest.View _, Session.Admin _ ) -> ( Chest.View _ _, Session.Admin _ ) ->
B.btn (GotChestMsg Chest.new) { text = "Remplacer", icon = "fas fa-sync-alt", color = "is-primary" } B.btn (GotChestMsg Chest.new) { text = "Remplacer", icon = "fas fa-sync-alt", color = "is-primary" }
( Chest.View _, Session.Player _ ) -> ( Chest.View _ _, Session.Player _ ) ->
B.btn (GotChestMsg Chest.buy) { text = "Acheter", icon = "fas fa-coins", color = "is-primary" } B.btn (GotChestMsg Chest.buy) { text = "Acheter", icon = "fas fa-coins", color = "is-primary" }
( Chest.Buy _, Session.Player _ ) -> ( Chest.Buy _ _, Session.Player _ ) ->
B.confirmButtons ConfirmBuy (GotChestMsg Chest.show) B.confirmButtons ConfirmBuy (GotChestMsg Chest.show)
( Chest.New _, Session.Admin _ ) -> ( Chest.New _, Session.Admin _ ) ->
@@ -78,7 +78,7 @@ type Msg
type ShopMsg type ShopMsg
= GotLoot Api.ToChest (HttpResult Loot) = GotLoot (HttpResult Loot)
| ConfirmRefresh | ConfirmRefresh
| GotRefreshResult (Maybe ()) | GotRefreshResult (Maybe ())
| ConfirmBuy | ConfirmBuy
@@ -97,7 +97,7 @@ update msg model =
case msg of case msg of
Internal ConfirmBuy -> Internal ConfirmBuy ->
case ( Session.user (getSession model), model.loot, model.chest ) of case ( Session.user (getSession model), model.loot, model.chest ) of
( Session.Player data, Loaded loot, Chest.Buy _ ) -> ( Session.Player data, Loaded loot, Chest.Buy _ _ ) ->
( model ( model
, Chest.confirmBuy , Chest.confirmBuy
data.player.id data.player.id
@@ -120,49 +120,46 @@ update msg model =
) )
Internal shopMsg -> Internal shopMsg ->
let Tuple.mapSecond (Cmd.map Internal) <|
( nModel, cmd ) = case shopMsg of
case shopMsg of GotLoot response ->
GotLoot Api.OfShop response -> case response of
case response of Ok loot ->
Ok loot -> ( { model | loot = Loaded loot }, Cmd.none )
( { model | loot = Loaded loot }, Cmd.none )
-- TODO: handle error -- TODO: handle error
Err e -> Err e ->
( { model | loot = LoadError <| Debug.toString e }, Cmd.none ) ( { model | loot = LoadError <| Debug.toString e }, Cmd.none )
ConfirmRefresh -> ConfirmRefresh ->
case Session.user (getSession model) of case Session.user (getSession model) of
Session.Admin _ -> Session.Admin _ ->
let let
loot = loot =
case model.chest of case model.chest of
Chest.New chest -> Chest.New chest ->
NewChest.allLoot chest NewChest.allLoot chest
_ -> _ ->
[] []
in in
( model, Api.replaceShopItems GotRefreshResult loot ) ( model, Api.replaceShopItems GotRefreshResult loot )
_ -> _ ->
let let
_ = _ =
Debug.log "Forbidden action ! (is not admin)" () Debug.log "Forbidden action ! (is not admin)" ()
in in
( model, Cmd.none ) ( model, Cmd.none )
GotChestMsg subMsg -> GotChestMsg subMsg ->
Chest.update subMsg model.chest Chest.update subMsg model.chest
|> Tuple.mapBoth |> Tuple.mapBoth
(\c -> { model | chest = c }) (\c -> { model | chest = c })
(Cmd.map GotChestMsg) (Cmd.map GotChestMsg)
_ -> _ ->
( model, Cmd.none ) ( model, Cmd.none )
in
( nModel, Cmd.map Internal cmd )
_ -> _ ->
( model, Cmd.none ) ( model, Cmd.none )