Update tag counts in search menu

modules/webapp/src/main/elm/Api.elm

@@ -67,6 +67,7 @@ module Api exposing
     , itemDetail
     , itemIndexSearch
     , itemSearch
+    , itemSearchStats
     , login
     , loginSession
     , logout
@@ -184,6 +185,7 @@ import Api.Model.ReferenceList exposing (ReferenceList)
 import Api.Model.Registration exposing (Registration)
 import Api.Model.ScanMailboxSettings exposing (ScanMailboxSettings)
 import Api.Model.ScanMailboxSettingsList exposing (ScanMailboxSettingsList)
+import Api.Model.SearchStats exposing (SearchStats)
 import Api.Model.SentMails exposing (SentMails)
 import Api.Model.SimpleMail exposing (SimpleMail)
 import Api.Model.SourceAndTags exposing (SourceAndTags)
@@ -1702,6 +1704,16 @@ itemSearch flags search receive =
         }
 
 
+itemSearchStats : Flags -> ItemSearch -> (Result Http.Error SearchStats -> msg) -> Cmd msg
+itemSearchStats flags search receive =
+    Http2.authPost
+        { url = flags.config.baseUrl ++ "/api/v1/sec/item/searchStats"
+        , account = getAccount flags
+        , body = Http.jsonBody (Api.Model.ItemSearch.encode search)
+        , expect = Http.expectJson receive Api.Model.SearchStats.decoder
+        }
+
+
 itemDetail : Flags -> String -> (Result Http.Error ItemDetail -> msg) -> Cmd msg
 itemDetail flags id receive =
     Http2.authGet

modules/webapp/src/main/elm/Comp/SearchMenu.elm

@@ -23,6 +23,7 @@ import Api.Model.IdName exposing (IdName)
 import Api.Model.ItemSearch exposing (ItemSearch)
 import Api.Model.PersonList exposing (PersonList)
 import Api.Model.ReferenceList exposing (ReferenceList)
+import Api.Model.SearchStats exposing (SearchStats)
 import Api.Model.TagCloud exposing (TagCloud)
 import Comp.CustomFieldMultiInput
 import Comp.DatePicker
@@ -338,7 +339,6 @@ type Msg
     | FromDueDateMsg Comp.DatePicker.Msg
     | UntilDueDateMsg Comp.DatePicker.Msg
     | ToggleInbox
-    | GetTagsResp (Result Http.Error TagCloud)
     | GetOrgResp (Result Http.Error ReferenceList)
     | GetEquipResp (Result Http.Error EquipmentList)
     | GetPersonResp (Result Http.Error PersonList)
@@ -359,6 +359,7 @@ type Msg
     | SetTag String
     | CustomFieldMsg Comp.CustomFieldMultiInput.Msg
     | SetSource String
+    | GetStatsResp (Result Http.Error SearchStats)
 
 
 type alias NextState =
@@ -425,7 +426,7 @@ updateDrop ddm flags settings msg model =
             { model = mdp
             , cmd =
                 Cmd.batch
-                    [ Api.getTagCloud flags GetTagsResp
+                    [ Api.itemSearchStats flags (getItemSearch model) GetStatsResp
                     , Api.getOrgLight flags GetOrgResp
                     , Api.getEquipments flags "" GetEquipResp
                     , Api.getPersons flags "" GetPersonResp
@@ -475,12 +476,12 @@ updateDrop ddm flags settings msg model =
         SetTag id ->
             resetAndSet (TagSelectMsg (Comp.TagSelect.toggleTag id))
 
-        GetTagsResp (Ok tags) ->
+        GetStatsResp (Ok stats) ->
             let
                 selectModel =
-                    List.sortBy .count tags.items
+                    List.sortBy .count stats.tagCloud.items
                         |> List.reverse
-                        |> Comp.TagSelect.init model.tagSelection
+                        |> Comp.TagSelect.modify model.tagSelection model.tagSelectModel
 
                 model_ =
                     { model | tagSelectModel = selectModel }
@@ -491,7 +492,7 @@ updateDrop ddm flags settings msg model =
             , dragDrop = DD.DragDropData ddm Nothing
             }
 
-        GetTagsResp (Err _) ->
+        GetStatsResp (Err _) ->
             { model = model
             , cmd = Cmd.none
             , stateChange = False

modules/webapp/src/main/elm/Comp/TagSelect.elm

@@ -5,6 +5,7 @@ module Comp.TagSelect exposing
     , Selection
     , emptySelection
     , init
+    , modify
     , reset
     , toggleTag
     , update
@@ -77,6 +78,45 @@ init sel tags =
     }
 
 
+modify : Selection -> Model -> List TagCount -> Model
+modify sel model tags =
+    let
+        newModel =
+            init sel tags
+    in
+    if List.isEmpty model.all then
+        newModel
+
+    else
+        let
+            tagId t =
+                t.tag.id
+
+            catId c =
+                c.name
+
+            tagDict =
+                List.map (\e -> ( tagId e, e )) tags
+                    |> Dict.fromList
+
+            catDict =
+                List.map (\e -> ( catId e, e )) newModel.categories
+                    |> Dict.fromList
+
+            replaceTag e =
+                Dict.get e.tag.id tagDict |> Maybe.withDefault { e | count = 0 }
+
+            replaceCat c =
+                Dict.get c.name catDict |> Maybe.withDefault { c | count = 0 }
+        in
+        { model
+            | all = List.map replaceTag model.all
+            , filteredTags = List.map replaceTag model.filteredTags
+            , categories = List.map replaceCat model.categories
+            , filteredCats = List.map replaceCat model.filteredCats
+        }
+
+
 reset : Model -> Model
 reset model =
     { model

modules/webapp/src/main/elm/Page/Home/Data.elm

@@ -19,6 +19,7 @@ module Page.Home.Data exposing
 import Api
 import Api.Model.BasicResult exposing (BasicResult)
 import Api.Model.ItemLightList exposing (ItemLightList)
+import Api.Model.SearchStats exposing (SearchStats)
 import Browser.Dom as Dom
 import Comp.FixedDropdown
 import Comp.ItemCardList
@@ -173,6 +174,7 @@ type Msg
     | DeleteAllResp (Result Http.Error BasicResult)
     | UiSettingsUpdated
     | SetLinkTarget LinkTarget
+    | SearchStatsResp (Result Http.Error SearchStats)
 
 
 type SearchType
@@ -237,7 +239,10 @@ doSearchDefaultCmd param model =
             }
     in
     if param.offset == 0 then
-        Api.itemSearch param.flags mask (ItemSearchResp param.scroll)
+        Cmd.batch
+            [ Api.itemSearch param.flags mask (ItemSearchResp param.scroll)
+            , Api.itemSearchStats param.flags mask SearchStatsResp
+            ]
 
     else
         Api.itemSearch param.flags mask ItemSearchAddResp

modules/webapp/src/main/elm/Page/Home/Update.elm

@@ -550,6 +550,13 @@ update mId key flags settings msg model =
             in
             update mId key flags settings (DoSearch model.lastSearchType) model_
 
+        SearchStatsResp result ->
+            let
+                lm =
+                    SearchMenuMsg (Comp.SearchMenu.GetStatsResp result)
+            in
+            update mId key flags settings lm model
+
 
 
 --- Helpers