TheAnachronism/docspell
1
0
Fork 0
mirror of https://github.com/TheAnachronism/docspell.git synced 2025-04-04 10:29:34 +00:00
Code Issues Packages Projects Releases Wiki Activity

Externalize error messages

Browse Source
This commit is contained in:
Eike Kettner 2021-04-17 11:14:29 +02:00
parent c9b54e80b7
commit b2cffb22ef
65 changed files with 1518 additions and 683 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
modules/webapp/src/main/elm/Comp/AttachmentMeta.elm
View File

@ -17,7 +17,6 @@ import Html.Attributes exposing (..)
import Http
import Messages.Comp.AttachmentMeta exposing (Texts)
import Styles as S
import Util.Http
type alias Model =
@ -29,7 +28,7 @@ type alias Model =
type DataResult a
= NotAvailable
| Success a
| Failure String
| HttpFailure Http.Error
emptyModel : Model
@ -57,7 +56,7 @@ update msg model =
{ model | meta = Success am }
MetaResp (Err err) ->
{ model | meta = Failure (Util.Http.errorToString err) }
{ model | meta = HttpFailure err }
@ -77,9 +76,9 @@ view2 texts attrs model =
, label = texts.basics.loading
}
Failure msg ->
HttpFailure err ->
div [ class S.errorMessage ]
[ text msg
[ text (texts.httpError err)
]
Success data ->

125
modules/webapp/src/main/elm/Comp/ChangePasswordForm.elm
View File

@ -18,7 +18,6 @@ import Html.Events exposing (onClick)
import Http
import Messages.Comp.ChangePasswordForm exposing (Texts)
import Styles as S
import Util.Http
type alias Model =
@ -28,12 +27,20 @@ type alias Model =
, newPass1 : Maybe String
, pass2Model : Comp.PasswordInput.Model
, newPass2 : Maybe String
, errors : List String
, formState : FormState
, loading : Bool
, successMsg : String
}
type FormState
= FormStateNone
| FormStateHttpError Http.Error
| FormStateSubmitOk
| FormStateRequiredMissing
| FormStatePasswordMismatch
| FormStateSubmitError String
emptyModel : Model
emptyModel =
validateModel
@ -43,9 +50,8 @@ emptyModel =
, pass1Model = Comp.PasswordInput.init
, newPass2 = Nothing
, pass2Model = Comp.PasswordInput.init
, errors = []
, loading = False
, successMsg = ""
, formState = FormStateNone
}
@ -57,37 +63,21 @@ type Msg
| SubmitResp (Result Http.Error BasicResult)
validate : Model -> List String
validate : Model -> FormState
validate model =
List.concat
[ if model.newPass1 /= Nothing && model.newPass2 /= Nothing && model.newPass1 /= model.newPass2 then
[ "New passwords do not match." ]
if model.newPass1 /= Nothing && model.newPass2 /= Nothing && model.newPass1 /= model.newPass2 then
FormStatePasswordMismatch
else
[]
, if model.newPass1 == Nothing || model.newPass2 == Nothing || model.current == Nothing then
[ "Please fill in required fields." ]
else if model.newPass1 == Nothing || model.newPass2 == Nothing || model.current == Nothing then
FormStateRequiredMissing
else
[]
]
else
FormStateNone
validateModel : Model -> Model
validateModel model =
let
err =
validate model
in
{ model
| errors = err
, successMsg =
if err == [] then
model.successMsg
else
""
}
{ model | formState = validate model }
@ -126,7 +116,7 @@ update flags msg model =
Submit ->
let
valid =
state =
validate model
cp =
@ -134,43 +124,34 @@ update flags msg model =
(Maybe.withDefault "" model.current)
(Maybe.withDefault "" model.newPass1)
in
if List.isEmpty valid then
( { model | loading = True, errors = [], successMsg = "" }
if state == FormStateNone then
( { model | loading = True, formState = state }
, Api.changePassword flags cp SubmitResp
)
else
( model, Cmd.none )
( { model | formState = state }, Cmd.none )
SubmitResp (Ok res) ->
let
em =
{ emptyModel
| errors = []
, successMsg = "Password has been changed."
}
{ emptyModel | formState = FormStateSubmitOk }
in
if res.success then
( em, Cmd.none )
else
( { model
| errors = [ res.message ]
| formState = FormStateSubmitError res.message
, loading = False
, successMsg = ""
}
, Cmd.none
)
SubmitResp (Err err) ->
let
str =
Util.Http.errorToString err
in
( { model
| errors = [ str ]
| formState = FormStateHttpError err
, loading = False
, successMsg = ""
}
, Cmd.none
)
@ -235,29 +216,7 @@ view2 texts model =
model.pass2Model
)
]
, div
[ class S.successMessage
, classList [ ( "hidden", model.successMsg == "" ) ]
]
[ text model.successMsg
]
, div
[ class S.errorMessage
, classList
[ ( "hidden"
, List.isEmpty model.errors
|| (currentEmpty && pass1Empty && pass2Empty)
)
]
]
[ case model.errors of
a :: [] ->
text a
_ ->
ul [ class "list-disc" ]
(List.map (\em -> li [] [ text em ]) model.errors)
]
, renderResultMessage texts model
, div [ class "flex flex-row" ]
[ button
[ class S.primaryButton
@ -272,3 +231,33 @@ view2 texts model =
, label = texts.basics.loading
}
]
renderResultMessage : Texts -> Model -> Html msg
renderResultMessage texts model =
div
[ classList
[ ( S.errorMessage, model.formState /= FormStateSubmitOk )
, ( S.successMessage, model.formState == FormStateSubmitOk )
, ( "hidden", model.formState == FormStateNone )
]
]
[ case model.formState of
FormStateNone ->
text ""
FormStateHttpError err ->
text (texts.httpError err)
FormStateSubmitError m ->
text m
FormStatePasswordMismatch ->
text texts.passwordMismatch
FormStateRequiredMissing ->
text texts.fillRequiredFields
FormStateSubmitOk ->
text texts.passwordChangeSuccessful
]

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

