TheAnachronism/docspell
1
0
Fork 0
mirror of https://github.com/TheAnachronism/docspell.git synced 2025-04-04 18:39:33 +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
, Msg
, init
, initDefault
, update
, view2
)
@ -19,12 +18,25 @@ import Html.Events exposing (onInput)
import Http
import Messages.Comp.CalEventInput exposing (Texts)
import Styles as S
import Util.Http
import Util.Maybe
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)
initDefault : Model
initDefault =
Model Nothing
init : Flags -> CalEvent -> ( Model, Cmd Msg )
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
@ -60,20 +81,33 @@ checkInput flags 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 =
( model, checkInput flags ev, Unknown ev )
( model, checkInput flags ev, Nothing )
isCheckError : Model -> Bool
isCheckError model =
Maybe.map .success model.checkResult
|> Maybe.withDefault True
|> not
case model.checkResult of
CheckResultOk _ ->
False
CheckResultFailed _ ->
True
CheckResultHttpError _ ->
True
CheckResultInitial ->
False
update : Flags -> CalEvent -> Msg -> Model -> ( Model, Cmd Msg, Validated CalEvent )
update flags ev msg model =
update : Flags -> Maybe CalEvent -> Msg -> Model -> ( Model, Cmd Msg, Maybe CalEvent )
update flags mev msg model =
let
ev =
Maybe.withDefault model.inner mev
in
case msg of
SetYear str ->
withCheckInput flags { ev | year = str } model
@ -96,42 +130,49 @@ update flags ev msg model =
CheckInputMsg event (Ok res) ->
let
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
( m
, Cmd.none
, if res.success then
Valid event
Just event
else
Invalid [ res.message ] event
Nothing
)
CheckInputMsg event (Err err) ->
let
emptyResult =
Api.Model.CalEventCheckResult.empty
m =
{ model
| checkResult =
Just
{ emptyResult
| success = False
, message = Util.Http.errorToString err
}
| checkResult = CheckResultHttpError err
, inner = event
}
in
( m, Cmd.none, Unknown event )
( m, Cmd.none, Nothing )
--- View2
view2 : Texts -> String -> CalEvent -> Model -> Html Msg
view2 texts extraClasses ev model =
view2 : Texts -> String -> Maybe CalEvent -> Model -> Html Msg
view2 texts extraClasses mev model =
let
ev =
Maybe.withDefault model.inner mev
yearLen =
Basics.max 4 (String.length ev.year)
@ -255,17 +296,21 @@ view2 texts extraClasses ev model =
, class S.errorMessage
]
[ text (texts.error ++ ": ")
, Maybe.map .message model.checkResult
|> Maybe.withDefault ""
|> text
, case model.checkResult of
CheckResultOk _ ->
text ""
CheckResultFailed str ->
text str
CheckResultHttpError err ->
text (texts.httpError err)
CheckResultInitial ->
text ""
]
, div
[ classList
[ ( "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 "px-2 pt-4 pb-2 border-0 border-l border-b border-r bg-gray-50 dark:bg-bluegray-700"
, class S.border
]
[ div []
@ -273,7 +318,8 @@ view2 texts extraClasses ev model =
[ text (texts.schedule ++ ": ")
]
, div [ class "px-12 font-mono " ]
[ Maybe.andThen .event model.checkResult
[ eventData model
|> Maybe.andThen .eventString
|> Maybe.withDefault ""
|> text
]
@ -281,7 +327,8 @@ view2 texts extraClasses ev model =
[ text (texts.next ++ ": ")
]
, ul [ class "list-decimal list-inside text-sm" ]
(Maybe.map .next model.checkResult
(eventData model
|> Maybe.map .nextEvents
|> Maybe.withDefault []
|> List.map texts.formatDateTime
|> 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.ListType exposing (ListType)
import Data.UiSettings exposing (UiSettings)
import Data.Validated exposing (Validated(..))
import Html exposing (..)
import Html.Attributes exposing (..)
import Http
@ -31,7 +30,7 @@ import Util.Tag
type alias Model =
{ scheduleModel : Comp.CalEventInput.Model
, schedule : Validated CalEvent
, schedule : Maybe CalEvent
, itemCountModel : Comp.IntField.Model
, itemCount : Maybe Int
, categoryListModel : Comp.Dropdown.Model String
@ -59,7 +58,7 @@ init flags sett =
Comp.CalEventInput.init flags newSchedule
in
( { scheduleModel = cem
, schedule = Data.Validated.Unknown newSchedule
, schedule = Just newSchedule
, itemCountModel = Comp.IntField.init (Just 0) Nothing True
, itemCount = Just sett.itemCount
, categoryListModel =
@ -90,12 +89,12 @@ init flags sett =
)
getSettings : Model -> Validated ClassifierSetting
getSettings : Model -> Maybe ClassifierSetting
getSettings model =
Data.Validated.map
(\sch ->
Maybe.map
(\s ->
{ schedule =
Data.CalEvent.makeEvent sch
Data.CalEvent.makeEvent s
, itemCount = Maybe.withDefault 0 model.itemCount
, listType = Data.ListType.toString model.categoryListType
, categoryList = Comp.Dropdown.getSelected model.categoryListModel
@ -126,7 +125,7 @@ update flags msg model =
( cm, cc, ce ) =
Comp.CalEventInput.update
flags
(Data.Validated.value model.schedule)
model.schedule
lmsg
model.scheduleModel
in
@ -240,7 +239,7 @@ view2 texts settings model =
(Comp.CalEventInput.view2
texts.calEventInput
""
(Data.Validated.value model.schedule)
model.schedule
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.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)
@ -79,9 +78,9 @@ init flags settings =
)
getSettings : Model -> Validated CollectiveSettings
getSettings : Model -> Maybe CollectiveSettings
getSettings model =
Data.Validated.map
Maybe.map
(\cls ->
{ language =
Comp.Dropdown.getSelected model.langModel
@ -184,10 +183,10 @@ update flags msg model =
SaveSettings ->
case getSettings model of
Data.Validated.Valid s ->
Just s ->
( model, Cmd.none, Just s )
_ ->
Nothing ->
( model, Cmd.none, Nothing )
StartClassifierTask ->
@ -245,7 +244,7 @@ view2 flags texts settings model =
[ title texts.saveSettings
, href "#"
]
, disabled = getSettings model |> Data.Validated.isInvalid
, disabled = getSettings model == Nothing
}
]
, end = []
@ -358,7 +357,7 @@ view2 flags texts settings model =
{ handler = onClick StartClassifierTask
, icon = "fa fa-play"
, label = texts.startNow
, disabled = Data.Validated.isInvalid model.classifierModel.schedule
, disabled = model.classifierModel.schedule == Nothing
, attrs = [ href "#" ]
}
, 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.Model.BasicResult exposing (BasicResult)
import Api.Model.EmailSettingsList exposing (EmailSettingsList)
import Api.Model.NotificationSettings exposing (NotificationSettings)
import Api.Model.Tag exposing (Tag)
@ -34,7 +33,6 @@ import Markdown
import Messages.Comp.NotificationForm exposing (Texts)
import Styles as S
import Util.Maybe
import Util.Result
import Util.Tag
import Util.Update
@ -50,7 +48,7 @@ type alias Model =
, remindDaysModel : Comp.IntField.Model
, capOverdue : Bool
, enabled : Bool
, schedule : Result CalEvent CalEvent
, schedule : Maybe CalEvent
, scheduleModel : Comp.CalEventInput.Model
, formState : FormState
, loading : Int
@ -134,7 +132,7 @@ initWith flags s =
, remindDays = Just s.remindDays
, enabled = s.enabled
, capOverdue = s.capOverdue
, schedule = Ok newSchedule
, schedule = Just newSchedule
, scheduleModel = sm
, formState = FormStateInitial
, loading = im.loading
@ -153,10 +151,10 @@ init : Flags -> ( Model, Cmd Msg )
init flags =
let
initialSchedule =
Ok Data.CalEvent.everyMonth
Data.CalEvent.everyMonth
sm =
Comp.CalEventInput.initDefault
( sm, scmd ) =
Comp.CalEventInput.init flags initialSchedule
in
( { settings = Api.Model.NotificationSettings.empty
, connectionModel = Comp.Dropdown.makeSingle
@ -168,7 +166,7 @@ init flags =
, remindDaysModel = Comp.IntField.init (Just 1) Nothing True
, enabled = False
, capOverdue = False
, schedule = initialSchedule
, schedule = Just initialSchedule
, scheduleModel = sm
, formState = FormStateInitial
, loading = 2
@ -178,6 +176,7 @@ init flags =
, Cmd.batch
[ Api.getMailSettings flags "" ConnResp
, Api.getTags flags "" GetTagsResp
, Cmd.map CalEventMsg scmd
]
)
@ -210,7 +209,12 @@ makeSettings model =
|> Maybe.withDefault (Err ValidateRemindDaysRequired)
schedule_ =
Result.mapError (\_ -> ValidateCalEventInvalid) model.schedule
case model.schedule of
Just s ->
Ok s
Nothing ->
Err ValidateCalEventInvalid
make smtp rec days timer =
{ prev
@ -255,21 +259,12 @@ update flags msg model =
let
( cm, cc, cs ) =
Comp.CalEventInput.update flags
(Util.Result.fold identity identity model.schedule)
model.schedule
lmsg
model.scheduleModel
in
( { model
| schedule =
case cs of
Data.Validated.Valid e ->
Ok e
Data.Validated.Invalid _ e ->
Err e
Data.Validated.Unknown e ->
Ok e
| schedule = cs
, scheduleModel = cm
, formState = FormStateInitial
}
@ -707,7 +702,7 @@ view2 texts extraClasses settings model =
(Comp.CalEventInput.view2
texts.calEventInput
""
(Util.Result.fold identity identity model.schedule)
model.schedule
model.scheduleModel
)
, 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.List
import Util.Maybe
import Util.Result
import Util.Tag
import Util.Update
@ -61,7 +60,7 @@ type alias Model =
, foldersModel : Comp.StringListInput.Model
, folders : List String
, direction : Maybe Direction
, schedule : Result CalEvent CalEvent
, schedule : Maybe CalEvent
, scheduleModel : Comp.CalEventInput.Model
, formState : FormState
, loading : Int
@ -190,7 +189,7 @@ initWith flags s =
, receivedHours = s.receivedSinceHours
, targetFolder = s.targetFolder
, folders = s.folders
, schedule = Ok newSchedule
, schedule = Just newSchedule
, direction = Maybe.andThen Data.Direction.fromString s.direction
, scheduleModel = sm
, formState = FormStateInitial
@ -222,10 +221,10 @@ init : Flags -> ( Model, Cmd Msg )
init flags =
let
initialSchedule =
Ok Data.CalEvent.everyMonth
Data.CalEvent.everyMonth
sm =
Comp.CalEventInput.initDefault
( sm, scmd ) =
Comp.CalEventInput.init flags initialSchedule
in
( { settings = Api.Model.ScanMailboxSettings.empty
, connectionModel = Comp.Dropdown.makeSingle
@ -237,7 +236,7 @@ init flags =
, folders = []
, targetFolder = Nothing
, direction = Nothing
, schedule = initialSchedule
, schedule = Just initialSchedule
, scheduleModel = sm
, formState = FormStateInitial
, loading = 3
@ -260,6 +259,7 @@ init flags =
[ Api.getImapSettings flags "" ConnResp
, Api.getFolders flags "" False GetFolderResp
, Api.getTags flags "" GetTagResp
, Cmd.map CalEventMsg scmd
]
)
@ -288,7 +288,12 @@ makeSettings model =
Ok model.folders
schedule_ =
Result.mapError (\_ -> ValidateCalEventInvalid) model.schedule
case model.schedule of
Just s ->
Ok s
Nothing ->
Err ValidateCalEventInvalid
make imap timer folders =
{ prev
@ -343,21 +348,12 @@ update flags msg model =
let
( cm, cc, cs ) =
Comp.CalEventInput.update flags
(Util.Result.fold identity identity model.schedule)
model.schedule
lmsg
model.scheduleModel
in
( { model
| schedule =
case cs of
Data.Validated.Valid e ->
Ok e
Data.Validated.Invalid _ e ->
Err e
Data.Validated.Unknown e ->
Ok e
| schedule = cs
, scheduleModel = cm
, formState = FormStateInitial
}
@ -1193,7 +1189,7 @@ viewSchedule2 texts model =
(Comp.CalEventInput.view2
texts.calEventInput
""
(Util.Result.fold identity identity model.schedule)
model.schedule
model.scheduleModel
)
, 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)
import Http
import Messages.Comp.HttpError
import Messages.DateFormat as DF
import Messages.UiLanguage
@ -15,6 +17,7 @@ type alias Texts =
, schedule : String
, next : String
, formatDateTime : Int -> String
, httpError : Http.Error -> String
}
@ -30,4 +33,5 @@ gb =
, schedule = "Schedule"
, next = "Next"
, formatDateTime = DF.formatDateTimeLong Messages.UiLanguage.English
, httpError = Messages.Comp.HttpError.gb
}