Merge branch 'master' of gitlab.cip.ifi.lmu.de:jost/UniWorX

.gitignore

@@ -31,4 +31,3 @@ src/Handler/Course.SnapCustom.hs
 .stack-work-*
 .directory
 tags
-.vscode

.vscode/tasks.json

@@ -0,0 +1,35 @@
+{  
+  "version": "2.0.0",
+  "tasks": [
+    {
+      "label": "build",
+      "type": "shell",
+      "command": "./build.sh",
+      "group": {
+        "kind": "build",
+        "isDefault": true
+      },
+      "presentation": {
+        "echo": true,
+        "reveal": "silent",
+        "focus": false,
+        "panel": "dedicated",
+        "showReuseMessage": false
+      }
+    },
+    {
+      "label": "start",
+      "type": "shell",
+      "command": "./start.sh",
+      "group": "build",
+      "presentation": {
+        "echo": true,
+        "reveal": "silent",
+        "focus": false,
+        "panel": "dedicated",
+        "showReuseMessage": false
+      },
+      "problemMatcher": []
+    }
+  ]
+}

config/submission-blacklist

@@ -10,3 +10,8 @@ $# Ignoriere rekursiv alle Ordner __MACOSX und ihren Inhalt
 
 $# Ignoriere rekursiv alle Dateien .DS_Store (Mac OS)
 **/.DS_Store
+
+$# Ignoriere VI-Style-Backup-Files
+**/*~
+$# Ignoriere Emacs-Style-Backup-Files
+**/.#*#

messages/uniworx/de.msg

@@ -346,7 +346,7 @@ MailSheetActiveIntro courseName@Text termDesc@Text sheetName@SheetName: Sie kön
 
 MailSubjectSheetSoonInactive csh@CourseShorthand sheetName@SheetName: #{sheetName} in #{csh} kann nur noch kurze Zeit abgegeben werden
 MailSheetSoonInactiveIntro courseName@Text termDesc@Text sheetName@SheetName: Abgabefirst für #{sheetName} im Kurs #{courseName} (#{termDesc}) endet in Kürze.
-MailSubjectSheetInactive csh@CourseShorthand sheetName@SheetName: Abgabfristt für #{sheetName} in #{csh} abgelaufen
+MailSubjectSheetInactive csh@CourseShorthand sheetName@SheetName: Abgabfrist für #{sheetName} in #{csh} abgelaufen
 MailSheetInactiveIntro courseName@Text termDesc@Text sheetName@SheetName: Die Abgabefirst für #{sheetName} im Kurs #{courseName} (#{termDesc}) beendet.
 MailCorrectionsAssignedIntro courseName@Text termDesc@Text sheetName@SheetName n@Int: #{display n} Abgaben wurden Ihnen zur Korrektur für #{sheetName} im Kurs #{courseName} (#{termDesc}) zugeteilt.
 MailEditNotifications: Benachrichtigungen ein-/ausschalten

routes

@@ -10,20 +10,20 @@
 --  Admins always have access to entities within their assigned schools.
 --
 --  Access Tags:
---    !free       -- free for all
+--    !free        -- free for all
---    !lecturer   -- lecturer    for this course (or the school, if route is not connected to a course)
+--    !lecturer    -- lecturer    for this course (or the school, if route is not connected to a course)
---    !corrector  -- corrector   for this sheet  (or the submission, if route is connected to a submission, or the course, if route is not connected to a sheet, or any course, if route is not connected to a course)
+--    !corrector   -- corrector   for this sheet  (or the submission, if route is connected to a submission, or the course, if route is not connected to a sheet, or any course, if route is not connected to a course)
---    !registered -- participant for this course (no effect outside of courses)
+--    !registered  -- participant for this course (no effect outside of courses)
---    !owner      -- part of the group of owners of this submission
+--    !owner       -- part of the group of owners of this submission
---    !capacity   -- course this route is associated with has at least one unit of participant capacity
+--    !capacity    -- course this route is associated with has at least one unit of participant capacity
 --
---    !materials  -- only if course allows all materials to be free (no meaning outside of courses)
+--    !materials   -- only if course allows all materials to be free (no meaning outside of courses)
---    !time       -- access depends on time somehow
+--    !time        -- access depends on time somehow
---    !isRead     -- only if it is read-only access (i.e. GET but not POST)
+--    !isRead      -- only if it is read-only access (i.e. GET but not POST)
---    !isWrite    -- only if it is write access     (i.e. POST only) why needed???
+--    !isWrite     -- only if it is write access     (i.e. POST only) why needed???
---
---    !deprecated -- like free, but logs and gives a warning; entirely disabled in production
 --
