TheAnachronism/docspell
1
0
Fork 0
mirror of https://github.com/TheAnachronism/docspell.git synced 2025-06-21 18:08:25 +00:00
Code Issues Packages Projects Releases Wiki Activity

Include tag categories into the new tag selection field

Browse Source
This commit is contained in:
Eike Kettner
2020-08-08 10:20:43 +02:00
parent 3642b95f8c
commit 7c8c2f856f
4 changed files with 204 additions and 110 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
modules/webapp/src/main/elm/Comp/FolderSelect.elm
View File

@ -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)

59
modules/webapp/src/main/elm/Comp/SearchMenu.elm
View File

@ -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

233
modules/webapp/src/main/elm/Comp/TagSelect.elm
View File

@ -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

20
modules/webapp/src/main/elm/Data/UiSettings.elm
View File

@ -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