Merge pull request #1321 from eikek/fix/tag-sorting

Fix sorting of tags in search menu

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

@@ -144,7 +144,7 @@ viewItemRow texts settings meta item =
             getColumns meta
 
         render col =
-            Comp.ItemColumnView.renderDiv texts.templateCtx settings col [ class "flex flex-row space-x-1" ] item
+            Comp.ItemColumnView.renderDiv texts.templateCtx settings col [ class "flex flex-row flex-wrap space-x-1" ] item
 
         td1 =
             td [ class "py-2 px-1" ]

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 ]