makes filter search case insensitive

Refactors to improve scalability

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)
         }
 
 
@@ -139,14 +136,16 @@ type alias Claim =
     { id : Int
     , player_id : Int
     , loot_id : Int
+    , conflicts : Bool
     }
 
 
 claimDecoder =
-    D.map3 Claim
+    D.map4 Claim
         (D.field "id" int)
         (D.field "player_id" int)
         (D.field "loot_id" int)
+        (D.succeed False)
 
 
 
@@ -244,6 +243,10 @@ apiResponseDecoder toValue =
         (D.maybe (field "errors" string))
 
 
+emptyResponse =
+    apiResponseDecoder (D.succeed ())
+
+
 
 {- ACTIONS
 
@@ -402,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
         }
@@ -432,20 +435,85 @@ getLoot id =
         }
 
 
-getClaims id =
-    let
-        path =
-            if id == 0 then
-                "api/claims"
 
-            else
+-- Updates the conflicts field on every claims
-                "api/players/" ++ String.fromInt id ++ "/claims"
+
-    in
+
+groupByLoot : List Claims -> Claims -> List Claims
+groupByLoot acc claims =
+    case claims of
+        last :: [] ->
+            groupByLoot ([ last ] :: acc) []
+
+        first :: rest ->
+            let
+                ( newGroup, left ) =
+                    List.partition (\c -> c.loot_id == first.loot_id) rest
+            in
+            groupByLoot ((first :: newGroup) :: acc) left
+
+        [] ->
+            acc
+
+
+updateConflicts : Claims -> Claims
+updateConflicts claims =
+    groupByLoot [] claims
+        |> List.concatMap
+            (\group ->
+                let
+                    _ =
+                        Debug.log "updating group" group
+                in
+                case group of
+                    [] ->
+                        []
+
+                    [ c ] ->
+                        [ { c | conflicts = False } ]
+
+                    xs ->
+                        List.map (\c -> { c | conflicts = True }) xs
+            )
+
+
+parseClaims : Int -> Claims -> Task x Claims
+parseClaims id claims =
+    -- Filter claims relevant to player
+    Task.succeed <|
+        List.filter (\claim -> id == 0 || claim.player_id == id) <|
+            updateConflicts claims
+
+
+getClaims : Int -> Task Http.Error Claims
+getClaims id =
     send
         { method = "GET"
-        , path = path
+        , path = "api/claims"
         , decoder = valueDecoder (D.list claimDecoder)
         }
+        |> Task.andThen (parseClaims 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
+        }
 
 
 

src/Bulma.elm

@@ -88,9 +88,23 @@ levelItem =
 
 
 
+-- INPUTS
+--
+
+
+inputField : String -> (String -> msg) -> Html msg
+inputField val toMsg =
+    input [ class "input", value val, onInput toMsg ] []
+
+
+
 -- COLORS
 --
 
 
 isInfo =
     class "is-info"
+
+
+isError =
+    class "is-error"

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 (String.toLower txt) (String.toLower i.name)) ls
+    in
     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 ->
             NewFromInventory.view subModel
                 |> 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
@@ -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,43 +190,59 @@ update msg model =
         ( IntoMode newMode, _ ) ->
             case newMode of
                 IntoView ->
-                    ( View Table.name, Cmd.none )
+                    ( View "" Table.name, Cmd.none )
 
                 IntoViewWithClaims claims ->
                     let
                         isClaimed item =
-                            List.any (\claim_ -> claim_.loot_id == item.id) claims
+                            case List.filter (\c -> c.loot_id == item.id) claims of
+                                [ c ] ->
+                                    Just c
+
+                                [] ->
+                                    Nothing
+
+                                _ ->
+                                    Debug.log "Warning ! Duplicated claim found" Nothing
 
                         renderItem item =
                             [ p [ B.levelItem ] [ text item.name ]
-                            , if isClaimed item then
+                            , case isClaimed item of
-                                B.tag [ B.levelItem, B.isInfo ]
+                                Just c ->
-                                    [ B.icon
+                                    B.tag
-                                        { icon = "fas fa-praying-hands"
+                                        [ B.levelItem
-                                        , size = Just "is-small"
+                                        , if c.conflicts then
-                                        , ratio = Just "fa-1x"
+                                            B.isError
-                                        }
-                                    , text "time left..."
-                                    ]
 
-                              else
+                                          else
-                                text ""
+                                            B.isInfo
+                                        ]
+                                        [ B.icon
+                                            { icon = "fas fa-praying-hands"
+                                            , size = Just "is-small"
+                                            , ratio = Just "fa-1x"
+                                            }
+                                        , p [] [ text "en attente..." ]
+                                        ]
+
+                                Nothing ->
+                                    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 )
@@ -213,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
 --
@@ -223,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
@@ -245,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
@@ -286,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,28 +303,35 @@ type PlayerMsg
 
 update msg model =
     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 ) ->
             ( 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,49 +120,46 @@ update msg model =
                     )
 
         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 )

src/Table.elm

@@ -16,8 +16,7 @@ type alias ItemRenderer a msg =
 view : RowRenderer a msg -> List a -> Html msg
 view rowRenderer content =
     table [ class "table is-fullwidth" ]
-        [ thead [ class "table-header" ]
+        [ thead [] [ th [] [ text "Nom" ] ]
-            [ th [] [ text "Nom" ] ]
         , tbody [] <|
             List.map
                 rowRenderer