Merge pull request #1290 from eikek/tag-cat-select

Tag cat select

modules/webapp/src/main/elm/Api.elm

@@ -89,6 +89,7 @@ module Api exposing
     , getSources
     , getTagCloud
     , getTags
+    , getTagsIgnoreError
     , getUsers
     , initOtp
     , itemBasePreviewURL
@@ -1280,20 +1281,35 @@ getContacts flags kind q receive =
 --- Tags
 
 
-getTags : Flags -> String -> TagOrder -> (Result Http.Error TagList -> msg) -> Cmd msg
+getTagsTask : Flags -> String -> TagOrder -> Task.Task Http.Error TagList
-getTags flags query order receive =
+getTagsTask flags query order =
-    Http2.authGet
+    Http2.authTask
         { url =
             flags.config.baseUrl
                 ++ "/api/v1/sec/tag?sort="
                 ++ Data.TagOrder.asString order
                 ++ "&q="
                 ++ Url.percentEncode query
+        , method = "GET"
+        , headers = []
         , account = getAccount flags
-        , expect = Http.expectJson receive Api.Model.TagList.decoder
+        , body = Http.emptyBody
+        , resolver = Http2.jsonResolver Api.Model.TagList.decoder
+        , timeout = Nothing
         }
 
 
+getTags : Flags -> String -> TagOrder -> (Result Http.Error TagList -> msg) -> Cmd msg
+getTags flags query order receive =
+    getTagsTask flags query order |> Task.attempt receive
+
+
+getTagsIgnoreError : Flags -> String -> TagOrder -> (TagList -> msg) -> Cmd msg
+getTagsIgnoreError flags query order tagger =
+    getTagsTask flags query order
+        |> Task.attempt (Result.map tagger >> Result.withDefault (tagger Api.Model.TagList.empty))
+
+
 postTag : Flags -> Tag -> (Result Http.Error BasicResult -> msg) -> Cmd msg
 postTag flags tag receive =
     let

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

@@ -22,9 +22,9 @@ import Api.Model.TagList exposing (TagList)
 import Comp.Basic as B
 import Comp.CalEventInput
 import Comp.ChannelForm
-import Comp.Dropdown
 import Comp.IntField
 import Comp.MenuBar as MB
+import Comp.TagDropdown
 import Comp.YesNoDimmer
 import Data.CalEvent exposing (CalEvent)
 import Data.ChannelType exposing (ChannelType)
