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

chore(profile): show user courses among enrolled course type list

Browse Source 
(Recall: course = tutorial, course type = course)
This commit is contained in:
Steffen Jost 2024-07-31 17:51:13 +02:00
parent 507a7e02fc
commit 0fde59c19a
2 changed files with 75 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

107
src/Handler/Profile.hs
View File

@ -31,9 +31,11 @@ import Utils.Print (validCmdArgument)
import Data.Map ((!)) import Data.Map ((!))
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Database.Esqueleto.Legacy as E import Database.Esqueleto.Experimental ((:&)(..))
import qualified Database.Esqueleto.Experimental as E
import qualified Database.Esqueleto.Legacy as EL (on,from)
import qualified Database.Esqueleto.Utils as E import qualified Database.Esqueleto.Utils as E
-- import Database.Esqueleto ((^.))
import qualified Data.Text as Text import qualified Data.Text as Text
import Data.List (inits) import Data.List (inits)
@ -192,28 +194,28 @@ notificationForm template = wFormToAForm $ do
-> return False -> return False
NTKCourseParticipant NTKCourseParticipant
| Just uid <- mbUid | Just uid <- mbUid
-> fmap not . E.selectExists . E.from $ \courseParticipant -> -> fmap not . E.selectExists . EL.from $ \courseParticipant ->
E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val uid E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val uid
E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
NTKSubmissionUser NTKSubmissionUser
| Just uid <- mbUid | Just uid <- mbUid
-> fmap not . E.selectExists . E.from $ \submissionUser -> -> fmap not . E.selectExists . EL.from $ \submissionUser ->
E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val uid E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val uid
NTKExamParticipant NTKExamParticipant
| Just uid <- mbUid | Just uid <- mbUid
-> fmap not . E.selectExists . E.from $ \examRegistration -> -> fmap not . E.selectExists . EL.from $ \examRegistration ->
E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val uid E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val uid
NTKCorrector NTKCorrector
| Just uid <- mbUid | Just uid <- mbUid
-> fmap not . E.selectExists . E.from $ \sheetCorrector -> -> fmap not . E.selectExists . EL.from $ \sheetCorrector ->
E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid
NTKCourseLecturer NTKCourseLecturer
| Just uid <- mbUid | Just uid <- mbUid
-> fmap not . E.selectExists . E.from $ \lecturer -> -> fmap not . E.selectExists . EL.from $ \lecturer ->
E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid
NTKFunctionary f NTKFunctionary f
| Just uid <- mbUid | Just uid <- mbUid
-> fmap not . E.selectExists . E.from $ \userFunction -> -> fmap not . E.selectExists . EL.from $ \userFunction ->
E.where_ $ userFunction E.^. UserFunctionUser E.==. E.val uid E.where_ $ userFunction E.^. UserFunctionUser E.==. E.val uid
E.&&. userFunction E.^. UserFunctionFunction E.==. E.val f E.&&. userFunction E.^. UserFunctionFunction E.==. E.val f
_ | Nothing <- mbUid -> return False -- Show everything for not-logged-in users (e.g. if they presented a token) _ | Nothing <- mbUid -> return False -- Show everything for not-logged-in users (e.g. if they presented a token)
@ -428,8 +430,8 @@ serveProfileR :: (UserId, User) -> Handler Html
serveProfileR (uid, user@User{..}) = do serveProfileR (uid, user@User{..}) = do
currentRoute <- fromMaybe ProfileR <$> getCurrentRoute currentRoute <- fromMaybe ProfileR <$> getCurrentRoute
(userSchools, userExamOfficeLabels) <- runDB $ do (userSchools, userExamOfficeLabels) <- runDB $ do
userSchools <- fmap (setOf $ folded . _Value) . E.select . E.from $ \school -> do userSchools <- fmap (setOf $ folded . _Value) . E.select . EL.from $ \school -> do
E.where_ . E.exists . E.from $ \userSchool -> E.where_ . E.exists . EL.from $ \userSchool ->
E.where_ $ E.not_ (userSchool E.^. UserSchoolIsOptOut) E.where_ $ E.not_ (userSchool E.^. UserSchoolIsOptOut)
E.&&. userSchool E.^. UserSchoolUser E.==. E.val uid E.&&. userSchool E.^. UserSchoolUser E.==. E.val uid
E.&&. userSchool E.^. UserSchoolSchool E.==. school E.^. SchoolId E.&&. userSchool E.^. UserSchoolSchool E.==. school E.^. SchoolId
@ -519,8 +521,8 @@ serveProfileR (uid, user@User{..}) = do
oldExamLabels = userExamOfficeLabels oldExamLabels = userExamOfficeLabels
newExamLabels = stgExamOfficeSettings & eosettingsLabels newExamLabels = stgExamOfficeSettings & eosettingsLabels
forM_ oldExamLabels $ \(Entity eolid ExamOfficeLabel{..}) -> unless (Right eolid `Map.member` newExamLabels || Left examOfficeLabelName `Map.member` newExamLabels) $ do forM_ oldExamLabels $ \(Entity eolid ExamOfficeLabel{..}) -> unless (Right eolid `Map.member` newExamLabels || Left examOfficeLabelName `Map.member` newExamLabels) $ do
E.delete . E.from $ \examOfficeExternalExamLabel -> E.where_ $ examOfficeExternalExamLabel E.^. ExamOfficeExternalExamLabelLabel E.==. E.val eolid E.delete . EL.from $ \examOfficeExternalExamLabel -> E.where_ $ examOfficeExternalExamLabel E.^. ExamOfficeExternalExamLabelLabel E.==. E.val eolid
E.delete . E.from $ \examOfficeExamLabel -> E.where_ $ examOfficeExamLabel E.^. ExamOfficeExamLabelLabel E.==. E.val eolid E.delete . EL.from $ \examOfficeExamLabel -> E.where_ $ examOfficeExamLabel E.^. ExamOfficeExamLabelLabel E.==. E.val eolid
when (csvExportLabel userCsvOptions == Just examOfficeLabelName) $ when (csvExportLabel userCsvOptions == Just examOfficeLabelName) $
update uid [ UserCsvOptions =. userCsvOptions { csvExportLabel = Nothing } ] update uid [ UserCsvOptions =. userCsvOptions { csvExportLabel = Nothing } ]
delete eolid delete eolid
@ -633,19 +635,19 @@ makeProfileData usrEnt@(Entity uid usrVal@User{..}) = do
addressLinkdIcon <- messageTooltip <$> messageIconI Info IconLink MsgAddressIsLinkedTip addressLinkdIcon <- messageTooltip <$> messageIconI Info IconLink MsgAddressIsLinkedTip
(actualPrefersPostal, (actualPostAddress, postalAutomatic), (actualDisplayEmail, emailAutomatic)) <- getPostalPreferenceAndAddress' usrEnt (actualPrefersPostal, (actualPostAddress, postalAutomatic), (actualDisplayEmail, emailAutomatic)) <- getPostalPreferenceAndAddress' usrEnt
functions <- Map.fromListWith Set.union . map (\(Entity _ UserFunction{..}) -> (userFunctionFunction, Set.singleton userFunctionSchool)) <$> selectList [UserFunctionUser ==. uid] [] functions <- Map.fromListWith Set.union . map (\(Entity _ UserFunction{..}) -> (userFunctionFunction, Set.singleton userFunctionSchool)) <$> selectList [UserFunctionUser ==. uid] []
lecture_corrector <- E.select $ E.distinct $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do lecture_corrector <- E.select $ E.distinct $ EL.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId EL.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet EL.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid
return (course E.^. CourseTerm, course E.^. CourseSchool, course E.^. CourseShorthand) return (course E.^. CourseTerm, course E.^. CourseSchool, course E.^. CourseShorthand)
studies <- E.select $ E.from $ \(studydegree `E.InnerJoin` studyfeat `E.InnerJoin` studyterms) -> do studies <- E.select $ EL.from $ \(studydegree `E.InnerJoin` studyfeat `E.InnerJoin` studyterms) -> do
E.on $ studyfeat E.^. StudyFeaturesField E.==. studyterms E.^. StudyTermsId EL.on $ studyfeat E.^. StudyFeaturesField E.==. studyterms E.^. StudyTermsId
E.on $ studyfeat E.^. StudyFeaturesDegree E.==. studydegree E.^. StudyDegreeId EL.on $ studyfeat E.^. StudyFeaturesDegree E.==. studydegree E.^. StudyDegreeId
E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid
return (studyfeat, studydegree, studyterms) return (studyfeat, studydegree, studyterms)
companies <- wgtCompanies uid companies <- wgtCompanies uid
-- supervisors' <- E.select $ E.from $ \(spvr `E.InnerJoin` usrSpvr) -> do -- supervisors' <- E.select $ EL.from $ \(spvr `E.InnerJoin` usrSpvr) -> do
-- E.on $ spvr E.^. UserSupervisorSupervisor E.==. usrSpvr E.^. UserId -- EL.on $ spvr E.^. UserSupervisorSupervisor E.==. usrSpvr E.^. UserId
-- E.where_ $ spvr E.^. UserSupervisorUser E.==. E.val uid -- E.where_ $ spvr E.^. UserSupervisorUser E.==. E.val uid
-- E.orderBy [E.asc (usrSpvr E.^. UserDisplayName)] -- E.orderBy [E.asc (usrSpvr E.^. UserDisplayName)]
-- return (usrSpvr, spvr E.^. UserSupervisorRerouteNotifications) -- return (usrSpvr, spvr E.^. UserSupervisorRerouteNotifications)
@ -653,8 +655,8 @@ makeProfileData usrEnt@(Entity uid usrVal@User{..}) = do
-- supervisors = intersperse (text2widget ", ") $ -- supervisors = intersperse (text2widget ", ") $
-- (\(usr, E.Value reroutCom) -> linkUserWidget ForProfileDataR usr <> bool mempty icnReroute reroutCom) <$> supervisors' -- (\(usr, E.Value reroutCom) -> linkUserWidget ForProfileDataR usr <> bool mempty icnReroute reroutCom) <$> supervisors'
-- icnReroute = text2widget " " <> toWgt (icon IconReroute) -- icnReroute = text2widget " " <> toWgt (icon IconReroute)
-- supervisees' <- E.select $ E.from $ \(spvr `E.InnerJoin` usrSpvr) -> do -- supervisees' <- E.select $ EL.from $ \(spvr `E.InnerJoin` usrSpvr) -> do
-- E.on $ spvr E.^. UserSupervisorUser E.==. usrSpvr E.^. UserId -- EL.on $ spvr E.^. UserSupervisorUser E.==. usrSpvr E.^. UserId
-- E.where_ $ spvr E.^. UserSupervisorSupervisor E.==. E.val uid -- E.where_ $ spvr E.^. UserSupervisorSupervisor E.==. E.val uid
-- return (usrSpvr, spvr E.^. UserSupervisorRerouteNotifications) -- return (usrSpvr, spvr E.^. UserSupervisorRerouteNotifications)
-- let numSupervisees = length supervisees' -- let numSupervisees = length supervisees'
@ -681,7 +683,7 @@ makeProfileData usrEnt@(Entity uid usrVal@User{..}) = do
-- let examTable, ownTutorialTable, tutorialTable :: Widget -- let examTable, ownTutorialTable, tutorialTable :: Widget
-- examTable = i18n MsgPersonalInfoExamAchievementsWip -- examTable = i18n MsgPersonalInfoExamAchievementsWip
-- ownTutorialTable = i18n MsgPersonalInfoOwnTutorialsWip -- ownTutorialTable = i18n MsgPersonalInfoOwnTutorialsWip
-- tutorialTable = i18n MsgPersonalInfoTutorialsWip -- tutorialTable = i18n MsgPersonalInfoTutorialsWip -- note that tutorials are linked in enrolledCoursesTable
cID <- encrypt uid cID <- encrypt uid
mCRoute <- getCurrentRoute mCRoute <- getCurrentRoute
@ -705,7 +707,7 @@ mkOwnedCoursesTable =
withType = id withType = id
dbtSQLQuery' uid (course `E.InnerJoin` lecturer) = do dbtSQLQuery' uid (course `E.InnerJoin` lecturer) = do
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse EL.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid
return ( course E.^. CourseTerm return ( course E.^. CourseTerm
, course E.^. CourseSchool , course E.^. CourseSchool
@ -747,18 +749,28 @@ mkOwnedCoursesTable =
-- | Table listing all courses that the given user is enrolled in -- | Table listing all courses that the given user is enrolled in
mkEnrolledCoursesTable :: UserId -> DB (Bool, Widget) mkEnrolledCoursesTable :: UserId -> DB (Bool, Widget)
mkEnrolledCoursesTable = mkEnrolledCoursesTable uid = do
let withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a) usrTuts <- E.select $ do
(tpar :& tut) <- E.from $ E.table @TutorialParticipant `E.innerJoin` E.table @Tutorial
`E.on` (\(tpar :& tut) -> tut E.^. TutorialId E.==. tpar E.^. TutorialParticipantTutorial)
E.where_ $ tpar E.^. TutorialParticipantUser E.==. E.val uid
E.orderBy [E.asc $ tut E.^. TutorialCourse, E.desc $ tut E.^. TutorialName] -- Data.Map.fromAscListWith reverses tutorials, hence E.desc
return (tut E.^. TutorialCourse, tut E.^. TutorialName)
let usrTutMap :: Map CourseId [TutorialName]
usrTutMap = Map.fromAscListWith (++) [(tcid, [tnm]) | (E.Value tcid, E.Value tnm) <- usrTuts]
withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a) -> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
withType = id withType = id
validator = def & defaultSorting [SortDescBy "time"] validator = def & defaultSorting [SortDescBy "time"]
in \uid -> (_1 %~ getAny) <$> dbTableWidget validator (_1 %~ getAny) <$> dbTableWidget validator
DBTable DBTable
{ dbtIdent = "courseMembership" :: Text { dbtIdent = "courseMembership" :: Text
, dbtSQLQuery = \(course `E.InnerJoin` participant) -> do , dbtSQLQuery = \(course `E.InnerJoin` participant) -> do
E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse EL.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse
E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid
E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
return (course, participant E.^. CourseParticipantRegistration) return (course, participant E.^. CourseParticipantRegistration)
@ -775,7 +787,14 @@ mkEnrolledCoursesTable =
, sortable (Just "time") (i18nCell MsgProfileRegistered) $ do , sortable (Just "time") (i18nCell MsgProfileRegistered) $ do
regTime <- view $ _dbrOutput . _2 regTime <- view $ _dbrOutput . _2
return $ dateTimeCell regTime return $ dateTimeCell regTime
] , sortable Nothing (i18nCell MsgCourseTutorials) $ \(view $ _dbrOutput . _1 -> Entity{entityKey=cid, entityVal=Course{..}}) ->
cell [whamlet|
<ul .list--iconless>
$forall tutName <- maybeMonoid (Map.lookup cid usrTutMap)
<li>
^{simpleLink (citext2widget tutName) (CTutorialR courseTerm courseSchool courseShorthand tutName TUsersR)}
|]
]
, dbtSorting = Map.fromList , dbtSorting = Map.fromList
[ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseName ) [ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseName )
, ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm ) , ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm )
@ -808,9 +827,9 @@ mkSubmissionTable =
withType = id withType = id
dbtSQLQuery' uid (course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` subUser) = do dbtSQLQuery' uid (course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` subUser) = do
E.on $ submission E.^. SubmissionId E.==. subUser E.^. SubmissionUserSubmission EL.on $ submission E.^. SubmissionId E.==. subUser E.^. SubmissionUserSubmission
E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet EL.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse EL.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
E.where_ $ subUser E.^. SubmissionUserUser E.==. E.val uid E.where_ $ subUser E.^. SubmissionUserUser E.==. E.val uid
let crse = ( course E.^. CourseTerm let crse = ( course E.^. CourseTerm
, course E.^. CourseSchool , course E.^. CourseSchool
@ -821,7 +840,7 @@ mkSubmissionTable =
dbtRowKey (_ `E.InnerJoin` _ `E.InnerJoin` submission `E.InnerJoin` _) = submission E.^. SubmissionId dbtRowKey (_ `E.InnerJoin` _ `E.InnerJoin` submission `E.InnerJoin` _) = submission E.^. SubmissionId
lastSubEdit uid submission = -- latest Edit-Time of this user for submission lastSubEdit uid submission = -- latest Edit-Time of this user for submission
E.subSelectMaybe . E.from $ \subEdit -> do E.subSelectMaybe . EL.from $ \subEdit -> do
E.where_ $ subEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId E.where_ $ subEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId
E.&&. subEdit E.^. SubmissionEditUser E.==. E.val (Just uid) E.&&. subEdit E.^. SubmissionEditUser E.==. E.val (Just uid)
return . E.max_ $ subEdit E.^. SubmissionEditTime return . E.max_ $ subEdit E.^. SubmissionEditTime
@ -888,8 +907,8 @@ mkSubmissionGroupTable =
withType = id withType = id
dbtSQLQuery' uid (course `E.InnerJoin` sgroup `E.InnerJoin` sguser) = do dbtSQLQuery' uid (course `E.InnerJoin` sgroup `E.InnerJoin` sguser) = do
E.on $ sguser E.^. SubmissionGroupUserSubmissionGroup E.==. sgroup E.^. SubmissionGroupId EL.on $ sguser E.^. SubmissionGroupUserSubmissionGroup E.==. sgroup E.^. SubmissionGroupId
E.on $ sgroup E.^. SubmissionGroupCourse E.==. course E.^. CourseId EL.on $ sgroup E.^. SubmissionGroupCourse E.==. course E.^. CourseId
E.where_ $ sguser E.^. SubmissionGroupUserUser E.==. E.val uid E.where_ $ sguser E.^. SubmissionGroupUserUser E.==. E.val uid
let crse = ( course E.^. CourseTerm let crse = ( course E.^. CourseTerm
, course E.^. CourseSchool , course E.^. CourseSchool
@ -942,18 +961,18 @@ mkCorrectionsTable =
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity SheetCorrector))->a) -> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity SheetCorrector))->a)
withType = id withType = id
corrsAssigned uid sheet = E.subSelectCount . E.from $ \submission -> corrsAssigned uid sheet = E.subSelectCount . EL.from $ \submission ->
E.where_ $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId E.where_ $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId
E.&&. submission E.^. SubmissionRatingBy E.==. E.just (E.val uid) E.&&. submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
corrsCorrected uid sheet = E.subSelectCount . E.from $ \submission -> corrsCorrected uid sheet = E.subSelectCount . EL.from $ \submission ->
E.where_ $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId E.where_ $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId
E.&&. submission E.^. SubmissionRatingBy E.==. E.just (E.val uid) E.&&. submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
E.&&. E.not_ (E.isNothing $ submission E.^. SubmissionRatingTime) E.&&. E.not_ (E.isNothing $ submission E.^. SubmissionRatingTime)
dbtSQLQuery' uid (course `E.InnerJoin` sheet `E.InnerJoin` corrector) = do dbtSQLQuery' uid (course `E.InnerJoin` sheet `E.InnerJoin` corrector) = do
E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet EL.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId EL.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid
let crse = ( course E.^. CourseTerm let crse = ( course E.^. CourseTerm
, course E.^. CourseSchool , course E.^. CourseSchool
@ -1018,9 +1037,9 @@ mkQualificationsTable =
DBTable DBTable
{ dbtIdent = "userQualifications" :: Text { dbtIdent = "userQualifications" :: Text
, dbtSQLQuery = \(quali `E.InnerJoin` quser `E.LeftOuterJoin` qblock) -> do , dbtSQLQuery = \(quali `E.InnerJoin` quser `E.LeftOuterJoin` qblock) -> do
E.on $ quser E.^. QualificationUserId E.=?. qblock E.?. QualificationUserBlockQualificationUser EL.on $ quser E.^. QualificationUserId E.=?. qblock E.?. QualificationUserBlockQualificationUser
E.&&. qblock `isLatestBlockBefore` E.val now E.&&. qblock `isLatestBlockBefore` E.val now
E.on $ quser E.^. QualificationUserQualification E.==. quali E.^. QualificationId EL.on $ quser E.^. QualificationUserQualification E.==. quali E.^. QualificationId
E.where_ $ quser E.^. QualificationUserUser E.==. E.val uid E.where_ $ quser E.^. QualificationUserUser E.==. E.val uid
return (quali, quser, qblock) return (quali, quser, qblock)
, dbtRowKey = \(_quali `E.InnerJoin` quser `E.LeftOuterJoin` _qblock) -> quser E.^. QualificationUserId , dbtRowKey = \(_quali `E.InnerJoin` quser `E.LeftOuterJoin` _qblock) -> quser E.^. QualificationUserId
@ -1078,7 +1097,7 @@ mkSupervisorsTable uid = dbTableWidget validator DBTable{..}
dbtStyle = def dbtStyle = def
dbtSQLQuery (usr `E.InnerJoin` spr) = do dbtSQLQuery (usr `E.InnerJoin` spr) = do
E.on $ spr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId EL.on $ spr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
E.where_ $ spr E.^. UserSupervisorUser E.==. E.val uid E.where_ $ spr E.^. UserSupervisorUser E.==. E.val uid
return (usr, spr) return (usr, spr)
dbtRowKey (_ `E.InnerJoin` spr) = spr E.^. UserSupervisorId dbtRowKey (_ `E.InnerJoin` spr) = spr E.^. UserSupervisorId
@ -1131,7 +1150,7 @@ mkSuperviseesTable userPrefersPostal uid = dbTableWidget validator DBTable{..}
dbtStyle = def dbtStyle = def
dbtSQLQuery (usr `E.InnerJoin` spr) = do dbtSQLQuery (usr `E.InnerJoin` spr) = do
E.on $ spr E.^. UserSupervisorUser E.==. usr E.^. UserId EL.on $ spr E.^. UserSupervisorUser E.==. usr E.^. UserId
E.where_ $ spr E.^. UserSupervisorSupervisor E.==. E.val uid E.where_ $ spr E.^. UserSupervisorSupervisor E.==. E.val uid
return (usr, spr) return (usr, spr)
dbtRowKey (_ `E.InnerJoin` spr) = spr E.^. UserSupervisorId dbtRowKey (_ `E.InnerJoin` spr) = spr E.^. UserSupervisorId
@ -1290,7 +1309,7 @@ postCsvOptionsR = do
Entity uid User{userCsvOptions} <- requireAuth Entity uid User{userCsvOptions} <- requireAuth
userIsExamOffice <- hasReadAccessTo $ ExamOfficeR EOExamsR userIsExamOffice <- hasReadAccessTo $ ExamOfficeR EOExamsR
examOfficeLabels <- if not userIsExamOffice then return mempty else runDB . E.select . E.from $ \examOfficeLabel -> do examOfficeLabels <- if not userIsExamOffice then return mempty else runDB . E.select . EL.from $ \examOfficeLabel -> do
E.where_ $ examOfficeLabel E.^. ExamOfficeLabelUser E.==. E.val uid E.where_ $ examOfficeLabel E.^. ExamOfficeLabelUser E.==. E.val uid
E.orderBy [ E.asc (examOfficeLabel E.^. ExamOfficeLabelName) ] E.orderBy [ E.asc (examOfficeLabel E.^. ExamOfficeLabelName) ]
return $ examOfficeLabel E.^. ExamOfficeLabelName return $ examOfficeLabel E.^. ExamOfficeLabelName

14
test/Database/Fill.hs
View File

@ -1098,7 +1098,7 @@ fillDb = do
, tutorialFirstDay = Just firstDay , tutorialFirstDay = Just firstDay
} }
insert_ $ Tutor tut1 jost insert_ $ Tutor tut1 jost
insert_ Tutorial tut2 <- insert Tutorial
{ tutorialName = mkName "Vorlage" { tutorialName = mkName "Vorlage"
, tutorialCourse = c , tutorialCourse = c
, tutorialType = "Vorlage" , tutorialType = "Vorlage"
@ -1138,7 +1138,7 @@ fillDb = do
, tutorialTutorControlled = True , tutorialTutorControlled = True
, tutorialFirstDay = Just firstDay , tutorialFirstDay = Just firstDay
} }
insert_ Tutorial tut3 <- insert Tutorial
{ tutorialName = mkName "Sondertutoriumsvorlage" { tutorialName = mkName "Sondertutoriumsvorlage"
, tutorialCourse = c , tutorialCourse = c
, tutorialType = "Vorlage_Sondertutorium" , tutorialType = "Vorlage_Sondertutorium"
@ -1178,6 +1178,16 @@ fillDb = do
, tutorialTutorControlled = True , tutorialTutorControlled = True
, tutorialFirstDay = Just $ succ $ succ firstDay , tutorialFirstDay = Just $ succ $ succ firstDay
} }
insert_ $ CourseParticipant c jost now CourseParticipantActive
insert_ $ CourseParticipant c gkleen now $ CourseParticipantInactive True
insert_ $ CourseParticipant c fhamann now $ CourseParticipantInactive False
insert_ $ CourseParticipant c svaupel now CourseParticipantActive
insert_ $ TutorialParticipant tut1 svaupel
insert_ $ TutorialParticipant tut2 svaupel
when (odd tyear) $ insert_ $ TutorialParticipant tut3 svaupel
insert_ $ TutorialParticipant tut1 gkleen
insert_ $ TutorialParticipant tut2 fhamann
when (even tyear) $ insert_ $ TutorialParticipant tut3 jost
when (odd tyear) $ when (odd tyear) $
void . insert' $ Exam void . insert' $ Exam
{ examCourse = c { examCourse = c