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

module Comp.ClassifierSettingsForm exposing
    ( Model
    , Msg
    , getSettings
    , init
    , update
    , view
    , view2
    )

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.DropdownStyle as DS
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 Http
import Markdown
import Styles as S
import Util.Tag


type alias 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
    | 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 )
init flags sett =
    let
        newSchedule =
            Data.CalEvent.fromEvent sett.schedule
                |> Maybe.withDefault Data.CalEvent.everyMonth

        ( cem, cec ) =
            Comp.CalEventInput.init flags newSchedule
    in
    ( { 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.batch
        [ Api.getTags flags "" GetTagsResp
        , Cmd.map ScheduleMsg cec
        ]
    )


getSettings : Model -> Validated ClassifierSetting
getSettings model =
    Data.Validated.map
        (\sch ->
            { 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


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 ) =
                    Comp.CalEventInput.update
                        flags
                        (Data.Validated.value model.schedule)
                        lmsg
                        model.scheduleModel
            in
            ( { model
                | scheduleModel = cm
                , schedule = ce
              }
            , Cmd.map ScheduleMsg cc
            )

        ItemCountMsg lmsg ->
            let
                ( im, iv ) =
                    Comp.IntField.update lmsg model.itemCountModel
            in
            ( { model
                | itemCountModel = im
                , itemCount = iv
              }
            , Cmd.none
            )

        CategoryListMsg lm ->
            let
                ( m_, cmd_ ) =
                    Comp.Dropdown.update lm model.categoryListModel
            in
            ( { model | categoryListModel = m_ }
            , Cmd.map CategoryListMsg cmd_
            )

        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


view : UiSettings -> Model -> Html Msg
view settings model =
    let
        catListTypeItem =
            Comp.FixedDropdown.Item
                model.categoryListType
                (Data.ListType.label model.categoryListType)
    in
    div []
        [ 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 "field" ]
            [ label []
                [ case model.categoryListType of
                    Data.ListType.Whitelist ->
                        text "Include tag categories for learning"

                    Data.ListType.Blacklist ->
                        text "Exclude tag categories from learning"
                ]
            , Html.map CategoryListMsg
                (Comp.Dropdown.view settings model.categoryListModel)
            ]
        , Html.map ItemCountMsg
            (Comp.IntField.viewWithInfo
                "The maximum number of items to learn from, order by date newest first. Use 0 to mean all."
                model.itemCount
                "field"
                model.itemCountModel
            )
        , div [ class "field" ]
            [ label [] [ text "Schedule" ]
            , Html.map ScheduleMsg
                (Comp.CalEventInput.view "" (Data.Validated.value model.schedule) model.scheduleModel)
            ]
        ]



--- View2


view2 : UiSettings -> Model -> Html Msg
view2 settings model =
    let
        catListTypeItem =
            Comp.FixedDropdown.Item
                model.categoryListType
                (Data.ListType.label model.categoryListType)
    in
    div []
        [ Markdown.toHtml [ class "px-2 py-2 opacity-75" ]
            """

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 "mb-4" ]
            [ label [ class S.inputLabel ]
                [ text "Is the following a blacklist or whitelist?" ]
            , Html.map CategoryListTypeMsg
                (Comp.FixedDropdown.view2 (Just catListTypeItem) model.categoryListTypeModel)
            ]
        , div [ class "mb-4" ]
            [ label [ class S.inputLabel ]
                [ case model.categoryListType of
                    Data.ListType.Whitelist ->
                        text "Include tag categories for learning"

                    Data.ListType.Blacklist ->
                        text "Exclude tag categories from learning"
                ]
            , Html.map CategoryListMsg
                (Comp.Dropdown.view2
                    DS.mainStyle
                    settings
                    model.categoryListModel
                )
            ]
        , Html.map ItemCountMsg
            (Comp.IntField.viewWithInfo2
                "The maximum number of items to learn from, order by date newest first. Use 0 to mean all."
                model.itemCount
                "mb-4"
                model.itemCountModel
            )
        , div [ class "mb-4" ]
            [ label [ class S.inputLabel ]
                [ text "Schedule" ]
            , Html.map ScheduleMsg
                (Comp.CalEventInput.view2 "" (Data.Validated.value model.schedule) model.scheduleModel)
            ]
        ]