Merge branch 'gate' of gitlab2.rz.ifi.lmu.de:uni2work/uni2work into gate

messages/uniworx/categories/courses/courses/de-de-formal.msg

@@ -4,6 +4,8 @@ FilterTerm !ident-ok: Semester
 FilterCourseSchoolShort: Institut
 FilterRegistered: Angemeldet
 FilterCourseSearch: Volltext-Suche
+FilterCourseSearchShorthand: Kürzel-Suche
+FilterCourseSearchTitle: Titel-Suche
 FilterCourseRegistered: Registriert
 FilterCourseRegisterOpen: Anmeldung möglich
 FilterCourseAllocation: Zentralanmeldung
@@ -279,4 +281,4 @@ LecturerInvitationAccepted lType@Text csh@CourseShorthand: Sie wurden als #{lTyp
 CourseExamRegistrationTime: Angemeldet seit
 CourseParticipantStateIsActiveFilter: Ansicht
 CourseApply: Zum Kurs bewerben
-CourseAdministrator: Kursadministrator:in
+CourseAdministrator: Kursadministrator:in

messages/uniworx/categories/courses/courses/en-eu.msg

@@ -4,6 +4,8 @@ FilterTerm: Semester
 FilterCourseSchoolShort: Department
 FilterRegistered: Enrolled
 FilterCourseSearch: Text search
+FilterCourseSearchShorthand: Shorthand search
+FilterCourseSearchTitle: Title search
 FilterCourseRegistered: Registered
 FilterCourseRegisterOpen: Enrolment is allowed
 FilterCourseAllocation: Central allocation
@@ -278,4 +280,4 @@ LecturerInvitationAccepted lType csh: You were registered as #{lType} for #{csh}
 CourseExamRegistrationTime: Registered since
 CourseParticipantStateIsActiveFilter: View
 CourseApply: Apply for course
-CourseAdministrator: Course administrator
+CourseAdministrator: Course administrator

messages/uniworx/utils/utils/de-de-formal.msg

@@ -4,6 +4,7 @@ RGCourseParticipants: Kursteilnehmer:innen
 RGCourseLecturers: Kursverwalter:innen
 RGCourseCorrectors: Korrektor:innen
 RGCourseTutors: Tutor:innen
+RGCourseParticipantsInTutorial: Kursteilnehmer:innen, die in mindestens einem Tutorium angemeldet sind
 RGCourseUnacceptedApplicants: Nicht akzeptierte Bewerber:innen
 RecipientToggleAll: Alle/Keine
 CommCourseTestSubject customSubject@Text !ident-ok: [TEST] #{customSubject}

messages/uniworx/utils/utils/en-eu.msg

@@ -4,6 +4,7 @@ RGCourseParticipants: Course participants
 RGCourseLecturers: Course administrators
 RGCourseCorrectors: Course correctors
 RGCourseTutors: Course tutors
+RGCourseParticipantsInTutorial: Course participants who are registered for at least one tutorial
 RGCourseUnacceptedApplicants: Applicants not accepted
 RecipientToggleAll: All/None
 CommCourseTestSubject customSubject: [TEST] #{customSubject}

src/Handler/Course/Communication.hs

@@ -7,8 +7,6 @@ import Import
 import Handler.Utils
 import Handler.Utils.Communication
 
-import qualified Data.Map as Map
-
 import qualified Database.Esqueleto.Legacy as E
 
 
@@ -17,8 +15,8 @@ getCCommR = postCCommR
 postCCommR tid ssh csh = do
   (cid, tuts, exams, sheets) <- runDB $ do
     cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
-    tuts' <- selectKeysList [TutorialCourse ==. cid] []
+    tuts'' <- selectKeysList [TutorialCourse ==. cid] []
-    tuts <- forM tuts' $ \tutid -> do
+    tuts' <- forM tuts'' $ \tutid -> do
       cID <- encrypt tutid
       return ( RGTutorialParticipants cID
              , E.from $ \(user `E.InnerJoin` participant) -> do
@@ -26,6 +24,18 @@ postCCommR tid ssh csh = do
                  E.where_ $ participant E.^. TutorialParticipantTutorial E.==. E.val tutid
                  return user
              )
