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

Merge branch 'master' of gitlab.cip.ifi.lmu.de:jost/UniWorX

Browse Source
This commit is contained in:
Gregor Kleen 2018-07-18 13:13:24 +02:00
commit b86d4de7ab
3 changed files with 62 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
messages/de.msg
View File

@ -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. SheetDelOk tid@TermId courseShortHand@Text sheetName@Text: #{display tid}-#{courseShortHand}: Übungsblatt #{sheetName} gelöscht.
SheetExercise: Aufgabenstellung SheetExercise: Aufgabenstellung
SheetHint: Hinweise SheetHint: Hinweis
SheetHintFrom: Hinweis ab
SheetSolution: Lösung SheetSolution: Lösung
SheetSolutionFrom: Lösung ab
SheetMarking: Korrekturhinweise 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 Deadline: Abgabe
Done: Eingereicht Done: Eingereicht
@ -208,8 +221,3 @@ AmbiguousUTCTime: Der angegebene Zeitpunkt lässt sich nicht eindeutig zu UTC ko
LastEdits: Letzte Änderungen LastEdits: Letzte Änderungen
EditedBy name@Text time@Text: Durch #{name} um #{time} EditedBy name@Text time@Text: Durch #{name} um #{time}
LastEdit: Letzte Änderung LastEdit: Letzte Änderung
SubmissionSince: Abgabe seit
SubmissionTo: Abgabe bis
SheetType: Bewertung

77
src/Handler/Sheet.hs
View File