@ -25,7 +25,6 @@ import Html.Events exposing (onCheck, onClick, onInput)
import Http
import Messages.Comp.CollectiveSettingsForm exposing (Texts)
import Styles as S
import Util.Http
type alias Model =
@ -33,12 +32,27 @@ type alias Model =
, intEnabled : Bool
, initSettings : CollectiveSettings
, fullTextConfirmText : String
, fullTextReIndexResult : Maybe BasicResult
, fullTextReIndexResult : FulltextReindexResult
, classifierModel : Comp.ClassifierSettingsForm.Model
, startClassifierResult : Maybe BasicResult
, startClassifierResult : ClassifierResult
}
type ClassifierResult
= ClassifierResultInitial
| ClassifierResultHttpError Http.Error
| ClassifierResultSubmitError String
| ClassifierResultOk
type FulltextReindexResult
= FulltextReindexInitial
| FulltextReindexHttpError Http.Error
| FulltextReindexSubmitError String
| FulltextReindexSubmitOk
| FulltextReindexOKMissing
init : Flags -> CollectiveSettings -> ( Model, Cmd Msg )
init flags settings =
let
@ -57,9 +71,9 @@ init flags settings =
, intEnabled = settings.integrationEnabled
, initSettings = settings
, fullTextConfirmText = ""
, fullTextReIndexResult = Nothing
, fullTextReIndexResult = FulltextReindexInitial
, classifierModel = cm
, startClassifierResult = Nothing
, startClassifierResult = ClassifierResultInitial
}
, Cmd.map ClassifierSettingMsg cc
)
@ -121,31 +135,36 @@ update flags msg model =
TriggerReIndex ->
case String.toLower model.fullTextConfirmText of
"ok" ->
( { model | fullTextReIndexResult = Nothing }
( { model | fullTextReIndexResult = FulltextReindexInitial }
, Api.startReIndex flags TriggerReIndexResult
, Nothing
)
_ ->
( { model
| fullTextReIndexResult =
Just
(BasicResult False <|
"Please type OK in the field if you really "
++ "want to start re-indexing your data."
)
| fullTextReIndexResult = FulltextReindexOKMissing
}
, Cmd.none
, Nothing
)
TriggerReIndexResult (Ok br) ->
( { model | fullTextReIndexResult = Just br }, Cmd.none, Nothing )
( { model
| fullTextReIndexResult =
if br.success then
FulltextReindexSubmitOk
else
FulltextReindexSubmitError br.message
}
, Cmd.none
, Nothing
)
TriggerReIndexResult (Err err) ->
( { model
| fullTextReIndexResult =
Just (BasicResult False (Util.Http.errorToString err))
FulltextReindexHttpError err
}
, Cmd.none
, Nothing
@ -175,16 +194,20 @@ update flags msg model =
( model, Api.startClassifier flags StartClassifierResp, Nothing )
StartClassifierResp (Ok br) ->
( { model | startClassifierResult = Just br }
( { model
| startClassifierResult =
if br.success then
ClassifierResultOk
else
ClassifierResultSubmitError br.message
}
, Cmd.none
, Nothing
)
StartClassifierResp (Err err) ->
( { model
| startClassifierResult =
Just (BasicResult False (Util.Http.errorToString err))
}
( { model | startClassifierResult = ClassifierResultHttpError err }
, Cmd.none
, Nothing
)
@ -209,12 +232,7 @@ view2 flags texts settings model =
}
in
div
[ classList
[ ( "ui form error success", True )
, ( "error", Maybe.map .success model.fullTextReIndexResult == Just False )
, ( "success", Maybe.map .success model.fullTextReIndexResult == Just True )
]
, class "flex flex-col relative"
[ class "flex flex-col relative"
]
[ MB.view
{ start =
@ -263,13 +281,13 @@ view2 flags texts settings model =
, div [ class "mb-4" ]
[ label
[ class "inline-flex items-center"
, for "intendpoint-enabled"
, for "int-endpoint-enabled"
]
[ input
[ type_ "checkbox"
, onCheck (\_ -> ToggleIntegrationEndpoint)
, checked model.intEnabled
, id "intendpoint-enabled"
, id "int-endpoint-enabled"
, class S.checkboxInput
]
[]
@ -316,7 +334,7 @@ view2 flags texts settings model =
, div [ class "opacity-50 text-sm" ]
[ text texts.reindexAllDataHelp
]
, renderResultMessage2 model.fullTextReIndexResult
, renderFulltextReindexResultMessage texts model.fullTextReIndexResult
]
]
, div
@ -343,23 +361,63 @@ view2 flags texts settings model =
, disabled = Data.Validated.isInvalid model.classifierModel.schedule
, attrs = [ href "#" ]
}
, renderResultMessage2 model.startClassifierResult
, renderClassifierResultMessage texts model.startClassifierResult
]
]
]
]
renderResultMessage2 : Maybe BasicResult -> Html msg
renderResultMessage2 result =
renderClassifierResultMessage : Texts -> ClassifierResult -> Html msg
renderClassifierResultMessage texts result =
let
isSuccess =
case result of
ClassifierResultOk ->
True
_ ->
False
isError =
not isSuccess
in
div
[ classList
[ ( S.errorMessage, Maybe.map .success result == Just False )
, ( S.successMessage, Maybe.map .success result == Just True )
, ( "hidden", result == Nothing )
[ ( S.errorMessage, isError )
, ( S.successMessage, isSuccess )
, ( "hidden", result == ClassifierResultInitial )
]
]
[ Maybe.map .message result
|> Maybe.withDefault ""
|> text
[ case result of
ClassifierResultInitial ->
text ""
ClassifierResultOk ->
text texts.classifierTaskStarted
ClassifierResultHttpError err ->
text (texts.httpError err)
ClassifierResultSubmitError m ->
text m
]
renderFulltextReindexResultMessage : Texts -> FulltextReindexResult -> Html msg
renderFulltextReindexResultMessage texts result =
case result of
FulltextReindexInitial ->
text ""
FulltextReindexSubmitOk ->
text texts.fulltextReindexSubmitted
FulltextReindexHttpError err ->
text (texts.httpError err)
FulltextReindexOKMissing ->
text texts.fulltextReindexOkMissing
FulltextReindexSubmitError m ->
text m

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

@ -20,19 +20,17 @@ import Comp.YesNoDimmer
import Data.CustomFieldType exposing (CustomFieldType)
import Data.DropdownStyle as DS
import Data.Flags exposing (Flags)
import Data.Validated exposing (Validated)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput)
import Http
import Messages.Comp.CustomFieldForm exposing (Texts)
import Styles as S
import Util.Http
import Util.Maybe
type alias Model =
{ result : Maybe BasicResult
{ formState : FormState
, field : CustomField
, name : Maybe String
, label : Maybe String
@ -43,20 +41,67 @@ type alias Model =
}
type FormState
= FormStateInitial
| FormStateHttp Http.Error
| FormStateNameRequired
| FormStateTypeRequired
| FormStateUpdateFailed UpdateType String
| FormStateUpdateOk UpdateType
type UpdateType
= UpdateCreate
| UpdateChange
| UpdateDelete
isFormError : FormState -> Bool
isFormError state =
case state of
FormStateInitial ->
False
FormStateHttp _ ->
True
FormStateNameRequired ->
True
FormStateTypeRequired ->
True
FormStateUpdateFailed _ _ ->
True
FormStateUpdateOk _ ->
False
isFormSuccess : FormState -> Bool
isFormSuccess state =
case state of
FormStateInitial ->
False
_ ->
not (isFormError state)
type Msg
= SetName String
| SetLabel String
| FTypeMsg (Comp.FixedDropdown.Msg CustomFieldType)
| RequestDelete
| DeleteMsg Comp.YesNoDimmer.Msg
| UpdateResp (Result Http.Error BasicResult)
| UpdateResp UpdateType (Result Http.Error BasicResult)
| GoBack
| SubmitForm
init : CustomField -> Model
init field =
{ result = Nothing
{ formState = FormStateInitial
, field = field
, name = Util.Maybe.fromString field.name
, label = field.label
@ -77,22 +122,22 @@ initEmpty =
--- Update
makeField : Model -> Validated NewCustomField
makeField : Model -> Result FormState NewCustomField
makeField model =
let
name =
Maybe.map Data.Validated.Valid model.name
|> Maybe.withDefault (Data.Validated.Invalid [ "A name is required." ] "")
Maybe.map Ok model.name
|> Maybe.withDefault (Err FormStateNameRequired)
ftype =
Maybe.map Data.CustomFieldType.asString model.ftype
|> Maybe.map Data.Validated.Valid
|> Maybe.withDefault (Data.Validated.Invalid [ "A field type is required." ] "")
|> Maybe.map Ok
|> Maybe.withDefault (Err FormStateTypeRequired)
make n ft =
NewCustomField n model.label ft
in
Data.Validated.map2 make name ftype
Result.map2 make name ftype
update : Flags -> Msg -> Model -> ( Model, Cmd Msg, Bool )
@ -129,29 +174,22 @@ update flags msg model =
makeField model
in
case newField of
Data.Validated.Valid f ->
Ok f ->
( model
, if model.field.id == "" then
Api.postCustomField flags f UpdateResp
Api.postCustomField flags f (UpdateResp UpdateCreate)
else
Api.putCustomField flags model.field.id f UpdateResp
Api.putCustomField flags model.field.id f (UpdateResp UpdateChange)
, False
)
Data.Validated.Invalid msgs _ ->
let
combined =
String.join "; " msgs
in
( { model | result = Just (BasicResult False combined) }
Err fe ->
( { model | formState = fe }
, Cmd.none
, False
)
Data.Validated.Unknown _ ->
( model, Cmd.none, False )
RequestDelete ->
let
( dm, _ ) =
@ -166,18 +204,28 @@ update flags msg model =
cmd =
if flag then
Api.deleteCustomField flags model.field.id UpdateResp
Api.deleteCustomField flags model.field.id (UpdateResp UpdateDelete)
else
Cmd.none
in
( { model | deleteDimmer = dm }, cmd, False )
UpdateResp (Ok r) ->
( { model | result = Just r }, Cmd.none, r.success )
UpdateResp updateType (Ok r) ->
( { model
| formState =
if r.success then
FormStateUpdateOk updateType
UpdateResp (Err err) ->
( { model | result = Just (BasicResult False (Util.Http.errorToString err)) }
else
FormStateUpdateFailed updateType r.message
}
, Cmd.none
, r.success
)
UpdateResp _ (Err err) ->
( { model | formState = FormStateHttp err }
, Cmd.none
, False
)
@ -230,15 +278,30 @@ view2 texts viewSettings model =
)
, div
[ classList
[ ( "hidden", model.result == Nothing )
, ( S.errorMessage, Maybe.map .success model.result == Just False )
, ( S.successMessage, Maybe.map .success model.result == Just True )
[ ( "hidden", model.formState == FormStateInitial )
, ( S.errorMessage, isFormError model.formState )
, ( S.successMessage, isFormSuccess model.formState )
]
, class "my-2"
]
[ Maybe.map .message model.result
|> Maybe.withDefault ""
|> text
[ case model.formState of
FormStateInitial ->
text ""
FormStateHttp err ->
text (texts.httpError err)
FormStateNameRequired ->
text texts.fieldNameRequired
FormStateTypeRequired ->
text texts.fieldTypeRequired
FormStateUpdateFailed _ m ->
text m
FormStateUpdateOk _ ->
text texts.updateSuccessful
]
, if model.field.id == "" then
div [ class "py-2 text-lg opacity-75" ]

138
modules/webapp/src/main/elm/Comp/DetailEdit.elm
View File

@ -42,14 +42,12 @@ import Comp.TagForm
import Data.Flags exposing (Flags)
import Data.Icons as Icons
import Data.UiSettings exposing (UiSettings)
import Data.Validated
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Http
import Messages.Comp.DetailEdit exposing (Texts)
import Styles as S
import Util.Http
type alias Model =
@ -57,10 +55,47 @@ type alias Model =
, itemId : String
, submitting : Bool
, loading : Bool
, result : Maybe BasicResult
, formState : FormState
}
type FormState
= FormStateInitial
| FormStateHttpError Http.Error
| FormStateSubmitSuccessful
| FormStateSubmitError String
| FormStateMissingRequiredFields
isError : FormState -> Bool
isError state =
case state of
FormStateInitial ->
False
FormStateHttpError _ ->
True
FormStateSubmitSuccessful ->
False
FormStateSubmitError _ ->
True
FormStateMissingRequiredFields ->
True
isSuccess : FormState -> Bool
isSuccess state =
case state of
FormStateInitial ->
False
_ ->
not (isError state)
type FormModel
= TM Comp.TagForm.Model
| PMR Comp.PersonForm.Model
@ -105,7 +140,7 @@ init itemId fm =
, itemId = itemId
, submitting = False
, loading = False
, result = Nothing
, formState = FormStateInitial
}
@ -125,7 +160,7 @@ editOrg flags orgId om =
, itemId = ""
, submitting = False
, loading = True
, result = Nothing
, formState = FormStateInitial
}
, Api.getOrgFull orgId flags GetOrgResp
)
@ -137,7 +172,7 @@ editPerson flags persId pm =
, itemId = ""
, submitting = False
, loading = True
, result = Nothing
, formState = FormStateInitial
}
, Cmd.batch
[ Api.getPersonFull persId flags GetPersonResp
@ -152,7 +187,7 @@ editEquip flags equipId em =
, itemId = ""
, submitting = False
, loading = True
, result = Nothing
, formState = FormStateInitial
}
, Api.getEquipment flags equipId GetEquipResp
)
@ -246,10 +281,10 @@ makeValue fm =
Comp.CustomFieldForm.makeField fieldModel
in
case cfield of
Data.Validated.Valid field ->
Ok field ->
SubmitCustomField field
_ ->
Err _ ->
CancelForm
@ -285,7 +320,10 @@ update flags msg model =
)
GetOrgResp (Err err) ->
( { model | loading = False, result = Just (BasicResult False (Util.Http.errorToString err)) }
( { model
| loading = False
, formState = FormStateHttpError err
}
, Cmd.none
, Nothing
)
@ -312,7 +350,10 @@ update flags msg model =
)
GetPersonResp (Err err) ->
( { model | loading = False, result = Just (BasicResult False (Util.Http.errorToString err)) }
( { model
| loading = False
, formState = FormStateHttpError err
}
, Cmd.none
, Nothing
)
@ -349,7 +390,10 @@ update flags msg model =
( { model | loading = False }, Cmd.none, Nothing )
GetOrgsResp (Err err) ->
( { model | loading = False, result = Just (BasicResult False (Util.Http.errorToString err)) }
( { model
| loading = False
, formState = FormStateHttpError err
}
, Cmd.none
, Nothing
)
@ -376,7 +420,10 @@ update flags msg model =
)
GetEquipResp (Err err) ->
( { model | loading = False, result = Just (BasicResult False (Util.Http.errorToString err)) }
( { model
| loading = False
, formState = FormStateHttpError err
}
, Cmd.none
, Nothing
)
@ -391,7 +438,12 @@ update flags msg model =
Nothing
in
( { model
| result = Just res
| formState =
if res.success then
FormStateSubmitSuccessful
else
FormStateSubmitError res.message
, submitting = False
}
, Cmd.none
@ -400,7 +452,7 @@ update flags msg model =
SubmitResp (Err err) ->
( { model
| result = Just (BasicResult False (Util.Http.errorToString err))
| formState = FormStateHttpError err
, submitting = False
}
, Cmd.none
@ -408,10 +460,6 @@ update flags msg model =
)
Submit ->
let
failMsg =
Just (BasicResult False "Please fill required fields.")
in
case model.form of
TM tm ->
let
@ -425,7 +473,7 @@ update flags msg model =
)
else
( { model | result = failMsg }
( { model | formState = FormStateMissingRequiredFields }
, Cmd.none
, Nothing
)
@ -446,7 +494,7 @@ update flags msg model =
)
else
( { model | result = failMsg }
( { model | formState = FormStateMissingRequiredFields }
, Cmd.none
, Nothing
)
@ -467,7 +515,7 @@ update flags msg model =
)
else
( { model | result = failMsg }
( { model | formState = FormStateMissingRequiredFields }
, Cmd.none
, Nothing
)
@ -488,7 +536,7 @@ update flags msg model =
)
else
( { model | result = failMsg }
( { model | formState = FormStateMissingRequiredFields }
, Cmd.none
, Nothing
)
@ -509,7 +557,7 @@ update flags msg model =
)
else
( { model | result = failMsg }
( { model | formState = FormStateMissingRequiredFields }
, Cmd.none
, Nothing
)
@ -520,14 +568,14 @@ update flags msg model =
Comp.CustomFieldForm.makeField fm
in
case cfield of
Data.Validated.Valid newField ->
Ok newField ->
( { model | submitting = True }
, Api.postCustomField flags newField SubmitResp
, Nothing
)
_ ->
( { model | result = failMsg }
Err _ ->
( { model | formState = FormStateMissingRequiredFields }
, Cmd.none
, Nothing
)
@ -541,7 +589,7 @@ update flags msg model =
in
( { model
| form = TM tm_
, result = Nothing
, formState = FormStateInitial
}
, Cmd.map TagMsg tc_
, Nothing
@ -559,7 +607,7 @@ update flags msg model =
in
( { model
| form = PMR pm_
, result = Nothing
, formState = FormStateInitial
}
, Cmd.map PersonMsg pc_
, Nothing
@ -572,7 +620,7 @@ update flags msg model =
in
( { model
| form = PMC pm_
, result = Nothing
, formState = FormStateInitial
}
, Cmd.map PersonMsg pc_
, Nothing
@ -590,7 +638,7 @@ update flags msg model =
in
( { model
| form = OM om_
, result = Nothing
, formState = FormStateInitial
}
, Cmd.map OrgMsg oc_
, Nothing
@ -608,7 +656,7 @@ update flags msg model =
in
( { model
| form = EM em_
, result = Nothing
, formState = FormStateInitial
}
, Cmd.map EquipMsg ec_
, Nothing
@ -626,7 +674,7 @@ update flags msg model =
in
( { model
| form = CFM fm_
, result = Nothing
, formState = FormStateInitial
}
, Cmd.map CustomFieldMsg fc_
, Nothing
@ -756,14 +804,26 @@ viewIntern2 : Texts -> UiSettings -> Bool -> Model -> List (Html Msg)
viewIntern2 texts settings withButtons model =
[ div
[ classList
[ ( S.errorMessage, Maybe.map .success model.result == Just False )
, ( S.successMessage, Maybe.map .success model.result == Just True )
, ( "hidden", model.result == Nothing )
[ ( S.errorMessage, isError model.formState )
, ( S.successMessage, isSuccess model.formState )
, ( "hidden", model.formState == FormStateInitial )
]
]
[ Maybe.map .message model.result
|> Maybe.withDefault ""
|> text
[ case model.formState of
FormStateInitial ->
text ""
FormStateHttpError err ->
text (texts.httpError err)
FormStateSubmitSuccessful ->
text texts.submitSuccessful
FormStateSubmitError m ->
text m
FormStateMissingRequiredFields ->
text texts.missingRequiredFields
]
, case model.form of
TM tm ->

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

@ -23,26 +23,32 @@ import Html.Attributes exposing (..)
import Http
import Messages.Comp.EmailSettingsManage exposing (Texts)
import Styles as S
import Util.Http
type alias Model =
{ tableModel : Comp.EmailSettingsTable.Model
, formModel : Comp.EmailSettingsForm.Model
, viewMode : ViewMode
, formError : Maybe String
, formError : FormError
, loading : Bool
, query : String
, deleteConfirm : Comp.YesNoDimmer.Model
}
type FormError
= FormErrorNone
| FormErrorHttp Http.Error
| FormErrorSubmit String
| FormErrorFillRequired
emptyModel : Model
emptyModel =
{ tableModel = Comp.EmailSettingsTable.emptyModel
, formModel = Comp.EmailSettingsForm.emptyModel
, viewMode = Table
, formError = Nothing
, formError = FormErrorNone
, loading = False
, query = ""
, deleteConfirm = Comp.YesNoDimmer.emptyModel
@ -84,7 +90,7 @@ update flags msg model =
nm =
{ model
| viewMode = Form
, formError = Nothing
, formError = FormErrorNone
, formModel = Comp.EmailSettingsForm.init ems
}
in
@ -101,7 +107,7 @@ update flags msg model =
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
, formError =
if tm.selected /= Nothing then
Nothing
FormErrorNone
else
model.formError
@ -166,7 +172,7 @@ update flags msg model =
( { model | loading = True }, Api.createMailSettings flags mid ems SubmitResp )
else
( { model | formError = Just "Please fill required fields." }, Cmd.none )
( { model | formError = FormErrorFillRequired }, Cmd.none )
LoadSettings ->
( { model | loading = True }, Api.getMailSettings flags model.query MailSettingsResp )
@ -183,10 +189,10 @@ update flags msg model =
( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else
( { model | formError = Just res.message, loading = False }, Cmd.none )
( { model | formError = FormErrorSubmit res.message, loading = False }, Cmd.none )
SubmitResp (Err err) ->
( { model | formError = Just (Util.Http.errorToString err), loading = False }, Cmd.none )
( { model | formError = FormErrorHttp err, loading = False }, Cmd.none )
MailSettingsResp (Ok ems) ->
let
@ -286,12 +292,23 @@ viewForm2 texts settings model =
}
, div
[ classList
[ ( "hidden", model.formError == Nothing )
[ ( "hidden", model.formError == FormErrorNone )
]
, class "my-2"
, class S.errorMessage
]
[ Maybe.withDefault "" model.formError |> text
[ case model.formError of
FormErrorNone ->
text ""
FormErrorHttp err ->
text (texts.httpError err)
FormErrorFillRequired ->
text texts.fillRequiredFields
FormErrorSubmit m ->
text m
]
, Html.map FormMsg
(Comp.EmailSettingsForm.view2 texts.settingsForm

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

@ -22,7 +22,6 @@ import Html.Events exposing (onSubmit)
import Http
import Messages.Comp.EquipmentManage exposing (Texts)
import Styles as S
import Util.Http
import Util.Maybe
@ -30,13 +29,20 @@ type alias Model =
{ tableModel : Comp.EquipmentTable.Model
, formModel : Comp.EquipmentForm.Model
, viewMode : ViewMode
, formError : Maybe String
, formError : FormError
, loading : Bool
, deleteConfirm : Comp.YesNoDimmer.Model
, query : String
}
type FormError
= FormErrorNone
| FormErrorHttp Http.Error
| FormErrorSubmit String
| FormErrorInvalid
type ViewMode
= Table
| Form
@ -47,7 +53,7 @@ emptyModel =
{ tableModel = Comp.EquipmentTable.emptyModel
, formModel = Comp.EquipmentForm.emptyModel
, viewMode = Table
, formError = Nothing
, formError = FormErrorNone
, loading = False
, deleteConfirm = Comp.YesNoDimmer.emptyModel
, query = ""
@ -82,7 +88,7 @@ update flags msg model =
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
, formError =
if Util.Maybe.nonEmpty tm.selected then
Nothing
FormErrorNone
else
model.formError
@ -135,7 +141,7 @@ update flags msg model =
InitNewEquipment ->
let
nm =
{ model | viewMode = Form, formError = Nothing }
{ model | viewMode = Form, formError = FormErrorNone }
equipment =
Api.Model.Equipment.empty
@ -154,7 +160,7 @@ update flags msg model =
( { model | loading = True }, Api.postEquipment flags equipment SubmitResp )
else
( { model | formError = Just "Please correct the errors in the form." }, Cmd.none )
( { model | formError = FormErrorInvalid }, Cmd.none )
SubmitResp (Ok res) ->
if res.success then
@ -168,10 +174,10 @@ update flags msg model =
( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else
( { model | formError = Just res.message, loading = False }, Cmd.none )
( { model | formError = FormErrorSubmit res.message, loading = False }, Cmd.none )
SubmitResp (Err err) ->
( { model | formError = Just (Util.Http.errorToString err), loading = False }, Cmd.none )
( { model | formError = FormErrorHttp err, loading = False }, Cmd.none )
RequestDelete ->
update flags (YesNoMsg Comp.YesNoDimmer.activate) model
@ -316,12 +322,23 @@ viewForm2 texts model =
}
, div
[ classList
[ ( "hidden", Util.Maybe.isEmpty model.formError )
[ ( "hidden", model.formError == FormErrorNone )
]
, class S.errorMessage
, class "my-2"
]
[ Maybe.withDefault "" model.formError |> text
[ case model.formError of
FormErrorNone ->
text ""
FormErrorSubmit m ->
text m
FormErrorInvalid ->
text texts.correctFormErrors
FormErrorHttp err ->
text (texts.httpError err)
]
, Html.map FormMsg (Comp.EquipmentForm.view2 texts.equipmentForm model.formModel)
, B.loadingDimmer

128
modules/webapp/src/main/elm/Comp/FolderDetail.elm
View File

@ -26,12 +26,11 @@ import Html.Events exposing (onClick, onInput)
import Http
import Messages.Comp.FolderDetail exposing (Texts)
import Styles as S
import Util.Http
import Util.Maybe
type alias Model =
{ result : Maybe BasicResult
{ formState : FormState
, folder : FolderDetail
, name : Maybe String
, members : List IdName
@ -43,6 +42,59 @@ type alias Model =
}
type FormState
= FormStateInitial
| FormStateHttpError Http.Error
| FormStateFolderCreated
| FormStateGenericError String
| FormStateNameChangeSuccessful
| FormStateDeleteSuccessful
isError : FormState -> Bool
isError state =
case state of
FormStateInitial ->
False
FormStateHttpError _ ->
True
FormStateGenericError _ ->
True
FormStateFolderCreated ->
False
FormStateNameChangeSuccessful ->
False
FormStateDeleteSuccessful ->
False
isSuccess : FormState -> Bool
isSuccess state =
case state of
FormStateInitial ->
False
FormStateHttpError _ ->
False
FormStateGenericError _ ->
False
FormStateFolderCreated ->
True
FormStateNameChangeSuccessful ->
True
FormStateDeleteSuccessful ->
True
type Msg
= SetName String
| MemberDropdownMsg (Comp.FixedDropdown.Msg IdName)
@ -61,7 +113,7 @@ type Msg
init : List User -> FolderDetail -> Model
init users folder =
{ result = Nothing
{ formState = FormStateInitial
, folder = folder
, name = Util.Maybe.fromString folder.name
, members = folder.members
@ -143,7 +195,7 @@ update flags msg model =
in
( { model
| loading = True
, result = Nothing
, formState = FormStateInitial
}
, cmd
, False
@ -159,7 +211,12 @@ update flags msg model =
else
( { model
| loading = False
, result = Just (BasicResult ir.success ir.message)
, formState =
if ir.success then
FormStateFolderCreated
else
FormStateGenericError ir.message
}
, Cmd.none
, False
@ -168,7 +225,7 @@ update flags msg model =
NewFolderResp (Err err) ->
( { model
| loading = False
, result = Just (BasicResult False (Util.Http.errorToString err))
, formState = FormStateHttpError err
}
, Cmd.none
, False
@ -182,7 +239,7 @@ update flags msg model =
)
else
( { model | loading = False, result = Just r }
( { model | loading = False, formState = FormStateGenericError r.message }
, Cmd.none
, False
)
@ -190,7 +247,7 @@ update flags msg model =
ChangeFolderResp (Err err) ->
( { model
| loading = False
, result = Just (BasicResult False (Util.Http.errorToString err))
, formState = FormStateHttpError err
}
, Cmd.none
, False
@ -199,13 +256,21 @@ update flags msg model =
ChangeNameResp (Ok r) ->
let
model_ =
{ model | result = Just r, loading = False }
{ model
| formState =
if r.success then
FormStateNameChangeSuccessful
else
FormStateGenericError r.message
, loading = False
}
in
( model_, Cmd.none, False )
ChangeNameResp (Err err) ->
( { model
| result = Just (BasicResult False (Util.Http.errorToString err))
| formState = FormStateHttpError err
, loading = False
}
, Cmd.none
@ -218,7 +283,7 @@ update flags msg model =
FolderDetailResp (Err err) ->
( { model
| loading = False
, result = Just (BasicResult False (Util.Http.errorToString err))
, formState = FormStateHttpError err
}
, Cmd.none
, False
@ -263,10 +328,20 @@ update flags msg model =
( { model | deleteDimmer = dm }, cmd, False )
DeleteResp (Ok r) ->
( { model | result = Just r }, Cmd.none, r.success )
( { model
| formState =
if r.success then
FormStateDeleteSuccessful
else
FormStateGenericError r.message
}
, Cmd.none
, r.success
)
DeleteResp (Err err) ->
( { model | result = Just (BasicResult False (Util.Http.errorToString err)) }
( { model | formState = FormStateHttpError err }
, Cmd.none
, False
)
@ -350,15 +425,30 @@ view2 texts flags model =
]
, div
[ classList
[ ( "hidden", model.result == Nothing )
, ( S.errorMessage, Maybe.map .success model.result == Just False )
, ( S.successMessage, Maybe.map .success model.result == Just True )
[ ( "hidden", model.formState == FormStateInitial )
, ( S.errorMessage, isError model.formState )
, ( S.successMessage, isSuccess model.formState )
]
, class "my-4"
]
[ Maybe.map .message model.result
|> Maybe.withDefault ""
|> text
[ case model.formState of
FormStateInitial ->
text ""
FormStateHttpError err ->
text (texts.httpError err)
FormStateGenericError m ->
text m
FormStateFolderCreated ->
text texts.folderCreated
FormStateNameChangeSuccessful ->
text texts.nameChangeSuccessful
FormStateDeleteSuccessful ->
text texts.deleteSuccessful
]
]
++ viewMembers2 texts model

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

@ -23,26 +23,32 @@ import Html.Attributes exposing (..)
import Http
import Messages.Comp.ImapSettingsManage exposing (Texts)
import Styles as S
import Util.Http
type alias Model =
{ tableModel : Comp.ImapSettingsTable.Model
, formModel : Comp.ImapSettingsForm.Model
, viewMode : ViewMode
, formError : Maybe String
, formError : FormError
, loading : Bool
, query : String
, deleteConfirm : Comp.YesNoDimmer.Model
}
type FormError
= FormErrorNone
| FormErrorHttp Http.Error
| FormErrorSubmit String
| FormErrorFillRequired
emptyModel : Model
emptyModel =
{ tableModel = Comp.ImapSettingsTable.emptyModel
, formModel = Comp.ImapSettingsForm.emptyModel
, viewMode = Table
, formError = Nothing
, formError = FormErrorNone
, loading = False
, query = ""
, deleteConfirm = Comp.YesNoDimmer.emptyModel
@ -84,7 +90,7 @@ update flags msg model =
nm =
{ model
| viewMode = Form
, formError = Nothing
, formError = FormErrorNone
, formModel = Comp.ImapSettingsForm.init ems
}
in
@ -101,7 +107,7 @@ update flags msg model =
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
, formError =
if tm.selected /= Nothing then
Nothing
FormErrorNone
else
model.formError
@ -166,7 +172,7 @@ update flags msg model =
( { model | loading = True }, Api.createImapSettings flags mid ems SubmitResp )
else
( { model | formError = Just "Please fill required fields." }, Cmd.none )
( { model | formError = FormErrorFillRequired }, Cmd.none )
LoadSettings ->
( { model | loading = True }, Api.getImapSettings flags model.query MailSettingsResp )
@ -183,10 +189,10 @@ update flags msg model =
( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else
( { model | formError = Just res.message, loading = False }, Cmd.none )
( { model | formError = FormErrorSubmit res.message, loading = False }, Cmd.none )
SubmitResp (Err err) ->
( { model | formError = Just (Util.Http.errorToString err), loading = False }, Cmd.none )
( { model | formError = FormErrorHttp err, loading = False }, Cmd.none )
MailSettingsResp (Ok ems) ->
let
@ -287,12 +293,23 @@ viewForm2 texts settings model =
}
, div
[ classList
[ ( "hidden", model.formError == Nothing )
[ ( "hidden", model.formError == FormErrorNone )
]
, class "my-2"
, class S.errorMessage
]
[ Maybe.withDefault "" model.formError |> text
[ case model.formError of
FormErrorNone ->
text ""
FormErrorHttp err ->
text (texts.httpError err)
FormErrorFillRequired ->
text texts.fillRequiredFields
FormErrorSubmit m ->
text m
]
, Html.map FormMsg
(Comp.ImapSettingsForm.view2

12
modules/webapp/src/main/elm/Comp/ItemDetail/Model.elm
View File

@ -1,5 +1,6 @@
module Comp.ItemDetail.Model exposing
( AttachmentRename
, MailSendResult(..)
, Model
, Msg(..)
, NotesField(..)
@ -84,7 +85,7 @@ type alias Model =
, itemMail : Comp.ItemMail.Model
, mailOpen : Bool
, mailSending : Bool
, mailSendResult : Maybe BasicResult
, mailSendResult : MailSendResult
, sentMails : Comp.SentMails.Model
, sentMailsOpen : Bool
, attachMeta : Dict String Comp.AttachmentMeta.Model
@ -128,6 +129,13 @@ type SelectActionMode
| DeleteSelected
type MailSendResult
= MailSendSuccessful
| MailSendHttpError Http.Error
| MailSendFailed String
| MailSendResultInitial
type NotesField
= ViewNotes
| EditNotes Comp.MarkdownInput.Model
@ -181,7 +189,7 @@ emptyModel =
, itemMail = Comp.ItemMail.emptyModel
, mailOpen = False
, mailSending = False
, mailSendResult = Nothing
, mailSendResult = MailSendResultInitial
, sentMails = Comp.SentMails.init
, sentMailsOpen = False
, attachMeta = Dict.empty

36
modules/webapp/src/main/elm/Comp/ItemDetail/Update.elm
View File

@ -24,7 +24,23 @@ import Comp.Dropdown exposing (isDropdownChangeMsg)
import Comp.Dropzone
import Comp.EquipmentForm
import Comp.ItemDetail.FieldTabState as FTabState
import Comp.ItemDetail.Model exposing (AttachmentRename, Model, Msg(..), NotesField(..), SaveNameState(..), SelectActionMode(..), UpdateResult, ViewMode(..), initSelectViewModel, isEditNotes, resultModel, resultModelCmd, resultModelCmdSub)
import Comp.ItemDetail.Model
exposing
( AttachmentRename
, MailSendResult(..)
, Model
, Msg(..)
, NotesField(..)
, SaveNameState(..)
, SelectActionMode(..)
, UpdateResult
, ViewMode(..)
, initSelectViewModel
, isEditNotes
, resultModel
, resultModelCmd
, resultModelCmdSub
)
import Comp.ItemMail
import Comp.KeyInput
import Comp.LinkTarget
@ -48,7 +64,6 @@ import Set exposing (Set)
import Throttle
import Time
import Util.File exposing (makeFileId)
import Util.Http
import Util.List
import Util.Maybe
import Util.String
@ -750,7 +765,7 @@ update key flags inav settings msg model =
( { model
| itemMail = Comp.ItemMail.clear im
, mailOpen = False
, mailSendResult = Nothing
, mailSendResult = MailSendResultInitial
}
, Cmd.map ItemMailMsg ic
)
@ -788,7 +803,7 @@ update key flags inav settings msg model =
model.mailSendResult
else
Nothing
MailSendResultInitial
in
resultModel
{ model
@ -810,7 +825,12 @@ update key flags inav settings msg model =
( { model
| itemMail = mm
, mailSending = False
, mailSendResult = Just br
, mailSendResult =
if br.success then
MailSendSuccessful
else
MailSendFailed br.message
}
, if br.success then
Api.itemDetail flags model.item.id GetItemResp
@ -820,13 +840,9 @@ update key flags inav settings msg model =
)
SendMailResp (Err err) ->
let
errmsg =
Util.Http.errorToString err
in
resultModel
{ model
| mailSendResult = Just (BasicResult False errmsg)
| mailSendResult = MailSendHttpError err
, mailSending = False
}

31
modules/webapp/src/main/elm/Comp/ItemDetail/View2.elm
View File

@ -7,7 +7,8 @@ import Comp.ItemDetail.AddFilesForm
import Comp.ItemDetail.ItemInfoHeader
import Comp.ItemDetail.Model
exposing
( Model
( MailSendResult(..)
, Model
, Msg(..)
, NotesField(..)
, SaveNameState(..)
@ -257,22 +258,24 @@ sendMailForm texts settings model =
, Html.map ItemMailMsg (Comp.ItemMail.view2 texts.itemMail settings model.itemMail)
, div
[ classList
[ ( S.errorMessage
, Maybe.map .success model.mailSendResult
|> Maybe.map not
|> Maybe.withDefault False
)
, ( S.successMessage
, Maybe.map .success model.mailSendResult
|> Maybe.withDefault False
)
, ( "hidden", model.mailSendResult == Nothing )
[ ( S.errorMessage, model.mailSendResult /= MailSendSuccessful )
, ( S.successMessage, model.mailSendResult == MailSendSuccessful )
, ( "hidden", model.mailSendResult == MailSendResultInitial )
]
, class "mt-2"
]
[ Maybe.map .message model.mailSendResult
|> Maybe.withDefault ""
|> text
[ case model.mailSendResult of
MailSendSuccessful ->
text texts.mailSendSuccessful
MailSendHttpError err ->
text (texts.httpError err)
MailSendFailed m ->
text m
MailSendResultInitial ->
text ""
]
]

47
modules/webapp/src/main/elm/Comp/ItemMail.elm
View File

@ -25,7 +25,6 @@ import Html.Events exposing (onClick, onInput)
import Http
import Messages.Comp.ItemMail exposing (Texts)
import Styles as S
import Util.Http
type alias Model =
@ -39,10 +38,16 @@ type alias Model =
, bccRecipientsModel : Comp.EmailInput.Model
, body : String
, attachAll : Bool
, formError : Maybe String
, formError : FormError
}
type FormError
= FormErrorNone
| FormErrorNoConnection
| FormErrorHttp Http.Error
type Msg
= SetSubject String
| RecipientMsg Comp.EmailInput.Msg
@ -80,7 +85,7 @@ emptyModel =
, bccRecipientsModel = Comp.EmailInput.init
, body = ""
, attachAll = True
, formError = Nothing
, formError = FormErrorNone
}
@ -111,7 +116,10 @@ update flags msg model =
( em, ec, rec ) =
Comp.EmailInput.update flags model.recipients m model.recipientsModel
in
( { model | recipients = rec, recipientsModel = em }
( { model
| recipients = rec
, recipientsModel = em
}
, Cmd.map RecipientMsg ec
, FormNone
)
@ -121,7 +129,10 @@ update flags msg model =
( em, ec, rec ) =
Comp.EmailInput.update flags model.ccRecipients m model.ccRecipientsModel
in
( { model | ccRecipients = rec, ccRecipientsModel = em }
( { model
| ccRecipients = rec
, ccRecipientsModel = em
}
, Cmd.map CCRecipientMsg ec
, FormNone
)
@ -165,24 +176,24 @@ update flags msg model =
| connectionModel = cm
, formError =
if names == [] then
Just "No E-Mail connections configured. Goto user settings to add one."
FormErrorNoConnection
else
Nothing
FormErrorNone
}
, Cmd.none
, FormNone
)
ConnResp (Err err) ->
( { model | formError = Just (Util.Http.errorToString err) }, Cmd.none, FormNone )
( { model | formError = FormErrorHttp err }, Cmd.none, FormNone )
Cancel ->
( model, Cmd.none, FormCancel )
Send ->
case ( model.formError, Comp.Dropdown.getSelected model.connectionModel ) of
( Nothing, conn :: [] ) ->
( FormErrorNone, conn :: [] ) ->
let
emptyMail =
Api.Model.SimpleMail.empty
@ -212,7 +223,9 @@ isValid model =
&& model.body
/= ""
&& model.formError
== Nothing
== FormErrorNone
&& Comp.Dropdown.getSelected model.connectionModel
/= []
@ -249,9 +262,17 @@ view2 texts settings model =
]
, div
[ class S.errorMessage
, classList [ ( "hidden", model.formError == Nothing ) ]
, classList [ ( "hidden", model.formError == FormErrorNone ) ]
]
[ Maybe.withDefault "" model.formError |> text
[ case model.formError of
FormErrorNone ->
text ""
FormErrorHttp err ->
text (texts.httpError err)
FormErrorNoConnection ->
text texts.connectionMissing
]
, div [ class "mb-4" ]
[ label
@ -320,7 +341,7 @@ view2 texts settings model =
}
, div [ class "flex flex-row space-x-2" ]
[ B.primaryButton
{ label = "Send"
{ label = texts.sendLabel
, icon = "fa fa-paper-plane font-thin"
, handler = onClick Send
, attrs = [ href "#" ]

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

@ -33,8 +33,8 @@ import Http
import Markdown
import Messages.Comp.NotificationForm exposing (Texts)
import Styles as S
import Util.Http
import Util.Maybe
import Util.Result
import Util.Tag
import Util.Update
@ -50,15 +50,28 @@ type alias Model =
, remindDaysModel : Comp.IntField.Model
, capOverdue : Bool
, enabled : Bool
, schedule : Validated CalEvent
, schedule : Result CalEvent CalEvent
, scheduleModel : Comp.CalEventInput.Model
, formMsg : Maybe BasicResult
, formState : FormState
, loading : Int
, yesNoDelete : Comp.YesNoDimmer.Model
, summary : Maybe String
}
type FormState
= FormStateInitial
| FormStateHttpError Http.Error
| FormStateInvalid ValidateError
type ValidateError
= ValidateConnectionMissing
| ValidateRemindDaysRequired
| ValidateRecipientsRequired
| ValidateCalEventInvalid
type Action
= SubmitAction NotificationSettings
| StartOnceAction NotificationSettings
@ -121,9 +134,9 @@ initWith flags s =
, remindDays = Just s.remindDays
, enabled = s.enabled
, capOverdue = s.capOverdue
, schedule = Data.Validated.Unknown newSchedule
, schedule = Ok newSchedule
, scheduleModel = sm
, formMsg = Nothing
, formState = FormStateInitial
, loading = im.loading
, yesNoDelete = Comp.YesNoDimmer.emptyModel
, summary = s.summary
@ -140,7 +153,7 @@ init : Flags -> ( Model, Cmd Msg )
init flags =
let
initialSchedule =
Data.Validated.Valid Data.CalEvent.everyMonth
Ok Data.CalEvent.everyMonth
sm =
Comp.CalEventInput.initDefault
@ -157,7 +170,7 @@ init flags =
, capOverdue = False
, schedule = initialSchedule
, scheduleModel = sm
, formMsg = Nothing
, formState = FormStateInitial
, loading = 2
, yesNoDelete = Comp.YesNoDimmer.emptyModel
, summary = Nothing
@ -173,7 +186,7 @@ init flags =
--- Update
makeSettings : Model -> Validated NotificationSettings
makeSettings : Model -> Result ValidateError NotificationSettings
makeSettings model =
let
prev =
@ -182,19 +195,22 @@ makeSettings model =
conn =
Comp.Dropdown.getSelected model.connectionModel
|> List.head
|> Maybe.map Valid
|> Maybe.withDefault (Invalid [ "Connection missing" ] "")
|> Maybe.map Ok
|> Maybe.withDefault (Err ValidateConnectionMissing)
recp =
if List.isEmpty model.recipients then
Invalid [ "No recipients" ] []
Err ValidateRecipientsRequired
else
Valid model.recipients
Ok model.recipients
rmdays =
Maybe.map Valid model.remindDays
|> Maybe.withDefault (Invalid [ "Remind Days is required" ] 0)
Maybe.map Ok model.remindDays
|> Maybe.withDefault (Err ValidateRemindDaysRequired)
schedule_ =
Result.mapError (\_ -> ValidateCalEventInvalid) model.schedule
make smtp rec days timer =
{ prev
@ -209,34 +225,24 @@ makeSettings model =
, summary = model.summary
}
in
Data.Validated.map4 make
Result.map4 make
conn
recp
rmdays
model.schedule
schedule_
withValidSettings : (NotificationSettings -> Action) -> Model -> ( Model, Action, Cmd Msg )
withValidSettings mkcmd model =
case makeSettings model of
Valid set ->
( { model | formMsg = Nothing }
Ok set ->
( { model | formState = FormStateInitial }
, mkcmd set
, Cmd.none
)
Invalid errs _ ->
let
errMsg =
String.join ", " errs
in
( { model | formMsg = Just (BasicResult False errMsg) }
, NoAction
, Cmd.none
)
Unknown _ ->
( { model | formMsg = Just (BasicResult False "An unknown error occured") }
Err errs ->
( { model | formState = FormStateInvalid errs }
, NoAction
, Cmd.none
)
@ -249,14 +255,23 @@ update flags msg model =
let
( cm, cc, cs ) =
Comp.CalEventInput.update flags
(Data.Validated.value model.schedule)
(Util.Result.fold identity identity model.schedule)
lmsg
model.scheduleModel
in
( { model
| schedule = cs
| schedule =
case cs of
Data.Validated.Valid e ->
Ok e
Data.Validated.Invalid _ e ->
Err e
Data.Validated.Unknown e ->
Ok e
, scheduleModel = cm
, formMsg = Nothing
, formState = FormStateInitial
}
, NoAction
, Cmd.map CalEventMsg cc
@ -270,7 +285,7 @@ update flags msg model =
( { model
| recipients = rec
, recipientsModel = em
, formMsg = Nothing
, formState = FormStateInitial
}
, NoAction
, Cmd.map RecipientMsg ec
@ -283,7 +298,7 @@ update flags msg model =
in
( { model
| connectionModel = cm
, formMsg = Nothing
, formState = FormStateInitial
}
, NoAction
, Cmd.map ConnMsg cc
@ -303,15 +318,12 @@ update flags msg model =
( { model
| connectionModel = cm
, loading = model.loading - 1
, formMsg =
, formState =
if names == [] then
Just
(BasicResult False
"No E-Mail connections configured. Goto E-Mail Settings to add one."
)
FormStateInvalid ValidateConnectionMissing
else
Nothing
FormStateInitial
}
, NoAction
, Cmd.none
@ -319,7 +331,7 @@ update flags msg model =
ConnResp (Err err) ->
( { model
| formMsg = Just (BasicResult False (Util.Http.errorToString err))
| formState = FormStateHttpError err
, loading = model.loading - 1
}
, NoAction
@ -333,7 +345,7 @@ update flags msg model =
in
( { model
| tagInclModel = m2
, formMsg = Nothing
, formState = FormStateInitial
}
, NoAction
, Cmd.map TagIncMsg c2
@ -346,7 +358,7 @@ update flags msg model =
in
( { model
| tagExclModel = m2
, formMsg = Nothing
, formState = FormStateInitial
}
, NoAction
, Cmd.map TagExcMsg c2
@ -372,7 +384,7 @@ update flags msg model =
GetTagsResp (Err err) ->
( { model
| loading = model.loading - 1
, formMsg = Just (BasicResult False (Util.Http.errorToString err))
, formState = FormStateHttpError err
}
, NoAction
, Cmd.none
@ -386,7 +398,7 @@ update flags msg model =
( { model
| remindDaysModel = pm
, remindDays = val
, formMsg = Nothing
, formState = FormStateInitial
}
, NoAction
, Cmd.none
@ -395,7 +407,7 @@ update flags msg model =
ToggleEnabled ->
( { model
| enabled = not model.enabled
, formMsg = Nothing
, formState = FormStateInitial
}
, NoAction
, Cmd.none
@ -404,7 +416,7 @@ update flags msg model =
ToggleCapOverdue ->
( { model
| capOverdue = not model.capOverdue
, formMsg = Nothing
, formState = FormStateInitial
}
, NoAction
, Cmd.none
@ -465,15 +477,17 @@ update flags msg model =
isFormError : Model -> Bool
isFormError model =
Maybe.map .success model.formMsg
|> Maybe.map not
|> Maybe.withDefault False
case model.formState of
FormStateInitial ->
False
_ ->
True
isFormSuccess : Model -> Bool
isFormSuccess model =
Maybe.map .success model.formMsg
|> Maybe.withDefault False
not (isFormError model)
view2 : Texts -> String -> UiSettings -> Model -> Html Msg
@ -547,13 +561,28 @@ view2 texts extraClasses settings model =
[ classList
[ ( S.successMessage, isFormSuccess model )
, ( S.errorMessage, isFormError model )
, ( "hidden", model.formMsg == Nothing )
, ( "hidden", model.formState == FormStateInitial )
]
, class "mb-4"
]
[ Maybe.map .message model.formMsg
|> Maybe.withDefault ""
|> text
[ case model.formState of
FormStateInitial ->
text ""
FormStateHttpError err ->
text (texts.httpError err)
FormStateInvalid ValidateConnectionMissing ->
text texts.connectionMissing
FormStateInvalid ValidateCalEventInvalid ->
text texts.invalidCalEvent
FormStateInvalid ValidateRemindDaysRequired ->
text texts.remindDaysRequired
FormStateInvalid ValidateRecipientsRequired ->
text texts.recipientsRequired
]
, div [ class "mb-4" ]
[ MB.viewItem <|
@ -678,7 +707,7 @@ view2 texts extraClasses settings model =
(Comp.CalEventInput.view2
texts.calEventInput
""
(Data.Validated.value model.schedule)
(Util.Result.fold identity identity model.schedule)
model.scheduleModel
)
, span [ class "opacity-50 text-sm" ]

118
modules/webapp/src/main/elm/Comp/NotificationManage.elm
View File

@ -20,24 +20,36 @@ import Html.Attributes exposing (..)
import Http
import Messages.Comp.NotificationManage exposing (Texts)
import Styles as S
import Util.Http
type alias Model =
{ listModel : Comp.NotificationList.Model
, detailModel : Maybe Comp.NotificationForm.Model
, items : List NotificationSettings
, result : Maybe BasicResult
, formState : FormState
}
type SubmitType
= SubmitDelete
| SubmitUpdate
| SubmitCreate
| SubmitStartOnce
type FormState
= FormStateInitial
| FormHttpError Http.Error
| FormSubmitSuccessful SubmitType
| FormSubmitFailed String
type Msg
= ListMsg Comp.NotificationList.Msg
| DetailMsg Comp.NotificationForm.Msg
| GetDataResp (Result Http.Error NotificationSettingsList)
| NewTask
| SubmitResp Bool (Result Http.Error BasicResult)
| DeleteResp (Result Http.Error BasicResult)
| SubmitResp SubmitType (Result Http.Error BasicResult)
initModel : Model
@ -45,7 +57,7 @@ initModel =
{ listModel = Comp.NotificationList.init
, detailModel = Nothing
, items = []
, result = Nothing
, formState = FormStateInitial
}
@ -69,13 +81,13 @@ update flags msg model =
GetDataResp (Ok res) ->
( { model
| items = res.items
, result = Nothing
, formState = FormStateInitial
}
, Cmd.none
)
GetDataResp (Err err) ->
( { model | result = Just (BasicResult False (Util.Http.errorToString err)) }
( { model | formState = FormHttpError err }
, Cmd.none
)
@ -113,26 +125,29 @@ update flags msg model =
( model_, cmd_ ) =
case action of
Comp.NotificationForm.NoAction ->
( { model | detailModel = Just mm }
( { model
| detailModel = Just mm
, formState = FormStateInitial
}
, Cmd.none
)
Comp.NotificationForm.SubmitAction settings ->
( { model
| detailModel = Just mm
, result = Nothing
, formState = FormStateInitial
}
, if settings.id == "" then
Api.createNotifyDueItems flags settings (SubmitResp True)
Api.createNotifyDueItems flags settings (SubmitResp SubmitCreate)
else
Api.updateNotifyDueItems flags settings (SubmitResp True)
Api.updateNotifyDueItems flags settings (SubmitResp SubmitUpdate)
)
Comp.NotificationForm.CancelAction ->
( { model
| detailModel = Nothing
, result = Nothing
, formState = FormStateInitial
}
, initCmd flags
)
@ -140,17 +155,17 @@ update flags msg model =
Comp.NotificationForm.StartOnceAction settings ->
( { model
| detailModel = Just mm
, result = Nothing
, formState = FormStateInitial
}
, Api.startOnceNotifyDueItems flags settings (SubmitResp False)
, Api.startOnceNotifyDueItems flags settings (SubmitResp SubmitStartOnce)
)
Comp.NotificationForm.DeleteAction id ->
( { model
| detailModel = Just mm
, result = Nothing
, formState = FormStateInitial
}
, Api.deleteNotifyDueItems flags id DeleteResp
, Api.deleteNotifyDueItems flags id (SubmitResp SubmitDelete)
)
in
( model_
@ -170,17 +185,22 @@ update flags msg model =
in
( { model | detailModel = Just mm }, Cmd.map DetailMsg mc )
SubmitResp close (Ok res) ->
SubmitResp submitType (Ok res) ->
( { model
| result = Just res
| formState =
if res.success then
FormSubmitSuccessful submitType
else
FormSubmitFailed res.message
, detailModel =
if close then
if submitType == SubmitDelete then
Nothing
else
model.detailModel
}
, if close then
, if submitType == SubmitDelete then
initCmd flags
else
@ -188,23 +208,7 @@ update flags msg model =
)
SubmitResp _ (Err err) ->
( { model | result = Just (BasicResult False (Util.Http.errorToString err)) }
, Cmd.none
)
DeleteResp (Ok res) ->
if res.success then
( { model | result = Nothing, detailModel = Nothing }
, initCmd flags
)
else
( { model | result = Just res }
, Cmd.none
)
DeleteResp (Err err) ->
( { model | result = Just (BasicResult False (Util.Http.errorToString err)) }
( { model | formState = FormHttpError err }
, Cmd.none
)
@ -218,15 +222,33 @@ view2 texts settings model =
div [ class "flex flex-col" ]
(div
[ classList
[ ( S.errorMessage, Maybe.map .success model.result == Just False )
, ( S.successMessage, Maybe.map .success model.result == Just True )
, ( "hidden", model.result == Nothing )
[ ( S.errorMessage, model.formState /= FormStateInitial )
, ( S.successMessage, isSuccess model.formState )
, ( "hidden", model.formState == FormStateInitial )
]
, class "mb-2"
]
[ Maybe.map .message model.result
|> Maybe.withDefault ""
|> text
[ case model.formState of
FormStateInitial ->
text ""
FormSubmitSuccessful SubmitCreate ->
text texts.taskCreated
FormSubmitSuccessful SubmitUpdate ->
text texts.taskUpdated
FormSubmitSuccessful SubmitStartOnce ->
text texts.taskStarted
FormSubmitSuccessful SubmitDelete ->
text texts.taskDeleted
FormSubmitFailed m ->
text m
FormHttpError err ->
text (texts.httpError err)
]
:: (case model.detailModel of
Just msett ->
@ -238,6 +260,16 @@ view2 texts settings model =
)
isSuccess : FormState -> Bool
isSuccess state =
case state of
FormSubmitSuccessful _ ->
True
_ ->
False
viewForm2 : Texts -> UiSettings -> Comp.NotificationForm.Model -> List (Html Msg)
viewForm2 texts settings model =
[ Html.map DetailMsg

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

@ -23,7 +23,6 @@ import Html.Events exposing (onSubmit)
import Http
import Messages.Comp.OrgManage exposing (Texts)
import Styles as S
import Util.Http
import Util.Maybe
@ -31,13 +30,20 @@ type alias Model =
{ tableModel : Comp.OrgTable.Model
, formModel : Comp.OrgForm.Model
, viewMode : ViewMode
, formError : Maybe String
, formError : FormError
, loading : Bool
, deleteConfirm : Comp.YesNoDimmer.Model
, query : String
}
type FormError
= FormErrorNone
| FormErrorHttp Http.Error
| FormErrorSubmit String
| FormErrorInvalid
type ViewMode
= Table
| Form
@ -48,7 +54,7 @@ emptyModel =
{ tableModel = Comp.OrgTable.emptyModel
, formModel = Comp.OrgForm.emptyModel
, viewMode = Table
, formError = Nothing
, formError = FormErrorNone
, loading = False
, deleteConfirm = Comp.YesNoDimmer.emptyModel
, query = ""
@ -83,7 +89,7 @@ update flags msg model =
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
, formError =
if Util.Maybe.nonEmpty tm.selected then
Nothing
FormErrorNone
else
model.formError
@ -136,7 +142,7 @@ update flags msg model =
InitNewOrg ->
let
nm =
{ model | viewMode = Form, formError = Nothing }
{ model | viewMode = Form, formError = FormErrorNone }
org =
Api.Model.Organization.empty
@ -155,7 +161,7 @@ update flags msg model =
( { model | loading = True }, Api.postOrg flags org SubmitResp )
else
( { model | formError = Just "Please correct the errors in the form." }, Cmd.none )
( { model | formError = FormErrorInvalid }, Cmd.none )
SubmitResp (Ok res) ->
if res.success then
@ -169,10 +175,10 @@ update flags msg model =
( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else
( { model | formError = Just res.message, loading = False }, Cmd.none )
( { model | formError = FormErrorSubmit res.message, loading = False }, Cmd.none )
SubmitResp (Err err) ->
( { model | formError = Just (Util.Http.errorToString err), loading = False }, Cmd.none )
( { model | formError = FormErrorHttp err, loading = False }, Cmd.none )
RequestDelete ->
update flags (YesNoMsg Comp.YesNoDimmer.activate) model
@ -310,12 +316,23 @@ viewForm2 texts settings model =
}
, div
[ classList
[ ( "hidden", Util.Maybe.isEmpty model.formError )
[ ( "hidden", model.formError == FormErrorNone )
]
, class S.errorMessage
, class "my-2"
]
[ Maybe.withDefault "" model.formError |> text
[ case model.formError of
FormErrorNone ->
text ""
FormErrorSubmit m ->
text m
FormErrorHttp err ->
text (texts.httpError err)
FormErrorInvalid ->
text texts.correctFormErrors
]
, Html.map FormMsg
(Comp.OrgForm.view2

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

@ -24,7 +24,6 @@ import Html.Events exposing (onSubmit)
import Http
import Messages.Comp.PersonManage exposing (Texts)
import Styles as S
import Util.Http
import Util.Maybe
@ -32,13 +31,20 @@ type alias Model =
{ tableModel : Comp.PersonTable.Model
, formModel : Comp.PersonForm.Model
, viewMode : ViewMode
, formError : Maybe String
, formError : FormError
, loading : Int
, deleteConfirm : Comp.YesNoDimmer.Model
, query : String
}
type FormError
= FormErrorNone
| FormErrorHttp Http.Error
| FormErrorSubmit String
| FormErrorInvalid
type ViewMode
= Table
| Form
@ -49,7 +55,7 @@ emptyModel =
{ tableModel = Comp.PersonTable.emptyModel
, formModel = Comp.PersonForm.emptyModel
, viewMode = Table
, formError = Nothing
, formError = FormErrorNone
, loading = 0
, deleteConfirm = Comp.YesNoDimmer.emptyModel
, query = ""
@ -85,7 +91,7 @@ update flags msg model =
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
, formError =
if Util.Maybe.nonEmpty tm.selected then
Nothing
FormErrorNone
else
model.formError
@ -156,7 +162,7 @@ update flags msg model =
InitNewPerson ->
let
nm =
{ model | viewMode = Form, formError = Nothing }
{ model | viewMode = Form, formError = FormErrorNone }
org =
Api.Model.Person.empty
@ -177,7 +183,7 @@ update flags msg model =
)
else
( { model | formError = Just "Please correct the errors in the form." }, Cmd.none )
( { model | formError = FormErrorInvalid }, Cmd.none )
SubmitResp (Ok res) ->
if res.success then
@ -192,7 +198,7 @@ update flags msg model =
else
( { model
| formError = Just res.message
| formError = FormErrorSubmit res.message
, loading = Basics.max 0 (model.loading - 1)
}
, Cmd.none
@ -200,7 +206,7 @@ update flags msg model =
SubmitResp (Err err) ->
( { model
| formError = Just (Util.Http.errorToString err)
| formError = FormErrorHttp err
, loading = Basics.max 0 (model.loading - 1)
}
, Cmd.none
@ -347,12 +353,23 @@ viewForm2 texts settings model =
}
, div
[ classList
[ ( "hidden", Util.Maybe.isEmpty model.formError )
[ ( "hidden", model.formError == FormErrorNone )
]
, class S.errorMessage
, class "my-2"
]
[ Maybe.withDefault "" model.formError |> text
[ case model.formError of
FormErrorNone ->
text ""
FormErrorSubmit m ->
text m
FormErrorHttp err ->
text (texts.httpError err)
FormErrorInvalid ->
text texts.correctFormErrors
]
, Html.map FormMsg
(Comp.PersonForm.view2 texts.personForm

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

@ -9,7 +9,6 @@ module Comp.ScanMailboxForm exposing
)
import Api
import Api.Model.BasicResult exposing (BasicResult)
import Api.Model.FolderItem exposing (FolderItem)
import Api.Model.FolderList exposing (FolderList)
import Api.Model.IdName exposing (IdName)
@ -44,9 +43,9 @@ import Messages.Data.Language
import Set exposing (Set)
import Styles as S
import Util.Folder exposing (mkFolderOption)
import Util.Http
import Util.List
import Util.Maybe
import Util.Result
import Util.Tag
import Util.Update
@ -62,9 +61,9 @@ type alias Model =
, foldersModel : Comp.StringListInput.Model
, folders : List String
, direction : Maybe Direction
, schedule : Validated CalEvent
, schedule : Result CalEvent CalEvent
, scheduleModel : Comp.CalEventInput.Model
, formMsg : Maybe BasicResult
, formState : FormState
, loading : Int
, yesNoDelete : Comp.YesNoDimmer.Model
, folderModel : Comp.Dropdown.Model IdName
@ -82,6 +81,18 @@ type alias Model =
}
type FormState
= FormStateInitial
| FormStateHttpError Http.Error
| FormStateInvalid ValidateError
type ValidateError
= ValidateNoProcessingFolders
| ValidateConnectionMissing
| ValidateCalEventInvalid
type Action
= SubmitAction ScanMailboxSettings
| StartOnceAction ScanMailboxSettings
@ -179,10 +190,10 @@ initWith flags s =
, receivedHours = s.receivedSinceHours
, targetFolder = s.targetFolder
, folders = s.folders
, schedule = Data.Validated.Unknown newSchedule
, schedule = Ok newSchedule
, direction = Maybe.andThen Data.Direction.fromString s.direction
, scheduleModel = sm
, formMsg = Nothing
, formState = FormStateInitial
, yesNoDelete = Comp.YesNoDimmer.emptyModel
, itemFolderId = s.itemFolder
, tagModel = Util.Tag.makeDropdownModel
@ -211,7 +222,7 @@ init : Flags -> ( Model, Cmd Msg )
init flags =
let
initialSchedule =
Data.Validated.Valid Data.CalEvent.everyMonth
Ok Data.CalEvent.everyMonth
sm =
Comp.CalEventInput.initDefault
@ -228,7 +239,7 @@ init flags =
, direction = Nothing
, schedule = initialSchedule
, scheduleModel = sm
, formMsg = Nothing
, formState = FormStateInitial
, loading = 3
, yesNoDelete = Comp.YesNoDimmer.emptyModel
, folderModel = Comp.Dropdown.makeSingle
@ -257,7 +268,7 @@ init flags =
--- Update
makeSettings : Model -> Validated ScanMailboxSettings
makeSettings : Model -> Result ValidateError ScanMailboxSettings
makeSettings model =
let
prev =
@ -266,15 +277,18 @@ makeSettings model =
conn =
Comp.Dropdown.getSelected model.connectionModel
|> List.head
|> Maybe.map Valid
|> Maybe.withDefault (Invalid [ "Connection missing" ] "")
|> Maybe.map Ok
|> Maybe.withDefault (Err ValidateConnectionMissing)
infolders =
if model.folders == [] then
Invalid [ "No processing folders given" ] []
Err ValidateNoProcessingFolders
else
Valid model.folders
Ok model.folders
schedule_ =
Result.mapError (\_ -> ValidateCalEventInvalid) model.schedule
make imap timer folders =
{ prev
@ -303,33 +317,20 @@ makeSettings model =
, summary = model.summary
}
in
Data.Validated.map3 make
conn
model.schedule
infolders
Result.map3 make conn schedule_ infolders
withValidSettings : (ScanMailboxSettings -> Action) -> Model -> ( Model, Action, Cmd Msg )
withValidSettings mkAction model =
case makeSettings model of
Valid set ->
( { model | formMsg = Nothing }
Ok set ->
( { model | formState = FormStateInitial }
, mkAction set
, Cmd.none
)
Invalid errs _ ->
let
errMsg =
String.join ", " errs
in
( { model | formMsg = Just (BasicResult False errMsg) }
, NoAction
, Cmd.none
)
Unknown _ ->
( { model | formMsg = Just (BasicResult False "An unknown error occured") }
Err errs ->
( { model | formState = FormStateInvalid errs }
, NoAction
, Cmd.none
)
@ -342,14 +343,23 @@ update flags msg model =
let
( cm, cc, cs ) =
Comp.CalEventInput.update flags
(Data.Validated.value model.schedule)
(Util.Result.fold identity identity model.schedule)
lmsg
model.scheduleModel
in
( { model
| schedule = cs
| schedule =
case cs of
Data.Validated.Valid e ->
Ok e
Data.Validated.Invalid _ e ->
Err e
Data.Validated.Unknown e ->
Ok e
, scheduleModel = cm
, formMsg = Nothing
, formState = FormStateInitial
}
, NoAction
, Cmd.map CalEventMsg cc
@ -362,7 +372,7 @@ update flags msg model =
in
( { model
| connectionModel = cm
, formMsg = Nothing
, formState = FormStateInitial
}
, NoAction
, Cmd.map ConnMsg cc
@ -394,15 +404,12 @@ update flags msg model =
( { model
| connectionModel = cm
, loading = model.loading - 1
, formMsg =
, formState =
if names == [] then
Just
(BasicResult False
"No E-Mail connections configured. Goto E-Mail Settings to add one."
)
FormStateInvalid ValidateConnectionMissing
else
Nothing
FormStateInitial
}
, NoAction
, Cmd.none
@ -410,7 +417,7 @@ update flags msg model =
ConnResp (Err err) ->
( { model
| formMsg = Just (BasicResult False (Util.Http.errorToString err))
| formState = FormStateHttpError err
, loading = model.loading - 1
}
, NoAction
@ -420,7 +427,7 @@ update flags msg model =
ToggleEnabled ->
( { model
| enabled = not model.enabled
, formMsg = Nothing
, formState = FormStateInitial
}
, NoAction
, Cmd.none
@ -429,7 +436,7 @@ update flags msg model =
ToggleDeleteMail ->
( { model
| deleteMail = not model.deleteMail
, formMsg = Nothing
, formState = FormStateInitial
}
, NoAction
, Cmd.none
@ -443,7 +450,7 @@ update flags msg model =
( { model
| receivedHoursModel = pm
, receivedHours = val
, formMsg = Nothing
, formState = FormStateInitial
}
, NoAction
, Cmd.none
@ -714,15 +721,17 @@ update flags msg model =
isFormError : Model -> Bool
isFormError model =
Maybe.map .success model.formMsg
|> Maybe.map not
|> Maybe.withDefault False
case model.formState of
FormStateInitial ->
False
_ ->
True
isFormSuccess : Model -> Bool
isFormSuccess model =
Maybe.map .success model.formMsg
|> Maybe.withDefault False
not (isFormError model)
isFolderMember : Model -> Bool
@ -796,12 +805,24 @@ view2 texts flags extraClasses settings model =
[ classList
[ ( S.successMessage, isFormSuccess model )
, ( S.errorMessage, isFormError model )
, ( "hidden", model.formMsg == Nothing )
, ( "hidden", model.formState == FormStateInitial )
]
]
[ Maybe.map .message model.formMsg
|> Maybe.withDefault ""
|> text
[ case model.formState of
FormStateInitial ->
text ""
FormStateHttpError err ->
text (texts.httpError err)
FormStateInvalid ValidateConnectionMissing ->
text texts.connectionMissing
FormStateInvalid ValidateNoProcessingFolders ->
text texts.noProcessingFolders
FormStateInvalid ValidateCalEventInvalid ->
text texts.invalidCalEvent
]
, Comp.Tabs.akkordion
Comp.Tabs.defaultStyle
@ -1172,7 +1193,7 @@ viewSchedule2 texts model =
(Comp.CalEventInput.view2
texts.calEventInput
""
(Data.Validated.value model.schedule)
(Util.Result.fold identity identity model.schedule)
model.scheduleModel
)
, span [ class "opacity-50 text-sm" ]

119
modules/webapp/src/main/elm/Comp/ScanMailboxManage.elm
View File

@ -20,24 +20,36 @@ import Html.Attributes exposing (..)
import Http
import Messages.Comp.ScanMailboxManage exposing (Texts)
import Styles as S
import Util.Http
type alias Model =
{ listModel : Comp.ScanMailboxList.Model
, detailModel : Maybe Comp.ScanMailboxForm.Model
, items : List ScanMailboxSettings
, result : Maybe BasicResult
, formState : FormState
}
type SubmitType
= SubmitDelete
| SubmitUpdate
| SubmitCreate
| SubmitStartOnce
type FormState
= FormStateInitial
| FormHttpError Http.Error
| FormSubmitSuccessful SubmitType
| FormSubmitFailed String
type Msg
= ListMsg Comp.ScanMailboxList.Msg
| DetailMsg Comp.ScanMailboxForm.Msg
| GetDataResp (Result Http.Error ScanMailboxSettingsList)
| NewTask
| SubmitResp Bool (Result Http.Error BasicResult)
| DeleteResp (Result Http.Error BasicResult)
| SubmitResp SubmitType (Result Http.Error BasicResult)
initModel : Model
@ -45,7 +57,7 @@ initModel =
{ listModel = Comp.ScanMailboxList.init
, detailModel = Nothing
, items = []
, result = Nothing
, formState = FormStateInitial
}
@ -69,13 +81,13 @@ update flags msg model =
GetDataResp (Ok res) ->
( { model
| items = res.items
, result = Nothing
, formState = FormStateInitial
}
, Cmd.none
)
GetDataResp (Err err) ->
( { model | result = Just (BasicResult False (Util.Http.errorToString err)) }
( { model | formState = FormHttpError err }
, Cmd.none
)
@ -113,26 +125,29 @@ update flags msg model =
( model_, cmd_ ) =
case action of
Comp.ScanMailboxForm.NoAction ->
( { model | detailModel = Just mm }
( { model
| detailModel = Just mm
, formState = FormStateInitial
}
, Cmd.none
)
Comp.ScanMailboxForm.SubmitAction settings ->
( { model
| detailModel = Just mm
, result = Nothing
, formState = FormStateInitial
}
, if settings.id == "" then
Api.createScanMailbox flags settings (SubmitResp True)
Api.createScanMailbox flags settings (SubmitResp SubmitCreate)
else
Api.updateScanMailbox flags settings (SubmitResp True)
Api.updateScanMailbox flags settings (SubmitResp SubmitUpdate)
)
Comp.ScanMailboxForm.CancelAction ->
( { model
| detailModel = Nothing
, result = Nothing
, formState = FormStateInitial
}
, initCmd flags
)
@ -140,17 +155,17 @@ update flags msg model =
Comp.ScanMailboxForm.StartOnceAction settings ->
( { model
| detailModel = Just mm
, result = Nothing
, formState = FormStateInitial
}
, Api.startOnceScanMailbox flags settings (SubmitResp False)
, Api.startOnceScanMailbox flags settings (SubmitResp SubmitStartOnce)
)
Comp.ScanMailboxForm.DeleteAction id ->
( { model
| detailModel = Just mm
, result = Nothing
, formState = FormStateInitial
}
, Api.deleteScanMailbox flags id DeleteResp
, Api.deleteScanMailbox flags id (SubmitResp SubmitDelete)
)
in
( model_
@ -170,17 +185,22 @@ update flags msg model =
in
( { model | detailModel = Just mm }, Cmd.map DetailMsg mc )
SubmitResp close (Ok res) ->
SubmitResp submitType (Ok res) ->
( { model
| result = Just res
| formState =
if res.success then
FormSubmitSuccessful submitType
else
FormSubmitFailed res.message
, detailModel =
if close then
if submitType == SubmitDelete then
Nothing
else
model.detailModel
}
, if close then
, if submitType == SubmitDelete then
initCmd flags
else
@ -188,23 +208,7 @@ update flags msg model =
)
SubmitResp _ (Err err) ->
( { model | result = Just (BasicResult False (Util.Http.errorToString err)) }
, Cmd.none
)
DeleteResp (Ok res) ->
if res.success then
( { model | result = Nothing, detailModel = Nothing }
, initCmd flags
)
else
( { model | result = Just res }
, Cmd.none
)
DeleteResp (Err err) ->
( { model | result = Just (BasicResult False (Util.Http.errorToString err)) }
( { model | formState = FormHttpError err }
, Cmd.none
)
@ -218,14 +222,33 @@ view2 texts flags settings model =
div [ class "flex flex-col" ]
(div
[ classList
[ ( S.errorMessage, Maybe.map .success model.result == Just False )
, ( S.successMessage, Maybe.map .success model.result == Just True )
, ( "hidden", model.result == Nothing )
[ ( S.errorMessage, model.formState /= FormStateInitial )
, ( S.successMessage, isSuccess model.formState )
, ( "hidden", model.formState == FormStateInitial )
]
, class "mb-2"
]
[ Maybe.map .message model.result
|> Maybe.withDefault ""
|> text
[ case model.formState of
FormStateInitial ->
text ""
FormSubmitSuccessful SubmitCreate ->
text texts.taskCreated
FormSubmitSuccessful SubmitUpdate ->
text texts.taskUpdated
FormSubmitSuccessful SubmitStartOnce ->
text texts.taskStarted
FormSubmitSuccessful SubmitDelete ->
text texts.taskDeleted
FormSubmitFailed m ->
text m
FormHttpError err ->
text (texts.httpError err)
]
:: (case model.detailModel of
Just msett ->
@ -237,6 +260,16 @@ view2 texts flags settings model =
)
isSuccess : FormState -> Bool
isSuccess state =
case state of
FormSubmitSuccessful _ ->
True
_ ->
False
viewForm2 : Texts -> Flags -> UiSettings -> Comp.ScanMailboxForm.Model -> List (Html Msg)
viewForm2 texts flags settings model =
[ Html.map DetailMsg

38
modules/webapp/src/main/elm/Comp/SourceManage.elm
View File

@ -25,20 +25,25 @@ import Messages.Comp.SourceManage exposing (Texts)
import Ports
import QRCode
import Styles as S
import Util.Http
import Util.Maybe
type alias Model =
{ formModel : Comp.SourceForm.Model
, viewMode : SelectMode
, formError : Maybe String
, formError : FormError
, loading : Bool
, deleteConfirm : Comp.YesNoDimmer.Model
, sources : List SourceAndTags
}
type FormError
= FormErrorNone
| FormErrorHttp Http.Error
| FormErrorInvalid
| FormErrorSubmit String
init : Flags -> ( Model, Cmd Msg )
init flags =
let
@ -47,7 +52,7 @@ init flags =
in
( { formModel = fm
, viewMode = None
, formError = Nothing
, formError = FormErrorNone
, loading = False
, deleteConfirm = Comp.YesNoDimmer.emptyModel
, sources = []
@ -103,7 +108,7 @@ update flags msg model =
model.formError
else
Nothing
FormErrorNone
}
, Cmd.map TableMsg tc
)
@ -152,7 +157,7 @@ update flags msg model =
Api.Model.SourceAndTags.empty
nm =
{ model | viewMode = Edit source, formError = Nothing }
{ model | viewMode = Edit source, formError = FormErrorNone }
in
update flags (FormMsg (Comp.SourceForm.SetSource source)) nm
@ -168,7 +173,7 @@ update flags msg model =
( { model | loading = True }, Api.postSource flags source SubmitResp )
else
( { model | formError = Just "Please correct the errors in the form." }, Cmd.none )
( { model | formError = FormErrorInvalid }, Cmd.none )
SubmitResp (Ok res) ->
if res.success then
@ -182,10 +187,10 @@ update flags msg model =
( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else
( { model | formError = Just res.message, loading = False }, Cmd.none )
( { model | formError = FormErrorSubmit res.message, loading = False }, Cmd.none )
SubmitResp (Err err) ->
( { model | formError = Just (Util.Http.errorToString err), loading = False }, Cmd.none )
( { model | formError = FormErrorHttp err, loading = False }, Cmd.none )
RequestDelete ->
update flags (YesNoMsg Comp.YesNoDimmer.activate) model
@ -444,10 +449,21 @@ viewForm2 texts flags settings model =
, div
[ classList
[ ( S.errorMessage, True )
, ( "hidden", Util.Maybe.isEmpty model.formError )
, ( "hidden", model.formError == FormErrorNone )
]
]
[ Maybe.withDefault "" model.formError |> text
[ case model.formError of
FormErrorNone ->
text ""
FormErrorHttp err ->
text (texts.httpError err)
FormErrorSubmit m ->
text m
FormErrorInvalid ->
text texts.correctFormErrors
]
, Html.map YesNoMsg
(Comp.YesNoDimmer.viewN True

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

@ -22,7 +22,6 @@ import Html.Events exposing (onSubmit)
import Http
import Messages.Comp.TagManage exposing (Texts)
import Styles as S
import Util.Http
import Util.Maybe
import Util.Tag
import Util.Update
@ -32,13 +31,20 @@ type alias Model =
{ tagTableModel : Comp.TagTable.Model
, tagFormModel : Comp.TagForm.Model
, viewMode : ViewMode
, formError : Maybe String
, formError : FormError
, loading : Bool
, deleteConfirm : Comp.YesNoDimmer.Model
, query : String
}
type FormError
= FormErrorNone
| FormErrorHttp Http.Error
| FormErrorInvalid
| FormErrorSubmit String
type ViewMode
= Table
| Form
@ -49,7 +55,7 @@ emptyModel =
{ tagTableModel = Comp.TagTable.emptyModel
, tagFormModel = Comp.TagForm.emptyModel []
, viewMode = Table
, formError = Nothing
, formError = FormErrorNone
, loading = False
, deleteConfirm = Comp.YesNoDimmer.emptyModel
, query = ""
@ -84,7 +90,7 @@ update flags msg model =
, viewMode = Maybe.map (\_ -> Form) tm.selected |> Maybe.withDefault Table
, formError =
if Util.Maybe.nonEmpty tm.selected then
Nothing
FormErrorNone
else
model.formError
@ -144,7 +150,7 @@ update flags msg model =
InitNewTag ->
let
nm =
{ model | viewMode = Form, formError = Nothing }
{ model | viewMode = Form, formError = FormErrorNone }
tag =
Api.Model.Tag.empty
@ -163,7 +169,7 @@ update flags msg model =
( { model | loading = True }, Api.postTag flags tag SubmitResp )
else
( { model | formError = Just "Please correct the errors in the form." }, Cmd.none )
( { model | formError = FormErrorInvalid }, Cmd.none )
SubmitResp (Ok res) ->
if res.success then
@ -177,10 +183,10 @@ update flags msg model =
( { m3 | loading = False }, Cmd.batch [ c2, c3 ] )
else
( { model | formError = Just res.message, loading = False }, Cmd.none )
( { model | formError = FormErrorSubmit res.message, loading = False }, Cmd.none )
SubmitResp (Err err) ->
( { model | formError = Just (Util.Http.errorToString err), loading = False }, Cmd.none )
( { model | formError = FormErrorHttp err, loading = False }, Cmd.none )
RequestDelete ->
update flags (YesNoMsg Comp.YesNoDimmer.activate) model
@ -322,12 +328,23 @@ viewForm2 texts model =
}
, div
[ classList
[ ( "hidden", Util.Maybe.isEmpty model.formError )
[ ( "hidden", model.formError == FormErrorNone )
]
, class "my-2"
, class S.errorMessage
]
[ Maybe.withDefault "" model.formError |> text
[ case model.formError of
FormErrorNone ->
text ""
FormErrorHttp err ->
text (texts.httpError err)
FormErrorInvalid ->
text texts.correctFormErrors
FormErrorSubmit m ->
text m
]
, Html.map FormMsg (Comp.TagForm.view2 texts.tagForm model.tagFormModel)
, B.loadingDimmer

7
modules/webapp/src/main/elm/Comp/UserManage.elm
View File

@ -23,7 +23,6 @@ import Html.Events exposing (onSubmit)
import Http
import Messages.Comp.UserManage exposing (Texts)
import Styles as S
import Util.Http
import Util.Maybe
@ -45,6 +44,7 @@ type ViewMode
type FormError
= FormErrorNone
| FormErrorSubmit String
| FormErrorHttp Http.Error
| FormErrorInvalid
@ -183,7 +183,7 @@ update flags msg model =
SubmitResp (Err err) ->
( { model
| formError = FormErrorSubmit (Util.Http.errorToString err)
| formError = FormErrorHttp err
, loading = False
}
, Cmd.none
@ -319,6 +319,9 @@ viewForm2 texts settings model =
FormErrorSubmit err ->
text err
FormErrorHttp err ->
text (texts.httpError err)
FormErrorInvalid ->
text texts.pleaseCorrectErrors
]

16
modules/webapp/src/main/elm/Data/Validated.elm
View File

@ -5,9 +5,12 @@ module Data.Validated exposing
, map2
, map3
, map4
, toResult
, value
)
-- TODO Remove this, use Result
type Validated a
= Valid a
@ -15,6 +18,19 @@ type Validated a
| Unknown a
toResult : Validated a -> Result String a
toResult va =
case va of
Valid a ->
Ok a
Invalid errs _ ->
Err (String.join ", " errs)
Unknown a ->
Ok a
isInvalid : Validated a -> Bool
isInvalid v =
case v of

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

@ -1,12 +1,15 @@
module Messages.Comp.AttachmentMeta exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.HttpError
import Messages.DateFormat as DF
import Messages.UiLanguage
type alias Texts =
{ basics : Messages.Basics.Texts
, httpError : Http.Error -> String
, extractedMetadata : String
, content : String
, labels : String
@ -24,6 +27,7 @@ type alias Texts =
gb : Texts
gb =
{ basics = Messages.Basics.gb
, httpError = Messages.Comp.HttpError.gb
, extractedMetadata = "Extracted Meta Data"
, content = "Content"
, labels = "Labels"

10
modules/webapp/src/main/elm/Messages/Comp/ChangePasswordForm.elm
View File

@ -1,26 +1,36 @@
module Messages.Comp.ChangePasswordForm exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.HttpError
type alias Texts =
{ basics : Messages.Basics.Texts
, httpError : Http.Error -> String
, currentPassword : String
, newPassword : String
, repeatPassword : String
, currentPasswordPlaceholder : String
, newPasswordPlaceholder : String
, repeatPasswordPlaceholder : String
, passwordMismatch : String
, fillRequiredFields : String
, passwordChangeSuccessful : String
}
gb : Texts
gb =
{ basics = Messages.Basics.gb
, httpError = Messages.Comp.HttpError.gb
, currentPassword = "Current Password"
, newPassword = "New Password"
, repeatPassword = "New Password (repeat)"
, currentPasswordPlaceholder = "Password"
, newPasswordPlaceholder = "Password"
, repeatPasswordPlaceholder = "Password"
, passwordMismatch = "The passwords do not match."
, fillRequiredFields = "Please fill required fields."
, passwordChangeSuccessful = "Password has been changed."
}

11
modules/webapp/src/main/elm/Messages/Comp/CollectiveSettingsForm.elm
View File

@ -1,14 +1,17 @@
module Messages.Comp.CollectiveSettingsForm exposing (Texts, gb)
import Data.Language exposing (Language)
import Http
import Messages.Basics
import Messages.Comp.ClassifierSettingsForm
import Messages.Comp.HttpError
import Messages.Data.Language
type alias Texts =
{ basics : Messages.Basics.Texts
, classifierSettingsForm : Messages.Comp.ClassifierSettingsForm.Texts
, httpError : Http.Error -> String
, save : String
, saveSettings : String
, documentLanguage : String
@ -22,6 +25,9 @@ type alias Texts =
, autoTagging : String
, startNow : String
, languageLabel : Language -> String
, classifierTaskStarted : String
, fulltextReindexSubmitted : String
, fulltextReindexOkMissing : String
}
@ -29,6 +35,7 @@ gb : Texts
gb =
{ basics = Messages.Basics.gb
, classifierSettingsForm = Messages.Comp.ClassifierSettingsForm.gb
, httpError = Messages.Comp.HttpError.gb
, save = "Save"
, saveSettings = "Save Settings"
, documentLanguage = "Document Language"
@ -46,4 +53,8 @@ gb =
, autoTagging = "Auto-Tagging"
, startNow = "Start now"
, languageLabel = Messages.Data.Language.gb
, classifierTaskStarted = "Classifier task started."
, fulltextReindexSubmitted = "Fulltext Re-Index started."
, fulltextReindexOkMissing =
"Please type OK in the field if you really want to start re-indexing your data."
}

10
modules/webapp/src/main/elm/Messages/Comp/CustomFieldForm.elm
View File

@ -1,7 +1,9 @@
module Messages.Comp.CustomFieldForm exposing (Texts, gb)
import Data.CustomFieldType exposing (CustomFieldType)
import Http
import Messages.Basics
import Messages.Comp.HttpError
import Messages.Data.CustomFieldType
@ -9,6 +11,7 @@ type alias Texts =
{ basics : Messages.Basics.Texts
, reallyDeleteField : String
, fieldTypeLabel : CustomFieldType -> String
, httpError : Http.Error -> String
, createCustomField : String
, modifyTypeWarning : String
, nameInfo : String
@ -17,6 +20,9 @@ type alias Texts =
, label : String
, labelInfo : String
, deleteThisField : String
, fieldNameRequired : String
, fieldTypeRequired : String
, updateSuccessful : String
}
@ -25,6 +31,7 @@ gb =
{ basics = Messages.Basics.gb
, reallyDeleteField = "Really delete this custom field?"
, fieldTypeLabel = Messages.Data.CustomFieldType.gb
, httpError = Messages.Comp.HttpError.gb
, createCustomField = "Create a new custom field."
, modifyTypeWarning =
"Note that changing the format may "
@ -41,4 +48,7 @@ gb =
"The user defined label for this field. This is used to represent "
++ "this field in the ui. If not present, the name is used."
, deleteThisField = "Delete this field"
, fieldNameRequired = "A name is required."
, fieldTypeRequired = "A type is required."
, updateSuccessful = "Field has been saved."
}

8
modules/webapp/src/main/elm/Messages/Comp/DetailEdit.elm
View File

@ -1,8 +1,10 @@
module Messages.Comp.DetailEdit exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.CustomFieldForm
import Messages.Comp.EquipmentForm
import Messages.Comp.HttpError
import Messages.Comp.OrgForm
import Messages.Comp.PersonForm
import Messages.Comp.TagForm
@ -15,6 +17,9 @@ type alias Texts =
, orgForm : Messages.Comp.OrgForm.Texts
, equipmentForm : Messages.Comp.EquipmentForm.Texts
, customFieldForm : Messages.Comp.CustomFieldForm.Texts
, httpError : Http.Error -> String
, submitSuccessful : String
, missingRequiredFields : String
}
@ -26,4 +31,7 @@ gb =
, orgForm = Messages.Comp.OrgForm.gb
, equipmentForm = Messages.Comp.EquipmentForm.gb
, customFieldForm = Messages.Comp.CustomFieldForm.gb
, httpError = Messages.Comp.HttpError.gb
, submitSuccessful = "Successfully saved."
, missingRequiredFields = "Please fill required fields."
}

6
modules/webapp/src/main/elm/Messages/Comp/EmailSettingsManage.elm
View File

@ -1,18 +1,22 @@
module Messages.Comp.EmailSettingsManage exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.EmailSettingsForm
import Messages.Comp.EmailSettingsTable
import Messages.Comp.HttpError
type alias Texts =
{ basics : Messages.Basics.Texts
, settingsForm : Messages.Comp.EmailSettingsForm.Texts
, settingsTable : Messages.Comp.EmailSettingsTable.Texts
, httpError : Http.Error -> String
, newSettings : String
, addNewSmtpSettings : String
, reallyDeleteConnection : String
, deleteThisEntry : String
, fillRequiredFields : String
}
@ -21,8 +25,10 @@ gb =
{ basics = Messages.Basics.gb
, settingsForm = Messages.Comp.EmailSettingsForm.gb
, settingsTable = Messages.Comp.EmailSettingsTable.gb
, httpError = Messages.Comp.HttpError.gb
, newSettings = "New Settings"
, addNewSmtpSettings = "Add new SMTP settings"
, reallyDeleteConnection = "Really delete these connection?"
, deleteThisEntry = "Delete this connection"
, fillRequiredFields = "Please fill required fields."
}

6
modules/webapp/src/main/elm/Messages/Comp/EquipmentManage.elm
View File

@ -1,18 +1,22 @@
module Messages.Comp.EquipmentManage exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.EquipmentForm
import Messages.Comp.EquipmentTable
import Messages.Comp.HttpError
type alias Texts =
{ basics : Messages.Basics.Texts
, equipmentTable : Messages.Comp.EquipmentTable.Texts
, equipmentForm : Messages.Comp.EquipmentForm.Texts
, httpError : Http.Error -> String
, createNewEquipment : String
, newEquipment : String
, reallyDeleteEquipment : String
, deleteThisEquipment : String
, correctFormErrors : String
}
@ -21,8 +25,10 @@ gb =
{ basics = Messages.Basics.gb
, equipmentTable = Messages.Comp.EquipmentTable.gb
, equipmentForm = Messages.Comp.EquipmentForm.gb
, httpError = Messages.Comp.HttpError.gb
, createNewEquipment = "Create a new equipment"
, newEquipment = "New Equipment"
, reallyDeleteEquipment = "Really delete this equipment?"
, deleteThisEquipment = "Delete this equipment"
, correctFormErrors = "Please correct the errors in the form."
}

10
modules/webapp/src/main/elm/Messages/Comp/FolderDetail.elm
View File

@ -1,10 +1,13 @@
module Messages.Comp.FolderDetail exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.HttpError
type alias Texts =
{ basics : Messages.Basics.Texts
, httpError : Http.Error -> String
, reallyDeleteThisFolder : String
, autoOwnerInfo : String
, modifyInfo : String
@ -14,12 +17,16 @@ type alias Texts =
, add : String
, removeMember : String
, deleteThisFolder : String
, folderCreated : String
, nameChangeSuccessful : String
, deleteSuccessful : String
}
gb : Texts
gb =
{ basics = Messages.Basics.gb
, httpError = Messages.Comp.HttpError.gb
, reallyDeleteThisFolder = "Really delete this folder?"
, autoOwnerInfo = "You are automatically set as owner of this new folder."
, modifyInfo = "Modify this folder by changing the name or add/remove members."
@ -29,4 +36,7 @@ gb =
, add = "Add"
, removeMember = "Remove this member"
, deleteThisFolder = "Delete this folder"
, folderCreated = "Folder has been created."
, nameChangeSuccessful = "Name has been changed."
, deleteSuccessful = "Folder has been deleted."
}

71
modules/webapp/src/main/elm/Messages/Comp/HttpError.elm Normal file
View File

@ -0,0 +1,71 @@
module Messages.Comp.HttpError exposing (gb)
import Http
gb : Http.Error -> String
gb err =
let
texts =
{ badUrl = \url -> "There is something wrong with this url: " ++ url
, timeout = "There was a network timeout."
, networkError = "There was a network error."
, invalidResponseStatus =
\status ->
"There was an invalid response status: " ++ String.fromInt status ++ "."
, invalidInput = "Invalid input when processing the request."
, notFound = "The requested resource doesn't exist."
, invalidBody = \str -> "There was an error decoding the response: " ++ str
}
in
errorToString texts err
-- Error Utilities
type alias Texts =
{ badUrl : String -> String
, timeout : String
, networkError : String
, invalidResponseStatus : Int -> String
, invalidInput : String
, notFound : String
, invalidBody : String -> String
}
errorToStringStatus : Texts -> Http.Error -> (Int -> String) -> String
errorToStringStatus texts error statusString =
case error of
Http.BadUrl url ->
texts.badUrl url
Http.Timeout ->
texts.timeout
Http.NetworkError ->
texts.networkError
Http.BadStatus status ->
statusString status
Http.BadBody str ->
texts.invalidBody str
errorToString : Texts -> Http.Error -> String
errorToString texts error =
let
f sc =
if sc == 404 then
texts.notFound
else if sc >= 400 && sc < 500 then
texts.invalidInput
else
texts.invalidResponseStatus sc
in
errorToStringStatus texts error f

6
modules/webapp/src/main/elm/Messages/Comp/ImapSettingsManage.elm
View File

@ -1,6 +1,8 @@
module Messages.Comp.ImapSettingsManage exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.HttpError
import Messages.Comp.ImapSettingsForm
import Messages.Comp.ImapSettingsTable
@ -9,10 +11,12 @@ type alias Texts =
{ basics : Messages.Basics.Texts
, imapForm : Messages.Comp.ImapSettingsForm.Texts
, imapTable : Messages.Comp.ImapSettingsTable.Texts
, httpError : Http.Error -> String
, addNewImapSettings : String
, newSettings : String
, reallyDeleteSettings : String
, deleteThisEntry : String
, fillRequiredFields : String
}
@ -21,8 +25,10 @@ gb =
{ basics = Messages.Basics.gb
, imapForm = Messages.Comp.ImapSettingsForm.gb
, imapTable = Messages.Comp.ImapSettingsTable.gb
, httpError = Messages.Comp.HttpError.gb
, addNewImapSettings = "Add new IMAP settings"
, newSettings = "New Settings"
, reallyDeleteSettings = "Really delete this mail-box connection?"
, deleteThisEntry = "Delete this settings entry"
, fillRequiredFields = "Please fill required fields."
}

6
modules/webapp/src/main/elm/Messages/Comp/ItemDetail.elm
View File

@ -1,6 +1,8 @@
module Messages.Comp.ItemDetail exposing (Texts, gb)
import Http
import Messages.Comp.DetailEdit
import Messages.Comp.HttpError
import Messages.Comp.ItemDetail.AddFilesForm
import Messages.Comp.ItemDetail.ItemInfoHeader
import Messages.Comp.ItemDetail.Notes
@ -19,6 +21,7 @@ type alias Texts =
, notes : Messages.Comp.ItemDetail.Notes.Texts
, itemMail : Messages.Comp.ItemMail.Texts
, detailEdit : Messages.Comp.DetailEdit.Texts
, httpError : Http.Error -> String
, key : String
, backToSearchResults : String
, previousItem : String
@ -37,6 +40,7 @@ type alias Texts =
, lastUpdateOn : String
, sendingMailNow : String
, formatDateTime : Int -> String
, mailSendSuccessful : String
}
@ -49,6 +53,7 @@ gb =
, notes = Messages.Comp.ItemDetail.Notes.gb
, itemMail = Messages.Comp.ItemMail.gb
, detailEdit = Messages.Comp.DetailEdit.gb
, httpError = Messages.Comp.HttpError.gb
, key = "Key"
, backToSearchResults = "Back to search results"
, previousItem = "Previous item."
@ -67,4 +72,5 @@ gb =
, lastUpdateOn = "Last update on"
, sendingMailNow = "Sending e-mail…"
, formatDateTime = DF.formatDateTimeLong Messages.UiLanguage.English
, mailSendSuccessful = "Mail sent."
}

8
modules/webapp/src/main/elm/Messages/Comp/ItemMail.elm
View File

@ -1,10 +1,13 @@
module Messages.Comp.ItemMail exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.HttpError
type alias Texts =
{ basics : Messages.Basics.Texts
, httpError : Http.Error -> String
, selectConnection : String
, sendVia : String
, recipients : String
@ -13,12 +16,15 @@ type alias Texts =
, subject : String
, body : String
, includeAllAttachments : String
, connectionMissing : String
, sendLabel : String
}
gb : Texts
gb =
{ basics = Messages.Basics.gb
, httpError = Messages.Comp.HttpError.gb
, selectConnection = "Select connection..."
, sendVia = "Send via"
, recipients = "Recipient(s)"
@ -27,4 +33,6 @@ gb =
, subject = "Subject"
, body = "Body"
, includeAllAttachments = "Include all item attachments"
, connectionMissing = "No E-Mail connections configured. Goto user settings to add one."
, sendLabel = "Send"
}

12
modules/webapp/src/main/elm/Messages/Comp/NotificationForm.elm
View File

@ -1,12 +1,15 @@
module Messages.Comp.NotificationForm exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.CalEventInput
import Messages.Comp.HttpError
type alias Texts =
{ basics : Messages.Basics.Texts
, calEventInput : Messages.Comp.CalEventInput.Texts
, httpError : Http.Error -> String
, reallyDeleteTask : String
, startOnce : String
, startTaskNow : String
@ -30,6 +33,10 @@ type alias Texts =
, schedule : String
, scheduleClickForHelp : String
, scheduleInfo : String
, connectionMissing : String
, invalidCalEvent : String
, remindDaysRequired : String
, recipientsRequired : String
}
@ -37,6 +44,7 @@ gb : Texts
gb =
{ basics = Messages.Basics.gb
, calEventInput = Messages.Comp.CalEventInput.gb
, httpError = Messages.Comp.HttpError.gb
, reallyDeleteTask = "Really delete this notification task?"
, startOnce = "Start Once"
, startTaskNow = "Start this task now"
@ -64,4 +72,8 @@ gb =
++ "Use English 3-letter weekdays. Either a single value, "
++ "a list (ex. 1,2,3), a range (ex. 1..3) or a '*' (meaning all) "
++ "is allowed for each part."
, connectionMissing = "No E-Mail connections configured. Goto E-Mail Settings to add one."
, invalidCalEvent = "The calendar event is not valid."
, remindDaysRequired = "Remind-Days is required."
, recipientsRequired = "At least one recipient is required."
}

12
modules/webapp/src/main/elm/Messages/Comp/NotificationManage.elm
View File

@ -1,6 +1,8 @@
module Messages.Comp.NotificationManage exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.HttpError
import Messages.Comp.NotificationForm
import Messages.Comp.NotificationTable
@ -9,8 +11,13 @@ type alias Texts =
{ basics : Messages.Basics.Texts
, notificationForm : Messages.Comp.NotificationForm.Texts
, notificationTable : Messages.Comp.NotificationTable.Texts
, httpError : Http.Error -> String
, newTask : String
, createNewTask : String
, taskCreated : String
, taskUpdated : String
, taskStarted : String
, taskDeleted : String
}
@ -19,6 +26,11 @@ gb =
{ basics = Messages.Basics.gb
, notificationForm = Messages.Comp.NotificationForm.gb
, notificationTable = Messages.Comp.NotificationTable.gb
, httpError = Messages.Comp.HttpError.gb
, newTask = "New Task"
, createNewTask = "Create a new notification task"
, taskCreated = "Task created."
, taskUpdated = "Task updated."
, taskStarted = "Task started."
, taskDeleted = "Task deleted."
}

6
modules/webapp/src/main/elm/Messages/Comp/OrgManage.elm
View File

@ -1,6 +1,8 @@
module Messages.Comp.OrgManage exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.HttpError
import Messages.Comp.OrgForm
import Messages.Comp.OrgTable
@ -9,10 +11,12 @@ type alias Texts =
{ basics : Messages.Basics.Texts
, orgForm : Messages.Comp.OrgForm.Texts
, orgTable : Messages.Comp.OrgTable.Texts
, httpError : Http.Error -> String
, newOrganization : String
, createNewOrganization : String
, reallyDeleteOrg : String
, deleteThisOrg : String
, correctFormErrors : String
}
@ -21,8 +25,10 @@ gb =
{ basics = Messages.Basics.gb
, orgForm = Messages.Comp.OrgForm.gb
, orgTable = Messages.Comp.OrgTable.gb
, httpError = Messages.Comp.HttpError.gb
, newOrganization = "New Organization"
, createNewOrganization = "Create a new organization"
, reallyDeleteOrg = "Really delete this organization?"
, deleteThisOrg = "Delete this organization"
, correctFormErrors = "Please correct the errors in the form."
}

6
modules/webapp/src/main/elm/Messages/Comp/PersonManage.elm
View File

@ -1,6 +1,8 @@
module Messages.Comp.PersonManage exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.HttpError
import Messages.Comp.PersonForm
import Messages.Comp.PersonTable
@ -9,10 +11,12 @@ type alias Texts =
{ basics : Messages.Basics.Texts
, personForm : Messages.Comp.PersonForm.Texts
, personTable : Messages.Comp.PersonTable.Texts
, httpError : Http.Error -> String
, newPerson : String
, createNewPerson : String
, reallyDeletePerson : String
, deleteThisPerson : String
, correctFormErrors : String
}
@ -21,8 +25,10 @@ gb =
{ basics = Messages.Basics.gb
, personForm = Messages.Comp.PersonForm.gb
, personTable = Messages.Comp.PersonTable.gb
, httpError = Messages.Comp.HttpError.gb
, newPerson = "New Person"
, createNewPerson = "Create a new person"
, reallyDeletePerson = "Really delete this person?"
, deleteThisPerson = "Delete this person"
, correctFormErrors = "Please correct the errors in the form."
}

10
modules/webapp/src/main/elm/Messages/Comp/ScanMailboxForm.elm
View File

@ -1,12 +1,15 @@
module Messages.Comp.ScanMailboxForm exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.CalEventInput
import Messages.Comp.HttpError
type alias Texts =
{ basics : Messages.Basics.Texts
, calEventInput : Messages.Comp.CalEventInput.Texts
, httpError : Http.Error -> String
, reallyDeleteTask : String
, startOnce : String
, startNow : String
@ -54,6 +57,9 @@ type alias Texts =
, schedule : String
, scheduleClickForHelp : String
, scheduleInfo : String
, connectionMissing : String
, noProcessingFolders : String
, invalidCalEvent : String
}
@ -61,6 +67,7 @@ gb : Texts
gb =
{ basics = Messages.Basics.gb
, calEventInput = Messages.Comp.CalEventInput.gb
, httpError = Messages.Comp.HttpError.gb
, reallyDeleteTask = "Really delete this scan mailbox task?"
, startOnce = "Start Once"
, startNow = "Start this task now"
@ -135,4 +142,7 @@ disappear then.
++ "Use English 3-letter weekdays. Either a single value, "
++ "a list (ex. 1,2,3), a range (ex. 1..3) or a '*' (meaning all) "
++ "is allowed for each part."
, connectionMissing = "No E-Mail connections configured. Goto E-Mail Settings to add one."
, noProcessingFolders = "No processing folders given."
, invalidCalEvent = "The calendar event is not valid."
}

12
modules/webapp/src/main/elm/Messages/Comp/ScanMailboxManage.elm
View File

@ -1,6 +1,8 @@
module Messages.Comp.ScanMailboxManage exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.HttpError
import Messages.Comp.ScanMailboxForm
import Messages.Comp.ScanMailboxTable
@ -9,8 +11,13 @@ type alias Texts =
{ basics : Messages.Basics.Texts
, form : Messages.Comp.ScanMailboxForm.Texts
, table : Messages.Comp.ScanMailboxTable.Texts
, httpError : Http.Error -> String
, newTask : String
, createNewTask : String
, taskCreated : String
, taskUpdated : String
, taskStarted : String
, taskDeleted : String
}
@ -19,6 +26,11 @@ gb =
{ basics = Messages.Basics.gb
, form = Messages.Comp.ScanMailboxForm.gb
, table = Messages.Comp.ScanMailboxTable.gb
, httpError = Messages.Comp.HttpError.gb
, newTask = "New Task"
, createNewTask = "Create a new scan mailbox task"
, taskCreated = "Task created."
, taskUpdated = "Task updated."
, taskStarted = "Task started."
, taskDeleted = "Task deleted."
}

6
modules/webapp/src/main/elm/Messages/Comp/SourceManage.elm
View File

@ -1,6 +1,8 @@
module Messages.Comp.SourceManage exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.HttpError
import Messages.Comp.SourceForm
import Messages.Comp.SourceTable
@ -9,6 +11,7 @@ type alias Texts =
{ basics : Messages.Basics.Texts
, sourceTable : Messages.Comp.SourceTable.Texts
, sourceForm : Messages.Comp.SourceForm.Texts
, httpError : Http.Error -> String
, addSourceUrl : String
, newSource : String
, publicUploads : String
@ -22,6 +25,7 @@ type alias Texts =
, createNewSource : String
, deleteThisSource : String
, errorGeneratingQR : String
, correctFormErrors : String
}
@ -30,6 +34,7 @@ gb =
{ basics = Messages.Basics.gb
, sourceTable = Messages.Comp.SourceTable.gb
, sourceForm = Messages.Comp.SourceForm.gb
, httpError = Messages.Comp.HttpError.gb
, addSourceUrl = "Add a source url"
, newSource = "New source"
, publicUploads = "Public Uploads"
@ -50,4 +55,5 @@ gb =
, createNewSource = "Create new source"
, deleteThisSource = "Delete this source"
, errorGeneratingQR = "Error generating QR Code"
, correctFormErrors = "Please correct the errors in the form."
}

6
modules/webapp/src/main/elm/Messages/Comp/TagManage.elm
View File

@ -1,6 +1,8 @@
module Messages.Comp.TagManage exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.HttpError
import Messages.Comp.TagForm
import Messages.Comp.TagTable
@ -9,10 +11,12 @@ type alias Texts =
{ basics : Messages.Basics.Texts
, tagTable : Messages.Comp.TagTable.Texts
, tagForm : Messages.Comp.TagForm.Texts
, httpError : Http.Error -> String
, createNewTag : String
, newTag : String
, reallyDeleteTag : String
, deleteThisTag : String
, correctFormErrors : String
}
@ -21,8 +25,10 @@ gb =
{ basics = Messages.Basics.gb
, tagTable = Messages.Comp.TagTable.gb
, tagForm = Messages.Comp.TagForm.gb
, httpError = Messages.Comp.HttpError.gb
, createNewTag = "Create a new tag"
, newTag = "New Tag"
, reallyDeleteTag = "Really delete this tag?"
, deleteThisTag = "Delete this tag"
, correctFormErrors = "Please correct the errors in the form."
}

9
modules/webapp/src/main/elm/Messages/Comp/UserManage.elm
View File

@ -1,6 +1,8 @@
module Messages.Comp.UserManage exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.HttpError
import Messages.Comp.UserForm
import Messages.Comp.UserTable
@ -8,6 +10,7 @@ import Messages.Comp.UserTable
type alias Texts =
{ userTable : Messages.Comp.UserTable.Texts
, userForm : Messages.Comp.UserForm.Texts
, httpError : Http.Error -> String
, users : String
, newUser : String
, addNewUser : String
@ -24,6 +27,7 @@ gb =
{ userTable = Messages.Comp.UserTable.gb
, userForm = Messages.Comp.UserForm.gb
, basics = Messages.Basics.gb
, httpError = Messages.Comp.HttpError.gb
, users = "Users"
, newUser = "New user"
, addNewUser = "Add new user"
@ -32,8 +36,3 @@ gb =
, deleteThisUser = "Delete this user"
, pleaseCorrectErrors = "Please correct the errors in the form."
}
de : Texts
de =
gb

6
modules/webapp/src/main/elm/Messages/Page/CollectiveSettings.elm
View File

@ -1,7 +1,9 @@
module Messages.Page.CollectiveSettings exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.CollectiveSettingsForm
import Messages.Comp.HttpError
import Messages.Comp.SourceManage
import Messages.Comp.UserManage
@ -11,6 +13,7 @@ type alias Texts =
, userManage : Messages.Comp.UserManage.Texts
, collectiveSettingsForm : Messages.Comp.CollectiveSettingsForm.Texts
, sourceManage : Messages.Comp.SourceManage.Texts
, httpError : Http.Error -> String
, collectiveSettings : String
, insights : String
, sources : String
@ -19,6 +22,7 @@ type alias Texts =
, user : String
, collective : String
, size : String
, submitSuccessful : String
}
@ -28,6 +32,7 @@ gb =
, userManage = Messages.Comp.UserManage.gb
, collectiveSettingsForm = Messages.Comp.CollectiveSettingsForm.gb
, sourceManage = Messages.Comp.SourceManage.gb
, httpError = Messages.Comp.HttpError.gb
, collectiveSettings = "Collective Settings"
, insights = "Insights"
, sources = "Sources"
@ -36,4 +41,5 @@ gb =
, user = "User"
, collective = "Collective"
, size = "Size"
, submitSuccessful = "Settings saved."
}

9
modules/webapp/src/main/elm/Messages/Page/Login.elm
View File

@ -1,8 +1,12 @@
module Messages.Page.Login exposing (Texts, gb)
import Http
import Messages.Comp.HttpError
type alias Texts =
{ loginToDocspell : String
{ httpError : Http.Error -> String
, loginToDocspell : String
, username : String
, collectiveSlashLogin : String
, password : String
@ -18,7 +22,8 @@ type alias Texts =
gb : Texts
gb =
{ loginToDocspell = "Login to Docspell"
{ httpError = Messages.Comp.HttpError.gb
, loginToDocspell = "Login to Docspell"
, username = "Username"
, collectiveSlashLogin = "Collective / Login"
, password = "Password"

22
modules/webapp/src/main/elm/Messages/Page/NewInvite.elm
View File

@ -1,14 +1,18 @@
module Messages.Page.NewInvite exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.HttpError
type alias Texts =
{ basics : Messages.Basics.Texts
, httpError : Http.Error -> String
, createNewInvitations : String
, invitationKey : String
, password : String
, reset : String
, newInvitationCreated : String
, inviteInfo : String
}
@ -16,18 +20,22 @@ type alias Texts =
gb : Texts
gb =
{ basics = Messages.Basics.gb
, httpError = Messages.Comp.HttpError.gb
, createNewInvitations = "Create new invitations"
, invitationKey = "Invitation Key"
, password = "Password"
, reset = "Reset"
, newInvitationCreated = "New invitation created."
, inviteInfo =
"""Docspell requires an invite when signing up. You can
create these invites here and send them to friends so
they can signup with docspell.
"""
Docspell requires an invite when signing up. You can
create these invites here and send them to friends so
they can signup with docspell.
Each invite can only be used once. You'll need to
create one key for each person you want to invite.
Each invite can only be used once. You'll need to
create one key for each person you want to invite.
Creating an invite requires providing the password
from the configuration."""
Creating an invite requires providing the password
from the configuration.
"""
}

4
modules/webapp/src/main/elm/Messages/Page/Queue.elm
View File

@ -1,12 +1,15 @@
module Messages.Page.Queue exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.HttpError
import Messages.DateFormat as DF
import Messages.UiLanguage
type alias Texts =
{ basics : Messages.Basics.Texts
, httpError : Http.Error -> String
, currentlyRunning : String
, queue : String
, waiting : String
@ -32,6 +35,7 @@ type alias Texts =
gb : Texts
gb =
{ basics = Messages.Basics.gb
, httpError = Messages.Comp.HttpError.gb
, currentlyRunning = "Currently Running"
, queue = "Queue"
, waiting = "Waiting"

8
modules/webapp/src/main/elm/Messages/Page/Register.elm
View File

@ -1,10 +1,13 @@
module Messages.Page.Register exposing (Texts, gb)
import Http
import Messages.Basics
import Messages.Comp.HttpError
type alias Texts =
{ basics : Messages.Basics.Texts
, httpError : Http.Error -> String
, signupToDocspell : String
, collectiveId : String
, collective : String
@ -16,12 +19,15 @@ type alias Texts =
, alreadySignedUp : String
, signIn : String
, registrationSuccessful : String
, passwordsDontMatch : String
, allFieldsRequired : String
}
gb : Texts
gb =
{ basics = Messages.Basics.gb
, httpError = Messages.Comp.HttpError.gb
, signupToDocspell = "Signup to Docspell"
, collectiveId = "Collective ID"
, collective = "Collective"
@ -33,4 +39,6 @@ gb =
, alreadySignedUp = "Already signed up?"
, signIn = "Sign in"
, registrationSuccessful = "Registration successful."
, passwordsDontMatch = "The passwords do not match."
, allFieldsRequired = "All fields are required!"
}

14
modules/webapp/src/main/elm/Page/CollectiveSettings/Data.elm
View File

@ -1,5 +1,6 @@
module Page.CollectiveSettings.Data exposing
( Model
( FormState(..)
, Model
, Msg(..)
, Tab(..)
, init
@ -21,10 +22,17 @@ type alias Model =
, userModel : Comp.UserManage.Model
, settingsModel : Comp.CollectiveSettingsForm.Model
, insights : ItemInsights
, submitResult : Maybe BasicResult
, formState : FormState
}
type FormState
= InitialState
| SubmitSuccessful
| SubmitFailed String
| SubmitError Http.Error
init : Flags -> ( Model, Cmd Msg )
init flags =
let
@ -39,7 +47,7 @@ init flags =
, userModel = Comp.UserManage.emptyModel
, settingsModel = cm
, insights = Api.Model.ItemInsights.empty
, submitResult = Nothing
, formState = InitialState
}
, Cmd.batch
[ Cmd.map SourceMsg sc

23
modules/webapp/src/main/elm/Page/CollectiveSettings/Update.elm
View File

@ -1,13 +1,11 @@
module Page.CollectiveSettings.Update exposing (update)
import Api
import Api.Model.BasicResult exposing (BasicResult)
import Comp.CollectiveSettingsForm
import Comp.SourceManage
import Comp.UserManage
import Data.Flags exposing (Flags)
import Page.CollectiveSettings.Data exposing (..)
import Util.Http
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
@ -58,12 +56,12 @@ update flags msg model =
Just sett ->
Api.setCollectiveSettings flags sett SubmitResp
in
( { model | settingsModel = m2, submitResult = Nothing }
( { model | settingsModel = m2, formState = InitialState }
, Cmd.batch [ cmd, Cmd.map SettingsFormMsg c2 ]
)
Init ->
( { model | submitResult = Nothing }
( { model | formState = InitialState }
, Cmd.batch
[ Api.getInsights flags GetInsightsResp
, Api.getCollectiveSettings flags CollectiveSettingsResp
@ -89,11 +87,16 @@ update flags msg model =
( model, Cmd.none )
SubmitResp (Ok res) ->
( { model | submitResult = Just res }, Cmd.none )
( { model
| formState =
if res.success then
SubmitSuccessful
else
SubmitFailed res.message
}
, Cmd.none
)
SubmitResp (Err err) ->
let
res =
BasicResult False (Util.Http.errorToString err)
in
( { model | submitResult = Just res }, Cmd.none )
( { model | formState = SubmitError err }, Cmd.none )

41
modules/webapp/src/main/elm/Page/CollectiveSettings/View2.elm
View File

@ -14,7 +14,6 @@ import Html.Events exposing (onClick)
import Messages.Page.CollectiveSettings exposing (Texts)
import Page.CollectiveSettings.Data exposing (..)
import Styles as S
import Util.Maybe
import Util.Size
@ -249,6 +248,27 @@ viewSettings texts flags settings model =
[ text texts.collectiveSettings
]
]
, div
[ classList
[ ( "hidden", model.formState == InitialState )
, ( S.successMessage, model.formState == SubmitSuccessful )
, ( S.errorMessage, model.formState /= SubmitSuccessful )
]
, class "mb-2"
]
[ case model.formState of
SubmitSuccessful ->
text texts.submitSuccessful
SubmitError err ->
text (texts.httpError err)
SubmitFailed m ->
text m
InitialState ->
text ""
]
, Html.map SettingsFormMsg
(Comp.CollectiveSettingsForm.view2
flags
@ -256,23 +276,4 @@ viewSettings texts flags settings model =
settings
model.settingsModel
)
, div
[ classList
[ ( "hidden", Util.Maybe.isEmpty model.submitResult )
, ( S.successMessage
, Maybe.map .success model.submitResult
|> Maybe.withDefault False
)
, ( S.errorMessage
, Maybe.map .success model.submitResult
|> Maybe.map not
|> Maybe.withDefault False
)
]
, class "mt-2"
]
[ Maybe.map .message model.submitResult
|> Maybe.withDefault ""
|> text
]
]

14
modules/webapp/src/main/elm/Page/Login/Data.elm
View File

@ -1,5 +1,6 @@
module Page.Login.Data exposing
( Model
( FormState(..)
, Model
, Msg(..)
, emptyModel
)
@ -13,16 +14,23 @@ type alias Model =
{ username : String
, password : String
, rememberMe : Bool
, result : Maybe AuthResult
, formState : FormState
}
type FormState
= AuthSuccess AuthResult
| AuthFailed AuthResult
| HttpError Http.Error
| FormInitial
emptyModel : Model
emptyModel =
{ username = ""
, password = ""
, rememberMe = False
, result = Nothing
, formState = FormInitial
}

13
modules/webapp/src/main/elm/Page/Login/Update.elm
View File

@ -6,7 +6,6 @@ import Data.Flags exposing (Flags)
import Page exposing (Page(..))
import Page.Login.Data exposing (..)
import Ports
import Util.Http
update : Maybe Page -> Flags -> Msg -> Model -> ( Model, Cmd Msg, Maybe AuthResult )
@ -37,13 +36,13 @@ update referrer flags msg model =
Maybe.withDefault HomePage referrer |> Page.goto
in
if lr.success then
( { model | result = Just lr, password = "" }
( { model | formState = AuthSuccess lr, password = "" }
, Cmd.batch [ setAccount lr, gotoRef ]
, Just lr
)
else
( { model | result = Just lr, password = "" }
( { model | formState = AuthFailed lr, password = "" }
, Ports.removeAccount ()
, Just lr
)
@ -52,11 +51,11 @@ update referrer flags msg model =
let
empty =
Api.Model.AuthResult.empty
lr =
{ empty | message = Util.Http.errorToString err }
in
( { model | password = "", result = Just lr }, Ports.removeAccount (), Just empty )
( { model | password = "", formState = HttpError err }
, Ports.removeAccount ()
, Just empty
)
setAccount : AuthResult -> Cmd msg

26
modules/webapp/src/main/elm/Page/Login/View2.elm
View File

@ -158,17 +158,21 @@ viewContent texts flags versionInfo _ model =
resultMessage : Texts -> Model -> Html Msg
resultMessage texts model =
case model.result of
Just r ->
if r.success then
div [ class ("my-2" ++ S.successMessage) ]
[ text texts.loginSuccessful
]
case model.formState of
AuthSuccess _ ->
div [ class ("my-2" ++ S.successMessage) ]
[ text texts.loginSuccessful
]
else
div [ class ("my-2" ++ S.errorMessage) ]
[ text r.message
]
AuthFailed r ->
div [ class ("my-2" ++ S.errorMessage) ]
[ text r.message
]
Nothing ->
HttpError err ->
div [ class ("my-2" ++ S.errorMessage) ]
[ text (texts.httpError err)
]
FormInitial ->
span [ class "hidden" ] []

6
modules/webapp/src/main/elm/Page/NewInvite/Data.elm
View File

@ -19,7 +19,8 @@ type alias Model =
type State
= Empty
| Failed String
| Failed Http.Error
| GenericFail String
| Success InviteResult
@ -29,6 +30,9 @@ isFailed state =
Failed _ ->
True
GenericFail _ ->
True
_ ->
False

5
modules/webapp/src/main/elm/Page/NewInvite/Update.elm
View File

@ -4,7 +4,6 @@ import Api
import Api.Model.GenInvite exposing (GenInvite)
import Data.Flags exposing (Flags)
import Page.NewInvite.Data exposing (..)
import Util.Http
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
@ -24,7 +23,7 @@ update flags msg model =
( { model | result = Success res }, Cmd.none )
else
( { model | result = Failed res.message }, Cmd.none )
( { model | result = GenericFail res.message }, Cmd.none )
InviteResp (Err err) ->
( { model | result = Failed (Util.Http.errorToString err) }, Cmd.none )
( { model | result = Failed err }, Cmd.none )

15
modules/webapp/src/main/elm/Page/NewInvite/View2.elm
View File

@ -43,7 +43,11 @@ viewContent texts flags _ model =
[ text texts.invitationKey
]
, div [ class "relative" ]
[ div [ class "inline-flex items-center justify-center absolute left-0 top-0 h-full w-10 text-gray-400 dark:text-bluegray-400 " ]
[ div
[ class "inline-flex items-center justify-center"
, class "absolute left-0 top-0 h-full w-10"
, class "text-gray-400 dark:text-bluegray-400"
]
[ i [ class "fa fa-key" ] []
]
, input
@ -93,13 +97,16 @@ resultMessage texts model =
]
]
[ case model.result of
Failed m ->
p [] [ text m ]
Failed err ->
text (texts.httpError err)
GenericFail m ->
text m
Success r ->
div [ class "" ]
[ p []
[ text r.message
[ text texts.newInvitationCreated
, text (" " ++ texts.invitationKey ++ ":")
]
, pre [ class "text-center font-mono mt-4" ]

12
modules/webapp/src/main/elm/Page/Queue/Data.elm
View File

@ -1,5 +1,6 @@
module Page.Queue.Data exposing
( Model
( FormState(..)
, Model
, Msg(..)
, QueueView(..)
, emptyModel
@ -20,7 +21,7 @@ import Util.Maybe
type alias Model =
{ state : JobQueueState
, error : String
, formState : FormState
, pollingInterval : Float
, init : Bool
, stopRefresh : Bool
@ -32,6 +33,11 @@ type alias Model =
}
type FormState
= InitialForm
| HttpError Http.Error
type QueueView
= CurrentJobs
| QueueAll
@ -44,7 +50,7 @@ type QueueView
emptyModel : Model
emptyModel =
{ state = Api.Model.JobQueueState.empty
, error = ""
, formState = InitialForm
, pollingInterval = 1200
, init = False
, stopRefresh = False

4
modules/webapp/src/main/elm/Page/Queue/Update.elm
View File

@ -4,10 +4,8 @@ import Api
import Comp.YesNoDimmer
import Data.Flags exposing (Flags)
import Page.Queue.Data exposing (..)
import Ports
import Task
import Time
import Util.Http
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
@ -42,7 +40,7 @@ update flags msg model =
( { model | state = s, stopRefresh = False }, refresh )
StateResp (Err err) ->
( { model | error = Util.Http.errorToString err }, Cmd.none )
( { model | formState = HttpError err }, Cmd.none )
StopRefresh ->
( { model | stopRefresh = True, init = False }, Cmd.none )

24
modules/webapp/src/main/elm/Page/Register/Data.elm
View File

@ -1,5 +1,6 @@
module Page.Register.Data exposing
( Model
( FormState(..)
, Model
, Msg(..)
, emptyModel
)
@ -9,31 +10,36 @@ import Http
type alias Model =
{ result : Maybe BasicResult
, collId : String
{ collId : String
, login : String
, pass1 : String
, pass2 : String
, showPass1 : Bool
, showPass2 : Bool
, errorMsg : List String
, formState : FormState
, loading : Bool
, successMsg : String
, invite : Maybe String
}
type FormState
= HttpError Http.Error
| GenericError String
| RegistrationSuccessful
| PasswordMismatch
| InputValid
| FormEmpty
emptyModel : Model
emptyModel =
{ result = Nothing
, collId = ""
{ collId = ""
, login = ""
, pass1 = ""
, pass2 = ""
, showPass1 = False
, showPass2 = False
, errorMsg = []
, successMsg = ""
, formState = FormEmpty
, loading = False
, invite = Nothing
}

38
modules/webapp/src/main/elm/Page/Register/Update.elm
View File

@ -1,19 +1,17 @@
module Page.Register.Update exposing (update)
import Api
import Api.Model.BasicResult exposing (BasicResult)
import Data.Flags exposing (Flags)
import Page exposing (Page(..))
import Page.Register.Data exposing (..)
import Util.Http
update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
update flags msg model =
case msg of
RegisterSubmit ->
case model.errorMsg of
[] ->
case model.formState of
InputValid ->
let
reg =
{ collectiveName = model.collId
@ -35,7 +33,7 @@ update flags msg model =
err =
validateForm m
in
( { m | errorMsg = err }, Cmd.none )
( { m | formState = err }, Cmd.none )
SetLogin str ->
let
@ -45,7 +43,7 @@ update flags msg model =
err =
validateForm m
in
( { m | errorMsg = err }, Cmd.none )
( { m | formState = err }, Cmd.none )
SetPass1 str ->
let
@ -55,7 +53,7 @@ update flags msg model =
err =
validateForm m
in
( { m | errorMsg = err }, Cmd.none )
( { m | formState = err }, Cmd.none )
SetPass2 str ->
let
@ -65,7 +63,7 @@ update flags msg model =
err =
validateForm m
in
( { m | errorMsg = err }, Cmd.none )
( { m | formState = err }, Cmd.none )
SetInvite str ->
( { model
@ -98,29 +96,21 @@ update flags msg model =
Cmd.none
in
( { m
| result =
| formState =
if r.success then
Nothing
RegistrationSuccessful
else
Just r
GenericError r.message
}
, cmd
)
SubmitResp (Err err) ->
let
errMsg =
Util.Http.errorToString err
res =
BasicResult False
(errMsg ++ " Please check the form and try again.")
in
( { model | result = Just res }, Cmd.none )
( { model | formState = HttpError err }, Cmd.none )
validateForm : Model -> List String
validateForm : Model -> FormState
validateForm model =
if
model.collId
@ -132,10 +122,10 @@ validateForm model =
|| model.pass2
== ""
then
[ "All fields are required!" ]
FormEmpty
else if model.pass1 /= model.pass2 then
[ "The passwords do not match." ]
PasswordMismatch
else
[]
InputValid

42
modules/webapp/src/main/elm/Page/Register/View2.elm
View File

@ -239,22 +239,32 @@ viewContent texts flags _ model =
resultMessage : Texts -> Model -> Html Msg
resultMessage texts model =
case model.result of
Just r ->
if r.success then
div [ class S.successMessage ]
[ text texts.registrationSuccessful
]
case model.formState of
InputValid ->
div [ class "hidden" ]
[]
else
div [ class S.errorMessage ]
[ text r.message
]
RegistrationSuccessful ->
div [ class S.successMessage ]
[ text texts.registrationSuccessful
]
Nothing ->
if List.isEmpty model.errorMsg then
span [ class "hidden" ] []
PasswordMismatch ->
div [ class S.errorMessage ]
[ text texts.passwordsDontMatch
]
else
div [ class S.errorMessage ]
(List.map (\s -> div [] [ text s ]) model.errorMsg)
GenericError m ->
div [ class S.errorMessage ]
[ text m
]
FormEmpty ->
div [ class S.errorMessage ]
[ text texts.allFieldsRequired
]
HttpError err ->
div [ class S.errorMessage ]
[ text (texts.httpError err)
]

44
modules/webapp/src/main/elm/Util/Http.elm
View File

@ -17,6 +17,11 @@ import Process
import Task exposing (Task)
errorToString : Http.Error -> String
errorToString _ =
Debug.todo "remove me"
-- Authenticated Requests
@ -138,45 +143,6 @@ authDelete req =
-- Error Utilities
errorToStringStatus : Http.Error -> (Int -> String) -> String
errorToStringStatus error statusString =
case error of
Http.BadUrl url ->
"There is something wrong with this url: " ++ url
Http.Timeout ->
"There was a network timeout."
Http.NetworkError ->
"There was a network error."
Http.BadStatus status ->
statusString status
Http.BadBody str ->
"There was an error decoding the response: " ++ str
errorToString : Http.Error -> String
errorToString error =
let
f sc =
if sc == 404 then
"The requested resource doesn't exist."
else if sc >= 400 && sc < 500 then
"Invalid input when processing the request."
else
"There was an invalid response status: " ++ String.fromInt sc ++ "."
in
errorToStringStatus error f
-- Http.Task Utilities

11
modules/webapp/src/main/elm/Util/Result.elm Normal file
View File

@ -0,0 +1,11 @@
module Util.Result exposing (fold)
fold : (a -> x) -> (b -> x) -> Result b a -> x
fold fa fb rba =
case rba of
Ok a ->
fa a
Err b ->
fb b