fix(day): fix #2347 by adding repeated examiner check to day consistency check for day exam occurrences
This commit is contained in:
parent
134f18641d
commit
a8dd5bc142
@ -73,6 +73,7 @@ ExamCorrectorEmail: E-Mail
|
||||
ExamCorrectors: Prüfer:innen
|
||||
ExamCorrectorsTip: Hier eingetragene Prüfer:innen können zwischen Beginn der Prüfung und "Bewertung abgeschlossen ab" Ergebnisse für alle Teilprüfungen und alle Teilnehmer:innen im System hinterlegen.
|
||||
ExamCorrectorAlreadyAdded: Ein Prüfer:innen mit dieser E-Mail ist bereits für diese Prüfung eingetragen
|
||||
ExamParticipant: Prüfungsteilnehmer:in
|
||||
ExamRoom: Raum
|
||||
ExamRoomManual': Keine automatische bzw. selbstständige Zuteilung
|
||||
ExamRoomSurname': Nach Nachname
|
||||
@ -226,6 +227,8 @@ ExamOccurrencesEdited num@Int del@Int: #{pluralENsN num "Prüfungstermin"} geän
|
||||
ExamOccurrenceCopyNoStartDate: Dieser Kurs hat noch keine eigene Termine um Prüfungstermine zeitlich damit zu assoziieren
|
||||
ExamOccurrenceCopyFail: Keine passenden Prüfungstermine zum Kopieren gefunden
|
||||
ExaminerReocurrence examiner@Text: Mehrfache Prüfung durch #{examiner}!
|
||||
ExamProblemReoccurrence: Prüfungen mit wiederholt gleichem Prüfer
|
||||
ExamNoProblemReoccurrence: Heute keine Prüfungen mit wiederholtem Prüfer.
|
||||
GradingFrom: Ab
|
||||
ExamNoShow: Nicht erschienen
|
||||
ExamVoided: Entwertet
|
||||
|
||||
@ -73,6 +73,7 @@ ExamCorrectorEmail: Email
|
||||
ExamCorrectors: Examiner
|
||||
ExamCorrectorsTip: Examiners configured here may, after the start of the exam and until "Results visible from", enter exam part results for all exam parts and participants.
|
||||
ExamCorrectorAlreadyAdded: An examiner with this email address already exists
|
||||
ExamParticipant: Examinee
|
||||
ExamRoom: Room
|
||||
ExamRoomManual': No automatic or autonomous assignment
|
||||
ExamRoomSurname': By surname
|
||||
@ -226,6 +227,8 @@ ExamOccurrencesEdited num del: #{pluralENsN num "exam occurrence"} edited #{guar
|
||||
ExamOccurrenceCopyNoStartDate: This course needs its own occurrence to copy associated exam occurrences.
|
||||
ExamOccurrenceCopyFail: No suitable exam occurrences found to copy from.
|
||||
ExaminerReocurrence examiner: Multiple examinations by #{examiner}!
|
||||
ExamProblemReoccurrence: Exams with reoccurring examiner
|
||||
ExamNoProblemReoccurrence: Today there are no exams with a reoccurring examiner.
|
||||
GradingFrom: From
|
||||
|
||||
#templates widgets/bonus-rule
|
||||
|
||||
@ -10,7 +10,7 @@ module Handler.Course.Users
|
||||
, postCUsersR, getCUsersR
|
||||
, colUserSex'
|
||||
, colUserQualifications, colUserQualificationBlocked
|
||||
, colUserExams, colUserExamOccurrences, colUserExamOccurrencesCheck, colUserExamOccurrencesCheckDB
|
||||
, colUserExams, colUserExamOccurrences, colUserExamOccurrencesCheck
|
||||
, _userQualifications
|
||||
) where
|
||||
|
||||
@ -24,7 +24,7 @@ import Handler.Utils.Company
|
||||
import qualified Database.Esqueleto.Legacy as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
import qualified Database.Esqueleto.PostgreSQL as E
|
||||
import qualified Database.Esqueleto.Experimental as X (from,on,table,innerJoin,leftJoin)
|
||||
import qualified Database.Esqueleto.Experimental as X (from,on,table,leftJoin)
|
||||
import Database.Esqueleto.Experimental ((:&)(..))
|
||||
|
||||
import Database.Esqueleto.Utils.TH
|
||||
@ -190,6 +190,7 @@ colUserExamOccurrencesCheck _tid _ssh _csh = sortable (Just "exam-occurrences")
|
||||
in wgtCell warnExaminer <> examOccurrenceCell exOcc
|
||||
)
|
||||
|
||||
{-
|
||||
colUserExamOccurrencesCheckDB :: (IsDBTable (MForm Handler) c, MonadHandler (DBCell (MForm Handler)), HandlerSite (DBCell (MForm Handler)) ~ UniWorX) -- this type seems to be unusable+
|
||||
=> TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell (MForm Handler) c)
|
||||
colUserExamOccurrencesCheckDB _tid _ssh _csh = sortable (Just "exam-occurrences") (i18nCell MsgCourseUserExamOccurrences)
|
||||
@ -214,6 +215,7 @@ colUserExamOccurrencesCheckDB _tid _ssh _csh = sortable (Just "exam-occurrences
|
||||
(Just exname) -> messageTooltip <$> messageI Warning (MsgExaminerReocurrence exname)
|
||||
[whamlet|^{warnExaminer}#{examOccurrenceName}:^{formatTimeRangeW SelFormatDateTime examOccurrenceStart examOccurrenceEnd}|]
|
||||
)
|
||||
-}
|
||||
|
||||
colUserSex' :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
|
||||
colUserSex' = colUserSex $ hasUser . _userSex
|
||||
|
||||
@ -46,7 +46,17 @@ import Database.Esqueleto.Utils.TH
|
||||
import qualified Data.Text as Text
|
||||
import Data.List (inits)
|
||||
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.CaseInsensitive as CI-- data TableHasData = TableHasData{tableHasRows :: Bool, tableWidget :: Widget}
|
||||
-- a poor man's record subsitute
|
||||
|
||||
{-
|
||||
type TableHasData = (Bool, Widget)
|
||||
tableHasRows :: TableHasData -> Bool
|
||||
tableHasRows = fst
|
||||
tableWidget :: TableHasData -> Widget
|
||||
tableWidget = snd
|
||||
-}
|
||||
|
||||
|
||||
import Jobs
|
||||
|
||||
@ -601,41 +611,6 @@ getForProfileDataR cID = do
|
||||
setTitleI $ MsgHeadingForProfileData $ userDisplayName user
|
||||
dataWidget
|
||||
|
||||
-- data TableHasData = TableHasData{tableHasRows :: Bool, tableWidget :: Widget}
|
||||
-- a poor man's record subsitute
|
||||
|
||||
{-
|
||||
type TableHasData = (Bool, Widget)
|
||||
tableHasRows :: TableHasData -> Bool
|
||||
tableHasRows = fst
|
||||
tableWidget :: TableHasData -> Widget
|
||||
tableWidget = snd
|
||||
-}
|
||||
|
||||
-- | Given a header message, a bool and widget; display widget and header only if the boolean is true
|
||||
maybeTable :: (RenderMessage UniWorX a)
|
||||
=> a -> (Bool, Widget) -> Widget
|
||||
maybeTable m = maybeTable' m Nothing Nothing
|
||||
|
||||
maybeTable' :: (RenderMessage UniWorX a)
|
||||
=> a -> Maybe a -> Maybe Widget -> (Bool, Widget) -> Widget
|
||||
maybeTable' _ Nothing _ (False, _ ) = mempty
|
||||
maybeTable' _ (Just nodata) _ (False, _ ) =
|
||||
[whamlet|
|
||||
<div .container>
|
||||
_{nodata}
|
||||
|]
|
||||
maybeTable' hdr _ mbRemark (True ,tbl) =
|
||||
[whamlet|
|
||||
<div .container>
|
||||
<h2> _{hdr}
|
||||
<div .container>
|
||||
^{tbl}
|
||||
$maybe remark <- mbRemark
|
||||
<em>_{MsgProfileRemark}
|
||||
\ ^{remark}
|
||||
|]
|
||||
|
||||
|
||||
makeProfileData :: Entity User -> DB Widget
|
||||
makeProfileData usrEnt@(Entity uid usrVal@User{..}) = do
|
||||
|
||||
@ -353,7 +353,7 @@ colParkingField = colParkingField' _dailyFormParkingToken
|
||||
|
||||
colParkingField' :: ASetter' a Bool -> Text -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData)))
|
||||
colParkingField' l dday = sortable (Just "parking") (i18nCell $ MsgTableUserParkingToken dday) $ (cellAttrs %~ addAttrsClass "text--center") <$> formCell
|
||||
id -- TODO: this should not be id! Refactor to simplify the thrid argument below
|
||||
id -- TODO: this should not be id! Refactor to simplify the third argument below
|
||||
(views (resultParticipant . _entityKey) return)
|
||||
(\(preview (resultUserDay . _userDayParkingToken) -> parking) mkUnique ->
|
||||
over (_1.mapped) (l .~) . over _2 fvWidget <$> mreq checkBoxField (fsUniq mkUnique "parktoken") parking
|
||||
@ -709,7 +709,7 @@ getSchoolDayCheckR ssh nd = do
|
||||
let nowaday = utctDay now
|
||||
dday <- formatTime SelFormatDate nd
|
||||
|
||||
(tuts, parts_avs) <- runDB $ do
|
||||
(tuts, parts_avs, examProblemsTbl) <- runDB $ do
|
||||
tuts <- getDayTutorials ssh (nd,nd)
|
||||
parts_avs :: [ParticipantCheckData] <- $(unValueNIs 5 [2..5]) <<$>> E.select (do
|
||||
(tpa :& usr :& avs :& cmp) <- E.from $ E.table @TutorialParticipant
|
||||
@ -725,7 +725,9 @@ getSchoolDayCheckR ssh nd = do
|
||||
)
|
||||
-- additionally queue proper AVS synchs for all users, unless there were already done today
|
||||
void $ queueAvsUpdateByUID (foldMap (^. _1 . _entityVal . _tutorialParticipantUser . to Set.singleton) parts_avs) (Just nowaday)
|
||||
return (tuts, parts_avs)
|
||||
-- check for double examiners
|
||||
examProblemsTbl <- mkExamProblemsTable ssh nd
|
||||
return (tuts, parts_avs, examProblemsTbl)
|
||||
let getApi :: ParticipantCheckData -> Set AvsPersonId
|
||||
getApi = foldMap Set.singleton . view _4
|
||||
avsStats :: Map AvsPersonId AvsDataPerson <- catchAVShandler False False True mempty $ lookupAvsUsers $ foldMap getApi parts_avs -- query AVS, but does not affect DB (no update)
|
||||
@ -772,16 +774,104 @@ getSchoolDayCheckR ssh nd = do
|
||||
$forall ((_udn,pid),pcd) <- Map.toList badis
|
||||
<li>
|
||||
^{mkBaddieWgt pid pcd}
|
||||
<p>
|
||||
^{linkButton mempty (i18n MsgBtnCloseReload) [BCIsButton, BCPrimary] (SomeRoute (SchoolR ssh (SchoolDayR nd)))}
|
||||
<section>
|
||||
<p>
|
||||
<h4 .show-hide__toggle uw-show-hide data-show-hide-collapsed>
|
||||
_{MsgPossibleCheckResults}
|
||||
<p>
|
||||
<ul>
|
||||
$forall msg <- dcrMessages
|
||||
<li>_{msg}
|
||||
<p>
|
||||
_{MsgAvsUpdateDayCheck}
|
||||
<section>
|
||||
<p>
|
||||
<h4 .show-hide__toggle uw-show-hide data-show-hide-collapsed>
|
||||
_{MsgPossibleCheckResults}
|
||||
<p>
|
||||
<ul>
|
||||
$forall msg <- dcrMessages
|
||||
<li>_{msg}
|
||||
<p>
|
||||
_{MsgAvsUpdateDayCheck}
|
||||
|]
|
||||
^{maybeTable' MsgExamProblemReoccurrence (Just MsgExamNoProblemReoccurrence) Nothing examProblemsTbl}
|
||||
<section>
|
||||
^{linkButton mempty (i18n MsgBtnCloseReload) [BCIsButton, BCPrimary] (SomeRoute (SchoolR ssh (SchoolDayR nd)))}
|
||||
|]
|
||||
|
||||
|
||||
type TblExamPrbsExpr = ( E.SqlExpr (Entity Course)
|
||||
`E.InnerJoin` E.SqlExpr (Entity Exam)
|
||||
`E.InnerJoin` E.SqlExpr (Entity ExamRegistration)
|
||||
`E.InnerJoin` E.SqlExpr (Entity ExamOccurrence)
|
||||
`E.InnerJoin` E.SqlExpr (Entity User)
|
||||
`E.InnerJoin` E.SqlExpr (Entity User)
|
||||
)
|
||||
type TblExamPrbsData = DBRow (Entity Course, Entity Exam, Entity ExamRegistration, Entity ExamOccurrence, Entity User, Entity User)
|
||||
|
||||
-- | Table listing double examiner problems for a given school and day
|
||||
mkExamProblemsTable :: SchoolId -> Day -> DB (Bool, Widget)
|
||||
mkExamProblemsTable =
|
||||
let dbtIdent = "exams-user" :: Text
|
||||
dbtStyle = def
|
||||
dbtSQLQuery' exOccs (crs `E.InnerJoin` exm `E.InnerJoin` reg `E.InnerJoin` occ `E.InnerJoin` usr `E.InnerJoin` xmr) = do
|
||||
EL.on $ xmr E.^. UserId E.=?. occ E.^. ExamOccurrenceExaminer
|
||||
EL.on $ usr E.^. UserId E.==. reg E.^. ExamRegistrationUser
|
||||
EL.on $ occ E.^. ExamOccurrenceId E.=?. reg E.^. ExamRegistrationOccurrence
|
||||
EL.on $ exm E.^. ExamId E.==. reg E.^. ExamRegistrationExam
|
||||
EL.on $ exm E.^. ExamCourse E.==. crs E.^. CourseId
|
||||
E.where_ $ occ E.^. ExamOccurrenceId `E.in_` E.vals exOccs
|
||||
E.&&. E.exists (do
|
||||
altReg :& altOcc <- E.from $ E.table @ExamRegistration `E.innerJoin` E.table @ExamOccurrence
|
||||
`E.on` (\(altReg :& altOcc) -> altReg E.^. ExamRegistrationOccurrence E.?=. altOcc E.^. ExamOccurrenceId)
|
||||
E.where_ $ altReg E.^. ExamRegistrationUser E.==. reg E.^. ExamRegistrationUser
|
||||
E.&&. altReg E.^. ExamRegistrationId E.!=. reg E.^. ExamRegistrationId
|
||||
E.&&. altOcc E.^. ExamOccurrenceExaminer E.==. occ E.^. ExamOccurrenceExaminer
|
||||
E.&&. altOcc E.^. ExamOccurrenceId E.!=. occ E.^. ExamOccurrenceId
|
||||
)
|
||||
return (crs,exm,reg,occ,usr,xmr)
|
||||
queryExmCourse :: TblExamPrbsExpr -> E.SqlExpr (Entity Course)
|
||||
queryExmCourse = $(sqlIJproj 6 1)
|
||||
queryExam :: TblExamPrbsExpr -> E.SqlExpr (Entity Exam)
|
||||
queryExam = $(sqlIJproj 6 2)
|
||||
queryRegistration :: TblExamPrbsExpr -> E.SqlExpr (Entity ExamRegistration)
|
||||
queryRegistration = $(sqlIJproj 6 3)
|
||||
queryOccurrence :: TblExamPrbsExpr -> E.SqlExpr (Entity ExamOccurrence)
|
||||
queryOccurrence = $(sqlIJproj 6 4)
|
||||
queryTestee :: TblExamPrbsExpr -> E.SqlExpr (Entity User)
|
||||
queryTestee = $(sqlIJproj 6 5)
|
||||
queryExaminer :: TblExamPrbsExpr -> E.SqlExpr (Entity User)
|
||||
queryExaminer = $(sqlIJproj 6 6)
|
||||
resultExmCourse :: Lens' TblExamPrbsData (Entity Course)
|
||||
resultExmCourse = _dbrOutput . _1
|
||||
resultExam :: Lens' TblExamPrbsData (Entity Exam)
|
||||
resultExam = _dbrOutput . _2
|
||||
resultRegistration :: Lens' TblExamPrbsData (Entity ExamRegistration)
|
||||
resultRegistration = _dbrOutput . _3
|
||||
resultOccurrence :: Lens' TblExamPrbsData (Entity ExamOccurrence)
|
||||
resultOccurrence = _dbrOutput . _4
|
||||
resultTestee :: Lens' TblExamPrbsData (Entity User)
|
||||
resultTestee = _dbrOutput . _5
|
||||
resultExaminer :: Lens' TblExamPrbsData (Entity User)
|
||||
resultExaminer = _dbrOutput . _6
|
||||
dbtRowKey = queryRegistration >>> (E.^. ExamRegistrationId)
|
||||
dbtProj = dbtProjId
|
||||
dbtColonnade = mconcat
|
||||
[ sortable (Just "course") (i18nCell MsgTableCourse) $ fmap addIndicatorCell courseCell <$> view (resultExmCourse . _entityVal)
|
||||
, sortable (Just "exam") (i18nCell MsgCourseExam) $ \row -> examCell (row ^. resultExmCourse . _entityVal) (row ^. resultExam . _entityVal)
|
||||
, sortable (Just "registration")(i18nCell MsgCourseExamRegistrationTime)$ dateCell . view (resultRegistration . _entityVal . _examRegistrationTime)
|
||||
, sortable (Just "occurrence") (i18nCell MsgTableExamOccurrence) $ examOccurrenceCell . view resultOccurrence
|
||||
, sortable (Just "testee") (i18nCell MsgExamParticipant) $ cellHasUserLink ForProfileDataR . view resultTestee
|
||||
, sortable (Just "examiner") (i18nCell MsgExamCorrectors) $ cellHasUser . view resultExaminer
|
||||
]
|
||||
validator = def & defaultSorting [SortAscBy "course", SortAscBy "exam", SortAscBy "testee"] -- [SortDescBy "registration"]
|
||||
dbtSorting = Map.fromList
|
||||
[ ( "course" , SortColumn $ queryExmCourse >>> (E.^. CourseName))
|
||||
, ( "exam" , SortColumn $ queryExam >>> (E.^. ExamName))
|
||||
, ( "registration", SortColumn $ queryRegistration >>> (E.^. ExamRegistrationTime))
|
||||
, ( "occurrence" , SortColumn $ queryOccurrence >>> (E.^. ExamOccurrenceName))
|
||||
, ( "testee" , SortColumn $ queryTestee >>> (E.^. UserDisplayName))
|
||||
, ( "examiner" , SortColumn $ queryExaminer >>> (E.^. UserDisplayName))
|
||||
]
|
||||
dbtFilter = mempty
|
||||
dbtFilterUI = mempty
|
||||
dbtParams = def
|
||||
dbtCsvEncode = noCsvEncode
|
||||
dbtCsvDecode = Nothing
|
||||
dbtExtraReps = []
|
||||
in \ssh nd -> do
|
||||
exOccs <- getDayExamOccurrences False ssh Nothing (nd,nd)
|
||||
let dbtSQLQuery = dbtSQLQuery' $ Map.keys exOccs
|
||||
(_1 %~ getAny) <$> dbTableWidget validator DBTable{..}
|
||||
|
||||
|
||||
@ -6,6 +6,33 @@ module Handler.Utils.Table
|
||||
( module Handler.Utils.Table
|
||||
) where
|
||||
|
||||
import Import hiding (link)
|
||||
|
||||
import Handler.Utils.Table.Pagination as Handler.Utils.Table
|
||||
import Handler.Utils.Table.Columns as Handler.Utils.Table
|
||||
import Handler.Utils.Table.Cells as Handler.Utils.Table
|
||||
|
||||
|
||||
-- | Given a header message, a bool and widget; display widget and header only if the boolean is true
|
||||
maybeTable :: (RenderMessage UniWorX a)
|
||||
=> a -> (Bool, Widget) -> Widget
|
||||
maybeTable m = maybeTable' m Nothing Nothing
|
||||
|
||||
maybeTable' :: (RenderMessage UniWorX a)
|
||||
=> a -> Maybe a -> Maybe Widget -> (Bool, Widget) -> Widget
|
||||
maybeTable' _ Nothing _ (False, _ ) = mempty
|
||||
maybeTable' _ (Just nodata) _ (False, _ ) =
|
||||
[whamlet|
|
||||
<div .container>
|
||||
_{nodata}
|
||||
|]
|
||||
maybeTable' hdr _ mbRemark (True ,tbl) =
|
||||
[whamlet|
|
||||
<div .container>
|
||||
<h2> _{hdr}
|
||||
<div .container>
|
||||
^{tbl}
|
||||
$maybe remark <- mbRemark
|
||||
<em>_{MsgProfileRemark}
|
||||
\ ^{remark}
|
||||
|]
|
||||
Loading…
Reference in New Issue
Block a user