Save notify-due-items user task

This commit is contained in:
Eike Kettner 2020-04-21 00:39:39 +02:00
parent 3a90d874a5
commit 93182c040e
4 changed files with 196 additions and 9 deletions

View File

@ -59,6 +59,7 @@ module Api exposing
, setItemNotes , setItemNotes
, setTags , setTags
, setUnconfirmed , setUnconfirmed
, submitNotifyDueItems
, upload , upload
, uploadSingle , uploadSingle
, versionInfo , versionInfo
@ -122,6 +123,20 @@ import Util.Http as Http2
--- NotifyDueItems --- NotifyDueItems
submitNotifyDueItems :
Flags
-> NotificationSettings
-> (Result Http.Error BasicResult -> msg)
-> Cmd msg
submitNotifyDueItems flags settings receive =
Http2.authPost
{ url = flags.config.baseUrl ++ "/api/v1/sec/usertask/notifydueitems"
, account = getAccount flags
, body = Http.jsonBody (Api.Model.NotificationSettings.encode settings)
, expect = Http.expectJson receive Api.Model.BasicResult.decoder
}
getNotifyDueItems : getNotifyDueItems :
Flags Flags
-> (Result Http.Error NotificationSettings -> msg) -> (Result Http.Error NotificationSettings -> msg)

View File

@ -97,7 +97,7 @@ update flags ev msg model =
Valid event Valid event
else else
Invalid event Invalid [ res.message ] event
) )
CheckInputMsg event (Err err) -> CheckInputMsg event (Err err) ->

View File

