TheAnachronism/docspell
1
0
Fork 0
mirror of https://github.com/TheAnachronism/docspell.git synced 2025-06-06 15:15:58 +00:00
Code Issues Packages Projects Releases Wiki Activity

Refactor caleventinput field

Browse Source
This commit is contained in:
Eike Kettner 2021-04-26 18:28:16 +02:00
parent b2cffb22ef
commit a39dfbf82a
6 changed files with 139 additions and 99 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

131
modules/webapp/src/main/elm/Comp/CalEventInput.elm
View File

@ -2,7 +2,6 @@ module Comp.CalEventInput exposing
( Model ( Model
, Msg , Msg
, init , init
, initDefault
, update , update
, view2 , view2
) )
@ -19,12 +18,25 @@ import Html.Events exposing (onInput)
import Http import Http
import Messages.Comp.CalEventInput exposing (Texts) import Messages.Comp.CalEventInput exposing (Texts)
import Styles as S import Styles as S
import Util.Http
import Util.Maybe import Util.Maybe
type alias Model = type alias Model =
{ checkResult : Maybe CalEventCheckResult { checkResult : CheckResult
, inner : CalEvent
}
type CheckResult
= CheckResultOk EventData
| CheckResultFailed String
| CheckResultHttpError Http.Error
| CheckResultInitial
type alias EventData =
{ nextEvents : List Int
, eventString : Maybe String
} }
@ -38,14 +50,23 @@ type Msg
| CheckInputMsg CalEvent (Result Http.Error CalEventCheckResult) | CheckInputMsg CalEvent (Result Http.Error CalEventCheckResult)
initDefault : Model
initDefault =
Model Nothing
init : Flags -> CalEvent -> ( Model, Cmd Msg ) init : Flags -> CalEvent -> ( Model, Cmd Msg )
init flags ev = init flags ev =
( Model Nothing, checkInput flags ev ) ( { checkResult = CheckResultInitial
, inner = ev
}
, checkInput flags ev
)
eventData : Model -> Maybe EventData
eventData model =
case model.checkResult of
CheckResultOk data ->
Just data
_ ->
Nothing
checkInput : Flags -> CalEvent -> Cmd Msg checkInput : Flags -> CalEvent -> Cmd Msg
@ -60,20 +81,33 @@ checkInput flags ev =
Api.checkCalEvent flags input (CheckInputMsg ev) Api.checkCalEvent flags input (CheckInputMsg ev)
withCheckInput : Flags -> CalEvent -> Model -> ( Model, Cmd Msg, Validated CalEvent ) withCheckInput : Flags -> CalEvent -> Model -> ( Model, Cmd Msg, Maybe CalEvent )
withCheckInput flags ev model = withCheckInput flags ev model =
( model, checkInput flags ev, Unknown ev ) ( model, checkInput flags ev, Nothing )
isCheckError : Model -> Bool isCheckError : Model -> Bool
isCheckError model = isCheckError model =
Maybe.map .success model.checkResult case model.checkResult of
|> Maybe.withDefault True CheckResultOk _ ->
|> not False
CheckResultFailed _ ->
True
CheckResultHttpError _ ->
True
CheckResultInitial ->
False
update : Flags -> CalEvent -> Msg -> Model -> ( Model, Cmd Msg, Validated CalEvent ) update : Flags -> Maybe CalEvent -> Msg -> Model -> ( Model, Cmd Msg, Maybe CalEvent )
update flags ev msg model = update flags mev msg model =
let
ev =
Maybe.withDefault model.inner mev
in
case msg of case msg of
SetYear str -> SetYear str ->
withCheckInput flags { ev | year = str } model withCheckInput flags { ev | year = str } model
@ -96,42 +130,49 @@ update flags ev msg model =
CheckInputMsg event (Ok res) -> CheckInputMsg event (Ok res) ->
let let
m = m =
{ model | checkResult = Just res } { model
| checkResult =
if res.success then
CheckResultOk
{ nextEvents = res.next
, eventString = res.event
}
else
CheckResultFailed res.message
, inner = event
}
in in
( m ( m
, Cmd.none , Cmd.none
, if res.success then , if res.success then
Valid event Just event
else else
Invalid [ res.message ] event Nothing
) )
CheckInputMsg event (Err err) -> CheckInputMsg event (Err err) ->
let let
emptyResult =
Api.Model.CalEventCheckResult.empty
m = m =
{ model { model
| checkResult = | checkResult = CheckResultHttpError err
Just , inner = event
{ emptyResult
| success = False
, message = Util.Http.errorToString err
}
} }
in in
( m, Cmd.none, Unknown event ) ( m, Cmd.none, Nothing )
--- View2 --- View2
view2 : Texts -> String -> CalEvent -> Model -> Html Msg view2 : Texts -> String -> Maybe CalEvent -> Model -> Html Msg
view2 texts extraClasses ev model = view2 texts extraClasses mev model =
let let
ev =
Maybe.withDefault model.inner mev
yearLen = yearLen =
Basics.max 4 (String.length ev.year) Basics.max 4 (String.length ev.year)
@ -255,17 +296,21 @@ view2 texts extraClasses ev model =
, class S.errorMessage , class S.errorMessage
] ]
[ text (texts.error ++ ": ") [ text (texts.error ++ ": ")
, Maybe.map .message model.checkResult , case model.checkResult of
|> Maybe.withDefault "" CheckResultOk _ ->
|> text text ""
CheckResultFailed str ->
text str
CheckResultHttpError err ->
text (texts.httpError err)
CheckResultInitial ->
text ""
] ]
, div , div
[ classList [ class "px-2 pt-4 pb-2 border-0 border-l border-b border-r bg-gray-50 dark:bg-bluegray-700"
[ ( "hidden1"
, model.checkResult == Nothing || isCheckError model
)
]
, class "px-2 pt-4 pb-2 border-0 border-l border-b border-r bg-gray-50 dark:bg-bluegray-700"
, class S.border , class S.border
] ]
[ div [] [ div []
@ -273,7 +318,8 @@ view2 texts extraClasses ev model =
[ text (texts.schedule ++ ": ") [ text (texts.schedule ++ ": ")
] ]
, div [ class "px-12 font-mono " ] , div [ class "px-12 font-mono " ]
[ Maybe.andThen .event model.checkResult [ eventData model
|> Maybe.andThen .eventString
|> Maybe.withDefault "" |> Maybe.withDefault ""
|> text |> text
] ]
@ -281,7 +327,8 @@ view2 texts extraClasses ev model =
[ text (texts.next ++ ": ") [ text (texts.next ++ ": ")
] ]
, ul [ class "list-decimal list-inside text-sm" ] , ul [ class "list-decimal list-inside text-sm" ]
(Maybe.map .next model.checkResult (eventData model
|> Maybe.map .nextEvents
|> Maybe.withDefault [] |> Maybe.withDefault []
|> List.map texts.formatDateTime |> List.map texts.formatDateTime
|> List.map (\s -> li [ class "" ] [ text s ]) |> List.map (\s -> li [ class "" ] [ text s ])

17
modules/webapp/src/main/elm/Comp/ClassifierSettingsForm.elm
View File

@ -19,7 +19,6 @@ import Data.DropdownStyle as DS
import Data.Flags exposing (Flags) import Data.Flags exposing (Flags)
import Data.ListType exposing (ListType) import Data.ListType exposing (ListType)
import Data.UiSettings exposing (UiSettings) import Data.UiSettings exposing (UiSettings)
import Data.Validated exposing (Validated(..))
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Http import Http
@ -31,7 +30,7 @@ import Util.Tag
type alias Model = type alias Model =
{ scheduleModel : Comp.CalEventInput.Model { scheduleModel : Comp.CalEventInput.Model
, schedule : Validated CalEvent , schedule : Maybe CalEvent
, itemCountModel : Comp.IntField.Model , itemCountModel : Comp.IntField.Model
, itemCount : Maybe Int , itemCount : Maybe Int
, categoryListModel : Comp.Dropdown.Model String , categoryListModel : Comp.Dropdown.Model String
@ -59,7 +58,7 @@ init flags sett =
Comp.CalEventInput.init flags newSchedule Comp.CalEventInput.init flags newSchedule
in in
( { scheduleModel = cem ( { scheduleModel = cem
, schedule = Data.Validated.Unknown newSchedule , schedule = Just newSchedule
, itemCountModel = Comp.IntField.init (Just 0) Nothing True , itemCountModel = Comp.IntField.init (Just 0) Nothing True
, itemCount = Just sett.itemCount , itemCount = Just sett.itemCount
, categoryListModel = , categoryListModel =
@ -90,12 +89,12 @@ init flags sett =
) )
getSettings : Model -> Validated ClassifierSetting getSettings : Model -> Maybe ClassifierSetting
getSettings model = getSettings model =
Data.Validated.map Maybe.map
(\sch -> (\s ->
{ schedule = { schedule =
Data.CalEvent.makeEvent sch Data.CalEvent.makeEvent s
, itemCount = Maybe.withDefault 0 model.itemCount , itemCount = Maybe.withDefault 0 model.itemCount
, listType = Data.ListType.toString model.categoryListType , listType = Data.ListType.toString model.categoryListType
, categoryList = Comp.Dropdown.getSelected model.categoryListModel , categoryList = Comp.Dropdown.getSelected model.categoryListModel
@ -126,7 +125,7 @@ update flags msg model =
( cm, cc, ce ) = ( cm, cc, ce ) =
Comp.CalEventInput.update Comp.CalEventInput.update
flags flags
(Data.Validated.value model.schedule) model.schedule
lmsg lmsg
model.scheduleModel model.scheduleModel
in in
@ -240,7 +239,7 @@ view2 texts settings model =
(Comp.CalEventInput.view2 (Comp.CalEventInput.view2
texts.calEventInput texts.calEventInput
"" ""
(Data.Validated.value model.schedule) model.schedule
model.scheduleModel model.scheduleModel
) )
] ]

13
modules/webapp/src/main/elm/Comp/CollectiveSettingsForm.elm
View File

@ -18,7 +18,6 @@ import Data.DropdownStyle as DS
import Data.Flags exposing (Flags) import Data.Flags exposing (Flags)
import Data.Language exposing (Language) import Data.Language exposing (Language)
import Data.UiSettings exposing (UiSettings) import Data.UiSettings exposing (UiSettings)
import Data.Validated exposing (Validated)
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onCheck, onClick, onInput) import Html.Events exposing (onCheck, onClick, onInput)
@ -79,9 +78,9 @@ init flags settings =
) )
getSettings : Model -> Validated CollectiveSettings getSettings : Model -> Maybe CollectiveSettings
getSettings model = getSettings model =
Data.Validated.map Maybe.map
(\cls -> (\cls ->
{ language = { language =
Comp.Dropdown.getSelected model.langModel Comp.Dropdown.getSelected model.langModel
@ -184,10 +183,10 @@ update flags msg model =
SaveSettings -> SaveSettings ->
case getSettings model of case getSettings model of
Data.Validated.Valid s -> Just s ->
( model, Cmd.none, Just s ) ( model, Cmd.none, Just s )
_ -> Nothing ->
( model, Cmd.none, Nothing ) ( model, Cmd.none, Nothing )
StartClassifierTask -> StartClassifierTask ->
@ -245,7 +244,7 @@ view2 flags texts settings model =
[ title texts.saveSettings [ title texts.saveSettings
, href "#" , href "#"
] ]
, disabled = getSettings model |> Data.Validated.isInvalid , disabled = getSettings model == Nothing
} }
] ]
, end = [] , end = []
@ -358,7 +357,7 @@ view2 flags texts settings model =
{ handler = onClick StartClassifierTask { handler = onClick StartClassifierTask
, icon = "fa fa-play" , icon = "fa fa-play"
, label = texts.startNow , label = texts.startNow
, disabled = Data.Validated.isInvalid model.classifierModel.schedule , disabled = model.classifierModel.schedule == Nothing
, attrs = [ href "#" ] , attrs = [ href "#" ]
} }
, renderClassifierResultMessage texts model.startClassifierResult , renderClassifierResultMessage texts model.startClassifierResult

37
modules/webapp/src/main/elm/Comp/NotificationForm.elm
View File

@ -9,7 +9,6 @@ module Comp.NotificationForm exposing
) )
import Api import Api
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.EmailSettingsList exposing (EmailSettingsList) import Api.Model.EmailSettingsList exposing (EmailSettingsList)
import Api.Model.NotificationSettings exposing (NotificationSettings) import Api.Model.NotificationSettings exposing (NotificationSettings)
import Api.Model.Tag exposing (Tag) import Api.Model.Tag exposing (Tag)
@ -34,7 +33,6 @@ import Markdown
import Messages.Comp.NotificationForm exposing (Texts) import Messages.Comp.NotificationForm exposing (Texts)
import Styles as S import Styles as S
import Util.Maybe import Util.Maybe
import Util.Result
import Util.Tag import Util.Tag
import Util.Update import Util.Update
@ -50,7 +48,7 @@ type alias Model =
, remindDaysModel : Comp.IntField.Model , remindDaysModel : Comp.IntField.Model
, capOverdue : Bool , capOverdue : Bool
, enabled : Bool , enabled : Bool
, schedule : Result CalEvent CalEvent , schedule : Maybe CalEvent
, scheduleModel : Comp.CalEventInput.Model , scheduleModel : Comp.CalEventInput.Model
, formState : FormState , formState : FormState
, loading : Int , loading : Int
@ -134,7 +132,7 @@ initWith flags s =
, remindDays = Just s.remindDays , remindDays = Just s.remindDays
, enabled = s.enabled , enabled = s.enabled
, capOverdue = s.capOverdue , capOverdue = s.capOverdue
, schedule = Ok newSchedule , schedule = Just newSchedule
, scheduleModel = sm , scheduleModel = sm
, formState = FormStateInitial , formState = FormStateInitial
, loading = im.loading , loading = im.loading
@ -153,10 +151,10 @@ init : Flags -> ( Model, Cmd Msg )
init flags = init flags =
let let
initialSchedule = initialSchedule =
Ok Data.CalEvent.everyMonth Data.CalEvent.everyMonth
sm = ( sm, scmd ) =
Comp.CalEventInput.initDefault Comp.CalEventInput.init flags initialSchedule
in in
( { settings = Api.Model.NotificationSettings.empty ( { settings = Api.Model.NotificationSettings.empty
, connectionModel = Comp.Dropdown.makeSingle , connectionModel = Comp.Dropdown.makeSingle
@ -168,7 +166,7 @@ init flags =
, remindDaysModel = Comp.IntField.init (Just 1) Nothing True , remindDaysModel = Comp.IntField.init (Just 1) Nothing True
, enabled = False , enabled = False
, capOverdue = False , capOverdue = False
, schedule = initialSchedule , schedule = Just initialSchedule
, scheduleModel = sm , scheduleModel = sm
, formState = FormStateInitial , formState = FormStateInitial
, loading = 2 , loading = 2
@ -178,6 +176,7 @@ init flags =
, Cmd.batch , Cmd.batch
[ Api.getMailSettings flags "" ConnResp [ Api.getMailSettings flags "" ConnResp
, Api.getTags flags "" GetTagsResp , Api.getTags flags "" GetTagsResp
, Cmd.map CalEventMsg scmd
] ]
) )
@ -210,7 +209,12 @@ makeSettings model =
|> Maybe.withDefault (Err ValidateRemindDaysRequired) |> Maybe.withDefault (Err ValidateRemindDaysRequired)
schedule_ = schedule_ =
Result.mapError (\_ -> ValidateCalEventInvalid) model.schedule case model.schedule of
Just s ->
Ok s
Nothing ->
Err ValidateCalEventInvalid
make smtp rec days timer = make smtp rec days timer =
{ prev { prev
@ -255,21 +259,12 @@ update flags msg model =
let let
( cm, cc, cs ) = ( cm, cc, cs ) =
Comp.CalEventInput.update flags Comp.CalEventInput.update flags
(Util.Result.fold identity identity model.schedule) model.schedule
lmsg lmsg
model.scheduleModel model.scheduleModel
in in
( { model ( { model
| schedule = | schedule = cs
case cs of
Data.Validated.Valid e ->
Ok e
Data.Validated.Invalid _ e ->
Err e
Data.Validated.Unknown e ->
Ok e
, scheduleModel = cm , scheduleModel = cm
, formState = FormStateInitial , formState = FormStateInitial
} }
@ -707,7 +702,7 @@ view2 texts extraClasses settings model =
(Comp.CalEventInput.view2 (Comp.CalEventInput.view2
texts.calEventInput texts.calEventInput
"" ""
(Util.Result.fold identity identity model.schedule) model.schedule
model.scheduleModel model.scheduleModel
) )
, span [ class "opacity-50 text-sm" ] , span [ class "opacity-50 text-sm" ]

36
modules/webapp/src/main/elm/Comp/ScanMailboxForm.elm
View File

@ -45,7 +45,6 @@ import Styles as S
import Util.Folder exposing (mkFolderOption) import Util.Folder exposing (mkFolderOption)
import Util.List import Util.List
import Util.Maybe import Util.Maybe
import Util.Result
import Util.Tag import Util.Tag
import Util.Update import Util.Update
@ -61,7 +60,7 @@ type alias Model =
, foldersModel : Comp.StringListInput.Model , foldersModel : Comp.StringListInput.Model
, folders : List String , folders : List String
, direction : Maybe Direction , direction : Maybe Direction
, schedule : Result CalEvent CalEvent , schedule : Maybe CalEvent
, scheduleModel : Comp.CalEventInput.Model , scheduleModel : Comp.CalEventInput.Model
, formState : FormState , formState : FormState
, loading : Int , loading : Int
@ -190,7 +189,7 @@ initWith flags s =
, receivedHours = s.receivedSinceHours , receivedHours = s.receivedSinceHours
, targetFolder = s.targetFolder , targetFolder = s.targetFolder
, folders = s.folders , folders = s.folders
, schedule = Ok newSchedule , schedule = Just newSchedule
, direction = Maybe.andThen Data.Direction.fromString s.direction , direction = Maybe.andThen Data.Direction.fromString s.direction
, scheduleModel = sm , scheduleModel = sm
, formState = FormStateInitial , formState = FormStateInitial
@ -222,10 +221,10 @@ init : Flags -> ( Model, Cmd Msg )
init flags = init flags =
let let
initialSchedule = initialSchedule =
Ok Data.CalEvent.everyMonth Data.CalEvent.everyMonth
sm = ( sm, scmd ) =
Comp.CalEventInput.initDefault Comp.CalEventInput.init flags initialSchedule
in in
( { settings = Api.Model.ScanMailboxSettings.empty ( { settings = Api.Model.ScanMailboxSettings.empty
, connectionModel = Comp.Dropdown.makeSingle , connectionModel = Comp.Dropdown.makeSingle
@ -237,7 +236,7 @@ init flags =
, folders = [] , folders = []
, targetFolder = Nothing , targetFolder = Nothing
, direction = Nothing , direction = Nothing
, schedule = initialSchedule , schedule = Just initialSchedule
, scheduleModel = sm , scheduleModel = sm
, formState = FormStateInitial , formState = FormStateInitial
, loading = 3 , loading = 3
@ -260,6 +259,7 @@ init flags =
[ Api.getImapSettings flags "" ConnResp [ Api.getImapSettings flags "" ConnResp
, Api.getFolders flags "" False GetFolderResp , Api.getFolders flags "" False GetFolderResp
, Api.getTags flags "" GetTagResp , Api.getTags flags "" GetTagResp
, Cmd.map CalEventMsg scmd
] ]
) )
@ -288,7 +288,12 @@ makeSettings model =
Ok model.folders Ok model.folders
schedule_ = schedule_ =
Result.mapError (\_ -> ValidateCalEventInvalid) model.schedule case model.schedule of
Just s ->
Ok s
Nothing ->
Err ValidateCalEventInvalid
make imap timer folders = make imap timer folders =
{ prev { prev
@ -343,21 +348,12 @@ update flags msg model =
let let
( cm, cc, cs ) = ( cm, cc, cs ) =
Comp.CalEventInput.update flags Comp.CalEventInput.update flags
(Util.Result.fold identity identity model.schedule) model.schedule
lmsg lmsg
model.scheduleModel model.scheduleModel
in in
( { model ( { model
| schedule = | schedule = cs
case cs of
Data.Validated.Valid e ->
Ok e
Data.Validated.Invalid _ e ->
Err e
Data.Validated.Unknown e ->
Ok e
, scheduleModel = cm , scheduleModel = cm
, formState = FormStateInitial , formState = FormStateInitial
} }
@ -1193,7 +1189,7 @@ viewSchedule2 texts model =
(Comp.CalEventInput.view2 (Comp.CalEventInput.view2
texts.calEventInput texts.calEventInput
"" ""
(Util.Result.fold identity identity model.schedule) model.schedule
model.scheduleModel model.scheduleModel
) )
, span [ class "opacity-50 text-sm" ] , span [ class "opacity-50 text-sm" ]

4
modules/webapp/src/main/elm/Messages/Comp/CalEventInput.elm
View File

@ -1,5 +1,7 @@
module Messages.Comp.CalEventInput exposing (Texts, gb) module Messages.Comp.CalEventInput exposing (Texts, gb)
import Http
import Messages.Comp.HttpError
import Messages.DateFormat as DF import Messages.DateFormat as DF
import Messages.UiLanguage import Messages.UiLanguage
@ -15,6 +17,7 @@ type alias Texts =
, schedule : String , schedule : String
, next : String , next : String
, formatDateTime : Int -> String , formatDateTime : Int -> String
, httpError : Http.Error -> String
} }
@ -30,4 +33,5 @@ gb =
, schedule = "Schedule" , schedule = "Schedule"
, next = "Next" , next = "Next"
, formatDateTime = DF.formatDateTimeLong Messages.UiLanguage.English , formatDateTime = DF.formatDateTimeLong Messages.UiLanguage.English
, httpError = Messages.Comp.HttpError.gb
} }