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

fix(exams): make examClosed a button

Browse Source 
Show examFinished and examClosed to ExamOffice
Mark not-yet-closed exams for ExamOffice
This commit is contained in:
Gregor Kleen 2019-09-16 11:24:14 +02:00
parent 5841a7b5d2
commit 530a8c688e
12 changed files with 145 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
messages/uniworx/de.msg
View File

@ -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
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}

8
src/Handler/Exam/Edit.hs
View File

@ -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

11
src/Handler/Exam/Form.hs
View File

@ -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)

2
src/Handler/Exam/New.hs
View File

@ -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

8
src/Handler/Exam/Users.hs
View File

@ -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")

49
src/Handler/ExamOffice/Exam.hs
View File

@ -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")

49
src/Handler/ExamOffice/Exams.hs
View File

@ -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))

26
src/Handler/Utils/Table/Columns.hs
View File

@ -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 --
---------------------

5
templates/exam-office/exam-results.hamlet
View File

@ -1,2 +1,5 @@
$newline never
^{examUsersTable}
<section>
^{closeWgt}
<section>
^{examUsersTable}

3
templates/exam-show.hamlet
View File

@ -55,6 +55,9 @@ $maybe desc <- examDescription
$maybe finished <- examFinished
<dt .deflist__dt>_{MsgExamFinishedParticipant}
<dd .deflist__dd>^{formatTimeW SelFormatDateTime finished}
$maybe closed <- examClosed
<dt .deflist__dt>_{MsgExamClosed}
<dd .deflist__dd>^{formatTimeW SelFormatDateTime closed}
$if gradingShown
$if examGradingRule /= ExamGradingManual
<dt .deflist__dt>

5
templates/exam-users.hamlet
View File

@ -1,2 +1,5 @@
$newline never
^{examUsersTable}
<section>
^{closeWgt}
<section>
^{examUsersTable}

9
templates/widgets/exam-close.hamlet Normal file
View File

@ -0,0 +1,9 @@
$newline never
$maybe closed <- examClosed'
_{MsgExamClosedSince closed}
$nothing
<p>
_{MsgExamCloseTip}
<p>
_{MsgExamCloseReminder}
^{closeView'}