@ -7,6 +7,7 @@ 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)
@ -17,7 +18,7 @@ import Comp.EmailInput
import Comp.IntField import Comp.IntField
import Data.CalEvent exposing (CalEvent) import Data.CalEvent exposing (CalEvent)
import Data.Flags exposing (Flags) import Data.Flags exposing (Flags)
import Data.Validated exposing (Validated) 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) import Html.Events exposing (onCheck, onClick)
@ -40,6 +41,7 @@ type alias Model =
, schedule : Validated CalEvent , schedule : Validated CalEvent
, scheduleModel : Comp.CalEventInput.Model , scheduleModel : Comp.CalEventInput.Model
, formError : Maybe String , formError : Maybe String
, submitResp : Maybe BasicResult
} }
@ -55,6 +57,7 @@ type Msg
| ToggleEnabled | ToggleEnabled
| CalEventMsg Comp.CalEventInput.Msg | CalEventMsg Comp.CalEventInput.Msg
| SetNotificationSettings (Result Http.Error NotificationSettings) | SetNotificationSettings (Result Http.Error NotificationSettings)
| SubmitResp (Result Http.Error BasicResult)
initCmd : Flags -> Cmd Msg initCmd : Flags -> Cmd Msg
@ -91,6 +94,7 @@ init flags =
, schedule = initialSchedule , schedule = initialSchedule
, scheduleModel = sm , scheduleModel = sm
, formError = Nothing , formError = Nothing
, submitResp = Nothing
} }
, Cmd.batch , Cmd.batch
[ initCmd flags [ initCmd flags
@ -99,6 +103,47 @@ init flags =
) )
makeSettings : Model -> Validated NotificationSettings
makeSettings model =
let
prev =
model.settings
conn =
Comp.Dropdown.getSelected model.connectionModel
|> List.head
|> Maybe.map Valid
|> Maybe.withDefault (Invalid [ "Connection missing" ] "")
recp =
if List.isEmpty model.recipients then
Invalid [ "No recipients" ] []
else
Valid model.recipients
rmdays =
Maybe.map Valid model.remindDays
|> Maybe.withDefault (Invalid [ "Remind Days is required" ] 0)
make smtp rec days timer =
{ prev
| smtpConnection = smtp
, tagsInclude = Comp.Dropdown.getSelected model.tagInclModel
, tagsExclude = Comp.Dropdown.getSelected model.tagExclModel
, recipients = rec
, remindDays = days
, enabled = model.enabled
, schedule = Data.CalEvent.makeEvent timer
}
in
Data.Validated.map4 make
conn
recp
rmdays
model.schedule
update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model = update flags msg model =
case msg of case msg of
@ -232,6 +277,7 @@ update flags msg model =
, remindDays = Just s.remindDays , remindDays = Just s.remindDays
, enabled = s.enabled , enabled = s.enabled
, schedule = Data.Validated.Unknown newSchedule , schedule = Data.Validated.Unknown newSchedule
, scheduleModel = sm
} }
, Cmd.batch , Cmd.batch
[ nc [ nc
@ -243,7 +289,34 @@ update flags msg model =
( { model | formError = Just (Util.Http.errorToString err) }, Cmd.none ) ( { model | formError = Just (Util.Http.errorToString err) }, Cmd.none )
Submit -> Submit ->
( model, Cmd.none ) case makeSettings model of
Valid set ->
( { model | formError = Nothing }
, Api.submitNotifyDueItems flags set SubmitResp
)
Invalid errs _ ->
let
errMsg =
String.join ", " errs
in
( { model | formError = Just errMsg }, Cmd.none )
Unknown _ ->
( { model | formError = Just "An unknown error occured" }, Cmd.none )
SubmitResp (Ok res) ->
( { model | submitResp = Just res, formError = Nothing }
, Cmd.none
)
SubmitResp (Err err) ->
( { model
| formError = Nothing
, submitResp = Just (BasicResult False (Util.Http.errorToString err))
}
, Cmd.none
)
view : String -> Model -> Html Msg view : String -> Model -> Html Msg
@ -252,7 +325,18 @@ view extraClasses model =
[ classList [ classList
[ ( "ui form", True ) [ ( "ui form", True )
, ( extraClasses, True ) , ( extraClasses, True )
, ( "error", model.formError /= Nothing ) , ( "error"
, model.formError
/= Nothing
|| (Maybe.map .success model.submitResp
|> Maybe.map not
|> Maybe.withDefault False
)
)
, ( "success"
, Maybe.map .success model.submitResp
|> Maybe.withDefault False
)
] ]
] ]
[ div [ class "inline field" ] [ div [ class "inline field" ]
@ -331,8 +415,16 @@ view extraClasses model =
] ]
, div [ class "ui divider" ] [] , div [ class "ui divider" ] []
, div [ class "ui error message" ] , div [ class "ui error message" ]
[ Maybe.withDefault "" model.formError [ case Maybe.map .message model.submitResp of
|> text Just txt ->
text txt
Nothing ->
Maybe.withDefault "" model.formError
|> text
]
, div [ class "ui success message" ]
[ text "Successfully saved."
] ]
, button , button
[ class "ui primary button" [ class "ui primary button"

View File

@ -1,9 +1,16 @@
module Data.Validated exposing (Validated(..), value) module Data.Validated exposing
( Validated(..)
, map
, map2
, map3
, map4
, value
)
type Validated a type Validated a
= Valid a = Valid a
| Invalid a | Invalid (List String) a
| Unknown a | Unknown a
@ -13,8 +20,81 @@ value va =
Valid a -> Valid a ->
a a
Invalid a -> Invalid _ a ->
a a
Unknown a -> Unknown a ->
a a
map : (a -> b) -> Validated a -> Validated b
map f va =
case va of
Valid a ->
Valid (f a)
Invalid em a ->
Invalid em (f a)
Unknown a ->
Unknown (f a)
map2 : (a -> b -> c) -> Validated a -> Validated b -> Validated c
map2 f va vb =
case ( va, vb ) of
( Valid a, Valid b ) ->
Valid (f a b)
( Valid a, Invalid em b ) ->
Invalid em (f a b)
( Valid a, Unknown b ) ->
Unknown (f a b)
( Invalid em a, Valid b ) ->
Invalid em (f a b)
( Invalid em1 a, Invalid em2 b ) ->
Invalid (em1 ++ em2) (f a b)
( Invalid em a, Unknown b ) ->
Invalid em (f a b)
( Unknown a, Valid b ) ->
Unknown (f a b)
( Unknown a, Invalid em b ) ->
Invalid em (f a b)
( Unknown a, Unknown b ) ->
Unknown (f a b)
map3 :
(a -> b -> c -> d)
-> Validated a
-> Validated b
-> Validated c
-> Validated d
map3 f va vb vc =
let
vab =
map2 (\e1 -> \e2 -> f e1 e2) va vb
in
map2 (\g -> \e3 -> g e3) vab vc
map4 :
(a -> b -> c -> d -> e)
-> Validated a
-> Validated b
-> Validated c
-> Validated d
-> Validated e
map4 f va vb vc vd =
let
vabc =
map3 (\e1 -> \e2 -> \e3 -> f e1 e2 e3) va vb vc
in
map2 (\g -> \e4 -> g e4) vabc vd