From a39dfbf82a624afd5b97f67ba0d739f3eb890bad Mon Sep 17 00:00:00 2001 From: Eike Kettner Date: Mon, 26 Apr 2021 18:28:16 +0200 Subject: [PATCH] Refactor caleventinput field --- .../src/main/elm/Comp/CalEventInput.elm | 131 ++++++++++++------ .../main/elm/Comp/ClassifierSettingsForm.elm | 17 ++- .../main/elm/Comp/CollectiveSettingsForm.elm | 13 +- .../src/main/elm/Comp/NotificationForm.elm | 37 +++-- .../src/main/elm/Comp/ScanMailboxForm.elm | 36 +++-- .../main/elm/Messages/Comp/CalEventInput.elm | 4 + 6 files changed, 139 insertions(+), 99 deletions(-) diff --git a/modules/webapp/src/main/elm/Comp/CalEventInput.elm b/modules/webapp/src/main/elm/Comp/CalEventInput.elm index cfbe38f0..e9610043 100644 --- a/modules/webapp/src/main/elm/Comp/CalEventInput.elm +++ b/modules/webapp/src/main/elm/Comp/CalEventInput.elm @@ -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 ]) diff --git a/modules/webapp/src/main/elm/Comp/ClassifierSettingsForm.elm b/modules/webapp/src/main/elm/Comp/ClassifierSettingsForm.elm index afc6966e..e13eba68 100644 --- a/modules/webapp/src/main/elm/Comp/ClassifierSettingsForm.elm +++ b/modules/webapp/src/main/elm/Comp/ClassifierSettingsForm.elm @@ -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 ) ] diff --git a/modules/webapp/src/main/elm/Comp/CollectiveSettingsForm.elm b/modules/webapp/src/main/elm/Comp/CollectiveSettingsForm.elm index 0ba5f685..377be69d 100644 --- a/modules/webapp/src/main/elm/Comp/CollectiveSettingsForm.elm +++ b/modules/webapp/src/main/elm/Comp/CollectiveSettingsForm.elm @@ -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 diff --git a/modules/webapp/src/main/elm/Comp/NotificationForm.elm b/modules/webapp/src/main/elm/Comp/NotificationForm.elm index 98f46cb7..ca8a3b4f 100644 --- a/modules/webapp/src/main/elm/Comp/NotificationForm.elm +++ b/modules/webapp/src/main/elm/Comp/NotificationForm.elm @@ -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" ] diff --git a/modules/webapp/src/main/elm/Comp/ScanMailboxForm.elm b/modules/webapp/src/main/elm/Comp/ScanMailboxForm.elm index 82c8673a..bd6d8e25 100644 --- a/modules/webapp/src/main/elm/Comp/ScanMailboxForm.elm +++ b/modules/webapp/src/main/elm/Comp/ScanMailboxForm.elm @@ -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" ] diff --git a/modules/webapp/src/main/elm/Messages/Comp/CalEventInput.elm b/modules/webapp/src/main/elm/Messages/Comp/CalEventInput.elm index 1f83a01e..22aa9487 100644 --- a/modules/webapp/src/main/elm/Messages/Comp/CalEventInput.elm +++ b/modules/webapp/src/main/elm/Messages/Comp/CalEventInput.elm @@ -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 }