diff --git a/src/Api.elm b/src/Api.elm index e12cb36..0caab2d 100644 --- a/src/Api.elm +++ b/src/Api.elm @@ -8,6 +8,7 @@ module Api exposing , RequestData(..) , ToChest(..) , Update(..) + , adminAddPlayer , checkList , confirmAction , fetchLoot @@ -92,10 +93,6 @@ type alias Loot = List Item - --- Location of a loot - - lootDecoder : Decoder Loot lootDecoder = D.list itemDecoder @@ -107,7 +104,7 @@ type ToChest | OfShop -fetchLoot : (ToChest -> Result Http.Error Loot -> msg) -> ToChest -> Cmd msg +fetchLoot : (Result Http.Error Loot -> msg) -> ToChest -> Cmd msg fetchLoot toMsg dest = let url = @@ -123,7 +120,7 @@ fetchLoot toMsg dest = in Http.get { 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)) +emptyResponse = + apiResponseDecoder (D.succeed ()) + + {- ACTIONS @@ -404,7 +405,7 @@ replaceShopItems toMsg loot = , method = "POST" , headers = [] , body = Http.jsonBody data - , expect = Http.expectJson gotResponse (apiResponseDecoder <| D.succeed ()) + , expect = Http.expectJson gotResponse emptyResponse , timeout = 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 diff --git a/src/Bulma.elm b/src/Bulma.elm index a4cca56..39e757a 100644 --- a/src/Bulma.elm +++ b/src/Bulma.elm @@ -88,6 +88,16 @@ levelItem = +-- INPUTS +-- + + +inputField : String -> (String -> msg) -> Html msg +inputField val toMsg = + input [ class "input", value val, onInput toMsg ] [] + + + -- COLORS -- diff --git a/src/Chest.elm b/src/Chest.elm index 487a4f6..05158e7 100644 --- a/src/Chest.elm +++ b/src/Chest.elm @@ -29,10 +29,10 @@ type alias RowRenderer msg = type Chest = New NewFromInventory.Model - | View (Item -> Html Never) - | Buy Selection.Model - | Sell Selection.Model - | Claim Selection.Model + | View FilterText (Item -> Html Never) + | Buy FilterText Selection.Model + | Sell FilterText Selection.Model + | Claim FilterText Selection.Model type IntoMode @@ -44,6 +44,10 @@ type IntoMode | IntoClaim Claims +type alias FilterText = + String + + {- @@ -66,7 +70,7 @@ type IntoMode init = - View Table.name + View "" Table.name intoMode : IntoMode -> Msg @@ -100,31 +104,51 @@ claim initialClaims = showWith : Table.ItemRenderer Item Never -> Chest showWith renderItem = - View <| Table.renderRowLevel renderItem (\_ -> []) + View "" <| Table.renderRowLevel renderItem (\_ -> []) view : Chest -> Loot -> Html Msg view model loot = + let + filterLoot txt ls = + List.filter (\i -> String.contains txt i.name) ls + in case model of - View renderItem -> - Table.view renderItem loot - |> Html.map GotViewMsg + View filterText renderItem -> + div [] + [ viewFilterInput filterText + , Table.view renderItem (filterLoot filterText loot) + |> Html.map GotViewMsg + ] - Buy subModel -> - Selection.view subModel loot - |> Html.map GotSelectionMsg + Buy filterText subModel -> + div [] + [ viewFilterInput filterText + , Selection.view subModel (filterLoot filterText loot) + |> Html.map GotSelectionMsg + ] - Sell subModel -> - Selection.view subModel loot - |> Html.map GotSelectionMsg + Sell filterText subModel -> + div [] + [ viewFilterInput filterText + , Selection.view subModel (filterLoot filterText loot) + |> Html.map GotSelectionMsg + ] New subModel -> NewFromInventory.view subModel |> Html.map GotNewMsg - Claim subModel -> - Selection.view subModel loot - |> Html.map GotSelectionMsg + Claim filterText subModel -> + div [] + [ viewFilterInput filterText + , Selection.view subModel (filterLoot filterText loot) + |> Html.map GotSelectionMsg + ] + + +viewFilterInput filterText = + B.inputField filterText FilterTextChanged type Msg @@ -132,11 +156,15 @@ type Msg | GotSelectionMsg Selection.Msg | GotViewMsg Never | IntoMode IntoMode + | FilterTextChanged String update : Msg -> Chest -> ( Chest, Cmd Msg ) update msg model = case ( msg, model ) of + ( FilterTextChanged newText, m ) -> + ( updateFilterText newText m, Cmd.none ) + ( GotNewMsg subMsg, New subModel ) -> NewFromInventory.update subMsg subModel |> updateChest GotNewMsg New @@ -144,17 +172,17 @@ update msg model = ( GotNewMsg subMsg, _ ) -> ( model, Cmd.none ) - ( GotSelectionMsg subMsg, Buy subModel ) -> + ( GotSelectionMsg subMsg, Buy f 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 - |> updateChest GotSelectionMsg Sell + |> updateChest GotSelectionMsg (Sell f) - ( GotSelectionMsg subMsg, Claim subModel ) -> + ( GotSelectionMsg subMsg, Claim f subModel ) -> Selection.update subMsg subModel - |> updateChest GotSelectionMsg Claim + |> updateChest GotSelectionMsg (Claim f) ( GotSelectionMsg subMsg, _ ) -> ( model, Cmd.none ) @@ -162,7 +190,7 @@ update msg model = ( IntoMode newMode, _ ) -> case newMode of IntoView -> - ( View Table.name, Cmd.none ) + ( View "" Table.name, Cmd.none ) IntoViewWithClaims claims -> let @@ -201,20 +229,20 @@ update msg model = text "" ] in - ( View <| Table.renderRowLevel renderItem (\_ -> []), Cmd.none ) + ( View "" <| Table.renderRowLevel renderItem (\_ -> []), Cmd.none ) IntoBuy -> - ( Buy <| Selection.init Nothing (Just .base_price), Cmd.none ) + ( Buy "" <| Selection.init Nothing (Just .base_price), Cmd.none ) 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 -> let initialSelection = List.map .loot_id claims in - ( Claim <| Selection.init (Just initialSelection) Nothing, Cmd.none ) + ( Claim "" <| Selection.init (Just initialSelection) Nothing, Cmd.none ) IntoAdd -> ( 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 -- @@ -239,7 +285,7 @@ updateChest toMsg toChest ( model, cmd ) = confirmBuy : Int -> Chest -> Loot -> Cmd Api.Msg confirmBuy playerId model loot = case model of - Buy chest -> + Buy _ chest -> let items = Selection.selected chest loot @@ -261,7 +307,7 @@ confirmBuy playerId model loot = confirmSell : Int -> Chest -> Loot -> List Int -> Cmd Api.Msg confirmSell playerId model loot players = case model of - Sell chest -> + Sell _ chest -> let items = Selection.selected chest loot @@ -302,7 +348,7 @@ confirmAdd playerId sourceName model = confirmGrab : Int -> Loot -> Chest -> Cmd Api.Msg confirmGrab playerId loot model = case model of - Claim chest -> + Claim _ chest -> let items = Selection.selected chest loot diff --git a/src/Page/Dashboard.elm b/src/Page/Dashboard.elm index 35dfed2..736cd3e 100644 --- a/src/Page/Dashboard.elm +++ b/src/Page/Dashboard.elm @@ -109,7 +109,7 @@ view model = in ( Html.map PlayerViewer <| case config.chest of - Chest.View _ -> + Chest.View _ _ -> case data.player.id of 0 -> B.buttons @@ -135,7 +135,7 @@ view model = , color = "is-primary" } - Chest.Sell selection -> + Chest.Sell _ selection -> let sellText = case Selection.totalSelectedPrice selection data.loot of @@ -177,7 +177,7 @@ view model = [] ] - ( Chest.Sell _, True ) -> + ( Chest.Sell _ _, True ) -> selectPlayers config.extra.players _ -> @@ -303,28 +303,35 @@ type PlayerMsg update msg model = case ( msg, model ) of - ( AdminViewer aMsg, Admin config ) -> - (case ( aMsg, config.playerForm ) of - ( EditPlayer, Nothing ) -> - ( Admin { config | playerForm = Just <| NewPlayerForm "" 0.0 } - , Cmd.none - ) + ( AdminViewer ConfirmNewPlayer, Admin config ) -> + ( Admin { config | playerForm = Nothing } + , case config.playerForm of + Just form -> + Cmd.map Api <| + Api.adminAddPlayer form - ( GotFormMsg subMsg, Just f ) -> - ( Admin { config | playerForm = Just (updateForm subMsg f) } - , Cmd.none - ) - - ( ConfirmNewPlayer, Just f ) -> - ( model, Cmd.none ) - - ( CloseEdit, _ ) -> - ( Admin { config | playerForm = Nothing }, Cmd.none ) - - _ -> - ( model, Cmd.none ) + Nothing -> + 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 ) -> ( model diff --git a/src/Page/GroupChest.elm b/src/Page/GroupChest.elm index df38783..38af1b6 100644 --- a/src/Page/GroupChest.elm +++ b/src/Page/GroupChest.elm @@ -71,12 +71,12 @@ view model = ( True, data.player.id == 0 ) in case ( model.chest, isPlayer && not isGroup ) of - ( Chest.View _, True ) -> + ( Chest.View _ _, True ) -> B.btn (GotChestMsg <| Chest.claim (getClaimsFromSession model.session)) { text = "Demander", icon = "fas fa-praying-hands", color = "is-primary" } - ( Chest.Claim _, True ) -> + ( Chest.Claim _ _, True ) -> B.confirmButtons ConfirmGrab (GotChestMsg Chest.show) ( _, _ ) -> @@ -93,7 +93,7 @@ type Msg type InnerMsg - = GotLoot Api.ToChest (HttpResult Loot) + = GotLoot (HttpResult Loot) | GotChestMsg Chest.Msg | ConfirmGrab @@ -106,7 +106,7 @@ update msg model = Internal ConfirmGrab -> case ( Session.user model.session, model.loot, model.chest ) of - ( Player data, Loaded loot, Chest.Claim _ ) -> + ( Player data, Loaded loot, Chest.Claim _ _ ) -> ( model , Chest.confirmGrab data.player.id @@ -121,11 +121,11 @@ update msg model = Internal innerMsg -> Tuple.mapSecond (Cmd.map Internal) <| case innerMsg of - GotLoot _ (Ok loot) -> + GotLoot (Ok loot) -> ( { model | loot = Loaded loot }, Cmd.none ) - GotLoot _ (Err _) -> - ( { model | loot = LoadError "Le chargement a échoué" }, Cmd.none ) + GotLoot (Err e) -> + ( { model | loot = LoadError <| Debug.toString e }, Cmd.none ) GotChestMsg chestMsg -> Chest.update chestMsg model.chest diff --git a/src/Page/Shop.elm b/src/Page/Shop.elm index 76631e1..dae4b7e 100644 --- a/src/Page/Shop.elm +++ b/src/Page/Shop.elm @@ -47,13 +47,13 @@ view model = Loaded loot -> ( Html.map Internal <| 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" } - ( Chest.View _, Session.Player _ ) -> + ( Chest.View _ _, Session.Player _ ) -> 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) ( Chest.New _, Session.Admin _ ) -> @@ -78,7 +78,7 @@ type Msg type ShopMsg - = GotLoot Api.ToChest (HttpResult Loot) + = GotLoot (HttpResult Loot) | ConfirmRefresh | GotRefreshResult (Maybe ()) | ConfirmBuy @@ -97,7 +97,7 @@ update msg model = case msg of Internal ConfirmBuy -> 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 , Chest.confirmBuy data.player.id @@ -120,49 +120,46 @@ update msg model = ) Internal shopMsg -> - let - ( nModel, cmd ) = - case shopMsg of - GotLoot Api.OfShop response -> - case response of - Ok loot -> - ( { model | loot = Loaded loot }, Cmd.none ) + Tuple.mapSecond (Cmd.map Internal) <| + case shopMsg of + GotLoot response -> + case response of + Ok loot -> + ( { model | loot = Loaded loot }, Cmd.none ) - -- TODO: handle error - Err e -> - ( { model | loot = LoadError <| Debug.toString e }, Cmd.none ) + -- TODO: handle error + Err e -> + ( { model | loot = LoadError <| Debug.toString e }, Cmd.none ) - ConfirmRefresh -> - case Session.user (getSession model) of - Session.Admin _ -> - let - loot = - case model.chest of - Chest.New chest -> - NewChest.allLoot chest + ConfirmRefresh -> + case Session.user (getSession model) of + Session.Admin _ -> + let + loot = + case model.chest of + Chest.New chest -> + NewChest.allLoot chest - _ -> - [] - in - ( model, Api.replaceShopItems GotRefreshResult loot ) + _ -> + [] + in + ( model, Api.replaceShopItems GotRefreshResult loot ) - _ -> - let - _ = - Debug.log "Forbidden action ! (is not admin)" () - in - ( model, Cmd.none ) + _ -> + let + _ = + Debug.log "Forbidden action ! (is not admin)" () + in + ( model, Cmd.none ) - GotChestMsg subMsg -> - Chest.update subMsg model.chest - |> Tuple.mapBoth - (\c -> { model | chest = c }) - (Cmd.map GotChestMsg) + GotChestMsg subMsg -> + Chest.update subMsg model.chest + |> Tuple.mapBoth + (\c -> { model | chest = c }) + (Cmd.map GotChestMsg) - _ -> - ( model, Cmd.none ) - in - ( nModel, Cmd.map Internal cmd ) + _ -> + ( model, Cmd.none ) _ -> ( model, Cmd.none )