diff --git a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg index 9ffc6eb90..0bd1d6775 100644 --- a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg +++ b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg @@ -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 diff --git a/messages/uniworx/categories/courses/exam/exam/en-eu.msg b/messages/uniworx/categories/courses/exam/exam/en-eu.msg index 11361037d..8fa6275e2 100644 --- a/messages/uniworx/categories/courses/exam/exam/en-eu.msg +++ b/messages/uniworx/categories/courses/exam/exam/en-eu.msg @@ -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 diff --git a/src/Handler/Course/Users.hs b/src/Handler/Course/Users.hs index 8f881fc81..5b923c924 100644 --- a/src/Handler/Course/Users.hs +++ b/src/Handler/Course/Users.hs @@ -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 diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 1035954cd..9f39b8cf7 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -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| -
- _{nodata} - |] -maybeTable' hdr _ mbRemark (True ,tbl) = - [whamlet| -
-

_{hdr} -
- ^{tbl} - $maybe remark <- mbRemark - _{MsgProfileRemark} - \ ^{remark} - |] - makeProfileData :: Entity User -> DB Widget makeProfileData usrEnt@(Entity uid usrVal@User{..}) = do diff --git a/src/Handler/School/DayTasks.hs b/src/Handler/School/DayTasks.hs index 42fa96191..7655eb6f4 100644 --- a/src/Handler/School/DayTasks.hs +++ b/src/Handler/School/DayTasks.hs @@ -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
  • ^{mkBaddieWgt pid pcd} -

    - ^{linkButton mempty (i18n MsgBtnCloseReload) [BCIsButton, BCPrimary] (SomeRoute (SchoolR ssh (SchoolDayR nd)))} +

    +

    +

    + _{MsgPossibleCheckResults} +

    +

      + $forall msg <- dcrMessages +
    • _{msg} +

      + _{MsgAvsUpdateDayCheck}

      -

      -

      - _{MsgPossibleCheckResults} -

      -

        - $forall msg <- dcrMessages -
      • _{msg} -

        - _{MsgAvsUpdateDayCheck} - |] \ No newline at end of file + ^{maybeTable' MsgExamProblemReoccurrence (Just MsgExamNoProblemReoccurrence) Nothing examProblemsTbl} +

        + ^{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{..} + diff --git a/src/Handler/Utils/Table.hs b/src/Handler/Utils/Table.hs index ff7a15a1f..2888ce3f4 100644 --- a/src/Handler/Utils/Table.hs +++ b/src/Handler/Utils/Table.hs @@ -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| +
        + _{nodata} + |] +maybeTable' hdr _ mbRemark (True ,tbl) = + [whamlet| +
        +

        _{hdr} +
        + ^{tbl} + $maybe remark <- mbRemark + _{MsgProfileRemark} + \ ^{remark} + |] \ No newline at end of file