adds filter text input, add player for admin

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
 
 

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
 --
 

src/Chest.elm

@@ -29,10 +29,10 @@ type alias RowRenderer msg =
 
 type Chest
     = 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
@@ -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 ->
+        View filterText renderItem ->
-            Table.view renderItem loot
+            div []
+                [ viewFilterInput filterText
+                , Table.view renderItem (filterLoot filterText loot)
                     |> Html.map GotViewMsg
+                ]
 
-        Buy subModel ->
+        Buy filterText subModel ->
-            Selection.view subModel loot
+            div []
+                [ viewFilterInput filterText
+                , Selection.view subModel (filterLoot filterText loot)
                     |> Html.map GotSelectionMsg
+                ]
 
-        Sell subModel ->
+        Sell filterText subModel ->
-            Selection.view subModel loot
+            div []
+                [ viewFilterInput filterText
+                , Selection.view subModel (filterLoot filterText loot)
                     |> Html.map GotSelectionMsg
+                ]
 
         New subModel ->
             NewFromInventory.view subModel
                 |> Html.map GotNewMsg
 
-        Claim subModel ->
+        Claim filterText subModel ->
-            Selection.view subModel loot
+            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

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,8 +303,20 @@ type PlayerMsg
 
 update msg model =
     case ( msg, model ) of
+        ( AdminViewer ConfirmNewPlayer, Admin config ) ->
+            ( Admin { config | playerForm = Nothing }
+            , case config.playerForm of
+                Just form ->
+                    Cmd.map Api <|
+                        Api.adminAddPlayer form
+
+                Nothing ->
+                    Cmd.none
+            )
+
         ( AdminViewer aMsg, Admin config ) ->
-            (case ( aMsg, config.playerForm ) of
+            Tuple.mapSecond (Cmd.map AdminViewer) <|
+                case ( aMsg, config.playerForm ) of
                     ( EditPlayer, Nothing ) ->
                         ( Admin { config | playerForm = Just <| NewPlayerForm "" 0.0 }
                         , Cmd.none
@@ -315,16 +327,11 @@ update msg model =
                         , Cmd.none
                         )
 
-                ( ConfirmNewPlayer, Just f ) ->
-                    ( model, Cmd.none )
-
                     ( CloseEdit, _ ) ->
                         ( Admin { config | playerForm = Nothing }, Cmd.none )
 
                     _ ->
                         ( model, Cmd.none )
-            )
-                |> Tuple.mapSecond (Cmd.map AdminViewer)
 
         ( PlayerViewer ConfirmSell, Player config ) ->
             ( model

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 _) ->
+                    GotLoot (Err e) ->
-                        ( { model | loot = LoadError "Le chargement a échoué" }, Cmd.none )
+                        ( { model | loot = LoadError <| Debug.toString e }, Cmd.none )
 
                     GotChestMsg chestMsg ->
                         Chest.update chestMsg model.chest

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,10 +120,9 @@ update msg model =
                     )
 
         Internal shopMsg ->
-            let
+            Tuple.mapSecond (Cmd.map Internal) <|
-                ( nModel, cmd ) =
                 case shopMsg of
-                        GotLoot Api.OfShop response ->
+                    GotLoot response ->
                         case response of
                             Ok loot ->
                                 ( { model | loot = Loaded loot }, Cmd.none )
@@ -161,8 +160,6 @@ update msg model =
 
                     _ ->
                         ( model, Cmd.none )
-            in
-            ( nModel, Cmd.map Internal cmd )
 
         _ ->
             ( model, Cmd.none )