diff --git a/modules/webapp/src/main/elm/Comp/FolderSelect.elm b/modules/webapp/src/main/elm/Comp/FolderSelect.elm index 7907c715..0af88e01 100644 --- a/modules/webapp/src/main/elm/Comp/FolderSelect.elm +++ b/modules/webapp/src/main/elm/Comp/FolderSelect.elm @@ -80,7 +80,7 @@ view constr model = [ i [ class "folder open icon" ] [] , div [ class "content" ] [ div [ class "header" ] - [ text "All" + [ text "Folders" ] , div [ class "ui relaxed list" ] (renderItems constr model) diff --git a/modules/webapp/src/main/elm/Comp/SearchMenu.elm b/modules/webapp/src/main/elm/Comp/SearchMenu.elm index 5c28f62c..29118524 100644 --- a/modules/webapp/src/main/elm/Comp/SearchMenu.elm +++ b/modules/webapp/src/main/elm/Comp/SearchMenu.elm @@ -16,7 +16,6 @@ import Api.Model.FolderList exposing (FolderList) import Api.Model.IdName exposing (IdName) import Api.Model.ItemSearch exposing (ItemSearch) import Api.Model.ReferenceList exposing (ReferenceList) -import Api.Model.Tag exposing (Tag) import Api.Model.TagCloud exposing (TagCloud) import Comp.DatePicker import Comp.Dropdown exposing (isDropdownChangeMsg) @@ -33,7 +32,6 @@ import Html.Events exposing (onCheck, onClick, onInput) import Http import Util.Html exposing (KeyCode(..)) import Util.Maybe -import Util.Tag import Util.Update @@ -44,8 +42,6 @@ import Util.Update type alias Model = { tagSelectModel : Comp.TagSelect.Model , tagSelection : Comp.TagSelect.Selection - , tagCatInclModel : Comp.Dropdown.Model String - , tagCatExclModel : Comp.Dropdown.Model String , directionModel : Comp.Dropdown.Model Direction , orgModel : Comp.Dropdown.Model IdName , corrPersonModel : Comp.Dropdown.Model IdName @@ -74,8 +70,6 @@ init : Model init = { tagSelectModel = Comp.TagSelect.init [] , tagSelection = Comp.TagSelect.emptySelection - , tagCatInclModel = Util.Tag.makeCatDropdownModel - , tagCatExclModel = Util.Tag.makeCatDropdownModel , directionModel = Comp.Dropdown.makeSingleList { makeOption = @@ -158,8 +152,6 @@ type Msg | ToggleNameHelp | FolderSelectMsg Comp.FolderSelect.Msg | GetFolderResp (Result Http.Error FolderList) - | TagCatIncMsg (Comp.Dropdown.Msg String) - | TagCatExcMsg (Comp.Dropdown.Msg String) getDirection : Model -> Maybe Direction @@ -194,8 +186,8 @@ getItemSearch model = "*" ++ s ++ "*" in { e - | tagsInclude = model.tagSelection.include |> List.map .tag |> List.map .id - , tagsExclude = model.tagSelection.exclude |> List.map .tag |> List.map .id + | tagsInclude = model.tagSelection.includeTags |> List.map .tag |> List.map .id + , tagsExclude = model.tagSelection.excludeTags |> List.map .tag |> List.map .id , corrPerson = Comp.Dropdown.getSelected model.corrPersonModel |> List.map .id |> List.head , corrOrg = Comp.Dropdown.getSelected model.orgModel |> List.map .id |> List.head , concPerson = Comp.Dropdown.getSelected model.concPersonModel |> List.map .id |> List.head @@ -217,8 +209,8 @@ getItemSearch model = model.allNameModel |> Maybe.map amendWildcards , fullText = model.fulltextModel - , tagCategoriesInclude = Comp.Dropdown.getSelected model.tagCatInclModel - , tagCategoriesExclude = Comp.Dropdown.getSelected model.tagCatExclModel + , tagCategoriesInclude = model.tagSelection.includeCats |> List.map .name + , tagCategoriesExclude = model.tagSelection.excludeCats |> List.map .name } @@ -286,10 +278,6 @@ update flags settings msg model = GetTagsResp (Ok tags) -> let - catList = - Util.Tag.getCategories (List.map .tag tags.items) - |> Comp.Dropdown.SetOptions - selectModel = List.sortBy .count tags.items |> List.reverse @@ -298,12 +286,7 @@ update flags settings msg model = model_ = { model | tagSelectModel = selectModel } in - noChange <| - Util.Update.andThen1 - [ update flags settings (TagCatIncMsg catList) >> .modelCmd - , update flags settings (TagCatExcMsg catList) >> .modelCmd - ] - model_ + noChange ( model_, Cmd.none ) GetTagsResp (Err _) -> noChange ( model, Cmd.none ) @@ -563,28 +546,6 @@ update flags settings msg model = ) (model.selectedFolder /= sel) - TagCatIncMsg m -> - let - ( m2, c2 ) = - Comp.Dropdown.update m model.tagCatInclModel - in - NextState - ( { model | tagCatInclModel = m2 } - , Cmd.map TagCatIncMsg c2 - ) - (isDropdownChangeMsg m) - - TagCatExcMsg m -> - let - ( m2, c2 ) = - Comp.Dropdown.update m model.tagCatExclModel - in - NextState - ( { model | tagCatExclModel = m2 } - , Cmd.map TagCatExcMsg c2 - ) - (isDropdownChangeMsg m) - -- View @@ -633,17 +594,7 @@ view flags settings model = ] ] ] - , formHeader (Icons.tagsIcon "") "Tags" , Html.map TagSelectMsg (Comp.TagSelect.view settings model.tagSelectModel) - , div [ class "field" ] - [ label [] [ text "Category Include (and)" ] - , Html.map TagCatIncMsg (Comp.Dropdown.view settings model.tagCatInclModel) - ] - , div [ class "field" ] - [ label [] [ text "Category Exclude (or)" ] - , Html.map TagCatExcMsg (Comp.Dropdown.view settings model.tagCatExclModel) - ] - , formHeader (Icons.folderIcon "") "Folder" , Html.map FolderSelectMsg (Comp.FolderSelect.view settings.searchMenuFolders model.folderList) , formHeaderHelp nameIcon "Names" ToggleNameHelp diff --git a/modules/webapp/src/main/elm/Comp/TagSelect.elm b/modules/webapp/src/main/elm/Comp/TagSelect.elm index 2af7567b..ff8649b1 100644 --- a/modules/webapp/src/main/elm/Comp/TagSelect.elm +++ b/modules/webapp/src/main/elm/Comp/TagSelect.elm @@ -1,5 +1,6 @@ module Comp.TagSelect exposing - ( Model + ( Category + , Model , Msg , Selection , emptySelection @@ -19,84 +20,154 @@ import Html.Events exposing (onClick) type alias Model = { all : List TagCount - , selected : Dict String Bool - , expanded : Bool + , categories : List Category + , selectedTags : Dict String Bool + , selectedCats : Dict String Bool + , expandedTags : Bool + , expandedCats : Bool + } + + +type alias Category = + { name : String + , count : Int } init : List TagCount -> Model init tags = { all = tags - , selected = Dict.empty - , expanded = False + , categories = sumCategories tags + , selectedTags = Dict.empty + , selectedCats = Dict.empty + , expandedTags = False + , expandedCats = False } +sumCategories : List TagCount -> List Category +sumCategories tags = + let + filterCat tc = + Maybe.map (\cat -> Category cat tc.count) tc.tag.category + + withCats = + List.filterMap filterCat tags + + sum cat mc = + Maybe.map ((+) cat.count) mc + |> Maybe.withDefault cat.count + |> Just + + sumCounts cat dict = + Dict.update cat.name (sum cat) dict + + cats = + List.foldl sumCounts Dict.empty withCats + in + Dict.toList cats + |> List.map (\( n, c ) -> Category n c) + + --- Update type Msg - = Toggle String - | ToggleExpand + = ToggleTag String + | ToggleCat String + | ToggleExpandTags + | ToggleExpandCats type alias Selection = - { include : List TagCount - , exclude : List TagCount + { includeTags : List TagCount + , excludeTags : List TagCount + , includeCats : List Category + , excludeCats : List Category } emptySelection : Selection emptySelection = - Selection [] [] + Selection [] [] [] [] update : Msg -> Model -> ( Model, Selection ) update msg model = case msg of - Toggle id -> + ToggleTag id -> let - current = - Dict.get id model.selected - next = - case current of - Nothing -> - Dict.insert id True model.selected - - Just True -> - Dict.insert id False model.selected - - Just False -> - Dict.remove id model.selected + updateSelection id model.selectedTags model_ = - { model | selected = next } + { model | selectedTags = next } in ( model_, getSelection model_ ) - ToggleExpand -> - ( { model | expanded = not model.expanded } + ToggleCat name -> + let + next = + updateSelection name model.selectedCats + + model_ = + { model | selectedCats = next } + in + ( model_, getSelection model_ ) + + ToggleExpandTags -> + ( { model | expandedTags = not model.expandedTags } , getSelection model ) + ToggleExpandCats -> + ( { model | expandedCats = not model.expandedCats } + , getSelection model + ) + + +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 : Model -> Selection getSelection model = + let + ( inclTags, exclTags ) = + getSelection1 (\t -> t.tag.id) model.selectedTags model.all + + ( inclCats, exclCats ) = + getSelection1 (\c -> c.name) model.selectedCats model.categories + 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 t.tag.id model.selected + Dict.member (mkId t) selected isIncluded t = - Dict.get t.tag.id model.selected + Dict.get (mkId t) selected |> Maybe.withDefault False - - ( incl, excl ) = - List.filter selectedOnly model.all - |> List.partition isIncluded in - Selection incl excl + List.filter selectedOnly items + |> List.partition isIncluded @@ -109,9 +180,22 @@ type SelState | Deselect -selState : Model -> String -> SelState -selState model id = - case Dict.get id model.selected of +tagState : Model -> String -> SelState +tagState model id = + case Dict.get id model.selectedTags of + Just True -> + Include + + Just False -> + Exclude + + Nothing -> + Deselect + + +catState : Model -> String -> SelState +catState model name = + case Dict.get name model.selectedCats of Just True -> Include @@ -132,36 +216,72 @@ view settings model = [ text "Tags" ] , div [ class "ui relaxed list" ] - (List.map (viewItem settings model) model.all) + (List.map (viewTagItem settings model) model.all) + ] + ] + , div [ class "item" ] + [ I.tagsIcon "" + , div [ class "content" ] + [ div [ class "header" ] + [ text "Categories" + ] + , div [ class "ui relaxed list" ] + (List.map (viewCategoryItem settings model) model.categories) ] ] ] -viewItem : UiSettings -> Model -> TagCount -> Html Msg -viewItem settings model tag = +viewCategoryItem : UiSettings -> Model -> Category -> Html Msg +viewCategoryItem settings model cat = let state = - selState model tag.tag.id + catState model cat.name + + color = + Data.UiSettings.catColorString settings cat.name + + icon = + getIcon state color I.tagsIcon + in + a + [ class "item" + , href "#" + , onClick (ToggleCat cat.name) + ] + [ icon + , div [ class "content" ] + [ div + [ classList + [ ( "header", state == Include ) + , ( "description", state /= Include ) + ] + ] + [ text cat.name + , div [ class "ui right floated circular label" ] + [ text (String.fromInt cat.count) + ] + ] + ] + ] + + +viewTagItem : UiSettings -> Model -> TagCount -> Html Msg +viewTagItem settings model tag = + let + state = + tagState model tag.tag.id color = Data.UiSettings.tagColorString tag.tag settings icon = - case state of - Include -> - i [ class ("check icon " ++ color) ] [] - - Exclude -> - i [ class ("minus icon " ++ color) ] [] - - Deselect -> - I.tagIcon color + getIcon state color I.tagIcon in a [ class "item" , href "#" - , onClick (Toggle tag.tag.id) + , onClick (ToggleTag tag.tag.id) ] [ icon , div [ class "content" ] @@ -178,3 +298,16 @@ viewItem settings model tag = ] ] ] + + +getIcon : SelState -> String -> (String -> Html msg) -> Html msg +getIcon state color default = + case state of + Include -> + i [ class ("check icon " ++ color) ] [] + + Exclude -> + i [ class ("minus icon " ++ color) ] [] + + Deselect -> + default color diff --git a/modules/webapp/src/main/elm/Data/UiSettings.elm b/modules/webapp/src/main/elm/Data/UiSettings.elm index 77954000..a13cc8a7 100644 --- a/modules/webapp/src/main/elm/Data/UiSettings.elm +++ b/modules/webapp/src/main/elm/Data/UiSettings.elm @@ -2,6 +2,8 @@ module Data.UiSettings exposing ( Pos(..) , StoredUiSettings , UiSettings + , catColor + , catColorString , defaults , merge , mergeDefaults @@ -133,13 +135,21 @@ toStoredUiSettings settings = } +catColor : UiSettings -> String -> Maybe Color +catColor settings c = + Dict.get c settings.tagCategoryColors + + tagColor : Tag -> UiSettings -> Maybe Color tagColor tag settings = - let - readColor c = - Dict.get c settings.tagCategoryColors - in - Maybe.andThen readColor tag.category + Maybe.andThen (catColor settings) tag.category + + +catColorString : UiSettings -> String -> String +catColorString settings name = + catColor settings name + |> Maybe.map Data.Color.toString + |> Maybe.withDefault "" tagColorString : Tag -> UiSettings -> String