+    let
+      tuts | length tuts' < 2 = tuts'
+           | otherwise  = ( RGCourseParticipantsInTutorial
+                          , E.from $ \(user `E.InnerJoin` participant) -> do
+                              E.on $ user E.^. UserId E.==. participant E.^. CourseParticipantUser
+                              E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
+                                   E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
+                                   E.&&. (E.exists . E.from $ \tutParticipant -> E.where_ $
+                                       tutParticipant E.^. TutorialParticipantUser E.==. user E.^. UserId
+                                     )
+                              return user
+                          ) : tuts'
 
     exams' <- selectKeysList [ExamCourse ==. cid] []
     exams <- forM exams' $ \examid -> do
@@ -55,7 +65,7 @@ postCCommR tid ssh csh = do
     , crUltDest    = SomeRoute $ CourseR tid ssh csh CCommR
     , crJobs       = crJobsCourseCommunication cid
     , crTestJobs   = crTestJobsCourseCommunication cid
-    , crRecipients = Map.fromList $
+    , crRecipients =
       [ ( RGCourseParticipants
         , E.from $ \(user `E.InnerJoin` participant) -> do
             E.on $ user E.^. UserId E.==. participant E.^. CourseParticipantUser
@@ -69,14 +79,6 @@ postCCommR tid ssh csh = do
             E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
             return user
         )
-      , ( RGCourseCorrectors
-        , E.from $ \user -> do
-            E.where_ $ E.exists $ E.from $ \(sheet `E.InnerJoin` corrector) -> do
-              E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
-              E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
-                   E.&&. user E.^. UserId E.==. corrector E.^. SheetCorrectorUser
-            return user
-        )
       , ( RGCourseTutors
         , E.from $ \user -> do
             E.where_ $ E.exists $ E.from $ \(tutorial `E.InnerJoin` tutor) -> do
@@ -85,7 +87,16 @@ postCCommR tid ssh csh = do
                    E.&&. user E.^. UserId E.==. tutor E.^. TutorUser
             return user
         )
-      , ( RGCourseUnacceptedApplicants
+      , ( RGCourseCorrectors
+        , E.from $ \user -> do
+            E.where_ $ E.exists $ E.from $ \(sheet `E.InnerJoin` corrector) -> do
+              E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
+              E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
+                   E.&&. user E.^. UserId E.==. corrector E.^. SheetCorrectorUser
+            return user
+        )
+      ] ++ tuts ++ exams ++ sheets ++
+      [ ( RGCourseUnacceptedApplicants
         , E.from $ \user -> do
             E.where_ . E.exists . E.from $ \courseApplication ->
               E.where_ $ courseApplication E.^. CourseApplicationCourse E.==. E.val cid
@@ -96,7 +107,7 @@ postCCommR tid ssh csh = do
                    E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
             return user
         )
-      ] ++ tuts ++ exams ++ sheets
+      ]
     , crRecipientAuth = Just $ \uid -> do
         cID <- encrypt uid
         evalAccessDB (CourseR tid ssh csh $ CUserR cID) False

src/Handler/Course/List.hs

