Fix sorting of tags in search menu

The order of tags is based on their overall counts and doesn't change
when tag association changes (due drag and drop) or the search.

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

@@ -13,6 +13,7 @@ module Comp.SearchMenu exposing
     , TextSearchModel
     , getItemQuery
     , init
+    , initFromStats
     , isFulltextSearch
     , isNamesSearch
     , linkTargetMsg
@@ -113,7 +114,7 @@ type TextSearchModel
 
 init : Flags -> Model
 init flags =
-    { tagSelectModel = Comp.TagSelect.init [] [] [] []
+    { tagSelectModel = Comp.TagSelect.init [] []
     , tagSelection = Comp.TagSelect.emptySelection
     , directionModel =
         Comp.Dropdown.makeSingleList
@@ -257,13 +258,13 @@ getItemQuery model =
     in
     Q.and
         [ when model.inboxCheckbox (Q.Inbox True)
-        , whenNotEmpty (model.tagSelection.includeTags |> List.map (.tag >> .id))
+        , whenNotEmpty (model.tagSelection.includeTags |> Set.toList)
             (Q.TagIds Q.AllMatch)
-        , whenNotEmpty (model.tagSelection.excludeTags |> List.map (.tag >> .id))
+        , whenNotEmpty (model.tagSelection.excludeTags |> Set.toList)
             (\ids -> Q.Not (Q.TagIds Q.AnyMatch ids))
-        , whenNotEmpty (model.tagSelection.includeCats |> List.map .name)
+        , whenNotEmpty (model.tagSelection.includeCats |> Set.toList)
             (Q.CatNames Q.AllMatch)
-        , whenNotEmpty (model.tagSelection.excludeCats |> List.map .name)
+        , whenNotEmpty (model.tagSelection.excludeCats |> Set.toList)
             (\ids -> Q.Not <| Q.CatNames Q.AnyMatch ids)
         , model.selectedFolder |> Maybe.map .id |> Maybe.map (Q.FolderId Q.Eq)
         , Comp.Dropdown.getSelected model.orgModel
@@ -403,6 +404,11 @@ setFromStats stats =
     GetStatsResp (Ok stats)
 
 
+initFromStats : SearchStats -> Msg
+initFromStats stats =
+    GetAllTagsResp (Ok stats)
+
+
 linkTargetMsg : LinkTarget -> Maybe Msg
 linkTargetMsg linkTarget =
     case linkTarget of
@@ -579,7 +585,7 @@ updateDrop ddm flags settings msg model =
         GetAllTagsResp (Ok stats) ->
             let
                 tagSel =
-                    Comp.TagSelect.modifyAll stats.tagCloud.items
+                    Comp.TagSelect.initAll stats.tagCloud.items
                         stats.tagCategoryCloud.items
                         model.tagSelectModel
             in
@@ -605,7 +611,7 @@ updateDrop ddm flags settings msg model =
                     List.sortBy .count stats.tagCategoryCloud.items
 
                 selectModel =
-                    Comp.TagSelect.modifyCountKeepExisting model.tagSelectModel tagCount catCount
+                    Comp.TagSelect.initCounts tagCount catCount model.tagSelectModel
 
                 orgOpts =
                     Comp.Dropdown.update (Comp.Dropdown.SetOptions (List.map .ref stats.corrOrgStats))
@@ -735,7 +741,7 @@ updateDrop ddm flags settings msg model =
         TagSelectMsg m ->
             let
                 ( m_, sel, ddd ) =
-                    Comp.TagSelect.updateDrop ddm model.tagSelection m model.tagSelectModel
+                    Comp.TagSelect.update ddm model.tagSelection m model.tagSelectModel
             in
             { model =
                 { model
@@ -1278,6 +1284,13 @@ tabLook settings model tab =
             else
                 Comp.Tabs.Active
 
+        activeWhenNotEmptySet list1 list2 =
+            if Set.isEmpty list1 && Set.isEmpty list2 then
+                Comp.Tabs.Normal
+
+            else
+                Comp.Tabs.Active
+
         activeWhenJust mx =
             if mx == Nothing then
                 Comp.Tabs.Normal
@@ -1301,11 +1314,11 @@ tabLook settings model tab =
 
         TabTags ->
             hiddenOr [ Data.Fields.Tag ]
-                (activeWhenNotEmpty model.tagSelection.includeTags model.tagSelection.excludeTags)
+                (activeWhenNotEmptySet model.tagSelection.includeTags model.tagSelection.excludeTags)
 
         TabTagCategories ->
             hiddenOr [ Data.Fields.Tag ]
-                (activeWhenNotEmpty model.tagSelection.includeCats model.tagSelection.excludeCats)
+                (activeWhenNotEmptySet model.tagSelection.includeCats model.tagSelection.excludeCats)
 
         TabFolder ->
             hiddenOr [ Data.Fields.Folder ]
@@ -1373,9 +1386,6 @@ searchTabs texts ddd flags settings model =
         isHidden f =
             Data.UiSettings.fieldHidden settings f
 
-        tagSelectWM =
-            Comp.TagSelect.makeWorkModel model.tagSelection model.tagSelectModel
-
         directionCfg =
             { makeOption =
                 \entry ->
@@ -1430,11 +1440,11 @@ searchTabs texts ddd flags settings model =
       , info = Nothing
       , body =
             List.map (Html.map TagSelectMsg)
-                (Comp.TagSelect.viewTagsDrop2
+                (Comp.TagSelect.viewTags
                     texts.tagSelect
                     ddd.model
-                    tagSelectWM
                     settings
+                    model.tagSelection
                     model.tagSelectModel
                 )
       }
@@ -1444,10 +1454,10 @@ searchTabs texts ddd flags settings model =
       , info = Nothing
       , body =
             [ Html.map TagSelectMsg
-                (Comp.TagSelect.viewCats2
+                (Comp.TagSelect.viewCats
                     texts.tagSelect
                     settings
-                    tagSelectWM
+                    model.tagSelection
                     model.tagSelectModel
                 )
             ]

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

@@ -5,26 +5,7 @@
 -}
 
 
-module Comp.TagSelect exposing
+module Comp.TagSelect exposing (Model, Msg, Selection, emptySelection, init, initAll, initCounts, reset, toggleTag, update, view, viewCats, viewTags)
-    ( CategoryCount
-    , Model
-    , Msg
-    , Selection
-    , WorkModel
-    , emptySelection
-    , init
-    , makeWorkModel
-    , modifyAll
-    , modifyCount
-    , modifyCountKeepExisting
-    , reset
-    , toggleTag
-    , update
-    , updateDrop
-    , viewAll2
-    , viewCats2
-    , viewTagsDrop2
-    )
 
 import Api.Model.NameCount exposing (NameCount)
 import Api.Model.Tag exposing (Tag)
@@ -37,7 +18,7 @@ import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (onClick, onInput)
 import Messages.Comp.TagSelect exposing (Texts)
-import Set
+import Set exposing (Set)
 import Simple.Fuzzy
 import String as S
 import Styles as S
@@ -46,10 +27,12 @@ import Util.Maybe
 
 
 type alias Model =
-    { availableTags : Dict String TagCount
+    { availableTags : List Tag
-    , availableCats : Dict String CategoryCount
+    , availableCats : List String
-    , tagCounts : List TagCount
+    , filteredCats : List String
-    , categoryCounts : List CategoryCount
+    , filteredTags : List Tag
+    , tagCounts : Dict String Int
+    , catCounts : Dict String Int
     , filterTerm : Maybe String
     , expandedTags : Bool
     , expandedCats : Bool
@@ -57,22 +40,14 @@ type alias Model =
     }
 
 
-type alias CategoryCount =
+emptyModel : Model
-    { name : String
+emptyModel =
-    , count : Int
+    { availableTags = []
-    }
+    , availableCats = []
-
+    , filteredCats = []
-
+    , filteredTags = []
-init : List TagCount -> List NameCount -> List TagCount -> List NameCount -> Model
+    , tagCounts = Dict.empty
-init allTags allCats tags cats =
+    , catCounts = Dict.empty
-    { availableTags =
-        List.map (\e -> ( e.tag.id, e )) allTags
-            |> Dict.fromList
-    , availableCats =
-        List.filterMap (\e -> Maybe.map (\k -> ( k, CategoryCount k e.count )) e.name) allCats
-            |> Dict.fromList
-    , tagCounts = tags
-    , categoryCounts = List.filterMap (\e -> Maybe.map (\k -> CategoryCount k e.count) e.name) cats
     , filterTerm = Nothing
     , expandedTags = False
     , expandedCats = False
@@ -80,60 +55,79 @@ init allTags allCats tags cats =
     }
 
 
-modifyAll : List TagCount -> List NameCount -> Model -> Model
+type Msg
-modifyAll allTags allCats model =
+    = ToggleTag String
-    { model
+    | ToggleCat String
-        | availableTags =
+    | ToggleExpandTags
-            List.map (\e -> ( e.tag.id, e )) allTags
+    | ToggleExpandCats
-                |> Dict.fromList
+    | ToggleShowEmpty
-        , availableCats =
+    | TagDDMsg DD.Msg
-            List.filterMap (\e -> Maybe.map (\k -> ( k, CategoryCount k e.count )) e.name) allCats
+    | Search String
-                |> Dict.fromList
+
+
+type alias Selection =
+    { includeTags : Set String
+    , excludeTags : Set String
+    , includeCats : Set String
+    , excludeCats : Set String
     }
 
 
-modifyCount : Model -> List TagCount -> List NameCount -> Model
+type SelState
-modifyCount model tags cats =
+    = Include
-    { model
+    | Exclude
-        | tagCounts = tags
+    | Deselect
-        , categoryCounts = List.filterMap (\e -> Maybe.map (\k -> CategoryCount k e.count) e.name) cats
-    }
 
 
-modifyCountKeepExisting : Model -> List TagCount -> List NameCount -> Model
+emptySelection : Selection
-modifyCountKeepExisting model tags cats =
+emptySelection =
+    Selection Set.empty Set.empty Set.empty Set.empty
+
+
+init : List TagCount -> List NameCount -> Model
+init allTags allCats =
+    initAll allTags allCats emptyModel
+
+
+initAll : List TagCount -> List NameCount -> Model -> Model
+initAll allTags allCats model =
+    model
+        |> initAvailable allTags allCats
+        |> initCounts allTags allCats
+        |> applyFilter
+
+
+initAvailable : List TagCount -> List NameCount -> Model -> Model
+initAvailable allTags allCats model =
     let
-        tagZeros : Dict String TagCount
+        tags =
-        tagZeros =
+            List.sortBy (.count >> negate) allTags
-            Dict.map (\_ -> \tc -> TagCount tc.tag 0) model.availableTags
+                |> List.map .tag
 
-        tagAvail =
+        cats =
-            List.foldl (\tc -> \dict -> Dict.insert tc.tag.id tc dict) tagZeros tags
+            List.sortBy (.count >> negate) allCats
-
+                |> List.map (.name >> Maybe.withDefault "")
-        tcs =
-            Dict.values tagAvail
-
-        catcs =
-            List.filterMap (\e -> Maybe.map (\k -> CategoryCount k e.count) e.name) cats
-
-        catZeros : Dict String CategoryCount
-        catZeros =
-            Dict.map (\_ -> \cc -> CategoryCount cc.name 0) model.availableCats
-
-        catAvail =
-            List.foldl (\cc -> \dict -> Dict.insert cc.name cc dict) catZeros catcs
-
-        ccs =
-            Dict.values catAvail
     in
     { model
-        | tagCounts = tcs
+        | availableTags = tags
-        , availableTags = tagAvail
+        , availableCats = cats
-        , categoryCounts = ccs
+        , filteredTags = tags
-        , availableCats = catAvail
+        , filteredCats = cats
     }
 
 
+initCounts : List TagCount -> List NameCount -> Model -> Model
+initCounts tags cats model =
+    let
+        tc =
+            List.map (\t -> ( t.tag.id, t.count )) tags |> Dict.fromList
+
+        cc =
+            List.map (\c -> ( Maybe.withDefault "" c.name, c.count )) cats |> Dict.fromList
+    in
+    { model | tagCounts = tc, catCounts = cc }
+
+
 reset : Model -> Model
 reset model =
     { model
@@ -149,171 +143,97 @@ toggleTag id =
     ToggleTag id
 
 
-type alias Selection =
+{-| Goes from included -> excluded -> deselected
-    { includeTags : List TagCount
-    , excludeTags : List TagCount
-    , includeCats : List CategoryCount
-    , excludeCats : List CategoryCount
-    }
-
-
-emptySelection : Selection
-emptySelection =
-    Selection [] [] [] []
-
-
-type alias WorkModel =
-    { filteredCats : List CategoryCount
-    , filteredTags : List TagCount
-    , selectedTags : Dict String Bool
-    , selectedCats : Dict String Bool
-    }
-
-
-{-| Orders the list of tag counts by their overall counts and not by
-their direct counts.
 -}
-orderTagCountStable : Model -> List TagCount -> List TagCount
+updateTagSelection : String -> Selection -> Selection
-orderTagCountStable model tagCounts =
+updateTagSelection id sel =
+    case tagState sel id of
+        Include ->
+            { sel
+                | includeTags = Set.remove id sel.includeTags
+                , excludeTags = Set.insert id sel.excludeTags
+            }
+
+        Exclude ->
+            { sel
+                | includeTags = Set.remove id sel.includeTags
+                , excludeTags = Set.remove id sel.excludeTags
+            }
+
+        Deselect ->
+            { sel
+                | includeTags = Set.insert id sel.includeTags
+            }
+
+
+{-| Goes from included -> excluded -> deselected
+-}
+updateCatSelection : String -> Selection -> Selection
+updateCatSelection id sel =
+    case catState sel id of
+        Include ->
+            { sel
+                | includeCats = Set.remove id sel.includeCats
+                , excludeCats = Set.insert id sel.excludeCats
+            }
+
+        Exclude ->
+            { sel
+                | includeCats = Set.remove id sel.includeCats
+                , excludeCats = Set.remove id sel.excludeCats
+            }
+
+        Deselect ->
+            { sel
+                | includeCats = Set.insert id sel.includeCats
+            }
+
+
+tagFilter : Model -> Tag -> Bool
+tagFilter model tag =
     let
-        order tc =
+        showIfEmpty =
-            Dict.get tc.tag.id model.availableTags
+            model.showEmpty || ((Dict.get tag.id model.tagCounts |> Maybe.withDefault 0) > 0)
-                |> Maybe.map (\e -> ( e.count * -1, S.toLower e.tag.name ))
-                |> Maybe.withDefault ( 0, S.toLower tc.tag.name )
     in
-    List.sortBy order tagCounts
+    case model.filterTerm of
+        Just f ->
+            Simple.Fuzzy.match f tag.name && showIfEmpty
+
+        Nothing ->
+            showIfEmpty
 
 
-orderCatCountStable : Model -> List CategoryCount -> List CategoryCount
+catFilter : Model -> String -> Bool
-orderCatCountStable model catCounts =
+catFilter model cat =
     let
-        order cat =
+        showIfEmpty =
-            Dict.get cat.name model.availableCats
+            model.showEmpty || ((Dict.get cat model.catCounts |> Maybe.withDefault 0) > 0)
-                |> Maybe.map (\e -> ( e.count * -1, S.toLower e.name ))
-                |> Maybe.withDefault ( 0, S.toLower cat.name )
     in
-    List.sortBy order catCounts
+    case model.filterTerm of
+        Just f ->
+            Simple.Fuzzy.match f cat && showIfEmpty
+
+        Nothing ->
+            showIfEmpty
 
 
-removeEmptyTagCounts : Selection -> List TagCount -> List TagCount
+applyFilter : Model -> Model
-removeEmptyTagCounts sel tagCounts =
+applyFilter model =
-    let
+    { model
-        selected =
+        | filteredTags = List.filter (tagFilter model) model.availableTags
-            List.concat
+        , filteredCats = List.filter (catFilter model) model.availableCats
-                [ List.map (.tag >> .id) sel.includeTags
-                , List.map (.tag >> .id) sel.excludeTags
-                ]
-                |> Set.fromList
-
-        isSelected tc =
-            Set.member tc.tag.id selected
-    in
-    List.filter (\tc -> isSelected tc || tc.count > 0) tagCounts
-
-
-removeEmptyCatCounts : Selection -> List CategoryCount -> List CategoryCount
-removeEmptyCatCounts sel catCounts =
-    let
-        selected =
-            List.concat
-                [ List.map .name sel.includeCats
-                , List.map .name sel.excludeCats
-                ]
-                |> Set.fromList
-
-        isSelected cat =
-            Set.member cat.name selected
-    in
-    List.filter (\tc -> isSelected tc || tc.count > 0) catCounts
-
-
-makeWorkModel : Selection -> Model -> WorkModel
-makeWorkModel sel model =
-    let
-        tagCounts =
-            orderTagCountStable model
-                (if model.showEmpty then
-                    model.tagCounts
-
-                 else
-                    removeEmptyTagCounts sel model.tagCounts
-                )
-
-        catCounts =
-            orderCatCountStable model
-                (if model.showEmpty then
-                    model.categoryCounts
-
-                 else
-                    removeEmptyCatCounts sel model.categoryCounts
-                )
-
-        ( tags, cats ) =
-            case model.filterTerm of
-                Just filter ->
-                    ( List.filter (\t -> Simple.Fuzzy.match filter t.tag.name) tagCounts
-                    , List.filter (\c -> Simple.Fuzzy.match filter c.name) catCounts
-                    )
-
-                Nothing ->
-                    ( tagCounts, catCounts )
-
-        tagId t =
-            t.tag.id
-
-        constDict mkId flag list =
-            List.map (\e -> ( mkId e, flag )) list
-                |> Dict.fromList
-
-        selTag =
-            constDict tagId True sel.includeTags
-                |> Dict.union (constDict tagId False sel.excludeTags)
-
-        selCat =
-            constDict .name True sel.includeCats
-                |> Dict.union (constDict .name False sel.excludeCats)
-    in
-    { filteredCats = cats
-    , filteredTags = tags
-    , selectedTags = selTag
-    , selectedCats = selCat
     }
 
 
-noEmptyTags : Model -> Bool
+
-noEmptyTags model =
+--- Update
-    Dict.filter (\k -> \v -> v.count == 0) model.availableTags
-        |> Dict.isEmpty
 
 
-type Msg
+update : DD.Model -> Selection -> Msg -> Model -> ( Model, Selection, DD.DragDropData )
-    = ToggleTag String
+update ddm sel msg model =
-    | ToggleCat String
-    | ToggleExpandTags
-    | ToggleExpandCats
-    | ToggleShowEmpty
-    | TagDDMsg DD.Msg
-    | Search String
-
-
-update : Selection -> Msg -> Model -> ( Model, Selection )
-update sel msg model =
-    let
-        ( m, s, _ ) =
-            updateDrop DD.init sel msg model
-    in
-    ( m, s )
-
-
-updateDrop : DD.Model -> Selection -> Msg -> Model -> ( Model, Selection, DD.DragDropData )
-updateDrop ddm sel msg model =
-    let
-        wm =
-            makeWorkModel sel model
-    in
     case msg of
         ToggleShowEmpty ->
-            ( { model | showEmpty = not model.showEmpty }
+            ( applyFilter { model | showEmpty = not model.showEmpty }
             , sel
             , DD.DragDropData ddm Nothing
             )
@@ -321,22 +241,16 @@ updateDrop ddm sel msg model =
         ToggleTag id ->
             let
                 next =
-                    updateSelection id wm.selectedTags
+                    updateTagSelection id sel
-
-                wm_ =
-                    { wm | selectedTags = next }
             in
-            ( model, getSelection wm_, DD.DragDropData ddm Nothing )
+            ( model, next, DD.DragDropData ddm Nothing )
 
         ToggleCat name ->
             let
                 next =
-                    updateSelection name wm.selectedCats
+                    updateCatSelection name sel
-
-                wm_ =
-                    { wm | selectedCats = next }
             in
-            ( model, getSelection wm_, DD.DragDropData ddm Nothing )
+            ( model, next, DD.DragDropData ddm Nothing )
 
         ToggleExpandTags ->
             ( { model | expandedTags = not model.expandedTags }
@@ -358,106 +272,58 @@ updateDrop ddm sel msg model =
             ( model, sel, ddd )
 
         Search str ->
-            ( { model | filterTerm = Util.Maybe.fromString str }
+            ( applyFilter { model | filterTerm = Util.Maybe.fromString str }
             , sel
             , DD.DragDropData ddm Nothing
             )
 
 
-updateSelection : String -> Dict String Bool -> Dict String Bool
-updateSelection id selected =
-    let
-        current =
-            Dict.get id selected
-    in
-    case current of
-        Nothing ->
-            Dict.insert id True selected
-
-        Just True ->
-            Dict.insert id False selected
-
-        Just False ->
-            Dict.remove id selected
-
-
-getSelection : WorkModel -> Selection
-getSelection model =
-    let
-        ( inclTags, exclTags ) =
-            getSelection1 (\t -> t.tag.id) model.selectedTags model.filteredTags
-
-        ( inclCats, exclCats ) =
-            getSelection1 (\c -> c.name) model.selectedCats model.filteredCats
-    in
-    Selection inclTags exclTags inclCats exclCats
-
-
-getSelection1 : (a -> String) -> Dict String Bool -> List a -> ( List a, List a )
-getSelection1 mkId selected items =
-    let
-        selectedOnly t =
-            Dict.member (mkId t) selected
-
-        isIncluded t =
-            Dict.get (mkId t) selected
-                |> Maybe.withDefault False
-    in
-    List.filter selectedOnly items
-        |> List.partition isIncluded
-
-
 
 --- View
 
 
-type SelState
+noEmptyTags : Model -> Bool
-    = Include
+noEmptyTags model =
-    | Exclude
-    | Deselect
-
-
-tagState : WorkModel -> String -> SelState
-tagState model id =
-    case Dict.get id model.selectedTags of
-        Just True ->
-            Include
-
-        Just False ->
-            Exclude
-
-        Nothing ->
-            Deselect
-
-
-catState : WorkModel -> String -> SelState
-catState model name =
-    case Dict.get name model.selectedCats of
-        Just True ->
-            Include
-
-        Just False ->
-            Exclude
-
-        Nothing ->
-            Deselect
-
-
-
---- View2
-
-
-viewAll2 : Texts -> DD.Model -> UiSettings -> Selection -> Model -> List (Html Msg)
-viewAll2 texts ddm settings sel model =
     let
-        wm =
+        countGreaterThan num tag =
-            makeWorkModel sel model
+            Dict.get tag.name model.tagCounts
+                |> Maybe.withDefault 0
+                |> (>) num
     in
-    viewTagsDrop2 texts ddm wm settings model ++ [ viewCats2 texts settings wm model ]
+    List.all (countGreaterThan 0) model.availableTags
 
 
-viewTagsDrop2 : Texts -> DD.Model -> WorkModel -> UiSettings -> Model -> List (Html Msg)
+tagState : Selection -> String -> SelState
-viewTagsDrop2 texts ddm wm settings model =
+tagState model id =
+    if Set.member id model.includeTags then
+        Include
+
+    else if Set.member id model.excludeTags then
+        Exclude
+
+    else
+        Deselect
+
+
+catState : Selection -> String -> SelState
+catState model name =
+    if Set.member name model.includeCats then
+        Include
+
+    else if Set.member name model.excludeCats then
+        Exclude
+
+    else
+        Deselect
+
+
+view : Texts -> DD.Model -> UiSettings -> Selection -> Model -> List (Html Msg)
+view texts ddm settings sel model =
+    viewTags texts ddm settings sel model ++ [ viewCats texts settings sel model ]
+
+
+viewTags : Texts -> DD.Model -> UiSettings -> Selection -> Model -> List (Html Msg)
+viewTags texts ddm settings sel model =
     [ div [ class "flex flex-col" ]
         [ div [ class "flex flex-row h-6 items-center text-xs mb-2" ]
             [ a
@@ -489,23 +355,23 @@ viewTagsDrop2 texts ddm wm settings model =
             ]
         ]
     , div [ class "flex flex-col space-y-2 md:space-y-1" ]
-        (renderTagItems2 texts ddm settings model wm)
+        (renderTagItems texts ddm settings model sel)
     ]
 
 
-viewCats2 : Texts -> UiSettings -> WorkModel -> Model -> Html Msg
+viewCats : Texts -> UiSettings -> Selection -> Model -> Html Msg
-viewCats2 texts settings wm model =
+viewCats texts settings sel model =
     div [ class "flex flex-col" ]
         [ div [ class "flex flex-col space-y-2 md:space-y-1" ]
-            (renderCatItems2 texts settings model wm)
+            (renderCatItems texts settings model sel)
         ]
 
 
-renderTagItems2 : Texts -> DD.Model -> UiSettings -> Model -> WorkModel -> List (Html Msg)
+renderTagItems : Texts -> DD.Model -> UiSettings -> Model -> Selection -> List (Html Msg)
-renderTagItems2 texts ddm settings model wm =
+renderTagItems texts ddm settings model sel =
     let
         tags =
-            wm.filteredTags
+            model.filteredTags
 
         max =
             settings.searchMenuTagCount
@@ -527,29 +393,29 @@ renderTagItems2 texts ddm settings model wm =
                 ToggleExpandTags
     in
     if max <= 0 then
-        List.map (viewTagItem2 ddm settings wm) tags
+        List.map (viewTagItem ddm settings sel model) tags
 
     else if model.expandedTags then
-        List.map (viewTagItem2 ddm settings wm) tags ++ cpsLink
+        List.map (viewTagItem ddm settings sel model) tags ++ cpsLink
 
     else
-        List.map (viewTagItem2 ddm settings wm) (List.take max tags) ++ expLink
+        List.map (viewTagItem ddm settings sel model) (List.take max tags) ++ expLink
 
 
-viewTagItem2 : DD.Model -> UiSettings -> WorkModel -> TagCount -> Html Msg
+viewTagItem : DD.Model -> UiSettings -> Selection -> Model -> Tag -> Html Msg
-viewTagItem2 ddm settings model tag =
+viewTagItem ddm settings sel model tag =
     let
         state =
-            tagState model tag.tag.id
+            tagState sel tag.id
 
         color =
-            Data.UiSettings.tagColorFg2 tag.tag settings
+            Data.UiSettings.tagColorFg2 tag settings
 
         icon =
-            getIcon2 state color I.tagIcon
+            getIcon state color I.tagIcon
 
         dropActive =
-            DD.getDropId ddm == Just (DD.Tag tag.tag.id)
+            DD.getDropId ddm == Just (DD.Tag tag.id)
     in
     a
         ([ classList
@@ -558,9 +424,9 @@ viewTagItem2 ddm settings model tag =
          , class "flex flex-row items-center"
          , class "rounded px-1 py-1 hover:bg-blue-100 dark:hover:bg-slate-600"
          , href "#"
-         , onClick (ToggleTag tag.tag.id)
+         , onClick (ToggleTag tag.id)
          ]
-            ++ DD.droppable TagDDMsg (DD.Tag tag.tag.id)
+            ++ DD.droppable TagDDMsg (DD.Tag tag.id)
         )
         [ icon
         , div
@@ -570,30 +436,30 @@ viewTagItem2 ddm settings model tag =
                 ]
             , class "ml-2"
             ]
-            [ text tag.tag.name
+            [ text tag.name
             ]
         , div [ class "flex-grow" ] []
-        , numberLabel tag.count
+        , numberLabel <| Maybe.withDefault 0 (Dict.get tag.id model.tagCounts)
         ]
 
 
-viewCategoryItem2 : UiSettings -> WorkModel -> CategoryCount -> Html Msg
+viewCategoryItem : UiSettings -> Selection -> Model -> String -> Html Msg
-viewCategoryItem2 settings model cat =
+viewCategoryItem settings sel model cat =
     let
         state =
-            catState model cat.name
+            catState sel cat
 
         color =
-            Data.UiSettings.catColorFg2 settings cat.name
+            Data.UiSettings.catColorFg2 settings cat
 
         icon =
-            getIcon2 state color I.tagsIcon
+            getIcon state color I.tagsIcon
     in
     a
         [ class "flex flex-row items-center"
         , class "rounded px-1 py-1 hover:bg-blue-100 dark:hover:bg-slate-600"
         , href "#"
-        , onClick (ToggleCat cat.name)
+        , onClick (ToggleCat cat)
         ]
         [ icon
         , div
@@ -603,18 +469,18 @@ viewCategoryItem2 settings model cat =
                 ]
             , class "ml-2"
             ]
-            [ text cat.name
+            [ text cat
             ]
         , div [ class "flex-grow" ] []
-        , numberLabel cat.count
+        , numberLabel <| Maybe.withDefault 0 (Dict.get cat model.catCounts)
         ]
 
 
-renderCatItems2 : Texts -> UiSettings -> Model -> WorkModel -> List (Html Msg)
+renderCatItems : Texts -> UiSettings -> Model -> Selection -> List (Html Msg)
-renderCatItems2 texts settings model wm =
+renderCatItems texts settings model sel =
     let
         cats =
-            wm.filteredCats
+            model.filteredCats
 
         max =
             settings.searchMenuTagCatCount
@@ -636,17 +502,17 @@ renderCatItems2 texts settings model wm =
                 ToggleExpandCats
     in
     if max <= 0 then
-        List.map (viewCategoryItem2 settings wm) cats
+        List.map (viewCategoryItem settings sel model) cats
 
     else if model.expandedCats then
-        List.map (viewCategoryItem2 settings wm) cats ++ cpsLink
+        List.map (viewCategoryItem settings sel model) cats ++ cpsLink
 
     else
-        List.map (viewCategoryItem2 settings wm) (List.take max cats) ++ expLink
+        List.map (viewCategoryItem settings sel model) (List.take max cats) ++ expLink
 
 
-getIcon2 : SelState -> String -> (String -> Html msg) -> Html msg
+getIcon : SelState -> String -> (String -> Html msg) -> Html msg
-getIcon2 state color default =
+getIcon state color default =
     case state of
         Include ->
             i [ class ("fa fa-check " ++ color) ] []

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

@@ -106,7 +106,7 @@ initCmd shareId flags =
 type Msg
     = VerifyResp (Result Http.Error ShareVerifyResult)
     | SearchResp (Result Http.Error ItemLightList)
-    | StatsResp (Result Http.Error SearchStats)
+    | StatsResp Bool (Result Http.Error SearchStats)
     | PasswordMsg Comp.SharePasswordForm.Msg
     | SearchMenuMsg Comp.SearchMenu.Msg
     | PowerSearchMsg Comp.PowerSearchInput.Msg

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

@@ -8,7 +8,6 @@
 module Page.Share.Update exposing (UpdateResult, update)
 
 import Api
-import Api.Model.ItemQuery
 import Comp.ItemCardList
 import Comp.LinkTarget exposing (LinkTarget)
 import Comp.PowerSearchInput
@@ -37,13 +36,6 @@ update flags settings shareId msg model =
     case msg of
         VerifyResp (Ok res) ->
             if res.success then
-                let
-                    eq =
-                        Api.Model.ItemQuery.empty
-
-                    iq =
-                        { eq | withDetails = Just True }
-                in
                 noSub
                     ( { model
                         | pageError = PageErrorNone
@@ -51,7 +43,7 @@ update flags settings shareId msg model =
                         , verifyResult = res
                         , searchInProgress = True
                       }
-                    , makeSearchCmd flags model
+                    , makeSearchCmd flags True model
                     )
 
             else if res.passwordRequired then
@@ -82,14 +74,22 @@ update flags settings shareId msg model =
         SearchResp (Err err) ->
             noSub ( { model | pageError = PageErrorHttp err, searchInProgress = False }, Cmd.none )
 
-        StatsResp (Ok stats) ->
+        StatsResp doInit (Ok stats) ->
+            let
+                lm =
+                    if doInit then
+                        Comp.SearchMenu.initFromStats stats
+
+                    else
+                        Comp.SearchMenu.setFromStats stats
+            in
             update flags
                 settings
                 shareId
-                (SearchMenuMsg (Comp.SearchMenu.setFromStats stats))
+                (SearchMenuMsg lm)
                 model
 
-        StatsResp (Err err) ->
+        StatsResp _ (Err err) ->
             noSub ( { model | pageError = PageErrorHttp err }, Cmd.none )
 
         PasswordMsg lmsg ->
@@ -118,7 +118,7 @@ update flags settings shareId msg model =
 
                 ( initSearch, searchCmd ) =
                     if res.stateChange && not model.searchInProgress then
-                        ( True, makeSearchCmd flags nextModel )
+                        ( True, makeSearchCmd flags False nextModel )
 
                     else
                         ( False, Cmd.none )
@@ -142,7 +142,7 @@ update flags settings shareId msg model =
                             ( False, Cmd.none )
 
                         Comp.PowerSearchInput.SubmitSearch ->
-                            ( True, makeSearchCmd flags nextModel )
+                            ( True, makeSearchCmd flags False nextModel )
             in
             { model = { nextModel | searchInProgress = initSearch }
             , cmd = Cmd.batch [ Cmd.map PowerSearchMsg res.cmd, searchCmd ]
@@ -207,7 +207,7 @@ update flags settings shareId msg model =
             noSub ( { model | contentSearch = Util.Maybe.fromString q }, Cmd.none )
 
         ContentSearchKey (Just Util.Html.Enter) ->
-            noSub ( model, makeSearchCmd flags model )
+            noSub ( model, makeSearchCmd flags False model )
 
         ContentSearchKey _ ->
             noSub ( model, Cmd.none )
@@ -248,8 +248,8 @@ noSub ( m, c ) =
     UpdateResult m c Sub.none
 
 
-makeSearchCmd : Flags -> Model -> Cmd Msg
+makeSearchCmd : Flags -> Bool -> Model -> Cmd Msg
-makeSearchCmd flags model =
+makeSearchCmd flags doInit model =
     let
         xq =
             Q.and
@@ -279,7 +279,7 @@ makeSearchCmd flags model =
             Api.searchShare flags model.verifyResult.token (request xq) SearchResp
 
         statsCmd =
-            Api.searchShareStats flags model.verifyResult.token (request xq) StatsResp
+            Api.searchShareStats flags model.verifyResult.token (request xq) (StatsResp doInit)
     in
     Cmd.batch [ searchCmd, statsCmd ]