From b2355415005523517738d99ebd6993c44dcd728d Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Fri, 9 Nov 2018 10:28:53 +0100
Subject: [PATCH] Submission form shows submitter now

---
 src/Handler/Submission.hs | 32 +++++++++++++++++++-------------
 1 file changed, 19 insertions(+), 13 deletions(-)

diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs
index 26a7161d5..280fc3a48 100644
--- a/src/Handler/Submission.hs
+++ b/src/Handler/Submission.hs
@@ -47,22 +47,27 @@ import System.FilePath
 -- numberOfSubmissionEditDates = 3 -- for debugging only, should be 1 in production.
 
 
-makeSubmissionForm :: Maybe SubmissionId -> UploadMode -> SheetGroup -> [UserEmail] -> Form (Maybe (Source Handler File), [UserEmail])
-makeSubmissionForm msmid uploadMode grouping buddies = identForm FIDsubmission $ \html -> do
+makeSubmissionForm :: Maybe SubmissionId -> UploadMode -> SheetGroup -> NonEmpty UserEmail -> Form (Maybe (Source Handler File), NonEmpty UserEmail)
+makeSubmissionForm msmid uploadMode grouping (self :| buddies) = identForm FIDsubmission $ \html -> do
     let
       fileUploadForm = case uploadMode of
         NoUpload -> pure Nothing
         (Upload unpackZips) -> (bool (\f fs _ -> Just <$> areq f fs Nothing) aopt $ isJust msmid) (zipFileField unpackZips) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing
     flip (renderAForm FormStandard) html $ (,)
       <$> fileUploadForm
-      <*> (catMaybes <$> sequenceA [bool aforced' aopt editableBuddies ciField (fslpI (MsgSubmissionMember g) "user@campus.lmu.de" ) buddy
-                                    | g <- [1..(min (fromIntegral groupNr) $ length buddies)] -- groupNr might have decreased meanwhile
-                                    | buddy <- map (Just . Just) buddies ++ repeat Nothing -- show current buddies
-                                    ])
+      <*> ( (:|) 
+        -- #227 Part I: change aforced to areq if the user is the lecturer or an admin (lecturer can upload for students)
+        <$> aforced ciField (fslpI (MsgSubmissionMember 1) "user@campus.lmu.de" ) self
+        <*> (catMaybes <$> sequenceA [bool aforced' aopt editableBuddies ciField (fslpI (MsgSubmissionMember g) "user@campus.lmu.de" ) buddy
+                                      | g <- [2..(fromIntegral groupNr)]
+                                      | buddy <- map (Just . Just) buddies ++ repeat Nothing -- show current buddies
+                                      ])
+        )
       <*  submitButton
   where
     (groupNr, editableBuddies)
-      | Arbitrary{..} <- grouping = (pred maxParticipants, True) -- pred to account for the person submitting
+      | Arbitrary{..} <- grouping = (maxParticipants, True) 
+      | RegisteredGroups <- grouping = (fromIntegral $ length buddies, False)
       | otherwise = (0, False)
 
     aforced' f fs (Just (Just v)) = Just <$> aforced f fs v
@@ -95,7 +100,7 @@ getSubmissionOwnR tid ssh csh shn = do
 
 submissionHelper :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SubmissionMode -> Handler Html
 submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
-  uid       <- requireAuthId
+  (Entity uid userData) <- requireAuth
   msmid     <- traverse decrypt mcid
   actionUrl <- Data.Maybe.fromJust <$> getCurrentRoute
   maySubmit <- (== Authorized) <$> isAuthorized actionUrl True -- affects visibility of Edit-Dates, Submission-Button, etc.
@@ -141,7 +146,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
           invalidArgsI [MsgSubmissionWrongSheet]
         -- fetch buddies from current submission
         (Any isOwner, buddies) <- do
-          submittors <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
+          submitters <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
             E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId)
             E.where_ $  submissionUser E.^. SubmissionUserSubmission E.==. E.val smid
             E.orderBy  [E.asc $ user E.^. UserEmail]
@@ -149,7 +154,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
           let breakUserFromBuddies (E.Value userID, E.Value email)
                 | uid == userID  =  (Any True ,      [])
                 | otherwise      =  (Any False, [email])
-          return $ foldMap breakUserFromBuddies submittors
+          return $ foldMap breakUserFromBuddies submitters
 
         lastEdits <- do
             raw <- E.select . E.from $ \(user `E.InnerJoin` submissionEdit) -> do
@@ -163,13 +168,14 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
               return (userName, submissionEdit E.^. SubmissionEditTime)
             forM raw $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time
         return (csheet,buddies,lastEdits)
-  ((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid sheetUploadMode sheetGrouping buddies
+  ((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid sheetUploadMode sheetGrouping (userEmail userData :| buddies)
   mCID <- runDBJobs $ do
     res' <- case res of
       FormMissing              -> return   FormMissing
       (FormFailure failmsgs)   -> return $ FormFailure failmsgs
-      (FormSuccess (mFiles,[])) -> return $ FormSuccess (mFiles,[]) -- Type change
-      (FormSuccess (mFiles,gEMails@(_:_))) -- Validate AdHoc Group Members
+      -- #227 Part II: no longer ignore submitter, if the user is lecturer or admin (allow lecturers to submit for their students)
+      (FormSuccess (mFiles,_submitter:|[])) -> return $ FormSuccess (mFiles,[]) -- Type change
+      (FormSuccess (mFiles,_submitter:|gEMails@(_:_))) -- Validate AdHoc Group Members
         | Arbitrary{..} <- sheetGrouping -> do
           -- , length gEMails < maxParticipants -> do -- < since submitting user is already accounted for
           let prep :: [(E.Value UserEmail, (E.Value UserId, E.Value Bool, E.Value Bool))] -> Map (CI Text) (Maybe (UserId, Bool, Bool))