From 813d44697591daeae76f1579d9e3f1ef0b4118f8 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sat, 18 May 2019 23:14:21 +0200 Subject: [PATCH] Divide sheetForm into sections --- messages/uniworx/de.msg | 5 +++++ src/Handler/Sheet.hs | 40 +++++++++++++++++++++------------------- src/Utils/Form.hs | 3 +++ 3 files changed, 29 insertions(+), 19 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 9ea58fd65..70f005dfc 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -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 diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 0b0b62e40..f315c7709 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -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 diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index c11496380..c2797980d 100644 --- a/src/Utils/Form.hs +++ b/src/Utils/Form.hs @@ -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