From e42e59242f8b9003912c4f7b196a430c2de37a95 Mon Sep 17 00:00:00 2001 From: SJost Date: Wed, 18 Jul 2018 12:21:16 +0200 Subject: [PATCH 1/3] Sheet Form validation and tooltips augmented --- messages/de.msg | 16 ++++++++++++++-- src/Handler/Sheet.hs | 42 ++++++++++++++++++++++++------------------ 2 files changed, 38 insertions(+), 20 deletions(-) diff --git a/messages/de.msg b/messages/de.msg index 72239ce44..73490431f 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -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} \ No newline at end of file +EditedBy name@Text time@Text: Durch #{name} um #{time} diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index d85e9694a..552e34688 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -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 From 9feb4b7d5dfe5da1a4efb1ac628ff4fbab93128c Mon Sep 17 00:00:00 2001 From: SJost Date: Wed, 18 Jul 2018 12:30:32 +0200 Subject: [PATCH 2/3] Minor message cleaning --- messages/de.msg | 6 +----- src/Handler/Sheet.hs | 4 ++-- 2 files changed, 3 insertions(+), 7 deletions(-) diff --git a/messages/de.msg b/messages/de.msg index 9560f5a38..99220e436 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -64,6 +64,7 @@ SheetHintFrom: Hinweis ab SheetSolution: Lösung SheetSolutionFrom: Lösung ab SheetMarking: Korrekturhinweise +SheetType: Bewertung SheetVisibleFrom: Sichtbar ab SheetActiveFrom: Aktiv ab @@ -220,8 +221,3 @@ AmbiguousUTCTime: Der angegebene Zeitpunkt lässt sich nicht eindeutig zu UTC ko LastEdits: Letzte Änderungen EditedBy name@Text time@Text: Durch #{name} um #{time} LastEdit: Letzte Änderung - -SubmissionSince: Abgabe seit -SubmissionTo: Abgabe bis - -SheetType: Bewertung \ No newline at end of file diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 655894352..f564b0af4 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -162,9 +162,9 @@ getSheetListR tid csh = do $ \(_, E.Value mEditTime) -> case mEditTime of Just editTime -> cell $ formatTime SelFormatDateTime (editTime :: UTCTime) >>= toWidget Nothing -> mempty - , sortable (Just "submission-since") (i18nCell MsgSubmissionSince) + , sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom) $ \(Entity _ Sheet{..}, _) -> cell $ formatTime SelFormatDateTime sheetActiveFrom >>= toWidget - , sortable (Just "submission-until") (i18nCell MsgSubmissionTo) + , sortable (Just "submission-until") (i18nCell MsgSheetActiveTo) $ \(Entity _ Sheet{..}, _) -> cell $ formatTime SelFormatDateTime sheetActiveTo >>= toWidget , sortable Nothing (i18nCell MsgSheetType) $ \(Entity _ Sheet{..}, _) -> textCell $ display sheetType From ab80b9207d81fd8650ce45084f0589f2723b15e5 Mon Sep 17 00:00:00 2001 From: SJost Date: Wed, 18 Jul 2018 13:10:24 +0200 Subject: [PATCH 3/3] Multifile fields for Hints,Solutions,Markings --- src/Handler/Sheet.hs | 32 +++++++++++++++++++------------- src/Utils.hs | 5 +++++ 2 files changed, 24 insertions(+), 13 deletions(-) diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index f564b0af4..2dfe98535 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -78,9 +78,10 @@ data SheetForm = SheetForm , sfActiveTo :: UTCTime , sfSheetF :: Maybe (Source Handler (Either FileId File)) , sfHintFrom :: Maybe UTCTime - , sfHintF :: Maybe FileInfo + , sfHintF :: Maybe (Source Handler (Either FileId File)) , sfSolutionFrom :: Maybe UTCTime - , sfSolutionF :: Maybe FileInfo + , sfSolutionF :: Maybe (Source Handler (Either FileId File)) + , sfMarkingF :: Maybe (Source Handler (Either FileId File)) -- Keine SheetId im Formular! } @@ -113,11 +114,13 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do <*> 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 (multiFileField $ oldFileIds SheetHint) (fslI MsgSheetHint) (sfHintF <$> template) <*> 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) + <*> aopt (multiFileField $ oldFileIds SheetSolution) (fslI MsgSheetSolution) (sfSolutionF <$> template) + <*> aopt (multiFileField $ oldFileIds SheetMarking) (fslI MsgSheetMarking + & setTooltip "Hinweise zur Korrektur, sichtbar nur für Korrektoren") (sfMarkingF <$> template) <* submitButton return $ case result of FormSuccess sheetResult @@ -305,12 +308,13 @@ getSEditR :: TermId -> Text -> Text -> Handler Html getSEditR tid csh shn = do (sheetEnt, sheetFileIds) <- runDB $ do ent <- fetchSheet tid csh shn - fIds <- fmap setFromList . fmap (map E.unValue) . E.select . E.from $ \(file `E.InnerJoin` sheetFile) -> do + allfIds <- E.select . E.from $ \(file `E.InnerJoin` sheetFile) -> do E.on $ file E.^. FileId E.==. sheetFile E.^. SheetFileFile E.where_ $ sheetFile E.^. SheetFileSheet E.==. E.val (entityKey ent) - E.&&. sheetFile E.^. SheetFileType E.==. E.val SheetExercise - return (file E.^. FileId) - return (ent, fIds) + return (sheetFile E.^. SheetFileType, file E.^. FileId) + let ftIds :: SheetFileType -> Set FileId + ftIds ft = Set.fromList $ mapMaybe (\(E.Value t, E.Value i) -> i <$ guard (ft==t)) allfIds + return (ent, ftIds) let sid = entityKey sheetEnt let oldSheet@(Sheet {..}) = entityVal sheetEnt let template = Just $ SheetForm @@ -322,11 +326,12 @@ getSEditR tid csh shn = do , sfVisibleFrom = sheetVisibleFrom , sfActiveFrom = sheetActiveFrom , sfActiveTo = sheetActiveTo - , sfSheetF = Just . yieldMany . map Left $ Set.toList sheetFileIds + , sfSheetF = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetExercise , sfHintFrom = sheetHintFrom - , sfHintF = Nothing -- TODO + , sfHintF = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetHint , sfSolutionFrom = sheetSolutionFrom - , sfSolutionF = Nothing -- TODO + , sfSolutionF = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetSolution + , sfMarkingF = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetMarking } let action newSheet = do replaceRes <- myReplaceUnique sid $ newSheet @@ -366,8 +371,9 @@ handleSheetEdit tid csh msId template dbAction = do Nothing -> False <$ addMessageI "danger" (MsgSheetNameDup tid csh sfName) (Just sid) -> do -- save files in DB: whenIsJust sfSheetF $ insertSheetFile' sid SheetExercise - whenIsJust sfHintF $ insertSheetFile sid SheetHint - whenIsJust sfSolutionF $ insertSheetFile sid SheetSolution + whenIsJust sfHintF $ insertSheetFile' sid SheetHint + whenIsJust sfSolutionF $ insertSheetFile' sid SheetSolution + whenIsJust sfMarkingF $ insertSheetFile' sid SheetMarking insert_ $ SheetEdit aid actTime sid addMessageI "info" $ MsgSheetEditOk tid csh sfName return True diff --git a/src/Utils.hs b/src/Utils.hs index 7132bd178..1ec44e5ba 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -153,6 +153,11 @@ trd3 (_,_,z) = z ----------- -- Maybe -- ----------- + +toMaybe :: Bool -> a -> Maybe a +toMaybe True = Just +toMaybe False = const Nothing + whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m () whenIsJust (Just x) f = f x whenIsJust Nothing _ = return ()