From b67819d061fb3409fa9978a31cb94b700e9e86fb Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 23 Oct 2019 11:57:27 +0200
Subject: [PATCH] fix(submission-form): fix display of all courseParticipants

---
 src/Handler/Submission.hs | 26 +++++++++++++++++++++-----
 src/Handler/Utils/Form.hs |  7 ++++---
 2 files changed, 25 insertions(+), 8 deletions(-)

diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs
index a925753dd..8e5ca85c1 100644
--- a/src/Handler/Submission.hs
+++ b/src/Handler/Submission.hs
@@ -155,9 +155,24 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
       E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
       E.orderBy [E.asc $ user E.^. UserEmail]
       return user
+    previousCoSubmittors :: UserId -> E.SqlQuery (E.SqlExpr (Entity User))
+    previousCoSubmittors uid = E.from $ \(user `E.InnerJoin` submissionUser `E.InnerJoin` submission `E.InnerJoin` sheet) -> do
+      E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet
+       E.&&. sheet E.^. SheetCourse E.==. E.val cid
+      E.on $ submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission
+      E.on $ user E.^. UserId E.==. submissionUser E.^. SubmissionUserUser
+      E.where_ . E.exists . E.from $ \submissionUser' ->
+        E.where_ $ submissionUser' E.^. SubmissionUserUser E.==. E.val uid
+             E.&&. submissionUser' E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
+      E.orderBy [E.asc $ user E.^. UserEmail]
+      return user
 
-    addField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Bool -> Field m (Set (Either UserEmail UserId))
-    addField isAdmin = multiUserField True $ courseUsers <$ guard isAdmin
+    addField, addFieldLecturer :: (MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> Field m (Set (Either UserEmail UserId))
+    addField = addField' False
+    addFieldLecturer = addField' True
+    addField' isAdmin uid = multiUserField True . Just $ if
+      | isAdmin   -> courseUsers
+      | otherwise -> previousCoSubmittors uid
 
     addFieldSettings, submittorSettings, singleSubSettings :: FieldSettings UniWorX
     addFieldSettings  = fslI MsgSubmissionMembers
@@ -176,12 +191,13 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
     miButtonAction' mCurrent frag = mCurrent <&> \current -> SomeRoute (current :#: frag)
 
     submittorsForm
-      | isLecturer = do-- Form is being used by lecturer; allow Everything™
+      | isLecturer = do -- Form is being used by lecturer; allow Everything™
+        uid <- liftHandler requireAuthId
         let
           miAdd :: (Text -> Text) -> FieldView UniWorX -> Form ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId])
           miAdd nudge btn csrf = do
             MsgRenderer mr <- getMsgRenderer
-            (addRes, addView) <- mpreq (addField True) (addFieldSettings & addName (nudge "emails")) Nothing
+            (addRes, addView) <- mpreq (addFieldLecturer uid) (addFieldSettings & addName (nudge "emails")) Nothing
             let addRes' = addRes <&> \newData oldData -> if
                   | existing <- newData `Set.intersection` Set.fromList oldData
                   , not $ Set.null existing
@@ -208,7 +224,7 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
                 -> Maybe (Form (Map ListPosition (Either UserEmail UserId) -> FormResult (Map ListPosition (Either UserEmail UserId))))
           miAdd _ _ nudge btn = Just $ \csrf -> do
             MsgRenderer mr <- getMsgRenderer
-            (addRes, addView) <- mpreq (addField True) (addFieldSettings & addName (nudge "emails")) Nothing
+            (addRes, addView) <- mpreq (addField uid) (addFieldSettings & addName (nudge "emails")) Nothing
             let addRes' = addRes <&> \newData oldData -> if
                   | existing <- newData `Set.intersection` setOf folded oldData
                   , not $ Set.null existing
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 937d3eec3..9f132d2dd 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -1126,14 +1126,15 @@ multiUserField onlySuggested suggestions = Field{..}
       |]
 
       whenIsJust suggestions $ \suggestions' -> do
-        suggestedEmails <- fmap (Set.fromList . map E.unValue) . liftHandler . runDB . E.select $ do
+        suggestedEmails <- fmap (Set.fromList . map (over _2 E.unValue . over _1 E.unValue)) . liftHandler . runDB . E.select $ do
           user <- suggestions'
-          return $ user E.^. UserEmail
+          return $ (user E.^. UserEmail, user E.^. UserDisplayName)
         [whamlet|
           $newline never
           <datalist id=#{datalistId}>
-            $forall email <- suggestedEmails
+            $forall (email, dName) <- suggestedEmails
               <option value=#{email}>
+                #{email} (#{dName})
         |]
     fieldParse (all Text.null -> True) _ = return $ Right Nothing
     fieldParse ts _ = runExceptT . fmap Just $ do