ExcerciseBuddies working

src/Handler/Submission.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ParallelListComp #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -50,24 +51,28 @@ import qualified Text.Blaze.Html5.Attributes as HA
 
 
 
-makeSubmissionForm :: Bool -> SheetGroup -> Form (Source Handler File, [Text])
+makeSubmissionForm :: Bool -> SheetGroup -> [Text] -> Form (Source Handler File, [Text])
-makeSubmissionForm unpackZips grouping = identForm FIDsubmission $ \html -> do
+makeSubmissionForm unpackZips grouping buddies = identForm FIDsubmission $ \html -> do
     flip (renderAForm FormStandard) html $ (,)
       <$> areq (zipFileField unpackZips) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing
-      <*> (catMaybes <$> sequenceA [aopt textField (fsm $ MsgSubmissionMember g) Nothing | g <- [1..groupNr] ]) -- TODO: Convenience: preselect last buddies
+      <*> (catMaybes <$> sequenceA [aopt textField (fsm $ MsgSubmissionMember g) buddy
+                                    | g <- [1..(max groupNr $ length buddies)]             -- groupNr might have decreased meanwhile
+                                    | buddy <- map (Just . Just) buddies ++ repeat Nothing   -- show current buddies
+                                    ])
       <*  submitButton
   where
     groupNr
       | Arbitrary{..} <- grouping = pred maxParticipants -- pred to account for the person submitting
       | otherwise = 0
 
+
 getSubmissionR, postSubmissionR :: TermId -> Text -> Text -> SubmissionMode -> Handler Html
 getSubmissionR = postSubmissionR
 postSubmissionR tid csh shn (SubmissionMode mcid) = do
   uid   <- requireAuthId
   msmid <- traverse decrypt mcid
-  (Entity shid Sheet{..})  <- runDB $ do
+  (Entity shid Sheet{..}, buddies)  <- runDB $ do
-    sheet@(Entity shid _)  <- fetchSheet tid csh shn
+    sheet@(Entity shid Sheet{..})  <- fetchSheet tid csh shn
     case msmid of
       Nothing     -> do
         submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do
@@ -77,18 +82,41 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do
           return $ submission E.^. SubmissionId
         $logDebugS "Submission.DUPLICATENEW" (tshow submissions)
         case submissions of
-          []    -> return shid
+          []    -> do
+            -- fetch buddies from previous submission in this course
+            buddies <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
+              E.on (submissionUser E.^. SubmissionUserUserId E.==. user E.^. UserId)
+              let oldids = E.subList_select . E.from $ \(sheet `E.InnerJoin` submission `E.InnerJoin` submissionUser `E.InnerJoin` submissionEdit) -> do
+                    E.on (submissionEdit E.^. SubmissionEditSubmission   E.==. submission E.^. SubmissionId)
+                    E.on (submissionUser E.^. SubmissionUserSubmissionId E.==. submission E.^. SubmissionId)
+                    E.on (sheet E.^. SheetId E.==. submission E.^. SubmissionSheetId)
+                    E.where_ $  submissionUser E.^. SubmissionUserUserId E.==. E.val uid
+                          E.&&. sheet E.^.    SheetCourseId E.==. E.val sheetCourseId
+                    E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
+                    E.limit 1
+                    return $ submission E.^. SubmissionId
+              E.where_ $  submissionUser E.^. SubmissionUserSubmissionId `E.in_` oldids
+                    E.&&. submissionUser E.^. SubmissionUserUserId E.!=. E.val uid
+              E.orderBy  [E.asc $ user E.^. UserEmail]
+              return $ user E.^. UserEmail
+            return (sheet,buddies)
           (E.Value smid:_) -> do
             cID <- encrypt smid
             addMessageI "info" $ MsgSubmissionAlreadyExists
             redirect $ CourseR tid csh $ SheetR $ SubmissionR shn $ SubmissionMode $ Just cID
-        return sheet
       (Just smid) -> do
         shid' <- submissionSheetId <$> get404 smid
         when (shid /= shid') $ invalidArgsI [MsgSubmissionWrongSheet]
-        return sheet
+        -- fetch buddies from current submission
+        buddies <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
+          E.on (submissionUser E.^. SubmissionUserUserId E.==. user E.^. UserId)
+          E.where_ $  submissionUser E.^. SubmissionUserSubmissionId E.==. E.val smid
+                E.&&. submissionUser E.^. SubmissionUserUserId       E.!=. E.val uid
+          E.orderBy  [E.asc $ user E.^. UserEmail]
+          return $ user E.^. UserEmail
+        return (sheet,buddies)
   let unpackZips = True -- undefined -- TODO
-  ((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm unpackZips sheetGrouping
+  ((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm unpackZips sheetGrouping $ map E.unValue buddies
   mCID <- runDB $ do
     res' <- case res of
       (FormMissing )           -> return $ FormMissing

src/Handler/Utils/Form.hs

@@ -232,7 +232,6 @@ posIntField d = checkBool (>= 1) (T.append  d " muss eine positive Zahl sein.")
 minIntField :: (Monad m, Integral i, Show i, RenderMessage (HandlerSite m) FormMessage) => i -> Text -> Field m i
 minIntField m d = checkBool (>= m) (T.concat [d," muss größer als ", T.pack $ show m, " sein."]) $ intField
 
-
 --termField: see Utils.Term
 
 schoolField :: Field Handler SchoolId