@ -78,9 +78,10 @@ data SheetForm = SheetForm
, sfActiveTo :: UTCTime , sfActiveTo :: UTCTime
, sfSheetF :: Maybe (Source Handler (Either FileId File)) , sfSheetF :: Maybe (Source Handler (Either FileId File))
, sfHintFrom :: Maybe UTCTime , sfHintFrom :: Maybe UTCTime
, sfHintF :: Maybe FileInfo , sfHintF :: Maybe (Source Handler (Either FileId File))
, sfSolutionFrom :: Maybe UTCTime , sfSolutionFrom :: Maybe UTCTime
, sfSolutionF :: Maybe FileInfo , sfSolutionF :: Maybe (Source Handler (Either FileId File))
, sfMarkingF :: Maybe (Source Handler (Either FileId File))
-- Keine SheetId im Formular! -- Keine SheetId im Formular!
} }
@ -94,28 +95,36 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
E.&&. sheetFile E.^. SheetFileType E.==. E.val fType E.&&. sheetFile E.^. SheetFileType E.==. E.val fType
return (file E.^. FileId) return (file E.^. FileId)
| otherwise = return Set.empty | otherwise = return Set.empty
mr <- getMsgRenderer
ctime <- liftIO $ getCurrentTime
(result, widget) <- flip (renderAForm FormStandard) html $ SheetForm (result, widget) <- flip (renderAForm FormStandard) html $ SheetForm
<$> areq textField (fsb "Name") (sfName <$> template) <$> areq textField (fsb "Name") (sfName <$> template)
<*> aopt htmlField (fsb "Hinweise für Teilnehmer") (sfDescription <$> template) <*> aopt htmlField (fsb "Hinweise für Teilnehmer") (sfDescription <$> template)
<*> sheetTypeAFormReq (fsb "Bewertung") (sfType <$> template) <*> sheetTypeAFormReq (fsb "Bewertung") (sfType <$> template)
<*> sheetGroupAFormReq (fsb "Abgabegruppengröße") (sfGrouping <$> template) <*> sheetGroupAFormReq (fsb "Abgabegruppengröße") (sfGrouping <$> template)
<*> aopt htmlField (fsb "Hinweise für Korrektoren") (sfMarkingText <$> template) <*> aopt htmlField (fsb "Hinweise für Korrektoren") (sfMarkingText <$> template)
<*> aopt utcTimeField (fsb "Sichtbar ab" <*> aopt utcTimeField (fslI MsgSheetVisibleFrom
& setTooltip "Falls angegeben, wird das Blatt vor dem angegebenen Datum versteckt" & setTooltip "Ohne Datum ist das Blatt komplett unsichtbar, z.B. weil es noch nicht fertig ist.")
) ((sfVisibleFrom <$> template) <|> pure (Just ctime))
(sfVisibleFrom <$> template) <*> areq utcTimeField (fslI MsgSheetActiveFrom
<*> areq utcTimeField (fsb "Abgabe ab") (sfActiveFrom <$> template) & setTooltip "Abgabe und Dateien zur Aufgabenstellung sind erst ab diesem Datum zugänglich")
<*> areq utcTimeField (fsb "Abgabefrist") (sfActiveTo <$> template) (sfActiveFrom <$> template)
<*> areq utcTimeField (fslI MsgSheetActiveTo) (sfActiveTo <$> template)
<*> aopt (multiFileField $ oldFileIds SheetExercise) (fsb "Aufgabenstellung") (sfSheetF <$> template) <*> aopt (multiFileField $ oldFileIds SheetExercise) (fsb "Aufgabenstellung") (sfSheetF <$> template)
<*> aopt utcTimeField (fsb "Hinweis ab") (sfHintFrom <$> template) <*> aopt utcTimeField (fslpI MsgSheetHintFrom "Datum, sonst nur Korrektoren"
<*> fileAFormOpt (fsb "Hinweis") & setTooltip "Ohne Datum nie für Teilnehmer sichtbar, Korrektoren können diese Dateien immer herunterladen")
<*> aopt utcTimeField (fsb "Lösung ab") (sfSolutionFrom <$> template) (sfHintFrom <$> template)
<*> fileAFormOpt (fsb "Lösung") <*> 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 <* submitButton
return $ case result of return $ case result of
FormSuccess sheetResult FormSuccess sheetResult
| errorMsgs <- validateSheet sheetResult | errorMsgs <- validateSheet mr sheetResult
, not $ null errorMsgs -> , not $ null errorMsgs ->
(FormFailure errorMsgs, (FormFailure errorMsgs,
[whamlet| [whamlet|
@ -130,16 +139,13 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
) )
_ -> (result, widget) _ -> (result, widget)
where where
validateSheet :: SheetForm -> [Text] validateSheet :: MsgRenderer -> SheetForm -> [Text]
validateSheet (SheetForm{..}) = validateSheet (MsgRenderer {..}) (SheetForm{..}) =
[ msg | (False, msg) <- [ msg | (False, msg) <-
[ ( maybe True (sfActiveFrom >=) sfVisibleFrom [ ( sfVisibleFrom <= Just sfActiveFrom , render MsgSheetErrVisibility)
, "Sichtbarkeit muss vor Beginn der Abgabefrist liegen." , ( sfActiveFrom <= sfActiveTo , render MsgSheetErrDeadlineEarly)
) , ( NTop sfHintFrom >= NTop (Just sfActiveFrom) , render MsgSheetErrHintEarly)
, ( sfActiveTo >= sfActiveFrom , ( NTop sfSolutionFrom >= NTop (Just sfActiveTo) , render MsgSheetErrSolutionEarly)
, "Ende der Abgabefrist muss nach deren Beginn liegen."
)
-- TODO: continue validation here!!!
] ] ] ]
getSheetListR :: TermId -> Text -> Handler Html getSheetListR :: TermId -> Text -> Handler Html
@ -160,9 +166,9 @@ getSheetListR tid csh = do
$ \(_, E.Value mEditTime) -> case mEditTime of $ \(_, E.Value mEditTime) -> case mEditTime of
Just editTime -> cell $ formatTime SelFormatDateTime (editTime :: UTCTime) >>= toWidget Just editTime -> cell $ formatTime SelFormatDateTime (editTime :: UTCTime) >>= toWidget
Nothing -> mempty Nothing -> mempty
, sortable (Just "submission-since") (i18nCell MsgSubmissionSince) , sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom)
$ \(Entity _ Sheet{..}, _) -> cell $ formatTime SelFormatDateTime sheetActiveFrom >>= toWidget $ \(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 $ \(Entity _ Sheet{..}, _) -> cell $ formatTime SelFormatDateTime sheetActiveTo >>= toWidget
, sortable Nothing (i18nCell MsgSheetType) , sortable Nothing (i18nCell MsgSheetType)
$ \(Entity _ Sheet{..}, _) -> textCell $ display sheetType $ \(Entity _ Sheet{..}, _) -> textCell $ display sheetType
@ -306,12 +312,13 @@ getSEditR :: TermId -> Text -> Text -> Handler Html
getSEditR tid csh shn = do getSEditR tid csh shn = do
(sheetEnt, sheetFileIds) <- runDB $ do (sheetEnt, sheetFileIds) <- runDB $ do
ent <- fetchSheet tid csh shn 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.on $ file E.^. FileId E.==. sheetFile E.^. SheetFileFile
E.where_ $ sheetFile E.^. SheetFileSheet E.==. E.val (entityKey ent) E.where_ $ sheetFile E.^. SheetFileSheet E.==. E.val (entityKey ent)
E.&&. sheetFile E.^. SheetFileType E.==. E.val SheetExercise return (sheetFile E.^. SheetFileType, file E.^. FileId)
return (file E.^. FileId) let ftIds :: SheetFileType -> Set FileId
return (ent, fIds) ftIds ft = Set.fromList $ mapMaybe (\(E.Value t, E.Value i) -> i <$ guard (ft==t)) allfIds
return (ent, ftIds)
let sid = entityKey sheetEnt let sid = entityKey sheetEnt
let oldSheet@(Sheet {..}) = entityVal sheetEnt let oldSheet@(Sheet {..}) = entityVal sheetEnt
let template = Just $ SheetForm let template = Just $ SheetForm
@ -323,11 +330,12 @@ getSEditR tid csh shn = do
, sfVisibleFrom = sheetVisibleFrom , sfVisibleFrom = sheetVisibleFrom
, sfActiveFrom = sheetActiveFrom , sfActiveFrom = sheetActiveFrom
, sfActiveTo = sheetActiveTo , sfActiveTo = sheetActiveTo
, sfSheetF = Just . yieldMany . map Left $ Set.toList sheetFileIds , sfSheetF = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetExercise
, sfHintFrom = sheetHintFrom , sfHintFrom = sheetHintFrom
, sfHintF = Nothing -- TODO , sfHintF = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetHint
, sfSolutionFrom = sheetSolutionFrom , 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 let action newSheet = do
replaceRes <- myReplaceUnique sid $ newSheet replaceRes <- myReplaceUnique sid $ newSheet
@ -367,8 +375,9 @@ handleSheetEdit tid csh msId template dbAction = do
Nothing -> False <$ addMessageI "danger" (MsgSheetNameDup tid csh sfName) Nothing -> False <$ addMessageI "danger" (MsgSheetNameDup tid csh sfName)
(Just sid) -> do -- save files in DB: (Just sid) -> do -- save files in DB:
whenIsJust sfSheetF $ insertSheetFile' sid SheetExercise whenIsJust sfSheetF $ insertSheetFile' sid SheetExercise
whenIsJust sfHintF $ insertSheetFile sid SheetHint whenIsJust sfHintF $ insertSheetFile' sid SheetHint
whenIsJust sfSolutionF $ insertSheetFile sid SheetSolution whenIsJust sfSolutionF $ insertSheetFile' sid SheetSolution
whenIsJust sfMarkingF $ insertSheetFile' sid SheetMarking
insert_ $ SheetEdit aid actTime sid insert_ $ SheetEdit aid actTime sid
addMessageI "info" $ MsgSheetEditOk tid csh sfName addMessageI "info" $ MsgSheetEditOk tid csh sfName
return True return True

5
src/Utils.hs
View File

@ -153,6 +153,11 @@ trd3 (_,_,z) = z
----------- -----------
-- Maybe -- -- Maybe --
----------- -----------
toMaybe :: Bool -> a -> Maybe a
toMaybe True = Just
toMaybe False = const Nothing
whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m () whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
whenIsJust (Just x) f = f x whenIsJust (Just x) f = f x
whenIsJust Nothing _ = return () whenIsJust Nothing _ = return ()