mirror of
https://github.com/TheAnachronism/docspell.git
synced 2025-06-22 02:18:26 +00:00
Add classifier settings
This commit is contained in:
Eike Kettner
@ -218,12 +218,12 @@ loginInfo model =
|
||||
, menuEntry model
|
||||
CollectiveSettingPage
|
||||
[ i [ class "users circle icon" ] []
|
||||
, text "Collective Settings"
|
||||
, text "Collective Profile"
|
||||
]
|
||||
, menuEntry model
|
||||
UserSettingPage
|
||||
[ i [ class "user circle icon" ] []
|
||||
, text "User Settings"
|
||||
, text "User Profile"
|
||||
]
|
||||
, div [ class "divider" ] []
|
||||
, menuEntry model
|
||||
|
||||
199
modules/webapp/src/main/elm/Comp/ClassifierSettingsForm.elm
Normal file
199
modules/webapp/src/main/elm/Comp/ClassifierSettingsForm.elm
Normal file
@ -0,0 +1,199 @@
|
||||
module Comp.ClassifierSettingsForm exposing
|
||||
( Model
|
||||
, Msg
|
||||
, getSettings
|
||||
, init
|
||||
, update
|
||||
, view
|
||||
)
|
||||
|
||||
import Api
|
||||
import Api.Model.ClassifierSetting exposing (ClassifierSetting)
|
||||
import Api.Model.TagList exposing (TagList)
|
||||
import Comp.CalEventInput
|
||||
import Comp.FixedDropdown
|
||||
import Comp.IntField
|
||||
import Data.CalEvent exposing (CalEvent)
|
||||
import Data.Flags exposing (Flags)
|
||||
import Data.Validated exposing (Validated(..))
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onCheck)
|
||||
import Http
|
||||
import Util.Tag
|
||||
|
||||
|
||||
type alias Model =
|
||||
{ enabled : Bool
|
||||
, categoryModel : Comp.FixedDropdown.Model String
|
||||
, category : Maybe String
|
||||
, scheduleModel : Comp.CalEventInput.Model
|
||||
, schedule : Validated CalEvent
|
||||
, itemCountModel : Comp.IntField.Model
|
||||
, itemCount : Maybe Int
|
||||
}
|
||||
|
||||
|
||||
type Msg
|
||||
= GetTagsResp (Result Http.Error TagList)
|
||||
| ScheduleMsg Comp.CalEventInput.Msg
|
||||
| ToggleEnabled
|
||||
| CategoryMsg (Comp.FixedDropdown.Msg String)
|
||||
| ItemCountMsg Comp.IntField.Msg
|
||||
|
||||
|
||||
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
|
||||
( { enabled = sett.enabled
|
||||
, categoryModel = Comp.FixedDropdown.initString []
|
||||
, category = Nothing
|
||||
, scheduleModel = cem
|
||||
, schedule = Data.Validated.Unknown newSchedule
|
||||
, itemCountModel = Comp.IntField.init (Just 0) Nothing True "Item Count"
|
||||
, itemCount = Just sett.itemCount
|
||||
}
|
||||
, Cmd.batch
|
||||
[ Api.getTags flags "" GetTagsResp
|
||||
, Cmd.map ScheduleMsg cec
|
||||
]
|
||||
)
|
||||
|
||||
|
||||
getSettings : Model -> Validated ClassifierSetting
|
||||
getSettings model =
|
||||
Data.Validated.map
|
||||
(\sch ->
|
||||
{ enabled = model.enabled
|
||||
, category = model.category
|
||||
, schedule =
|
||||
Data.CalEvent.makeEvent sch
|
||||
, itemCount = Maybe.withDefault 0 model.itemCount
|
||||
}
|
||||
)
|
||||
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
|
||||
in
|
||||
( { model
|
||||
| categoryModel = Comp.FixedDropdown.initString categories
|
||||
, category = List.head categories
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
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
|
||||
)
|
||||
|
||||
ToggleEnabled ->
|
||||
( { model | enabled = not model.enabled }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
CategoryMsg lmsg ->
|
||||
let
|
||||
( mm, ma ) =
|
||||
Comp.FixedDropdown.update lmsg model.categoryModel
|
||||
in
|
||||
( { model
|
||||
| categoryModel = mm
|
||||
, category =
|
||||
if ma == Nothing then
|
||||
model.category
|
||||
|
||||
else
|
||||
ma
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
ItemCountMsg lmsg ->
|
||||
let
|
||||
( im, iv ) =
|
||||
Comp.IntField.update lmsg model.itemCountModel
|
||||
in
|
||||
( { model
|
||||
| itemCountModel = im
|
||||
, itemCount = iv
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
|
||||
view : Model -> Html Msg
|
||||
view model =
|
||||
div []
|
||||
[ div
|
||||
[ class "field"
|
||||
]
|
||||
[ 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 "Category" ]
|
||||
, Html.map CategoryMsg
|
||||
(Comp.FixedDropdown.viewString model.category
|
||||
model.categoryModel
|
||||
)
|
||||
]
|
||||
, 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)
|
||||
]
|
||||
]
|
||||
@ -10,10 +10,12 @@ module Comp.CollectiveSettingsForm exposing
|
||||
import Api
|
||||
import Api.Model.BasicResult exposing (BasicResult)
|
||||
import Api.Model.CollectiveSettings exposing (CollectiveSettings)
|
||||
import Comp.ClassifierSettingsForm
|
||||
import Comp.Dropdown
|
||||
import Data.Flags exposing (Flags)
|
||||
import Data.Language exposing (Language)
|
||||
import Data.UiSettings exposing (UiSettings)
|
||||
import Data.Validated exposing (Validated)
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onCheck, onClick, onInput)
|
||||
@ -27,44 +29,58 @@ type alias Model =
|
||||
, initSettings : CollectiveSettings
|
||||
, fullTextConfirmText : String
|
||||
, fullTextReIndexResult : Maybe BasicResult
|
||||
, classifierModel : Comp.ClassifierSettingsForm.Model
|
||||
}
|
||||
|
||||
|
||||
init : CollectiveSettings -> Model
|
||||
init settings =
|
||||
init : Flags -> CollectiveSettings -> ( Model, Cmd Msg )
|
||||
init flags settings =
|
||||
let
|
||||
lang =
|
||||
Data.Language.fromString settings.language
|
||||
|> Maybe.withDefault Data.Language.German
|
||||
|
||||
( cm, cc ) =
|
||||
Comp.ClassifierSettingsForm.init flags settings.classifier
|
||||
in
|
||||
{ langModel =
|
||||
Comp.Dropdown.makeSingleList
|
||||
{ makeOption =
|
||||
\l ->
|
||||
{ value = Data.Language.toIso3 l
|
||||
, text = Data.Language.toName l
|
||||
, additional = ""
|
||||
}
|
||||
, placeholder = ""
|
||||
, options = Data.Language.all
|
||||
, selected = Just lang
|
||||
}
|
||||
, intEnabled = settings.integrationEnabled
|
||||
, initSettings = settings
|
||||
, fullTextConfirmText = ""
|
||||
, fullTextReIndexResult = Nothing
|
||||
}
|
||||
( { langModel =
|
||||
Comp.Dropdown.makeSingleList
|
||||
{ makeOption =
|
||||
\l ->
|
||||
{ value = Data.Language.toIso3 l
|
||||
, text = Data.Language.toName l
|
||||
, additional = ""
|
||||
}
|
||||
, placeholder = ""
|
||||
, options = Data.Language.all
|
||||
, selected = Just lang
|
||||
}
|
||||
, intEnabled = settings.integrationEnabled
|
||||
, initSettings = settings
|
||||
, fullTextConfirmText = ""
|
||||
, fullTextReIndexResult = Nothing
|
||||
, classifierModel = cm
|
||||
}
|
||||
, Cmd.map ClassifierSettingMsg cc
|
||||
)
|
||||
|
||||
|
||||
getSettings : Model -> CollectiveSettings
|
||||
getSettings : Model -> Validated CollectiveSettings
|
||||
getSettings model =
|
||||
CollectiveSettings
|
||||
(Comp.Dropdown.getSelected model.langModel
|
||||
|> List.head
|
||||
|> Maybe.map Data.Language.toIso3
|
||||
|> Maybe.withDefault model.initSettings.language
|
||||
Data.Validated.map
|
||||
(\cls ->
|
||||
{ language =
|
||||
Comp.Dropdown.getSelected model.langModel
|
||||
|> List.head
|
||||
|> Maybe.map Data.Language.toIso3
|
||||
|> Maybe.withDefault model.initSettings.language
|
||||
, integrationEnabled = model.intEnabled
|
||||
, classifier = cls
|
||||
}
|
||||
)
|
||||
(Comp.ClassifierSettingsForm.getSettings
|
||||
model.classifierModel
|
||||
)
|
||||
model.intEnabled
|
||||
|
||||
|
||||
type Msg
|
||||
@ -73,6 +89,8 @@ type Msg
|
||||
| SetFullTextConfirm String
|
||||
| TriggerReIndex
|
||||
| TriggerReIndexResult (Result Http.Error BasicResult)
|
||||
| ClassifierSettingMsg Comp.ClassifierSettingsForm.Msg
|
||||
| SaveSettings
|
||||
|
||||
|
||||
update : Flags -> Msg -> Model -> ( Model, Cmd Msg, Maybe CollectiveSettings )
|
||||
@ -85,22 +103,15 @@ update flags msg model =
|
||||
|
||||
nextModel =
|
||||
{ model | langModel = m2 }
|
||||
|
||||
nextSettings =
|
||||
if Comp.Dropdown.isDropdownChangeMsg m then
|
||||
Just (getSettings nextModel)
|
||||
|
||||
else
|
||||
Nothing
|
||||
in
|
||||
( nextModel, Cmd.map LangDropdownMsg c2, nextSettings )
|
||||
( nextModel, Cmd.map LangDropdownMsg c2, Nothing )
|
||||
|
||||
ToggleIntegrationEndpoint ->
|
||||
let
|
||||
nextModel =
|
||||
{ model | intEnabled = not model.intEnabled }
|
||||
in
|
||||
( nextModel, Cmd.none, Just (getSettings nextModel) )
|
||||
( nextModel, Cmd.none, Nothing )
|
||||
|
||||
SetFullTextConfirm str ->
|
||||
( { model | fullTextConfirmText = str }, Cmd.none, Nothing )
|
||||
@ -138,6 +149,26 @@ update flags msg model =
|
||||
, Nothing
|
||||
)
|
||||
|
||||
ClassifierSettingMsg lmsg ->
|
||||
let
|
||||
( cm, cc ) =
|
||||
Comp.ClassifierSettingsForm.update flags lmsg model.classifierModel
|
||||
in
|
||||
( { model
|
||||
| classifierModel = cm
|
||||
}
|
||||
, Cmd.map ClassifierSettingMsg cc
|
||||
, Nothing
|
||||
)
|
||||
|
||||
SaveSettings ->
|
||||
case getSettings model of
|
||||
Data.Validated.Valid s ->
|
||||
( model, Cmd.none, Just s )
|
||||
|
||||
_ ->
|
||||
( model, Cmd.none, Nothing )
|
||||
|
||||
|
||||
view : Flags -> UiSettings -> Model -> Html Msg
|
||||
view flags settings model =
|
||||
@ -232,4 +263,31 @@ view flags settings model =
|
||||
|> text
|
||||
]
|
||||
]
|
||||
, h3
|
||||
[ classList
|
||||
[ ( "ui dividing header", True )
|
||||
, ( "invisible hidden", False )
|
||||
]
|
||||
]
|
||||
[ text "Document Classifier"
|
||||
]
|
||||
, div
|
||||
[ classList
|
||||
[ ( "field", True )
|
||||
, ( "invisible hidden", False )
|
||||
]
|
||||
]
|
||||
[ Html.map ClassifierSettingMsg
|
||||
(Comp.ClassifierSettingsForm.view model.classifierModel)
|
||||
]
|
||||
, div [ class "ui divider" ] []
|
||||
, button
|
||||
[ classList
|
||||
[ ( "ui primary button", True )
|
||||
, ( "disabled", getSettings model |> Data.Validated.isInvalid )
|
||||
]
|
||||
, onClick SaveSettings
|
||||
]
|
||||
[ text "Save"
|
||||
]
|
||||
]
|
||||
|
||||
@ -1,5 +1,6 @@
|
||||
module Data.Validated exposing
|
||||
( Validated(..)
|
||||
, isInvalid
|
||||
, map
|
||||
, map2
|
||||
, map3
|
||||
@ -14,6 +15,19 @@ type Validated a
|
||||
| Unknown a
|
||||
|
||||
|
||||
isInvalid : Validated a -> Bool
|
||||
isInvalid v =
|
||||
case v of
|
||||
Valid _ ->
|
||||
False
|
||||
|
||||
Invalid _ _ ->
|
||||
True
|
||||
|
||||
Unknown _ ->
|
||||
False
|
||||
|
||||
|
||||
value : Validated a -> a
|
||||
value va =
|
||||
case va of
|
||||
|
||||
@ -30,15 +30,21 @@ init flags =
|
||||
let
|
||||
( sm, sc ) =
|
||||
Comp.SourceManage.init flags
|
||||
|
||||
( cm, cc ) =
|
||||
Comp.CollectiveSettingsForm.init flags Api.Model.CollectiveSettings.empty
|
||||
in
|
||||
( { currentTab = Just InsightsTab
|
||||
, sourceModel = sm
|
||||
, userModel = Comp.UserManage.emptyModel
|
||||
, settingsModel = Comp.CollectiveSettingsForm.init Api.Model.CollectiveSettings.empty
|
||||
, settingsModel = cm
|
||||
, insights = Api.Model.ItemInsights.empty
|
||||
, submitResult = Nothing
|
||||
}
|
||||
, Cmd.map SourceMsg sc
|
||||
, Cmd.batch
|
||||
[ Cmd.map SourceMsg sc
|
||||
, Cmd.map SettingsFormMsg cc
|
||||
]
|
||||
)
|
||||
|
||||
|
||||
|
||||
@ -77,7 +77,13 @@ update flags msg model =
|
||||
( model, Cmd.none )
|
||||
|
||||
CollectiveSettingsResp (Ok data) ->
|
||||
( { model | settingsModel = Comp.CollectiveSettingsForm.init data }, Cmd.none )
|
||||
let
|
||||
( cm, cc ) =
|
||||
Comp.CollectiveSettingsForm.init flags data
|
||||
in
|
||||
( { model | settingsModel = cm }
|
||||
, Cmd.map SettingsFormMsg cc
|
||||
)
|
||||
|
||||
CollectiveSettingsResp (Err _) ->
|
||||
( model, Cmd.none )
|
||||
|
||||
@ -185,10 +185,11 @@ viewSettings : Flags -> UiSettings -> Model -> List (Html Msg)
|
||||
viewSettings flags settings model =
|
||||
[ h2 [ class "ui header" ]
|
||||
[ i [ class "cog icon" ] []
|
||||
, text "Settings"
|
||||
, text "Collective Settings"
|
||||
]
|
||||
, div [ class "ui segment" ]
|
||||
[ Html.map SettingsFormMsg (Comp.CollectiveSettingsForm.view flags settings model.settingsModel)
|
||||
[ Html.map SettingsFormMsg
|
||||
(Comp.CollectiveSettingsForm.view flags settings model.settingsModel)
|
||||
]
|
||||
, div
|
||||
[ classList
|
||||
|
||||
Reference in New Issue
Block a user