fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Divide sheetForm into sections

Browse Source
This commit is contained in:
Gregor Kleen 2019-05-18 23:14:21 +02:00
parent 9f101087ac
commit 813d446975
3 changed files with 29 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
messages/uniworx/de.msg
View File

@ -169,6 +169,7 @@ SheetHintFrom: Hinweis ab
SheetSolution: Lösung
SheetSolutionFrom: Lösung ab
SheetMarking: Hinweise für Korrektoren
SheetMarkingFiles: Korrektur
SheetType: Wertung
SheetInvisible: Dieses Übungsblatt ist für Teilnehmer momentan unsichtbar!
SheetInvisibleUntil date@Text: Dieses Übungsblatt ist für Teilnehmer momentan unsichtbar bis #{date}!
@ -186,6 +187,10 @@ SheetMarkingTip: Hinweise zur Korrektur, sichtbar nur für Korrektoren
SheetPseudonym: Persönliches Abgabe-Pseudonym
SheetGeneratePseudonym: Generieren
SheetFormType: Wertung & Abgabe
SheetFormTimes: Zeiten
SheetFormFiles: Dateien
SheetErrVisibility: "Beginn Abgabezeitraum" muss nach "Sichbar für Teilnehmer ab" liegen
SheetErrDeadlineEarly: "Ende Abgabezeitraum" muss nach "Beginn Abzeitraum" liegen
SheetErrHintEarly: Hinweise dürfen erst nach Beginn des Abgabezeitraums herausgegeben werden

40
src/Handler/Sheet.hs
View File

@ -68,19 +68,19 @@ import Text.Hamlet (ihamlet)
data SheetForm = SheetForm
{ sfName :: SheetName
, sfDescription :: Maybe Html
, sfType :: SheetType
, sfGrouping :: SheetGroup
, sfVisibleFrom :: Maybe UTCTime
, sfActiveFrom :: UTCTime
, sfActiveTo :: UTCTime
, sfSubmissionMode :: SubmissionMode
, sfSheetF :: Maybe (Source Handler (Either FileId File))
, sfHintFrom :: Maybe UTCTime
, sfHintF :: Maybe (Source Handler (Either FileId File))
, sfSolutionFrom :: Maybe UTCTime
, sfSheetF :: Maybe (Source Handler (Either FileId File))
, sfHintF :: Maybe (Source Handler (Either FileId File))
, sfSolutionF :: Maybe (Source Handler (Either FileId File))
, sfMarkingF :: Maybe (Source Handler (Either FileId File))
, sfType :: SheetType
, sfGrouping :: SheetGroup
, sfSubmissionMode :: SubmissionMode
, sfDescription :: Maybe Html
, sfMarkingText :: Maybe Html
-- Keine SheetId im Formular!
}
@ -102,12 +102,7 @@ makeSheetForm msId template = identifyForm FIDsheet $ \html -> do
ctime <- ceilingQuarterHour <$> liftIO getCurrentTime
(result, widget) <- flip (renderAForm FormStandard) html $ SheetForm
<$> areq ciField (fslI MsgSheetName) (sfName <$> template)
<*> aopt htmlField (fslpI MsgSheetDescription "Html")
(sfDescription <$> template)
<*> sheetTypeAFormReq (fslI MsgSheetType
& setTooltip (uniworxMessages [MsgSheetTypeInfoBonus,MsgSheetTypeInfoNotGraded]))
(sfType <$> template)
<*> sheetGroupAFormReq (fslI MsgSheetGroup) (sfGrouping <$> template)
<* aformSection MsgSheetFormTimes
<*> aopt utcTimeField (fslI MsgSheetVisibleFrom
& setTooltip MsgSheetVisibleFromTip)
((sfVisibleFrom <$> template) <|> pure (Just ctime))
@ -115,17 +110,24 @@ makeSheetForm msId template = identifyForm FIDsheet $ \html -> do
& setTooltip MsgSheetActiveFromTip)
(sfActiveFrom <$> template)
<*> areq utcTimeField (fslI MsgSheetActiveTo) (sfActiveTo <$> template)
<*> submissionModeForm ((sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ UploadAny True defaultExtensionRestriction))
<*> aopt (multiFileField $ oldFileIds SheetExercise) (fslI MsgSheetExercise) (sfSheetF <$> template)
<*> aopt utcTimeField (fslpI MsgSheetHintFrom "Datum, sonst nur für Korrektoren"
& setTooltip MsgSheetHintFromTip) (sfHintFrom <$> template)
<*> aopt (multiFileField $ oldFileIds SheetHint) (fslI MsgSheetHint) (sfHintF <$> template)
<*> aopt utcTimeField (fslpI MsgSheetSolutionFrom "Datum, sonst nur für Korrektoren"
& setTooltip MsgSheetSolutionFromTip)
(sfSolutionFrom <$> template)
& setTooltip MsgSheetSolutionFromTip) (sfSolutionFrom <$> template)
<* aformSection MsgSheetFormFiles
<*> aopt (multiFileField $ oldFileIds SheetExercise) (fslI MsgSheetExercise) (sfSheetF <$> template)
<*> aopt (multiFileField $ oldFileIds SheetHint) (fslI MsgSheetHint) (sfHintF <$> template)
<*> aopt (multiFileField $ oldFileIds SheetSolution) (fslI MsgSheetSolution) (sfSolutionF <$> template)
<*> aopt (multiFileField $ oldFileIds SheetMarking) (fslI MsgSheetMarking
& setTooltip MsgSheetMarkingTip) (sfMarkingF <$> template)
<*> aopt (multiFileField $ oldFileIds SheetMarking) (fslI MsgSheetMarkingFiles
& setTooltip MsgSheetMarkingTip) (sfMarkingF <$> template)
<* aformSection MsgSheetFormType
<*> sheetTypeAFormReq (fslI MsgSheetType
& setTooltip (uniworxMessages [MsgSheetTypeInfoBonus,MsgSheetTypeInfoNotGraded]))
(sfType <$> template)
<*> sheetGroupAFormReq (fslI MsgSheetGroup) (sfGrouping <$> template)
<*> submissionModeForm ((sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ UploadAny True defaultExtensionRestriction))
<*> aopt htmlField (fslpI MsgSheetDescription "Html")
(sfDescription <$> template)
<*> aopt htmlField (fslpI MsgSheetMarking "Html") (sfMarkingText <$> template)
return $ case result of
FormSuccess sheetResult

3
src/Utils/Form.hs
View File

@ -546,6 +546,9 @@ idFormSectionNoinput = "form-section-noinput"
aformSection :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site msg) => msg -> AForm m ()
aformSection = formToAForm . fmap (second pure) . formSection
wformSection :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => msg -> WForm m ()
wformSection = void . aFormToWForm . aformSection
formSection :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site msg) => msg -> MForm m (FormResult (), FieldView site) -- TODO: WIP, delete
formSection formSectionTitle = do
mr <- getMessageRender