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
}