diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index bd8e45ac9..babad5c46 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -1321,9 +1321,10 @@ ExamPublishOccurrenceAssignments: Termin- bzw. Raumzuteilung den Teilnehmern mit ExamPublishOccurrenceAssignmentsTip: Ab diesem Zeitpunkt Teilnehmer einsehen zu welcher Teilprüfung bzw. welchen Raum sie angemeldet sind ExamPublishOccurrenceAssignmentsParticipant: Termin- bzw. Raumzuteilung einsehbar ab ExamFinished: Bewertung abgeschlossen ab +ExamFinishedOffice: Noten bekannt gegeben ExamFinishedParticipant: Bewertung vorrausichtlich abgeschlossen ExamFinishedTip: Zeitpunkt zu dem Prüfungergebnisse den Teilnehmern gemeldet werden -ExamClosed: Noten stehen fest ab +ExamClosed: Noten gemeldet ExamClosedTip: Prüfungsämter, die im System Noten einsehen, werden zu diesem Zeitpunkt benachrichtigt und danach bei Änderungen informiert ExamShowGrades: Klausur ist benotet ExamShowGradesTip: Sollen genaue Noten angezeigt werden, oder sollen Teilnehmer und Prüfungsämter nur informiert werden, ob die Klausur bestanden wurde? @@ -1745,4 +1746,11 @@ MailSubjectChangeUserDisplayEmail: Diese E-Mail Adresse in Uni2work veröffentli MailIntroChangeUserDisplayEmail displayEmail@UserEmail: Der oben genannte Benutzer möchte „#{displayEmail}“ als öffentliche Adresse, assoziiert mit sich selbst, angeben. Wenn Sie diese Aktion nicht selbst ausgelöst haben, ignorieren Sie diese Mitteilung bitte! MailTitleChangeUserDisplayEmail displayName@Text: #{displayName} möchte diese E-Mail Adresse in Uni2work veröffentlichen -ExamOfficeOptOutsChanged: Zuständige Prüfungsämter erfolgreich angepasst \ No newline at end of file +ExamOfficeOptOutsChanged: Zuständige Prüfungsämter erfolgreich angepasst + +BtnCloseExam: Klausur abschließen +ExamCloseTip: Wenn eine Klausur abgeschlossen wird, werden Prüfungsämter, die im System Noten einsehen, benachrichtigt und danach bei Änderungen informiert. +ExamCloseReminder: Bitte schließen Sie die Klausur frühstmöglich, sobald die Prüfungsleistungen sich voraussichtlich nicht mehr ändern werden. Z.B. direkt nach der Klausureinsicht. +ExamDidClose: Klausur erfolgreich abgeschlossen + +ExamClosedSince time@Text: Klausur abgeschlossen seit #{time} \ No newline at end of file diff --git a/src/Handler/Exam/Edit.hs b/src/Handler/Exam/Edit.hs index 99bd12772..fbd0c1acc 100644 --- a/src/Handler/Exam/Edit.hs +++ b/src/Handler/Exam/Edit.hs @@ -18,12 +18,12 @@ import Jobs.Queue getEEditR, postEEditR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html getEEditR = postEEditR postEEditR tid ssh csh examn = do - (cid, eId, template) <- runDB $ do - (cid, exam@(Entity eId _)) <- fetchCourseIdExam tid ssh csh examn + (cid, Entity eId oldExam, template) <- runDB $ do + (cid, exam) <- fetchCourseIdExam tid ssh csh examn template <- examFormTemplate exam - return (cid, eId, template) + return (cid, exam, template) ((editExamResult, editExamWidget), editExamEnctype) <- runFormPost . validateForm validateExam . examForm $ Just template @@ -43,7 +43,7 @@ postEEditR tid ssh csh examn = do , examStart = efStart , examEnd = efEnd , examFinished = efFinished - , examClosed = efClosed + , examClosed = examClosed oldExam , examPublicStatistics = efPublicStatistics , examShowGrades = efShowGrades , examDescription = efDescription diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index cdfc86cb1..452b0aa3d 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -34,7 +34,6 @@ data ExamForm = ExamForm , efDeregisterUntil :: Maybe UTCTime , efPublishOccurrenceAssignments :: Maybe UTCTime , efFinished :: Maybe UTCTime - , efClosed :: Maybe UTCTime , efOccurrences :: Set ExamOccurrenceForm , efShowGrades :: Bool , efPublicStatistics :: Bool @@ -89,12 +88,11 @@ examForm template html = do <*> aopt utcTimeField (fslpI MsgExamDeregisterUntil (mr MsgDate)) (efDeregisterUntil <$> template) <*> aopt utcTimeField (fslpI MsgExamPublishOccurrenceAssignments (mr MsgDate) & setTooltip MsgExamPublishOccurrenceAssignmentsTip) (efPublishOccurrenceAssignments <$> template) <*> aopt utcTimeField (fslpI MsgExamFinished (mr MsgDate) & setTooltip MsgExamFinishedTip) (efFinished <$> template) - <*> aopt utcTimeField (fslpI MsgExamClosed (mr MsgDate) & setTooltip MsgExamClosedTip) (efClosed <$> template) <* aformSection MsgExamFormOccurrences <*> examOccurrenceForm (efOccurrences <$> template) <* aformSection MsgExamFormAutomaticFunctions - <*> (fromMaybe False <$> aopt checkBoxField (fslI MsgExamShowGrades & setTooltip MsgExamShowGradesTip) (Just . efShowGrades <$> template)) - <*> (fromMaybe False <$> aopt checkBoxField (fslI MsgExamPublicStatistics & setTooltip MsgExamPublicStatisticsTip) (Just . efPublicStatistics <$> template)) + <*> apopt checkBoxField (fslI MsgExamShowGrades & setTooltip MsgExamShowGradesTip) (efShowGrades <$> template <|> Just True) + <*> apopt checkBoxField (fslI MsgExamPublicStatistics & setTooltip MsgExamPublicStatisticsTip) (efPublicStatistics <$> template <|> Just True) <*> examGradingRuleForm (efGradingRule <$> template) <*> examBonusRuleForm (efBonusRule <$> template) <*> examOccurrenceRuleForm (efOccurrenceRule <$> template) @@ -250,7 +248,6 @@ examFormTemplate (Entity eId Exam{..}) = do , efStart = examStart , efEnd = examEnd , efFinished = examFinished - , efClosed = examClosed , efShowGrades = examShowGrades , efPublicStatistics = examPublicStatistics , efDescription = examDescription @@ -318,7 +315,6 @@ examTemplate cid = runMaybeT $ do , efStart = dateOffset <$> examStart oldExam , efEnd = dateOffset <$> examEnd oldExam , efFinished = dateOffset <$> examFinished oldExam - , efClosed = dateOffset <$> examClosed oldExam , efShowGrades = examShowGrades oldExam , efPublicStatistics = examPublicStatistics oldExam , efDescription = examDescription oldExam @@ -338,9 +334,6 @@ validateExam = do guardValidation MsgExamEndMustBeAfterStart $ NTop efEnd >= NTop efStart guardValidation MsgExamFinishedMustBeAfterEnd . fromMaybe True $ (>=) <$> efFinished <*> efEnd guardValidation MsgExamFinishedMustBeAfterStart $ NTop efFinished >= NTop efStart - guardValidation MsgExamClosedMustBeAfterFinished . fromMaybe True $ (>=) <$> efClosed <*> efFinished - guardValidation MsgExamClosedMustBeAfterStart $ NTop efClosed >= NTop efStart - guardValidation MsgExamClosedMustBeAfterEnd . fromMaybe True $ (>=) <$> efClosed <*> efEnd forM_ efOccurrences $ \ExamOccurrenceForm{..} -> do guardValidation (MsgExamOccurrenceEndMustBeAfterStart eofName) $ NTop eofEnd >= NTop (Just eofStart) diff --git a/src/Handler/Exam/New.hs b/src/Handler/Exam/New.hs index d6bcfc828..0f863f75b 100644 --- a/src/Handler/Exam/New.hs +++ b/src/Handler/Exam/New.hs @@ -40,7 +40,7 @@ postCExamNewR tid ssh csh = do , examStart = efStart , examEnd = efEnd , examFinished = efFinished - , examClosed = efClosed + , examClosed = Nothing , examShowGrades = efShowGrades , examPublicStatistics = efPublicStatistics , examDescription = efDescription diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs index 53f3d0b6c..42a1f12f5 100644 --- a/src/Handler/Exam/Users.hs +++ b/src/Handler/Exam/Users.hs @@ -10,6 +10,8 @@ import Handler.Utils import Handler.Utils.Exam import Handler.Utils.Csv +import Handler.ExamOffice.Exam (examCloseWidget) + import qualified Database.Esqueleto as E import qualified Database.Esqueleto.Utils as E import Database.Esqueleto.Utils.TH @@ -228,7 +230,7 @@ embedRenderMessage ''UniWorX ''ExamUserCsvException id getEUsersR, postEUsersR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html getEUsersR = postEUsersR postEUsersR tid ssh csh examn = do - (registrationResult, examUsersTable) <- runDB $ do + ((registrationResult, examUsersTable), Entity eId _) <- runDB $ do exam@(Entity eid Exam{..}) <- fetchExam tid ssh csh examn bonus <- examBonus exam @@ -654,7 +656,7 @@ postEUsersR tid ssh csh examn = do (First (Just act), regMap) <- inp let regSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) regMap return (act, regSet) - over _1 postprocess <$> dbTable examUsersDBTableValidator examUsersDBTable + (, exam) . over _1 postprocess <$> dbTable examUsersDBTableValidator examUsersDBTable formResult registrationResult $ \case (ExamUserDeregisterData, selectedRegistrations) -> do @@ -672,6 +674,8 @@ postEUsersR tid ssh csh examn = do addMessageI Success $ MsgExamUsersOccurrenceUpdated nrUpdated redirect $ CExamR tid ssh csh examn EUsersR + closeWgt <- examCloseWidget (SomeRoute $ CExamR tid ssh csh examn EUsersR) eId + siteLayoutMsg (prependCourseTitle tid ssh csh MsgExamUsersHeading) $ do setTitleI $ prependCourseTitle tid ssh csh MsgExamUsersHeading $(widgetFile "exam-users") diff --git a/src/Handler/ExamOffice/Exam.hs b/src/Handler/ExamOffice/Exam.hs index 4aeb046cd..c44f50ee1 100644 --- a/src/Handler/ExamOffice/Exam.hs +++ b/src/Handler/ExamOffice/Exam.hs @@ -1,5 +1,6 @@ module Handler.ExamOffice.Exam ( getEGradesR, postEGradesR + , examCloseWidget ) where import Import @@ -20,6 +21,46 @@ import qualified Data.Conduit.List as C import qualified Colonnade +data ButtonCloseExam = BtnCloseExam + deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable) +instance Universe ButtonCloseExam +instance Finite ButtonCloseExam + +nullaryPathPiece ''ButtonCloseExam $ camelToPathPiece' 1 + +embedRenderMessage ''UniWorX ''ButtonCloseExam id +instance Button UniWorX ButtonCloseExam where + btnClasses BtnCloseExam = [BCIsButton] + + +examCloseWidget :: SomeRoute UniWorX -> ExamId -> Handler Widget +examCloseWidget dest eId = do + Exam{..} <- runDB $ get404 eId + + ((closeRes, closeView), closeEnc) <- runFormPost $ identifyForm BtnCloseExam buttonForm + + formResult closeRes $ \case + BtnCloseExam -> do + now <- liftIO getCurrentTime + + unless (is _Nothing examClosed) $ + invalidArgs ["Exam is already closed"] + + runDB $ update eId [ ExamClosed =. Just now ] + addMessageI Success MsgExamDidClose + redirect dest + + let closeView' = wrapForm closeView def + { formSubmit = FormNoSubmit + , formAction = Just dest + , formEncoding = closeEnc + } + + examClosed' <- for examClosed $ formatTime SelFormatDateTime + + return $(widgetFile "widgets/exam-close") + + type ExamUserTableExpr = ( E.SqlExpr (Entity ExamResult) `E.InnerJoin` E.SqlExpr (Entity User) ) @@ -153,8 +194,8 @@ getEGradesR = postEGradesR postEGradesR tid ssh csh examn = do uid <- requireAuthId now <- liftIO getCurrentTime - (usersResult, examUsersTable) <- runDB $ do - Entity eid Exam{..} <- fetchExam tid ssh csh examn + ((usersResult, examUsersTable), Entity eId _) <- runDB $ do + exam@(Entity eid Exam{..}) <- fetchExam tid ssh csh examn csvName <- getMessageRender <*> pure (MsgExamUserCsvName tid ssh csh examn) isLecturer <- hasReadAccessTo $ CExamR tid ssh csh examn EUsersR @@ -387,10 +428,12 @@ postEGradesR tid ssh csh examn = do addMessageI Success $ MsgExamUserMarkedSynchronised (length selectedResults) redirect $ CExamR tid ssh csh examn EGradesR - return (usersResult', examUsersTable) + return ((usersResult', examUsersTable), exam) whenIsJust usersResult join + closeWgt <- examCloseWidget (SomeRoute $ CExamR tid ssh csh examn EGradesR) eId + siteLayoutMsg (prependCourseTitle tid ssh csh MsgExamOfficeExamUsersHeading) $ do setTitleI $ prependCourseTitle tid ssh csh MsgExamOfficeExamUsersHeading $(widgetFile "exam-office/exam-results") diff --git a/src/Handler/ExamOffice/Exams.hs b/src/Handler/ExamOffice/Exams.hs index 96637f5a3..a5794e701 100644 --- a/src/Handler/ExamOffice/Exams.hs +++ b/src/Handler/ExamOffice/Exams.hs @@ -48,15 +48,16 @@ queryResults office = to . runReader $ do return E.countRows return results -queryIsSynced :: E.SqlExpr (E.Value UserId) -> Getter ExamsTableExpr (E.SqlExpr (E.Value Bool)) -queryIsSynced office = to . runReader $ do +queryIsSynced :: UTCTime -> E.SqlExpr (E.Value UserId) -> Getter ExamsTableExpr (E.SqlExpr (E.Value Bool)) +queryIsSynced now office = to . runReader $ do exam <- view queryExam let synchronised = E.not_ . E.exists . E.from $ \examResult -> do E.where_ $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId E.where_ $ Exam.examOfficeExamResultAuth office examResult E.where_ . E.not_ $ Exam.resultIsSynced office examResult - return synchronised + open = E.maybe E.true (E.>. E.val now) $ exam E.^. ExamClosed + return $ synchronised E.||. open resultExam :: Lens' ExamsTableData (Entity Exam) @@ -78,6 +79,7 @@ resultIsSynced = to $ (>=) <$> view resultSynchronised <*> view resultResults getEOExamsR :: Handler Html getEOExamsR = do uid <- requireAuthId + now <- liftIO getCurrentTime examsTable <- runDB $ do let @@ -91,7 +93,7 @@ getEOExamsR = do querySynchronised' = querySynchronised $ E.val uid queryResults' = queryResults $ E.val uid - queryIsSynced' = queryIsSynced $ E.val uid + queryIsSynced' = queryIsSynced now $ E.val uid examsDBTable = DBTable{..} where @@ -122,21 +124,28 @@ getEOExamsR = do colSynced = Colonnade.singleton (fromSortable . Sortable (Just "synced") $ i18nCell MsgExamSynchronised) $ \x -> flip runReader x $ do - synced <- view resultSynchronised - results <- view resultResults - isSynced <- view resultIsSynced + Entity _ Exam{examClosed} <- view resultExam - return $ cell - [whamlet| - $newline never - $if isSynced - #{iconOK} - $else - #{synced}/#{results} - |] - & cellAttrs <>~ [ ("class", "heated") - , ("style", [st|--hotness: #{tshow (heat results synced)}|]) - ] + if + | NTop examClosed > NTop (Just now) + -> return . cell $ toWidget iconNew + | otherwise + -> do + synced <- view resultSynchronised + results <- view resultResults + isSynced <- view resultIsSynced + + return $ cell + [whamlet| + $newline never + $if isSynced + #{iconOK} + $else + #{synced}/#{results} + |] + & cellAttrs <>~ [ ("class", "heated") + , ("style", [st|--hotness: #{tshow (heat results synced)}|]) + ] dbtColonnade :: Colonnade Sortable _ _ @@ -145,6 +154,8 @@ getEOExamsR = do , anchorColonnade (views ($(multifocusG 2) (resultCourse . _entityVal) (resultExam . _entityVal)) (uncurry examLink)) $ colExamName (resultExam . _entityVal . _examName) , colExamTime (resultExam . _entityVal . $(multifocusG 2) _examStart _examEnd) + , colExamFinishedOffice (resultExam . _entityVal . _examFinished) + , colExamClosed (resultExam . _entityVal . _examClosed) , anchorColonnade (views (resultCourse . _entityVal) courseLink) $ colCourseName (resultCourse . _entityVal . _courseName) , colSchool (resultCourse . _entityVal . _courseSchool) @@ -155,6 +166,8 @@ getEOExamsR = do , singletonMap "is-synced" . SortColumn $ view queryIsSynced' , sortExamName (queryExam . to (E.^. ExamName)) , sortExamTime (queryExam . $(multifocusG 2) (to (E.^. ExamStart)) (to (E.^. ExamEnd))) + , sortExamFinished (queryExam . to (E.^. ExamFinished)) + , sortExamClosed (queryExam . to (E.^. ExamClosed)) , sortCourseName (queryCourse . to (E.^. CourseName)) , sortSchool (queryCourse . to (E.^. CourseSchool)) , sortTerm (queryCourse . to (E.^. CourseTerm)) diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs index 38b656c39..12ea839d3 100644 --- a/src/Handler/Utils/Table/Columns.hs +++ b/src/Handler/Utils/Table/Columns.hs @@ -226,7 +226,31 @@ colExamTime resultTimes = Colonnade.singleton (fromSortable header) body sortExamTime :: OpticSortColumn' (E.SqlExpr (E.Value (Maybe UTCTime)), E.SqlExpr (E.Value (Maybe UTCTime))) sortExamTime queryTimes = singletonMap "exam-time" . SortColumns . toListOf $ queryTimes . _1 . to SomeExprValue <> queryTimes . _2 . to SomeExprValue - + +colExamClosed :: OpticColonnade (Maybe UTCTime) +colExamClosed resultClosed = Colonnade.singleton (fromSortable header) body + where + header = Sortable (Just "exam-closed") (i18nCell MsgExamClosed) + body = views resultClosed $ maybe mempty (cell . formatTimeW SelFormatDateTime) + +sortExamClosed :: OpticSortColumn (Maybe UTCTime) +sortExamClosed queryClosed = singletonMap "exam-closed" . SortColumn $ view queryClosed + +colExamFinished :: OpticColonnade (Maybe UTCTime) +colExamFinished resultFinished = Colonnade.singleton (fromSortable header) body + where + header = Sortable (Just "exam-finished") (i18nCell MsgExamFinished) + body = views resultFinished $ maybe mempty (cell . formatTimeW SelFormatDateTime) + +colExamFinishedOffice :: OpticColonnade (Maybe UTCTime) +colExamFinishedOffice resultFinished = Colonnade.singleton (fromSortable header) body + where + header = Sortable (Just "exam-finished") (i18nCell MsgExamFinishedOffice) + body = views resultFinished $ maybe mempty (cell . formatTimeW SelFormatDateTime) + +sortExamFinished :: OpticSortColumn (Maybe UTCTime) +sortExamFinished queryFinished = singletonMap "exam-finished" . SortColumn $ view queryFinished + --------------------- -- Exam occurences -- --------------------- diff --git a/templates/exam-office/exam-results.hamlet b/templates/exam-office/exam-results.hamlet index dea20c2a7..efa46523c 100644 --- a/templates/exam-office/exam-results.hamlet +++ b/templates/exam-office/exam-results.hamlet @@ -1,2 +1,5 @@ $newline never -^{examUsersTable} +
+ ^{closeWgt} +
+ ^{examUsersTable} diff --git a/templates/exam-show.hamlet b/templates/exam-show.hamlet index 6e12d555d..4602c9184 100644 --- a/templates/exam-show.hamlet +++ b/templates/exam-show.hamlet @@ -55,6 +55,9 @@ $maybe desc <- examDescription $maybe finished <- examFinished
_{MsgExamFinishedParticipant}
^{formatTimeW SelFormatDateTime finished} + $maybe closed <- examClosed +
_{MsgExamClosed} +
^{formatTimeW SelFormatDateTime closed} $if gradingShown $if examGradingRule /= ExamGradingManual
diff --git a/templates/exam-users.hamlet b/templates/exam-users.hamlet index dea20c2a7..efa46523c 100644 --- a/templates/exam-users.hamlet +++ b/templates/exam-users.hamlet @@ -1,2 +1,5 @@ $newline never -^{examUsersTable} +
+ ^{closeWgt} +
+ ^{examUsersTable} diff --git a/templates/widgets/exam-close.hamlet b/templates/widgets/exam-close.hamlet new file mode 100644 index 000000000..6a768b533 --- /dev/null +++ b/templates/widgets/exam-close.hamlet @@ -0,0 +1,9 @@ +$newline never +$maybe closed <- examClosed' + _{MsgExamClosedSince closed} +$nothing +

+ _{MsgExamCloseTip} +

+ _{MsgExamCloseReminder} + ^{closeView'}