Sheet Form validation and tooltips augmented

This commit is contained in:
SJost 2018-07-18 12:21:16 +02:00
parent c2b94708c8
commit e42e59242f
2 changed files with 38 additions and 20 deletions

View File

@ -59,10 +59,22 @@ SheetDelText submissionNo@Int: Dies kann nicht mehr rückgängig gemacht w
SheetDelOk tid@TermId courseShortHand@Text sheetName@Text: #{display tid}-#{courseShortHand}: Übungsblatt #{sheetName} gelöscht.
SheetExercise: Aufgabenstellung
SheetHint: Hinweise
SheetHint: Hinweis
SheetHintFrom: Hinweis ab
SheetSolution: Lösung
SheetSolutionFrom: Lösung ab
SheetMarking: Korrekturhinweise
SheetVisibleFrom: Sichtbar ab
SheetActiveFrom: Aktiv ab
SheetActiveTo: Abgabefrist
SheetErrVisibility: Sichtbarkeit muss vor Beginn der Abgabefrist liegen
SheetErrDeadlineEarly: Ende der Abgabefrist muss nach deren Beginn liegen
SheetErrHintEarly: Hinweise dürfen erst nach Beginn der Abgabefrist herausgegeben werden
SheetErrSolutionEarly: Die Lösung sollte erst nach Ende der Abgabefrist herausgegeben werden
Deadline: Abgabe
Done: Eingereicht
@ -206,4 +218,4 @@ InvalidDateTimeFormat: Ungültiges Datums- und Zeitformat, JJJJ-MM-TTTHH:MM[:SS]
AmbiguousUTCTime: Der angegebene Zeitpunkt lässt sich nicht eindeutig zu UTC konvertieren
LastEdits: Letzte Änderungen
EditedBy name@Text time@Text: Durch #{name} um #{time}
EditedBy name@Text time@Text: Durch #{name} um #{time}

View File

@ -94,25 +94,34 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
E.&&. sheetFile E.^. SheetFileType E.==. E.val fType
return (file E.^. FileId)
| otherwise = return Set.empty
mr <- getMsgRenderer
ctime <- liftIO $ getCurrentTime
(result, widget) <- flip (renderAForm FormStandard) html $ SheetForm
<$> areq textField (fsb "Name") (sfName <$> template)
<*> aopt htmlField (fsb "Hinweise für Teilnehmer") (sfDescription <$> template)
<*> sheetTypeAFormReq (fsb "Bewertung") (sfType <$> template)
<*> sheetGroupAFormReq (fsb "Abgabegruppengröße") (sfGrouping <$> template)
<*> aopt htmlField (fsb "Hinweise für Korrektoren") (sfMarkingText <$> template)
<*> aopt utcTimeField (fsb "Sichtbar ab") (sfVisibleFrom <$> template)
<*> areq utcTimeField (fsb "Abgabe ab") (sfActiveFrom <$> template)
<*> areq utcTimeField (fsb "Abgabefrist") (sfActiveTo <$> template)
<*> aopt utcTimeField (fslI MsgSheetVisibleFrom
& setTooltip "Ohne Datum ist das Blatt komplett unsichtbar, z.B. weil es noch nicht fertig ist.")
((sfVisibleFrom <$> template) <|> pure (Just ctime))
<*> areq utcTimeField (fslI MsgSheetActiveFrom
& setTooltip "Abgabe und Dateien zur Aufgabenstellung sind erst ab diesem Datum zugänglich")
(sfActiveFrom <$> template)
<*> areq utcTimeField (fslI MsgSheetActiveTo) (sfActiveTo <$> template)
<*> aopt (multiFileField $ oldFileIds SheetExercise) (fsb "Aufgabenstellung") (sfSheetF <$> template)
<*> aopt utcTimeField (fsb "Hinweis ab") (sfHintFrom <$> template)
<*> fileAFormOpt (fsb "Hinweis")
<*> aopt utcTimeField (fsb "Lösung ab") (sfSolutionFrom <$> template)
<*> fileAFormOpt (fsb "Lösung")
<*> aopt utcTimeField (fslpI MsgSheetHintFrom "Datum, sonst nur Korrektoren"
& setTooltip "Ohne Datum nie für Teilnehmer sichtbar, Korrektoren können diese Dateien immer herunterladen")
(sfHintFrom <$> template)
<*> fileAFormOpt (fslI MsgSheetHint)
<*> aopt utcTimeField (fslpI MsgSheetSolutionFrom "Datum, sonst nur Korrektoren"
& setTooltip "Ohne Datum nie für Teilnehmer sichtbar, Korrektoren können diese Dateien immer herunterladen")
(sfSolutionFrom <$> template)
<*> fileAFormOpt (fslI MsgSheetSolution)
<* submitButton
return $ case result of
FormSuccess sheetResult
| errorMsgs <- validateSheet sheetResult
| errorMsgs <- validateSheet mr sheetResult
, not $ null errorMsgs ->
(FormFailure errorMsgs,
[whamlet|
@ -127,16 +136,13 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
)
_ -> (result, widget)
where
validateSheet :: SheetForm -> [Text]
validateSheet (SheetForm{..}) =
validateSheet :: MsgRenderer -> SheetForm -> [Text]
validateSheet (MsgRenderer {..}) (SheetForm{..}) =
[ msg | (False, msg) <-
[ ( maybe True (sfActiveFrom >=) sfVisibleFrom
, "Sichtbarkeit muss vor Beginn der Abgabefrist liegen."
)
, ( sfActiveTo >= sfActiveFrom
, "Ende der Abgabefrist muss nach deren Beginn liegen."
)
-- TODO: continue validation here!!!
[ ( sfVisibleFrom <= Just sfActiveFrom , render MsgSheetErrVisibility)
, ( sfActiveFrom <= sfActiveTo , render MsgSheetErrDeadlineEarly)
, ( NTop sfHintFrom >= NTop (Just sfActiveFrom) , render MsgSheetErrHintEarly)
, ( NTop sfSolutionFrom >= NTop (Just sfActiveTo) , render MsgSheetErrSolutionEarly)
] ]
-- List Sheets