Add quick-select for tag categories above dropdown

Closes: #960

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

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

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

@@ -1,3 +1,10 @@
+{-
+   Copyright 2020 Eike K. & Contributors
+
+   SPDX-License-Identifier: AGPL-3.0-or-later
+-}
+
+
 module Comp.TagDropdown exposing
     ( Model
     , Msg
@@ -20,25 +27,31 @@ import Data.DropdownStyle exposing (DropdownStyle)
 import Data.Flags exposing (Flags)
 import Data.TagOrder
 import Data.UiSettings exposing (UiSettings)
-import Html exposing (Html)
+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
     }
 
 
@@ -70,7 +83,7 @@ getSelected model =
 
 setOptions : List Tag -> Msg
 setOptions tags =
-    DropdownMsg (Comp.Dropdown.SetOptions tags)
+    GetTagsResp (TagList 0 tags)
 
 
 setSelected : List Tag -> Msg
@@ -88,6 +101,11 @@ isChangeMsg msg =
             False
 
 
+isConstrained : Model -> String -> Bool
+isConstrained model category =
+    model.constrainedCat == Just category
+
+
 
 --- api
 
@@ -109,7 +127,17 @@ update msg model =
                 ( dm, dc ) =
                     Comp.Dropdown.update lm model.ddm
             in
-            ( { model | ddm = dm }, Cmd.map DropdownMsg dc )
+            ( { model
+                | ddm = dm
+                , constrainedCat =
+                    if isChangeMsg msg then
+                        Nothing
+
+                    else
+                        model.constrainedCat
+              }
+            , Cmd.map DropdownMsg dc
+            )
 
         GetTagsResp list ->
             let
@@ -121,6 +149,24 @@ update msg model =
             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
@@ -132,7 +178,62 @@ view texts settings dds model =
         viewSettings =
             tagSettings texts.placeholder dds
     in
-    Html.map DropdownMsg (Comp.Dropdown.view2 viewSettings settings model.ddm)
+    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)
 
 
 

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/TagDropdown.elm

@@ -17,6 +17,7 @@ import Messages.Basics
 type alias Texts =
     { basics : Messages.Basics.Texts
     , placeholder : String
+    , noCategory : String
     }
 
 
@@ -24,6 +25,7 @@ gb : Texts
 gb =
     { basics = Messages.Basics.gb
     , placeholder = "Search…"
+    , noCategory = "No category"
     }
 
 
@@ -31,4 +33,5 @@ de : Texts
 de =
     { basics = Messages.Basics.de
     , placeholder = "Suche…"
+    , noCategory = "Keine Kategorie"
     }