@@ -253,6 +253,12 @@ makeCourseTable colChoices psValidator' = do
           Just needle -> (E.castString (course E.^. CourseName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
                    E.||. (E.castString (course E.^. CourseShorthand) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
                    E.||. (E.maybe (E.val mempty) (E.castString . esqueletoMarkupOutput) (course E.^. CourseDescription) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
+      , singletonMap "search-shorthand" . FilterColumn $ \(view queryCourse -> course) criterion -> case getLast (criterion :: Last Text) of
+          Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
+          Just needle -> (E.castString (course E.^. CourseShorthand) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
+      , singletonMap "search-title" . FilterColumn $ \(view queryCourse -> course) criterion -> case getLast (criterion :: Last Text) of
+          Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
+          Just needle -> (E.castString (course E.^. CourseName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
       , singletonMap "allocation" . FilterColumn $ \row (criteria :: Set AllocationSearch) -> if
           | Set.null criteria -> E.true
           | otherwise -> flip E.any criteria $ \case
@@ -267,6 +273,8 @@ makeCourseTable colChoices psValidator' = do
       , pure $ prismAForm (singletonFilter "schoolshort" . maybePrism (_PathPiece . from _SchoolId)) mPrev $ aopt (hoistField lift schoolField) (fslI MsgTableCourseSchool)
       , pure $ prismAForm (singletonFilter "lecturer") mPrev $ aopt textField (fslI MsgCourseLecturer)
       , pure $ prismAForm (singletonFilter "search") mPrev $ aopt textField (fslI MsgFilterCourseSearch)
+      , pure $ prismAForm (singletonFilter "search-shorthand") mPrev $ aopt textField (fslI MsgFilterCourseSearchShorthand)
+      , pure $ prismAForm (singletonFilter "search-title") mPrev $ aopt textField (fslI MsgFilterCourseSearchTitle)
       , pure $ prismAForm (singletonFilter "openregistration" . maybePrism _PathPiece) mPrev $ fmap (\x -> if isJust x && not (fromJust x) then Nothing else x) . aopt checkBoxField (fslI MsgFilterCourseRegisterOpen)
       , guardOn (is _Just muid)
              $ prismAForm (singletonFilter "registered" . maybePrism _PathPiece) mPrev (aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterCourseRegistered))

src/Handler/ExamOffice/Exam.hs

@@ -293,9 +293,15 @@ postEGradesR tid ssh csh examn = do
             isSynced <- view . queryIsSynced $ E.val uid
 
             lift $ do
-              E.on $ courseParticipant E.?. CourseParticipantCourse E.==. E.just (E.val examCourse)
+              E.on $ E.maybe E.true (\cCourse ->
-               E.&&. courseParticipant E.?. CourseParticipantUser E.==. E.just (user E.^. UserId)
+                  cCourse E.==. E.val examCourse
-               E.&&. courseParticipant E.?. CourseParticipantState E.==. E.just (E.val CourseParticipantActive)
+                ) (courseParticipant E.?. CourseParticipantCourse)
+                  E.&&. E.maybe E.true (\cUser ->
+                    cUser E.==. user E.^. UserId
+                  ) (courseParticipant E.?. CourseParticipantUser)
+                  E.&&. E.maybe E.true (\cState ->
+                   cState E.==. E.val CourseParticipantActive
+                  ) (courseParticipant E.?. CourseParticipantState)
               E.on $ occurrence E.?. ExamOccurrenceExam E.==. E.just (E.val eid)
                E.&&. occurrence E.?. ExamOccurrenceId   E.==. E.joinV (examRegistration E.?. ExamRegistrationOccurrence)
               E.on $ examRegistration E.?. ExamRegistrationUser E.==. E.just (user E.^. UserId)

src/Handler/Tutorial/Communication.hs

@@ -10,8 +10,6 @@ import Handler.Utils.Communication
 import qualified Database.Esqueleto.Legacy as E
 import qualified Database.Esqueleto.Utils as E
 
-import qualified Data.Map as Map
-
 
 getTCommR, postTCommR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html
 getTCommR = postTCommR
@@ -36,21 +34,13 @@ postTCommR tid ssh csh tutn = do
     , crUltDest    = SomeRoute $ CTutorialR tid ssh csh tutn TCommR
     , crJobs       = crJobsCourseCommunication cid
     , crTestJobs   = crTestJobsCourseCommunication cid
-    , crRecipients = Map.fromList $
+    , crRecipients =
       [ ( RGCourseLecturers
         , E.from $ \(user `E.InnerJoin` lecturer) -> do
             E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser
             E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
             return user
         )
-      , ( RGCourseCorrectors
-        , E.from $ \user -> do
-            E.where_ $ E.exists $ E.from $ \(sheet `E.InnerJoin` corrector) -> do
-              E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
-              E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
-                   E.&&. corrector E.^. SheetCorrectorUser E.==. user E.^. UserId
-            return user
-        )
       , ( RGCourseTutors
         , E.from $ \user -> do
             E.where_ $ E.exists $ E.from $ \(tutorial `E.InnerJoin` tutor) -> do
@@ -59,6 +49,14 @@ postTCommR tid ssh csh tutn = do
                    E.&&. tutor E.^. TutorUser E.==. user E.^. UserId
             return user
         )
+      , ( RGCourseCorrectors
+        , E.from $ \user -> do
+            E.where_ $ E.exists $ E.from $ \(sheet `E.InnerJoin` corrector) -> do
+              E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
+              E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
+                   E.&&. corrector E.^. SheetCorrectorUser E.==. user E.^. UserId
+            return user
+        )
       ] ++ usertuts
     , crRecipientAuth = Just $ \uid -> do
         isTutorialUser <- E.selectExists . E.from $ \tutorialUser ->

src/Handler/Utils/Communication.hs

@@ -22,7 +22,7 @@ import qualified Data.Set as Set
 import qualified Data.Conduit.Combinators as C
 
 
-data RecipientGroup = RGCourseParticipants | RGCourseLecturers | RGCourseCorrectors | RGCourseTutors | RGCourseUnacceptedApplicants
+data RecipientGroup = RGCourseParticipants | RGCourseLecturers | RGCourseCorrectors | RGCourseTutors | RGCourseParticipantsInTutorial | RGCourseUnacceptedApplicants
                     | RGTutorialParticipants CryptoUUIDTutorial
                     | RGExamRegistered CryptoUUIDExam
                     | RGSheetSubmittor CryptoUUIDSheet
@@ -69,7 +69,7 @@ instance Button UniWorX CommunicationButton where
 
 
 data CommunicationRoute = CommunicationRoute
-  { crRecipients    :: Map RecipientGroup (E.SqlQuery (E.SqlExpr (Entity User)))
+  { crRecipients    :: [(RecipientGroup, E.SqlQuery (E.SqlExpr (Entity User)))]
   , crRecipientAuth :: Maybe (UserId -> DB AuthResult) -- ^ Only resolve userids given as GET-Parameter if they fulfil this criterion
   , crJobs, crTestJobs :: Communication -> ConduitT () Job (YesodDB UniWorX) ()
   , crHeading       :: SomeMessage UniWorX
@@ -111,7 +111,8 @@ commR CommunicationRoute{..} =  do
   mbCurrentRoute <- getCurrentRoute
 
   (suggestedRecipients, chosenRecipients) <- runDB $ do
-    suggested <- for crRecipients $ \user -> E.select user
+    suggestedUsers <- for crRecipients $ \(_,user) -> E.select user
+    let suggested = zip (view _1 <$> crRecipients) suggestedUsers
 
     let
       decrypt' :: CryptoUUIDUser -> DB (Maybe (Entity User))
@@ -127,21 +128,21 @@ commR CommunicationRoute{..} =  do
   let
     lookupUser :: UserId -> User
     lookupUser lId
-      = entityVal . unsafeHead . filter ((== lId) . entityKey) $ concat (Map.elems suggestedRecipients) ++ chosenRecipients
+      = entityVal . unsafeHead . filter ((== lId) . entityKey) $ concat (view _2 <$> suggestedRecipients) ++ chosenRecipients
 
   let chosenRecipients' = Map.fromList $
         [ ( (BoundedPosition $ RecipientGroup g, pos)
           , (Right recp, recp `elem` map entityKey chosenRecipients)
           )
-        | (g, recps) <- Map.toList suggestedRecipients
+        | (g, recps) <- suggestedRecipients
         , (pos, recp) <- zip [0..] $ map entityKey recps
         ] ++
         [ ( (BoundedPosition   RecipientCustom, pos)
           , (Right recp, True)
           )
-        | (pos, recp) <- zip [0..] . Set.toList $ Set.fromList (map entityKey chosenRecipients) \\ Set.fromList (concatMap (map entityKey) $ Map.elems suggestedRecipients)
+        | (pos, recp) <- zip [0..] . Set.toList $ Set.fromList (map entityKey chosenRecipients) \\ Set.fromList (concatMap (map entityKey) $ view _2 <$> suggestedRecipients)
         ]
-      activeCategories = map RecipientGroup (Map.keys suggestedRecipients) `snoc` RecipientCustom
+      activeCategories = map RecipientGroup (view _1 <$> suggestedRecipients) `snoc` RecipientCustom
 
   let recipientAForm :: AForm Handler (Set (Either UserEmail UserId))
       recipientAForm = postProcess <$> massInputA MassInput{..} (fslI MsgCommRecipients & setTooltip MsgCommRecipientsTip) True (Just chosenRecipients')

templates/widgets/communication/recipientLayout.hamlet

@@ -16,14 +16,16 @@ $if not (null activeCategories)
               _{MsgRGCourseCorrectors}
             $of RecipientGroup RGCourseTutors
               _{MsgRGCourseTutors}
+            $of RecipientGroup RGCourseParticipantsInTutorial
+              _{MsgRGCourseParticipantsInTutorial}
             $of RecipientGroup (RGTutorialParticipants tutid)
               ^{rgTutorialParticipantsCaption tutid}
-            $of RecipientGroup RGCourseUnacceptedApplicants
-              _{MsgRGCourseUnacceptedApplicants}
             $of RecipientGroup (RGExamRegistered eid)
               ^{rgExamRegisteredCaption eid}
             $of RecipientGroup (RGSheetSubmittor sid)
               ^{rgSheetSubmittorCaption sid}
+            $of RecipientGroup RGCourseUnacceptedApplicants
+              _{MsgRGCourseUnacceptedApplicants}
 
         $if hasContent category
           <fieldset .recipient-category__fieldset uw-interactive-fieldset .interactive-fieldset__target data-conditional-input=#{checkedIdent category}>