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. SheetDelOk tid@TermId courseShortHand@Text sheetName@Text: #{display tid}-#{courseShortHand}: Übungsblatt #{sheetName} gelöscht.
SheetExercise: Aufgabenstellung SheetExercise: Aufgabenstellung
SheetHint: Hinweise SheetHint: Hinweis
SheetHintFrom: Hinweis ab
SheetSolution: Lösung SheetSolution: Lösung
SheetSolutionFrom: Lösung ab
SheetMarking: Korrekturhinweise 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 Deadline: Abgabe
Done: Eingereicht Done: Eingereicht

View File

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