Merge branch 'master' of gitlab.cip.ifi.lmu.de:jost/UniWorX
This commit is contained in:
Gregor Kleen
commit
b86d4de7ab
@ -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
|
||||
@ -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
|
||||
|
||||
@ -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 ()
|
||||
|
||||
Loading…
Reference in New Issue
Block a user