From 00b65f664d60ce1c3a214afe51ac8b00804fbba6 Mon Sep 17 00:00:00 2001 From: eikek Date: Fri, 28 Jan 2022 00:03:41 +0100 Subject: [PATCH 1/2] 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. --- .../webapp/src/main/elm/Comp/SearchMenu.elm | 44 +- .../webapp/src/main/elm/Comp/TagSelect.elm | 596 +++++++----------- .../webapp/src/main/elm/Page/Share/Data.elm | 2 +- .../webapp/src/main/elm/Page/Share/Update.elm | 36 +- 4 files changed, 277 insertions(+), 401 deletions(-) diff --git a/modules/webapp/src/main/elm/Comp/SearchMenu.elm b/modules/webapp/src/main/elm/Comp/SearchMenu.elm index 95271a3c..2be3e90e 100644 --- a/modules/webapp/src/main/elm/Comp/SearchMenu.elm +++ b/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 ) ] diff --git a/modules/webapp/src/main/elm/Comp/TagSelect.elm b/modules/webapp/src/main/elm/Comp/TagSelect.elm index b1fe5c79..4c8db026 100644 --- a/modules/webapp/src/main/elm/Comp/TagSelect.elm +++ b/modules/webapp/src/main/elm/Comp/TagSelect.elm @@ -5,26 +5,7 @@ -} -module Comp.TagSelect exposing - ( CategoryCount - , Model - , Msg - , Selection - , WorkModel - , emptySelection - , init - , makeWorkModel - , modifyAll - , modifyCount - , modifyCountKeepExisting - , reset - , toggleTag - , update - , updateDrop - , viewAll2 - , viewCats2 - , viewTagsDrop2 - ) +module Comp.TagSelect exposing (Model, Msg, Selection, emptySelection, init, initAll, initCounts, reset, toggleTag, update, view, viewCats, viewTags) 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 - , availableCats : Dict String CategoryCount - , tagCounts : List TagCount - , categoryCounts : List CategoryCount + { availableTags : List Tag + , availableCats : List String + , filteredCats : List String + , 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 = - { name : String - , count : Int - } - - -init : List TagCount -> List NameCount -> List TagCount -> List NameCount -> Model -init allTags allCats tags cats = - { 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 +emptyModel : Model +emptyModel = + { availableTags = [] + , availableCats = [] + , filteredCats = [] + , filteredTags = [] + , tagCounts = Dict.empty + , catCounts = Dict.empty , filterTerm = Nothing , expandedTags = False , expandedCats = False @@ -80,60 +55,79 @@ init allTags allCats tags cats = } -modifyAll : List TagCount -> List NameCount -> Model -> Model -modifyAll allTags allCats model = - { model - | 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 +type Msg + = ToggleTag String + | ToggleCat String + | ToggleExpandTags + | ToggleExpandCats + | ToggleShowEmpty + | TagDDMsg DD.Msg + | Search String + + +type alias Selection = + { includeTags : Set String + , excludeTags : Set String + , includeCats : Set String + , excludeCats : Set String } -modifyCount : Model -> List TagCount -> List NameCount -> Model -modifyCount model tags cats = - { model - | tagCounts = tags - , categoryCounts = List.filterMap (\e -> Maybe.map (\k -> CategoryCount k e.count) e.name) cats - } +type SelState + = Include + | Exclude + | Deselect -modifyCountKeepExisting : Model -> List TagCount -> List NameCount -> Model -modifyCountKeepExisting model tags cats = +emptySelection : Selection +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 - tagZeros = - Dict.map (\_ -> \tc -> TagCount tc.tag 0) model.availableTags + tags = + List.sortBy (.count >> negate) allTags + |> List.map .tag - tagAvail = - List.foldl (\tc -> \dict -> Dict.insert tc.tag.id tc dict) tagZeros tags - - 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 + cats = + List.sortBy (.count >> negate) allCats + |> List.map (.name >> Maybe.withDefault "") in { model - | tagCounts = tcs - , availableTags = tagAvail - , categoryCounts = ccs - , availableCats = catAvail + | availableTags = tags + , availableCats = cats + , filteredTags = tags + , 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 = - { 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. +{-| Goes from included -> excluded -> deselected -} -orderTagCountStable : Model -> List TagCount -> List TagCount -orderTagCountStable model tagCounts = +updateTagSelection : String -> Selection -> Selection +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 = - Dict.get tc.tag.id model.availableTags - |> Maybe.map (\e -> ( e.count * -1, S.toLower e.tag.name )) - |> Maybe.withDefault ( 0, S.toLower tc.tag.name ) + showIfEmpty = + model.showEmpty || ((Dict.get tag.id model.tagCounts |> Maybe.withDefault 0) > 0) 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 -orderCatCountStable model catCounts = +catFilter : Model -> String -> Bool +catFilter model cat = let - order cat = - Dict.get cat.name model.availableCats - |> Maybe.map (\e -> ( e.count * -1, S.toLower e.name )) - |> Maybe.withDefault ( 0, S.toLower cat.name ) + showIfEmpty = + model.showEmpty || ((Dict.get cat model.catCounts |> Maybe.withDefault 0) > 0) 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 -removeEmptyTagCounts sel tagCounts = - let - selected = - List.concat - [ 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 +applyFilter : Model -> Model +applyFilter model = + { model + | filteredTags = List.filter (tagFilter model) model.availableTags + , filteredCats = List.filter (catFilter model) model.availableCats } -noEmptyTags : Model -> Bool -noEmptyTags model = - Dict.filter (\k -> \v -> v.count == 0) model.availableTags - |> Dict.isEmpty + +--- Update -type Msg - = ToggleTag String - | 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 +update : DD.Model -> Selection -> Msg -> Model -> ( Model, Selection, DD.DragDropData ) +update ddm sel msg model = 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 - - wm_ = - { wm | selectedTags = next } + updateTagSelection id sel in - ( model, getSelection wm_, DD.DragDropData ddm Nothing ) + ( model, next, DD.DragDropData ddm Nothing ) ToggleCat name -> let next = - updateSelection name wm.selectedCats - - wm_ = - { wm | selectedCats = next } + updateCatSelection name sel 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 - = Include - | 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 = +noEmptyTags : Model -> Bool +noEmptyTags model = let - wm = - makeWorkModel sel model + countGreaterThan num tag = + 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) -viewTagsDrop2 texts ddm wm settings model = +tagState : Selection -> String -> SelState +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 -viewCats2 texts settings wm model = +viewCats : Texts -> UiSettings -> Selection -> Model -> Html Msg +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) -renderTagItems2 texts ddm settings model wm = +renderTagItems : Texts -> DD.Model -> UiSettings -> Model -> Selection -> List (Html Msg) +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 -viewTagItem2 ddm settings model tag = +viewTagItem : DD.Model -> UiSettings -> Selection -> Model -> Tag -> Html Msg +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 -viewCategoryItem2 settings model cat = +viewCategoryItem : UiSettings -> Selection -> Model -> String -> Html Msg +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) -renderCatItems2 texts settings model wm = +renderCatItems : Texts -> UiSettings -> Model -> Selection -> List (Html Msg) +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 -getIcon2 state color default = +getIcon : SelState -> String -> (String -> Html msg) -> Html msg +getIcon state color default = case state of Include -> i [ class ("fa fa-check " ++ color) ] [] diff --git a/modules/webapp/src/main/elm/Page/Share/Data.elm b/modules/webapp/src/main/elm/Page/Share/Data.elm index 22bf249b..35cd76c5 100644 --- a/modules/webapp/src/main/elm/Page/Share/Data.elm +++ b/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 diff --git a/modules/webapp/src/main/elm/Page/Share/Update.elm b/modules/webapp/src/main/elm/Page/Share/Update.elm index 0c9eb3ea..238c092b 100644 --- a/modules/webapp/src/main/elm/Page/Share/Update.elm +++ b/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 model = +makeSearchCmd : Flags -> Bool -> Model -> Cmd Msg +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 ] From d0248c530b77ee83b1936432a9eeab9aa1153120 Mon Sep 17 00:00:00 2001 From: eikek Date: Fri, 28 Jan 2022 00:21:42 +0100 Subject: [PATCH 2/2] Wrap tag columns in query boxes --- modules/webapp/src/main/elm/Comp/BoxQueryView.elm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/webapp/src/main/elm/Comp/BoxQueryView.elm b/modules/webapp/src/main/elm/Comp/BoxQueryView.elm index e46c6c41..c84bb9fa 100644 --- a/modules/webapp/src/main/elm/Comp/BoxQueryView.elm +++ b/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" ]