Control what tag categories to use for auto-tagging

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

@@ -11,31 +11,38 @@ import Api
 import Api.Model.ClassifierSetting exposing (ClassifierSetting)
 import Api.Model.TagList exposing (TagList)
 import Comp.CalEventInput
+import Comp.Dropdown
 import Comp.FixedDropdown
 import Comp.IntField
 import Data.CalEvent exposing (CalEvent)
 import Data.Flags exposing (Flags)
+import Data.ListType exposing (ListType)
+import Data.UiSettings exposing (UiSettings)
 import Data.Validated exposing (Validated(..))
 import Html exposing (..)
 import Html.Attributes exposing (..)
-import Html.Events exposing (onCheck)
 import Http
+import Markdown
 import Util.Tag
 
 
 type alias Model =
-    { enabled : Bool
-    , scheduleModel : Comp.CalEventInput.Model
+    { scheduleModel : Comp.CalEventInput.Model
     , schedule : Validated CalEvent
     , itemCountModel : Comp.IntField.Model
     , itemCount : Maybe Int
+    , categoryListModel : Comp.Dropdown.Model String
+    , categoryListType : ListType
+    , categoryListTypeModel : Comp.FixedDropdown.Model ListType
     }
 
 
 type Msg
     = ScheduleMsg Comp.CalEventInput.Msg
-    | ToggleEnabled
     | ItemCountMsg Comp.IntField.Msg
+    | GetTagsResp (Result Http.Error TagList)
+    | CategoryListMsg (Comp.Dropdown.Msg String)
+    | CategoryListTypeMsg (Comp.FixedDropdown.Msg ListType)
 
 
 init : Flags -> ClassifierSetting -> ( Model, Cmd Msg )
@@ -48,13 +55,41 @@ init flags sett =
         ( cem, cec ) =
             Comp.CalEventInput.init flags newSchedule
     in
-    ( { enabled = sett.enabled
-      , scheduleModel = cem
+    ( { scheduleModel = cem
       , schedule = Data.Validated.Unknown newSchedule
       , itemCountModel = Comp.IntField.init (Just 0) Nothing True "Item Count"
       , itemCount = Just sett.itemCount
+      , categoryListModel =
+            let
+                mkOption s =
+                    { value = s, text = s, additional = "" }
+
+                minit =
+                    Comp.Dropdown.makeModel
+                        { multiple = True
+                        , searchable = \n -> n > 0
+                        , makeOption = mkOption
+                        , labelColor = \_ -> \_ -> "grey "
+                        , placeholder = "Choose categories …"
+                        }
+
+                lm =
+                    Comp.Dropdown.SetSelection sett.categoryList
+
+                ( m_, _ ) =
+                    Comp.Dropdown.update lm minit
+            in
+            m_
+      , categoryListType =
+            Data.ListType.fromString sett.listType
+                |> Maybe.withDefault Data.ListType.Whitelist
+      , categoryListTypeModel =
+            Comp.FixedDropdown.initMap Data.ListType.label Data.ListType.all
       }
-    , Cmd.map ScheduleMsg cec
+    , Cmd.batch
+        [ Api.getTags flags "" GetTagsResp
+        , Cmd.map ScheduleMsg cec
+        ]
     )
 
 
@@ -62,10 +97,11 @@ getSettings : Model -> Validated ClassifierSetting
 getSettings model =
     Data.Validated.map
         (\sch ->
-            { enabled = model.enabled
-            , schedule =
+            { schedule =
                 Data.CalEvent.makeEvent sch
             , itemCount = Maybe.withDefault 0 model.itemCount
+            , listType = Data.ListType.toString model.categoryListType
+            , categoryList = Comp.Dropdown.getSelected model.categoryListModel
             }
         )
         model.schedule
@@ -74,6 +110,20 @@ getSettings model =
 update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
 update flags msg model =
     case msg of
+        GetTagsResp (Ok tl) ->
+            let
+                categories =
+                    Util.Tag.getCategories tl.items
+                        |> List.sort
+
+                lm =
+                    Comp.Dropdown.SetOptions categories
+            in
+            update flags (CategoryListMsg lm) model
+
+        GetTagsResp (Err _) ->
+            ( model, Cmd.none )
+
         ScheduleMsg lmsg ->
             let
                 ( cm, cc, ce ) =
@@ -90,11 +140,6 @@ update flags msg model =
             , Cmd.map ScheduleMsg cc
             )
 
-        ToggleEnabled ->
-            ( { model | enabled = not model.enabled }
-            , Cmd.none
-            )
-
         ItemCountMsg lmsg ->
             let
                 ( im, iv ) =
@@ -107,32 +152,61 @@ update flags msg model =
             , Cmd.none
             )
 
+        CategoryListMsg lm ->
+            let
+                ( m_, cmd_ ) =
+                    Comp.Dropdown.update lm model.categoryListModel
+            in
+            ( { model | categoryListModel = m_ }
+            , Cmd.map CategoryListMsg cmd_
+            )
 
-view : Model -> Html Msg
-view model =
+        CategoryListTypeMsg lm ->
+            let
+                ( m_, sel ) =
+                    Comp.FixedDropdown.update lm model.categoryListTypeModel
+
+                newListType =
+                    Maybe.withDefault model.categoryListType sel
+            in
+            ( { model
+                | categoryListTypeModel = m_
+                , categoryListType = newListType
+              }
+            , Cmd.none
+            )
+
+
+view : UiSettings -> Model -> Html Msg
+view settings model =
+    let
+        catListTypeItem =
+            Comp.FixedDropdown.Item
+                model.categoryListType
+                (Data.ListType.label model.categoryListType)
+    in
     div []
-        [ div
-            [ class "field"
+        [ Markdown.toHtml [ class "ui basic segment" ]
+            """
+
+Auto-tagging works by learning from existing documents. The more
+documents you have correctly tagged, the better. Learning is done
+periodically based on a schedule. You can specify tag-groups that
+should either be used (whitelist) or not used (blacklist) for
+learning.
+
+Use an empty whitelist to disable auto tagging.
+
+            """
+        , div [ class "field" ]
+            [ label [] [ text "Is the following a blacklist or whitelist?" ]
+            , Html.map CategoryListTypeMsg
+                (Comp.FixedDropdown.view (Just catListTypeItem) model.categoryListTypeModel)
             ]
-            [ div [ class "ui checkbox" ]
-                [ input
-                    [ type_ "checkbox"
-                    , onCheck (\_ -> ToggleEnabled)
-                    , checked model.enabled
-                    ]
-                    []
-                , label [] [ text "Enable classification" ]
-                , span [ class "small-info" ]
-                    [ text "Disable document classification if not needed."
-                    ]
-                ]
-            ]
-        , div [ class "ui basic segment" ]
-            [ text "Document classification tries to predict a tag for new incoming documents. This "
-            , text "works by learning from existing documents in order to find common patterns within "
-            , text "the text. The more documents you have correctly tagged, the better. Learning is done "
-            , text "periodically based on a schedule and you need to specify a tag-group that should "
-            , text "be used for learning."
+        , div [ class "field" ]
+            [ label [] [ text "Choose tag categories for learning" ]
+            , Html.map CategoryListMsg
+                (Comp.Dropdown.view settings model.categoryListModel)
             ]
         , Html.map ItemCountMsg
             (Comp.IntField.viewWithInfo

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

@@ -280,7 +280,7 @@ view flags settings model =
                 , ( "invisible hidden", not flags.config.showClassificationSettings )
                 ]
             ]
-            [ text "Document Classifier"
+            [ text "Auto-Tagging"
             ]
         , div
             [ classList
@@ -289,13 +289,10 @@ view flags settings model =
                 ]
             ]
             [ Html.map ClassifierSettingMsg
-                (Comp.ClassifierSettingsForm.view model.classifierModel)
+                (Comp.ClassifierSettingsForm.view settings model.classifierModel)
             , div [ class "ui vertical segment" ]
                 [ button
-                    [ classList
-                        [ ( "ui small secondary basic button", True )
-                        , ( "disabled", not model.classifierModel.enabled )
-                        ]
+                    [ class "ui small secondary basic button"
                     , title "Starts a task to train a classifier"
                     , onClick StartClassifierTask
                     ]

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

@@ -0,0 +1,50 @@
+module Data.ListType exposing
+    ( ListType(..)
+    , all
+    , fromString
+    , label
+    , toString
+    )
+
+
+type ListType
+    = Blacklist
+    | Whitelist
+
+
+all : List ListType
+all =
+    [ Blacklist, Whitelist ]
+
+
+toString : ListType -> String
+toString lt =
+    case lt of
+        Blacklist ->
+            "blacklist"
+
+        Whitelist ->
+            "whitelist"
+
+
+label : ListType -> String
+label lt =
+    case lt of
+        Blacklist ->
+            "Blacklist"
+
+        Whitelist ->
+            "Whitelist"
+
+
+fromString : String -> Maybe ListType
+fromString str =
+    case String.toLower str of
+        "blacklist" ->
+            Just Blacklist
+
+        "whitelist" ->
+            Just Whitelist
+
+        _ ->
+            Nothing