diff --git a/messages/de.msg b/messages/de.msg index 6668a448b..99220e436 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -59,9 +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 +SheetType: Bewertung + +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 @@ -208,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 041f60e9f..dc18c29a4 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! } @@ -94,28 +95,36 @@ 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" - & setTooltip "Falls angegeben, wird das Blatt vor dem angegebenen Datum versteckt" - ) - (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) + <*> 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) + <*> 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 - | errorMsgs <- validateSheet sheetResult + | errorMsgs <- validateSheet mr sheetResult , not $ null errorMsgs -> (FormFailure errorMsgs, [whamlet| @@ -130,16 +139,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) ] ] getSheetListR :: TermId -> Text -> Handler Html @@ -160,9 +166,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 @@ -306,12 +312,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 @@ -323,11 +330,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 @@ -367,8 +375,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 ()