@@ -50,8 +50,8 @@ import Util.Update
 type alias Model =
     { settings : PeriodicDueItemsSettings
     , channelModel : Comp.ChannelForm.Model
-    , tagInclModel : Comp.Dropdown.Model Tag
+    , tagInclModel : Comp.TagDropdown.Model
-    , tagExclModel : Comp.Dropdown.Model Tag
+    , tagExclModel : Comp.TagDropdown.Model
     , remindDays : Maybe Int
     , remindDaysModel : Comp.IntField.Model
     , capOverdue : Bool
@@ -87,8 +87,8 @@ type Action
 
 type Msg
     = Submit
-    | TagIncMsg (Comp.Dropdown.Msg Tag)
+    | TagIncMsg Comp.TagDropdown.Msg
-    | TagExcMsg (Comp.Dropdown.Msg Tag)
+    | TagExcMsg Comp.TagDropdown.Msg
     | GetTagsResp (Result Http.Error TagList)
     | RemindDaysMsg Comp.IntField.Msg
     | ToggleEnabled
@@ -112,16 +112,6 @@ initWith flags s =
         ( im, ic ) =
             init flags ct
 
-        removeAction ( tm, _, tc ) =
-            ( tm, tc )
-
-        ( nm, nc ) =
-            Util.Update.andThen1
-                [ update flags (TagIncMsg (Comp.Dropdown.SetSelection s.tagsInclude)) >> removeAction
-                , update flags (TagExcMsg (Comp.Dropdown.SetSelection s.tagsExclude)) >> removeAction
-                ]
-                im
-
         newSchedule =
             Data.CalEvent.fromEvent s.schedule
                 |> Maybe.withDefault Data.CalEvent.everyMonth
@@ -132,9 +122,11 @@ initWith flags s =
         ( cfm, cfc ) =
             Comp.ChannelForm.initWith flags s.channel
     in
-    ( { nm
+    ( { im
         | settings = s
         , channelModel = cfm
+        , tagExclModel = Comp.TagDropdown.initWith [] s.tagsExclude
+        , tagInclModel = Comp.TagDropdown.initWith [] s.tagsInclude
         , remindDays = Just s.remindDays
         , enabled = s.enabled
         , capOverdue = s.capOverdue
@@ -146,8 +138,7 @@ initWith flags s =
         , summary = s.summary
       }
     , Cmd.batch
-        [ nc
+        [ ic
-        , ic
         , Cmd.map CalEventMsg sc
         , Cmd.map ChannelMsg cfc
         ]
@@ -168,8 +159,8 @@ init flags ct =
     in
     ( { settings = Data.PeriodicDueItemsSettings.empty ct
       , channelModel = cfm
-      , tagInclModel = Util.Tag.makeDropdownModel
+      , tagInclModel = Comp.TagDropdown.initWith [] []
-      , tagExclModel = Util.Tag.makeDropdownModel
+      , tagExclModel = Comp.TagDropdown.initWith [] []
       , remindDays = Just 1
       , remindDaysModel = Comp.IntField.init (Just 1) Nothing True
       , enabled = False
@@ -218,8 +209,8 @@ makeSettings model =
 
         make days timer channel =
             { prev
-                | tagsInclude = Comp.Dropdown.getSelected model.tagInclModel
+                | tagsInclude = Comp.TagDropdown.getSelected model.tagInclModel
-                , tagsExclude = Comp.Dropdown.getSelected model.tagExclModel
+                , tagsExclude = Comp.TagDropdown.getSelected model.tagExclModel
                 , remindDays = days
                 , capOverdue = model.capOverdue
                 , enabled = model.enabled
@@ -283,7 +274,7 @@ update flags msg model =
         TagIncMsg m ->
             let
                 ( m2, c2 ) =
-                    Comp.Dropdown.update m model.tagInclModel
+                    Comp.TagDropdown.update m model.tagInclModel
             in
             ( { model
                 | tagInclModel = m2
@@ -296,7 +287,7 @@ update flags msg model =
         TagExcMsg m ->
             let
                 ( m2, c2 ) =
-                    Comp.Dropdown.update m model.tagExclModel
+                    Comp.TagDropdown.update m model.tagExclModel
             in
             ( { model
                 | tagExclModel = m2
@@ -308,20 +299,20 @@ update flags msg model =
 
         GetTagsResp (Ok tags) ->
             let
-                tagList =
+                incModel =
-                    Comp.Dropdown.SetOptions tags.items
+                    Comp.TagDropdown.initWith tags.items model.settings.tagsInclude
 
-                removeAction ( tm, _, tc ) =
+                excModel =
-                    ( tm, tc )
+                    Comp.TagDropdown.initWith tags.items model.settings.tagsExclude
 
-                ( m, c ) =
+                newModel =
-                    Util.Update.andThen1
+                    { model
-                        [ update flags (TagIncMsg tagList) >> removeAction
+                        | loading = model.loading - 1
-                        , update flags (TagExcMsg tagList) >> removeAction
+                        , tagExclModel = excModel
-                        ]
+                        , tagInclModel = incModel
-                        { model | loading = model.loading - 1 }
+                    }
             in
-            ( m, NoAction, c )
+            ( newModel, NoAction, Cmd.none )
 
         GetTagsResp (Err err) ->
             ( { model
@@ -556,9 +547,10 @@ view2 texts extraClasses settings model =
             [ label [ class S.inputLabel ]
                 [ text texts.tagsInclude ]
             , Html.map TagIncMsg
-                (Comp.Dropdown.view2
+                (Comp.TagDropdown.view
-                    (Util.Tag.tagSettings texts.basics.chooseTag DS.mainStyle)
+                    texts.tagDropdown
                     settings
+                    DS.mainStyle
                     model.tagInclModel
                 )
             , span [ class "opacity-50 text-sm" ]
@@ -569,9 +561,10 @@ view2 texts extraClasses settings model =
             [ label [ class S.inputLabel ]
                 [ text texts.tagsExclude ]
             , Html.map TagExcMsg
-                (Comp.Dropdown.view2
+                (Comp.TagDropdown.view
-                    (Util.Tag.tagSettings texts.basics.chooseTag DS.mainStyle)
+                    texts.tagDropdown
                     settings
+                    DS.mainStyle
                     model.tagExclModel
                 )
             , span [ class "opacity-50 text-sm" ]

modules/webapp/src/main/elm/Comp/ItemDetail/EditForm.elm

@@ -21,7 +21,7 @@ import Comp.ItemDetail.Model
         )
 import Comp.KeyInput
 import Comp.Tabs as TB
-import Data.Direction
+import Comp.TagDropdown
 import Data.DropdownStyle
 import Data.Fields
 import Data.Flags exposing (Flags)
@@ -38,7 +38,6 @@ import Set exposing (Set)
 import Styles as S
 import Util.Folder
 import Util.Person
-import Util.Tag
 
 
 view2 : Texts -> Flags -> UiSettings -> Model -> Html Msg
@@ -213,10 +212,7 @@ formTabs texts flags settings model =
       , body =
             [ div [ class "mb-4 flex flex-col" ]
                 [ Html.map TagDropdownMsg
-                    (Comp.Dropdown.view2 (Util.Tag.tagSettings texts.basics.chooseTag dds)
+                    (Comp.TagDropdown.view texts.tagDropdown settings dds model.tagModel)
-                        settings
-                        model.tagModel
-                    )
                 , div [ class "flex flex-row items-center justify-end" ]
                     [ a
                         [ class S.secondaryButton

modules/webapp/src/main/elm/Comp/ItemDetail/Model.elm

@@ -53,6 +53,7 @@ import Comp.KeyInput
 import Comp.LinkTarget exposing (LinkTarget)
 import Comp.MarkdownInput
 import Comp.SentMails
+import Comp.TagDropdown
 import Data.Direction exposing (Direction)
 import Data.Fields exposing (Field)
 import DatePicker exposing (DatePicker)
@@ -73,7 +74,7 @@ type alias Model =
     , visibleAttach : Int
     , attachMenuOpen : Bool
     , menuOpen : Bool
-    , tagModel : Comp.Dropdown.Model Tag
+    , tagModel : Comp.TagDropdown.Model
     , directionModel : Comp.Dropdown.Model Direction
     , corrOrgModel : Comp.Dropdown.Model IdName
     , corrPersonModel : Comp.Dropdown.Model IdName
@@ -204,7 +205,7 @@ emptyModel =
     , visibleAttach = 0
     , attachMenuOpen = False
     , menuOpen = False
-    , tagModel = Util.Tag.makeDropdownModel
+    , tagModel = Comp.TagDropdown.emptyModel
     , directionModel =
         Comp.Dropdown.makeSingleList
             { options = Data.Direction.all
@@ -272,7 +273,7 @@ type Msg
     | SetItem ItemDetail
     | SetActiveAttachment Int
     | ToggleAttachment String
-    | TagDropdownMsg (Comp.Dropdown.Msg Tag)
+    | TagDropdownMsg Comp.TagDropdown.Msg
     | DirDropdownMsg (Comp.Dropdown.Msg Direction)
     | OrgDropdownMsg (Comp.Dropdown.Msg IdName)
     | CorrPersonMsg (Comp.Dropdown.Msg IdName)

modules/webapp/src/main/elm/Comp/ItemDetail/MultiEditMenu.elm

@@ -32,6 +32,7 @@ import Comp.Dropdown exposing (isDropdownChangeMsg)
 import Comp.ItemDetail.FieldTabState as FTabState exposing (EditTab(..), tabName)
 import Comp.ItemDetail.FormChange exposing (FormChange(..))
 import Comp.Tabs as TB
+import Comp.TagDropdown
 import Data.CustomFieldChange exposing (CustomFieldChange(..))
 import Data.Direction exposing (Direction)
 import Data.DropdownStyle
@@ -60,7 +61,6 @@ import Time
 import Util.Folder
 import Util.List
 import Util.Maybe
-import Util.Tag
 
 
 
@@ -80,7 +80,7 @@ type TagEditMode
 
 
 type alias Model =
-    { tagModel : Comp.Dropdown.Model Tag
+    { tagModel : Comp.TagDropdown.Model
     , nameModel : String
     , nameSaveThrottle : Throttle Msg
     , folderModel : Comp.Dropdown.Model IdName
@@ -112,13 +112,12 @@ type Msg
     | ConfirmMsg Bool
     | ToggleTagEditMode
     | FolderDropdownMsg (Comp.Dropdown.Msg IdName)
-    | TagDropdownMsg (Comp.Dropdown.Msg Tag)
+    | TagDropdownMsg Comp.TagDropdown.Msg
     | DirDropdownMsg (Comp.Dropdown.Msg Direction)
     | OrgDropdownMsg (Comp.Dropdown.Msg IdName)
     | CorrPersonMsg (Comp.Dropdown.Msg IdName)
     | ConcPersonMsg (Comp.Dropdown.Msg IdName)
     | ConcEquipMsg (Comp.Dropdown.Msg IdName)
-    | GetTagsResp (Result Http.Error TagList)
     | GetOrgResp (Result Http.Error ReferenceList)
     | GetPersonResp (Result Http.Error PersonList)
     | GetEquipResp (Result Http.Error EquipmentList)
@@ -129,7 +128,7 @@ type Msg
 
 init : Model
 init =
-    { tagModel = Util.Tag.makeDropdownModel
+    { tagModel = Comp.TagDropdown.initWith [] []
     , directionModel =
         Comp.Dropdown.makeSingleList
             { options = Data.Direction.all
@@ -159,16 +158,19 @@ loadModel flags =
     let
         ( _, dpc ) =
             Comp.DatePicker.init
+
+        ( _, tc ) =
+            Comp.TagDropdown.init flags
     in
     Cmd.batch
-        [ Api.getTags flags "" Data.TagOrder.NameAsc GetTagsResp
+        [ Api.getOrgLight flags GetOrgResp
-        , Api.getOrgLight flags GetOrgResp
         , Api.getPersons flags "" Data.PersonOrder.NameAsc GetPersonResp
         , Api.getEquipments flags "" Data.EquipmentOrder.NameAsc GetEquipResp
         , Api.getFolders flags "" Data.FolderOrder.NameAsc False GetFolderResp
         , Cmd.map CustomFieldMsg (Comp.CustomFieldMultiInput.initCmd flags)
         , Cmd.map ItemDatePickerMsg dpc
         , Cmd.map DueDatePickerMsg dpc
+        , Cmd.map TagDropdownMsg tc
         ]
 
 
@@ -213,8 +215,8 @@ update flags msg model =
 
         TagDropdownMsg m ->
             let
-                ( m2, _ ) =
+                ( m2, c2 ) =
-                    Comp.Dropdown.update m model.tagModel
+                    Comp.TagDropdown.update m model.tagModel
 
                 newModel =
                     { model | tagModel = m2 }
@@ -231,8 +233,8 @@ update flags msg model =
                             ReplaceTagChange list
 
                 change =
-                    if isDropdownChangeMsg m then
+                    if Comp.TagDropdown.isChangeMsg m then
-                        Comp.Dropdown.getSelected newModel.tagModel
+                        Comp.TagDropdown.getSelected newModel.tagModel
                             |> Util.List.distinct
                             |> List.map (\t -> IdName t.id t.name)
                             |> ReferenceList
@@ -241,12 +243,12 @@ update flags msg model =
                     else
                         NoFormChange
             in
-            resultNoCmd change newModel
+            UpdateResult newModel (Cmd.map TagDropdownMsg c2) Sub.none change
 
         ToggleTagEditMode ->
             let
                 ( m2, _ ) =
-                    Comp.Dropdown.update (Comp.Dropdown.SetSelection []) model.tagModel
+                    Comp.TagDropdown.update (Comp.TagDropdown.setSelected []) model.tagModel
 
                 newModel =
                     { model | tagModel = m2 }
@@ -261,16 +263,6 @@ update flags msg model =
                 ReplaceTags ->
                     resultNone { newModel | tagEditMode = AddTags }
 
-        GetTagsResp (Ok tags) ->
-            let
-                tagList =
-                    Comp.Dropdown.SetOptions tags.items
-            in
-            update flags (TagDropdownMsg tagList) model
-
-        GetTagsResp (Err _) ->
-            resultNone model
-
         FolderDropdownMsg m ->
             let
                 ( m2, _ ) =
@@ -756,8 +748,10 @@ renderEditForm2 texts flags cfg settings model =
                                 ]
                             ]
                         , Html.map TagDropdownMsg
-                            (Comp.Dropdown.view2 (Util.Tag.tagSettings texts.basics.chooseTag dds)
+                            (Comp.TagDropdown.view
+                                texts.tagDropdown
                                 settings
+                                dds
                                 model.tagModel
                             )
                         , Markdown.toHtml [ class "opacity-50 text-sm" ] tagModeMsg

modules/webapp/src/main/elm/Comp/ItemDetail/Update.elm

@@ -57,6 +57,7 @@ import Comp.MarkdownInput
 import Comp.OrgForm
 import Comp.PersonForm
 import Comp.SentMails
+import Comp.TagDropdown
 import Data.CustomFieldChange exposing (CustomFieldChange(..))
 import Data.Direction
 import Data.EquipmentOrder
@@ -124,7 +125,7 @@ update key flags inav settings msg model =
                         flags
                         inav
                         settings
-                        (TagDropdownMsg (Comp.Dropdown.SetSelection item.tags))
+                        (TagDropdownMsg (Comp.TagDropdown.setSelected item.tags))
                         model
 
                 res2 =
@@ -348,13 +349,13 @@ update key flags inav settings msg model =
         TagDropdownMsg m ->
             let
                 ( m2, c2 ) =
-                    Comp.Dropdown.update m model.tagModel
+                    Comp.TagDropdown.update m model.tagModel
 
                 newModel =
                     { model | tagModel = m2 }
 
                 save =
-                    if isDropdownChangeMsg m then
+                    if Comp.TagDropdown.isChangeMsg m then
                         saveTags flags newModel
 
                     else
@@ -615,10 +616,13 @@ update key flags inav settings msg model =
 
         GetTagsResp (Ok tags) ->
             let
-                tagList =
+                tagModel =
-                    Comp.Dropdown.SetOptions tags.items
+                    Comp.TagDropdown.initWith tags.items model.item.tags
+
+                newModel =
+                    { model | allTags = tags.items, tagModel = tagModel }
             in
-            update key flags inav settings (TagDropdownMsg tagList) { model | allTags = tags.items }
+            resultModel newModel
 
         GetTagsResp (Err _) ->
             resultModel model
@@ -1645,7 +1649,7 @@ saveTags : Flags -> Model -> Cmd Msg
 saveTags flags model =
     let
         tags =
-            Comp.Dropdown.getSelected model.tagModel
+            Comp.TagDropdown.getSelected model.tagModel
                 |> Util.List.distinct
                 |> List.map (\t -> t.id)
                 |> StringList

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

@@ -22,7 +22,7 @@ import Api.Model.IdName exposing (IdName)
 import Api.Model.ImapSettingsList exposing (ImapSettingsList)
 import Api.Model.ScanMailboxSettings exposing (ScanMailboxSettings)
 import Api.Model.StringList exposing (StringList)
-import Api.Model.Tag exposing (Tag)
+import Api.Model.Tag
 import Api.Model.TagList exposing (TagList)
 import Comp.Basic as B
 import Comp.CalEventInput
@@ -32,6 +32,7 @@ import Comp.IntField
 import Comp.MenuBar as MB
 import Comp.StringListInput
 import Comp.Tabs
+import Comp.TagDropdown
 import Comp.YesNoDimmer
 import Data.CalEvent exposing (CalEvent)
 import Data.Direction exposing (Direction(..))
@@ -51,10 +52,9 @@ import Messages.Comp.ScanMailboxForm exposing (Texts)
 import Messages.Data.Language
 import Set exposing (Set)
 import Styles as S
-import Util.Folder exposing (mkFolderOption)
+import Util.Folder
 import Util.List
 import Util.Maybe
-import Util.Tag
 import Util.Update
 
 
@@ -77,7 +77,7 @@ type alias Model =
     , folderModel : Comp.Dropdown.Model IdName
     , allFolders : List FolderItem
     , itemFolderId : Maybe String
-    , tagModel : Comp.Dropdown.Model Tag
+    , tagModel : Comp.TagDropdown.Model
     , existingTags : List String
     , fileFilter : Maybe String
     , subjectFilter : Maybe String
@@ -161,7 +161,7 @@ type Msg
     | GetFolderResp (Result Http.Error FolderList)
     | FolderDropdownMsg (Comp.Dropdown.Msg IdName)
     | GetTagResp (Result Http.Error TagList)
-    | TagDropdownMsg (Comp.Dropdown.Msg Tag)
+    | TagDropdownMsg Comp.TagDropdown.Msg
     | SetFileFilter String
     | SetSubjectFilter String
     | LanguageMsg (Comp.FixedDropdown.Msg Language)
@@ -206,7 +206,7 @@ initWith flags s =
         , formState = FormStateInitial
         , yesNoDelete = Comp.YesNoDimmer.emptyModel
         , itemFolderId = s.itemFolder
-        , tagModel = Util.Tag.makeDropdownModel
+        , tagModel = Comp.TagDropdown.initWith [] []
         , existingTags =
             Maybe.map .items s.tags
                 |> Maybe.withDefault []
@@ -256,7 +256,7 @@ init flags =
       , folderModel = Comp.Dropdown.makeSingle
       , allFolders = []
       , itemFolderId = Nothing
-      , tagModel = Util.Tag.makeDropdownModel
+      , tagModel = Comp.TagDropdown.initWith [] []
       , existingTags = []
       , fileFilter = Nothing
       , subjectFilter = Nothing
@@ -322,7 +322,7 @@ makeSettings model =
                 , fileFilter = model.fileFilter
                 , subjectFilter = model.subjectFilter
                 , tags =
-                    case Comp.Dropdown.getSelected model.tagModel of
+                    case Comp.TagDropdown.getSelected model.tagModel of
                         [] ->
                             Nothing
 
@@ -628,17 +628,9 @@ update flags msg model =
 
                 selected =
                     List.filter isExistingTag list.items
-                        |> Comp.Dropdown.SetSelection
 
-                opts =
+                tagModel_ =
-                    Comp.Dropdown.SetOptions list.items
+                    Comp.TagDropdown.initWith list.items selected
-
-                ( tagModel_, tagcmd ) =
-                    Util.Update.andThen1
-                        [ Comp.Dropdown.update selected
-                        , Comp.Dropdown.update opts
-                        ]
-                        model.tagModel
 
                 nextModel =
                     { model
@@ -648,7 +640,7 @@ update flags msg model =
             in
             ( nextModel
             , NoAction
-            , Cmd.map TagDropdownMsg tagcmd
+            , Cmd.none
             )
 
         GetTagResp (Err _) ->
@@ -660,7 +652,7 @@ update flags msg model =
         TagDropdownMsg lm ->
             let
                 ( m2, c2 ) =
-                    Comp.Dropdown.update lm model.tagModel
+                    Comp.TagDropdown.update lm model.tagModel
 
                 newModel =
                     { model | tagModel = m2 }
@@ -1177,9 +1169,10 @@ viewMetadata2 texts flags settings model =
         [ label [ class S.inputLabel ]
             [ text texts.basics.tags ]
         , Html.map TagDropdownMsg
-            (Comp.Dropdown.view2
+            (Comp.TagDropdown.view
-                (Util.Tag.tagSettings texts.basics.chooseTag DS.mainStyle)
+                texts.tagDropdown
                 settings
+                DS.mainStyle
                 model.tagModel
             )
         , div [ class "opacity-50 text-sm" ]

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

@@ -25,12 +25,12 @@ import Api.Model.TagList exposing (TagList)
 import Comp.Basic as B
 import Comp.Dropdown exposing (isDropdownChangeMsg)
 import Comp.FixedDropdown
+import Comp.TagDropdown
 import Data.DropdownStyle as DS
 import Data.Flags exposing (Flags)
 import Data.FolderOrder
 import Data.Language exposing (Language)
 import Data.Priority exposing (Priority)
-import Data.TagOrder
 import Data.UiSettings exposing (UiSettings)
 import Html exposing (..)
 import Html.Attributes exposing (..)
@@ -41,7 +41,6 @@ import Messages.Comp.SourceForm exposing (Texts)
 import Styles as S
 import Util.Folder exposing (mkFolderOption)
 import Util.Maybe
-import Util.Tag
 import Util.Update
 
 
@@ -55,7 +54,7 @@ type alias Model =
     , folderModel : Comp.Dropdown.Model IdName
     , allFolders : List FolderItem
     , folderId : Maybe String
-    , tagModel : Comp.Dropdown.Model Tag
+    , tagModel : Comp.TagDropdown.Model
     , fileFilter : Maybe String
     , languageModel : Comp.Dropdown.Model Language
     , language : Maybe String
@@ -75,7 +74,7 @@ emptyModel =
     , folderModel = Comp.Dropdown.makeSingle
     , allFolders = []
     , folderId = Nothing
-    , tagModel = Util.Tag.makeDropdownModel
+    , tagModel = Comp.TagDropdown.initWith [] []
     , fileFilter = Nothing
     , languageModel =
         Comp.Dropdown.makeSingleList
@@ -89,10 +88,14 @@ emptyModel =
 
 init : Flags -> ( Model, Cmd Msg )
 init flags =
-    ( emptyModel
+    let
+        ( tm, tc ) =
+            Comp.TagDropdown.init flags
+    in
+    ( { emptyModel | tagModel = tm }
     , Cmd.batch
         [ Api.getFolders flags "" Data.FolderOrder.NameAsc False GetFolderResp
-        , Api.getTags flags "" Data.TagOrder.NameAsc GetTagResp
+        , Cmd.map TagDropdownMsg tc
         ]
     )
 
@@ -112,7 +115,7 @@ getSource model =
             st.source
 
         tags =
-            Comp.Dropdown.getSelected model.tagModel
+            Comp.TagDropdown.getSelected model.tagModel
 
         n =
             { s
@@ -137,8 +140,7 @@ type Msg
     | PrioDropdownMsg (Comp.FixedDropdown.Msg Priority)
     | GetFolderResp (Result Http.Error FolderList)
     | FolderDropdownMsg (Comp.Dropdown.Msg IdName)
-    | GetTagResp (Result Http.Error TagList)
+    | TagDropdownMsg Comp.TagDropdown.Msg
-    | TagDropdownMsg (Comp.Dropdown.Msg Tag)
     | SetFileFilter String
     | LanguageMsg (Comp.Dropdown.Msg Language)
     | ToggleAttachmentsOnly
@@ -213,7 +215,7 @@ update flags msg model =
                             []
 
                 tags =
-                    Comp.Dropdown.SetSelection t.tags.items
+                    Comp.TagDropdown.setSelected t.tags.items
             in
             Util.Update.andThen1
                 [ update flags (FolderDropdownMsg (Comp.Dropdown.SetSelection sel))
@@ -286,20 +288,10 @@ update flags msg model =
             in
             ( model_, Cmd.map FolderDropdownMsg c2 )
 
-        GetTagResp (Ok list) ->
-            let
-                opts =
-                    Comp.Dropdown.SetOptions list.items
-            in
-            update flags (TagDropdownMsg opts) model
-
-        GetTagResp (Err _) ->
-            ( model, Cmd.none )
-
         TagDropdownMsg lm ->
             let
                 ( m2, c2 ) =
-                    Comp.Dropdown.update lm model.tagModel
+                    Comp.TagDropdown.update lm model.tagModel
 
                 newModel =
                     { model | tagModel = m2 }
@@ -348,9 +340,6 @@ view2 flags texts settings model =
             , style = DS.mainStyle
             }
 
-        tagCfg =
-            Util.Tag.tagSettings texts.basics.chooseTag DS.mainStyle
-
         languageCfg =
             { makeOption =
                 \a ->
@@ -477,9 +466,10 @@ view2 flags texts settings model =
                 [ text texts.basics.tags
                 ]
             , Html.map TagDropdownMsg
-                (Comp.Dropdown.view2
+                (Comp.TagDropdown.view
-                    tagCfg
+                    texts.tagDropdown
                     settings
+                    DS.mainStyle
                     model.tagModel
                 )
             , div [ class "opacity-50 text-sm" ]

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

@@ -70,7 +70,7 @@ searchMenuStyle =
     { rootClasses = "border-0 "
     , tabClasses = "border-0 "
     , titleClasses = "py-4 md:py-2 pl-2 bg-blue-50 hover:bg-blue-100 dark:bg-slate-700 dark:hover:bg-opacity-100 dark:hover:bg-slate-600 rounded"
-    , bodyClasses = "mt-1 py-1 pl-2"
+    , bodyClasses = "mt-1 pl-2"
     }
 
 

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

@@ -0,0 +1,264 @@
+{-
+   Copyright 2020 Eike K. & Contributors
+
+   SPDX-License-Identifier: AGPL-3.0-or-later
+-}
+
+
+module Comp.TagDropdown exposing
+    ( Model
+    , Msg
+    , emptyModel
+    , getSelected
+    , init
+    , initSelected
+    , initWith
+    , isChangeMsg
+    , setSelected
+    , update
+    , view
+    )
+
+import Api
+import Api.Model.Tag exposing (Tag)
+import Api.Model.TagList exposing (TagList)
+import Comp.Dropdown
+import Data.DropdownStyle exposing (DropdownStyle)
+import Data.Flags exposing (Flags)
+import Data.TagOrder
+import Data.UiSettings exposing (UiSettings)
+import Html exposing (Html, a, div, i)
+import Html.Attributes exposing (class, classList, href, title)
+import Html.Events exposing (onClick)
+import Messages.Comp.TagDropdown exposing (Texts)
+import Util.List
+
+
+type alias Model =
+    { ddm : Comp.Dropdown.Model Tag
+    , allTags : List Tag
+    , constrainedCat : Maybe String
+    }
+
+
+type Msg
+    = DropdownMsg (Comp.Dropdown.Msg Tag)
+    | GetTagsResp TagList
+    | ConstrainCat String
+
+
+emptyModel : Model
+emptyModel =
+    { ddm = makeDropdownModel
+    , allTags = []
+    , constrainedCat = Nothing
+    }
+
+
+init : Flags -> ( Model, Cmd Msg )
+init flags =
+    ( emptyModel, getOptions flags )
+
+
+initSelected : Flags -> List Tag -> ( Model, Cmd Msg )
+initSelected flags selected =
+    ( update (setSelected selected) emptyModel
+        |> Tuple.first
+    , getOptions flags
+    )
+
+
+initWith : List Tag -> List Tag -> Model
+initWith options selected =
+    update (setSelected selected) emptyModel
+        |> Tuple.first
+        |> update (setOptions options)
+        |> Tuple.first
+
+
+getSelected : Model -> List Tag
+getSelected model =
+    Comp.Dropdown.getSelected model.ddm
+
+
+setOptions : List Tag -> Msg
+setOptions tags =
+    GetTagsResp (TagList 0 tags)
+
+
+setSelected : List Tag -> Msg
+setSelected tags =
+    DropdownMsg (Comp.Dropdown.SetSelection tags)
+
+
+isChangeMsg : Msg -> Bool
+isChangeMsg msg =
+    case msg of
+        DropdownMsg m ->
+            Comp.Dropdown.isDropdownChangeMsg m
+
+        _ ->
+            False
+
+
+isConstrained : Model -> String -> Bool
+isConstrained model category =
+    model.constrainedCat == Just category
+
+
+
+--- api
+
+
+getOptions : Flags -> Cmd Msg
+getOptions flags =
+    Api.getTagsIgnoreError flags "" Data.TagOrder.NameAsc GetTagsResp
+
+
+
+--- update
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case msg of
+        DropdownMsg lm ->
+            let
+                ( dm, dc ) =
+                    Comp.Dropdown.update lm model.ddm
+            in
+            ( { model
+                | ddm = dm
+                , constrainedCat =
+                    if isChangeMsg msg then
+                        Nothing
+
+                    else
+                        model.constrainedCat
+              }
+            , Cmd.map DropdownMsg dc
+            )
+
+        GetTagsResp list ->
+            let
+                newModel =
+                    { model | allTags = list.items }
+
+                ddMsg =
+                    Comp.Dropdown.SetOptions newModel.allTags
+            in
+            update (DropdownMsg ddMsg) newModel
+
+        ConstrainCat cat ->
+            let
+                setOpts tags =
+                    DropdownMsg (Comp.Dropdown.SetOptions tags)
+            in
+            if model.constrainedCat == Just cat then
+                update (setOpts model.allTags)
+                    { model | constrainedCat = Nothing }
+
+            else
+                update (setOpts <| List.filter (isCategory cat) model.allTags)
+                    { model | constrainedCat = Just cat }
+
+
+isCategory : String -> Tag -> Bool
+isCategory cat tag =
+    tag.category == Just cat || (tag.category == Nothing && cat == "")
+
+
+
+--- view
+
+
+view : Texts -> UiSettings -> DropdownStyle -> Model -> Html Msg
+view texts settings dds model =
+    let
+        viewSettings =
+            tagSettings texts.placeholder dds
+    in
+    div [ class "flex flex-col" ]
+        [ viewCategorySelect texts settings model
+        , Html.map DropdownMsg (Comp.Dropdown.view2 viewSettings settings model.ddm)
+        ]
+
+
+viewCategorySelect : Texts -> UiSettings -> Model -> Html Msg
+viewCategorySelect texts settings model =
+    let
+        categories =
+            List.map .category model.allTags
+                |> List.map (Maybe.withDefault "")
+                |> Util.List.distinct
+                |> List.sort
+
+        catFilterLink cat =
+            a
+                [ classList
+                    [ ( "opacity-75", not (isConstrained model cat) )
+                    ]
+                , href "#"
+                , title <|
+                    if cat == "" then
+                        texts.noCategory
+
+                    else
+                        cat
+                , onClick (ConstrainCat cat)
+                ]
+                [ if cat == "" then
+                    i
+                        [ class <|
+                            if isConstrained model cat then
+                                "fa fa-check-circle font-thin"
+
+                            else
+                                "fa fa-circle font-thin"
+                        ]
+                        []
+
+                  else
+                    i
+                        [ classList
+                            [ ( "fa fa-circle", not (isConstrained model cat) )
+                            , ( "fa fa-check-circle", isConstrained model cat )
+                            ]
+                        , class <| Data.UiSettings.catColorFg2 settings cat
+                        ]
+                        []
+                ]
+    in
+    div
+        [ class "flex-wrap space-x-1 text-xl sm:text-sm "
+        , classList [ ( "hidden", not model.ddm.menuOpen ) ]
+        ]
+        (List.map catFilterLink categories)
+
+
+
+--- private helper
+
+
+makeDropdownModel : Comp.Dropdown.Model Tag
+makeDropdownModel =
+    let
+        m =
+            Comp.Dropdown.makeModel
+                { multiple = True
+                , searchable = \n -> n > 0
+                }
+    in
+    { m | searchWithAdditional = True }
+
+
+tagSettings : String -> DropdownStyle -> Comp.Dropdown.ViewSettings Tag
+tagSettings placeholder ds =
+    { makeOption = \tag -> { text = tag.name, additional = Maybe.withDefault "" tag.category }
+    , labelColor =
+        \tag ->
+            \settings ->
+                Data.UiSettings.tagColorString2 tag settings
+    , placeholder = placeholder
+    , style = ds
+    }

modules/webapp/src/main/elm/Data/Color.elm

@@ -243,7 +243,7 @@ toStringFg2 color =
             "text-purple-600 dark:text-purple-400"
 
         Pink ->
-            "text-pink-600 text:text-pink-400"
+            "text-pink-600 dark:text-pink-400"
 
         Brown ->
             "text-amber-700 dark:text-amber-700"

modules/webapp/src/main/elm/Messages/Comp/DueItemsTaskForm.elm

@@ -16,6 +16,7 @@ import Messages.Basics
 import Messages.Comp.CalEventInput
 import Messages.Comp.ChannelForm
 import Messages.Comp.HttpError
+import Messages.Comp.TagDropdown
 import Messages.Data.ChannelType
 
 
@@ -24,6 +25,7 @@ type alias Texts =
     , calEventInput : Messages.Comp.CalEventInput.Texts
     , httpError : Http.Error -> String
     , channelForm : Messages.Comp.ChannelForm.Texts
+    , tagDropdown : Messages.Comp.TagDropdown.Texts
     , reallyDeleteTask : String
     , startOnce : String
     , startTaskNow : String
@@ -58,6 +60,7 @@ gb =
     , calEventInput = Messages.Comp.CalEventInput.gb
     , httpError = Messages.Comp.HttpError.gb
     , channelForm = Messages.Comp.ChannelForm.gb
+    , tagDropdown = Messages.Comp.TagDropdown.gb
     , reallyDeleteTask = "Really delete this notification task?"
     , startOnce = "Start Once"
     , startTaskNow = "Start this task now"
@@ -96,6 +99,7 @@ de =
     , calEventInput = Messages.Comp.CalEventInput.de
     , httpError = Messages.Comp.HttpError.de
     , channelForm = Messages.Comp.ChannelForm.gb
+    , tagDropdown = Messages.Comp.TagDropdown.gb
     , reallyDeleteTask = "Diesen Benachrichtigungsauftrag wirklich löschen?"
     , startOnce = "Jetzt starten"
     , startTaskNow = "Starte den Auftrag sofort"

modules/webapp/src/main/elm/Messages/Comp/ItemDetail/EditForm.elm

@@ -14,6 +14,7 @@ module Messages.Comp.ItemDetail.EditForm exposing
 import Data.Direction exposing (Direction)
 import Messages.Basics
 import Messages.Comp.CustomFieldMultiInput
+import Messages.Comp.TagDropdown
 import Messages.Data.Direction
 import Messages.DateFormat as DF
 import Messages.UiLanguage
@@ -22,6 +23,7 @@ import Messages.UiLanguage
 type alias Texts =
     { basics : Messages.Basics.Texts
     , customFieldInput : Messages.Comp.CustomFieldMultiInput.Texts
+    , tagDropdown : Messages.Comp.TagDropdown.Texts
     , createNewCustomField : String
     , chooseDirection : String
     , dueDateTab : String
@@ -45,6 +47,7 @@ gb : Texts
 gb =
     { basics = Messages.Basics.gb
     , customFieldInput = Messages.Comp.CustomFieldMultiInput.gb
+    , tagDropdown = Messages.Comp.TagDropdown.gb
     , createNewCustomField = "Create new custom field"
     , chooseDirection = "Choose a direction…"
     , dueDateTab = "Due Date"
@@ -68,6 +71,7 @@ de : Texts
 de =
     { basics = Messages.Basics.de
     , customFieldInput = Messages.Comp.CustomFieldMultiInput.de
+    , tagDropdown = Messages.Comp.TagDropdown.de
     , createNewCustomField = "Erstelle neues Benutzerfeld"
     , chooseDirection = "Wähle Richtung…"
     , dueDateTab = "Fälligkeitsdatum"

modules/webapp/src/main/elm/Messages/Comp/ItemDetail/MultiEditMenu.elm

@@ -14,12 +14,14 @@ module Messages.Comp.ItemDetail.MultiEditMenu exposing
 import Data.Direction exposing (Direction)
 import Messages.Basics
 import Messages.Comp.CustomFieldMultiInput
+import Messages.Comp.TagDropdown
 import Messages.Data.Direction
 
 
 type alias Texts =
     { basics : Messages.Basics.Texts
     , customFieldMultiInput : Messages.Comp.CustomFieldMultiInput.Texts
+    , tagDropdown : Messages.Comp.TagDropdown.Texts
     , tagModeAddInfo : String
     , tagModeRemoveInfo : String
     , tagModeReplaceInfo : String
@@ -37,6 +39,7 @@ gb : Texts
 gb =
     { basics = Messages.Basics.gb
     , customFieldMultiInput = Messages.Comp.CustomFieldMultiInput.gb
+    , tagDropdown = Messages.Comp.TagDropdown.gb
     , tagModeAddInfo = "Tags chosen here are *added* to all selected items."
     , tagModeRemoveInfo = "Tags chosen here are *removed* from all selected items."
     , tagModeReplaceInfo = "Tags chosen here *replace* those on selected items."
@@ -54,6 +57,7 @@ de : Texts
 de =
     { basics = Messages.Basics.de
     , customFieldMultiInput = Messages.Comp.CustomFieldMultiInput.de
+    , tagDropdown = Messages.Comp.TagDropdown.de
     , tagModeAddInfo = "Tags werden zu gewählten Dokumenten *hinzugefügt*."
     , tagModeRemoveInfo = "Tags werden von gewählten Dokumenten *entfernt*."
     , tagModeReplaceInfo = "Tags *ersetzen* die der gewählten Dokumente."

modules/webapp/src/main/elm/Messages/Comp/ScanMailboxForm.elm

@@ -15,12 +15,14 @@ import Http
 import Messages.Basics
 import Messages.Comp.CalEventInput
 import Messages.Comp.HttpError
+import Messages.Comp.TagDropdown
 
 
 type alias Texts =
     { basics : Messages.Basics.Texts
     , calEventInput : Messages.Comp.CalEventInput.Texts
     , httpError : Http.Error -> String
+    , tagDropdown : Messages.Comp.TagDropdown.Texts
     , reallyDeleteTask : String
     , startOnce : String
     , startNow : String
@@ -83,6 +85,7 @@ gb =
     { basics = Messages.Basics.gb
     , calEventInput = Messages.Comp.CalEventInput.gb
     , httpError = Messages.Comp.HttpError.gb
+    , tagDropdown = Messages.Comp.TagDropdown.gb
     , reallyDeleteTask = "Really delete this scan mailbox task?"
     , startOnce = "Start Once"
     , startNow = "Start this task now"
@@ -167,6 +170,7 @@ de =
     { basics = Messages.Basics.de
     , calEventInput = Messages.Comp.CalEventInput.de
     , httpError = Messages.Comp.HttpError.de
+    , tagDropdown = Messages.Comp.TagDropdown.de
     , reallyDeleteTask = "Den Auftrag wirklich löschen?"
     , startOnce = "Jetzt starten"
     , startNow = "Den Auftrag sofort starten"

modules/webapp/src/main/elm/Messages/Comp/SourceForm.elm

@@ -13,11 +13,13 @@ module Messages.Comp.SourceForm exposing
 
 import Data.Language exposing (Language)
 import Messages.Basics
+import Messages.Comp.TagDropdown
 import Messages.Data.Language
 
 
 type alias Texts =
     { basics : Messages.Basics.Texts
+    , tagDropdown : Messages.Comp.TagDropdown.Texts
     , description : String
     , enabled : String
     , priority : String
@@ -38,6 +40,7 @@ type alias Texts =
 gb : Texts
 gb =
     { basics = Messages.Basics.gb
+    , tagDropdown = Messages.Comp.TagDropdown.gb
     , description = "Description"
     , enabled = "Enabled"
     , priority = "Priority"
@@ -69,6 +72,7 @@ Specify a file glob to filter files when uploading archives
 de : Texts
 de =
     { basics = Messages.Basics.de
+    , tagDropdown = Messages.Comp.TagDropdown.de
     , description = "Beschreibung"
     , enabled = "Aktiviert"
     , priority = "Priorität"

modules/webapp/src/main/elm/Messages/Comp/TagDropdown.elm

@@ -0,0 +1,37 @@
+{-
+   Copyright 2020 Eike K. & Contributors
+
+   SPDX-License-Identifier: AGPL-3.0-or-later
+-}
+
+
+module Messages.Comp.TagDropdown exposing
+    ( Texts
+    , de
+    , gb
+    )
+
+import Messages.Basics
+
+
+type alias Texts =
+    { basics : Messages.Basics.Texts
+    , placeholder : String
+    , noCategory : String
+    }
+
+
+gb : Texts
+gb =
+    { basics = Messages.Basics.gb
+    , placeholder = "Search…"
+    , noCategory = "No category"
+    }
+
+
+de : Texts
+de =
+    { basics = Messages.Basics.de
+    , placeholder = "Suche…"
+    , noCategory = "Keine Kategorie"
+    }

modules/webapp/src/main/elm/Util/Tag.elm

@@ -9,41 +9,14 @@ module Util.Tag exposing
     ( catSettings
     , getCategories
     , makeCatDropdownModel
-    , makeDropdownModel
-    , tagSettings
     )
 
 import Api.Model.Tag exposing (Tag)
 import Comp.Dropdown
 import Data.DropdownStyle as DS
-import Data.UiSettings
 import Util.List
 
 
-makeDropdownModel : Comp.Dropdown.Model Tag
-makeDropdownModel =
-    let
-        init =
-            Comp.Dropdown.makeModel
-                { multiple = True
-                , searchable = \n -> n > 0
-                }
-    in
-    { init | searchWithAdditional = True }
-
-
-tagSettings : String -> DS.DropdownStyle -> Comp.Dropdown.ViewSettings Tag
-tagSettings placeholder ds =
-    { makeOption = \tag -> { text = tag.name, additional = Maybe.withDefault "" tag.category }
-    , labelColor =
-        \tag ->
-            \settings ->
-                Data.UiSettings.tagColorString2 tag settings
-    , placeholder = placeholder
-    , style = ds
-    }
-
-
 makeCatDropdownModel : Comp.Dropdown.Model String
 makeCatDropdownModel =
     Comp.Dropdown.makeModel