+--    !deprecated  -- like free, but logs and gives a warning; entirely disabled in production
+--    !development -- like free, but only for development builds 
 
 /static StaticR Static appStatic                              !free
 /auth   AuthR   Auth   getAuth                                !free

src/Handler/Sheet.hs

@@ -180,8 +180,7 @@ getSheetListR tid ssh csh = do
                     mkRoute = do
                       cid' <- mkCid
                       return $ CSubmissionR tid ssh csh sheetName cid' CorrectionR
-                    protoCell = anchorCellM mkRoute $(widgetFile "widgets/rating")
+                in anchorCellM mkRoute $(widgetFile "widgets/rating")
-                in protoCell & cellContents %~ (<* tell (sheetTypeSum sheetType submissionRatingPoints))
       , sortable Nothing -- (Just "percent") 
                         (i18nCell MsgRatingPercent)
           $ \(Entity _ Sheet{sheetType=sType}, _, mbSub) -> case mbSub of
@@ -196,23 +195,7 @@ getSheetListR tid ssh csh = do
       ]
     psValidator = def
       & defaultSorting [("submission-since", SortAsc)]
-  ------------------------------------------------------
+  ((), table) <- dbTable psValidator $ DBTable
-  -- ISSUE #223
-  -- The following line does not work; something is wrong with the tell in line 189 above.
-  -- (SheetTypeSummary{..}, table) <- dbTable psValidator $ DBTable
-  --
-  -- If fixed, remove the following workaround code:
-  SheetTypeSummary{..} <- do
-    rows <- runDB $ E.select $ E.from $ \(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) -> do
-      E.on $ submission E.?. SubmissionId E.==. submissionUser E.?. SubmissionUserSubmission
-      E.on $  (E.just $ sheet E.^. SheetId) E.==. submission E.?. SubmissionSheet
-        E.&&. submissionUser E.?. SubmissionUserUser E.==. E.val muid
-      E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
-      return (sheet E.^. SheetType, submission E.?. SubmissionRatingPoints)
-    return $ foldMap (\(E.Value sheetType, E.Value mbPts) -> sheetTypeSum sheetType (join mbPts)) rows
-  (_, table) <- dbTable psValidator $ DBTable
-  -- END ISSUE #223
-  -----------------------------------------------------
     { dbtSQLQuery  = sheetData
     , dbtColonnade = sheetCol
     , dbtProj = \DBRow{ dbrOutput = dbrOutput@(Entity _ Sheet{..}, _, _) }
@@ -245,6 +228,15 @@ getSheetListR tid ssh csh = do
     , dbtStyle     = def
     , dbtIdent     = "sheets" :: Text
     }
+  -- Collect summary over all Sheets, not just the ones shown due to pagination:
+  SheetTypeSummary{..} <- do
+    rows <- runDB $ E.select $ E.from $ \(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) -> do
+      E.on $ submission E.?. SubmissionId E.==. submissionUser E.?. SubmissionUserSubmission
+      E.on $  (E.just $ sheet E.^. SheetId) E.==. submission E.?. SubmissionSheet
+        E.&&. submissionUser E.?. SubmissionUserUser E.==. E.val muid
+      E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
+      return (sheet E.^. SheetType, submission E.?. SubmissionRatingPoints)
+    return $ foldMap (\(E.Value sheetType, E.Value mbPts) -> sheetTypeSum sheetType (join mbPts)) rows
   defaultLayout $ do
     $(widgetFile "sheetList")
     $(widgetFile "widgets/sheetTypeSummary")

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 :: Maybe SubmissionId -> UploadMode -> SheetGroup -> NonEmpty UserEmail -> Form (Maybe (Source Handler File), NonEmpty UserEmail)
-makeSubmissionForm msmid uploadMode grouping buddies = identForm FIDsubmission $ \html -> do
+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..(max (fromIntegral groupNr) $ length buddies)] -- groupNr might have decreased meanwhile
+        -- #227 Part I: change aforced to areq if the user is the lecturer or an admin (lecturer can upload for students)
-                                    | buddy <- map (Just . Just) buddies ++ repeat Nothing -- show current buddies
+        <$> 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
+      -- #227 Part II: no longer ignore submitter, if the user is lecturer or admin (allow lecturers to submit for their students)
-      (FormSuccess (mFiles,gEMails@(_:_))) -- Validate AdHoc Group Members
+      (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))