feat(personalised-sheet-files): download from CUsersR

messages/uniworx/de-de-formal.msg

@@ -2648,6 +2648,7 @@ CourseParticipantInactive: Abgemeldet
 CourseParticipantNoShow: Nicht erschienen
 CourseUserState: Zustand
 CourseUserSheets: Übungsblätter
+CourseUserDownloadPersonalisedSheetFiles: Personalisierte Übungsblatt-Dateien herunterladen
 
 TestDownload: Download-Test
 TestDownloadMaxSize: Maximale Dateigröße

messages/uniworx/en-eu.msg

@@ -2648,6 +2648,7 @@ CourseParticipantInactive: Deregistered
 CourseParticipantNoShow: No show
 CourseUserState: State
 CourseUserSheets: Exercise sheets
+CourseUserDownloadPersonalisedSheetFiles: Download personalised sheet files
 
 TestDownload: Download test
 TestDownloadMaxSize: Maximum filesize

src/Handler/Course/Users.hs

@@ -32,6 +32,8 @@ import qualified Data.CaseInsensitive as CI
 
 import Database.Persist.Sql (updateWhereCount)
 
+import Handler.Sheet.PersonalisedFiles
+
 
 type UserTableExpr   = (               E.SqlExpr (Entity User)
                          `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)
@@ -305,11 +307,12 @@ userTableCsvHeader showSex tuts sheets UserCsvExportData{..} = Csv.header $
 
 
 data CourseUserAction = CourseUserSendMail
-                      | CourseUserDeregister
                       | CourseUserRegisterTutorial
                       | CourseUserRegisterExam
                       | CourseUserSetSubmissionGroup
                       | CourseUserReRegister
+                      | CourseUserDeregister
+                      | CourseUserDownloadPersonalisedSheetFiles
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
 
 instance Universe CourseUserAction
@@ -331,6 +334,10 @@ data CourseUserActionData = CourseUserSendMailData
                             { setSubmissionGroup :: Maybe SubmissionGroupName
                             }
                           | CourseUserReRegisterData
+                          | CourseUserDownloadPersonalisedSheetFilesData
+                            { downloadPersonalisedFilesForSheet :: SheetName
+                            , downloadPersonalisedFilesAnonMode :: PersonalisedSheetFilesDownloadAnonymous
+                            }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 
@@ -598,7 +605,7 @@ getCUsersR, postCUsersR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCUsersR = postCUsersR
 postCUsersR tid ssh csh = do
   showSex <- getShowSex
-  (Entity cid course, numParticipants, (participantRes,participantTable)) <- runDB $ do
+  (Entity cid Course{..}, numParticipants, (participantRes,participantTable)) <- runDB $ do
     mayRegister <- hasWriteAccessTo $ CourseR tid ssh csh CAddUserR
     ent@(Entity cid _) <- getBy404 $ TermSchoolCourseShort tid ssh csh
     hasTutorials <- exists [TutorialCourse ==. cid]
@@ -612,6 +619,16 @@ postCUsersR tid ssh csh = do
       E.on $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
       E.where_ $ submissionGroup E.^. SubmissionGroupCourse E.==. E.val cid
     sheetList <- selectList [SheetCourse ==. cid] [Desc SheetActiveTo, Desc SheetActiveFrom]
+    personalisedSheets <- E.select . E.from $ \sheet -> do
+      let hasPersonalised = E.exists . E.from $ \psFile ->
+            E.where_ $ psFile E.^. PersonalisedSheetFileSheet E.==. sheet E.^. SheetId
+      E.where_ $ E.not_ (sheet E.^. SheetAllowNonPersonalisedSubmission)
+           E.||. hasPersonalised
+      E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
+      E.orderBy [ E.desc $ sheet E.^. SheetActiveTo
+                , E.desc $ sheet E.^. SheetActiveFrom
+                ]
+      return $ sheet E.^. SheetName
     let exams = nubOn entityKey $ examOccurrencesPerExam ^.. folded . _1
     let colChoices  = mconcat $ catMaybes
           [ pure . cap' $ dbSelect (applying _2) id (return . view (hasEntity . _entityKey))
@@ -659,6 +676,7 @@ postCUsersR tid ssh csh = do
             optionDisplay       = CI.original $ examName entityVal
           return Option{..}
         submissionGroupOpts = optionsPersist [SubmissionGroupCourse ==. cid] [Asc SubmissionGroupName] submissionGroupName <&> fmap (submissionGroupName . entityVal)
+        acts :: Map CourseUserAction (AForm Handler CourseUserActionData)
         acts = mconcat $ catMaybes
           [ pure . singletonMap CourseUserSendMail $ pure CourseUserSendMailData
           , pure . singletonMap CourseUserRegisterTutorial $ CourseUserRegisterTutorialData
@@ -671,6 +689,10 @@ postCUsersR tid ssh csh = do
               <$> aopt (textField & cfStrip & cfCI & addDatalist submissionGroupOpts) (fslI MsgSubmissionGroup & setTooltip MsgSubmissionGroupEmptyIsUnsetTip) Nothing
           , guardOn mayRegister . singletonMap CourseUserDeregister $ courseUserDeregisterForm cid
           , guardOn mayRegister . singletonMap CourseUserReRegister $ pure CourseUserReRegisterData
+          , guardOn (not $ null personalisedSheets) . singletonMap CourseUserDownloadPersonalisedSheetFiles $
+                  CourseUserDownloadPersonalisedSheetFilesData
+              <$> apopt (selectField' Nothing . optionsF $ map E.unValue personalisedSheets) (fslI MsgExerciseSheet) Nothing
+              <*> apopt (selectField optionsFinite) (fslI MsgPersonalisedSheetFilesDownloadAnonymousField) (Just PersonalisedSheetFilesDownloadAnonymous)
           ]
     numParticipants <- count [CourseParticipantCourse ==. cid, CourseParticipantState ==. CourseParticipantActive]
     table <- makeCourseUserTable cid acts (const E.true) colChoices psValidator (Just $ const True)
@@ -753,8 +775,14 @@ postCUsersR tid ssh csh = do
         return $ Sum didUpdate
       addMessageI Success $ MsgCourseUsersStateSet nrSet
       redirect $ CourseR tid ssh csh CUsersR
+    (CourseUserDownloadPersonalisedSheetFilesData shn anonMode, selectedUsers) -> do
+      shId <- runDB . getKeyBy404 $ CourseSheet cid shn
+      archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack) . ap getMessageRender . pure $
+        MsgPersonalisedSheetFilesArchiveName courseTerm courseSchool courseShorthand shn
+      sendResponse <=< serveZipArchive' archiveName $ sourcePersonalisedSheetFiles cid (Just shId) (Just selectedUsers) anonMode
 
-  let headingLong  = [whamlet|_{MsgMenuCourseMembers} #{courseName course} #{tid}|]
+
+  let headingLong  = [whamlet|_{MsgMenuCourseMembers} #{courseName} #{tid}|]
       headingShort = prependCourseTitle tid ssh csh MsgCourseMembers
   siteLayout headingLong $ do
     setTitleI headingShort

src/Handler/Sheet/PersonalisedFiles.hs

@@ -3,6 +3,7 @@ module Handler.Sheet.PersonalisedFiles
   , getSPersonalFilesR, getCPersonalFilesR
   , PersonalisedSheetFilesKeyException(..)
   , sourcePersonalisedSheetFiles, resolvePersonalisedSheetFiles
+  , PersonalisedSheetFilesDownloadAnonymous(..)
   , PersonalisedSheetFileUnresolved(..)
   , _PSFUnresolved, _PSFUnresolvedCollatable, _PSFUnresolvedDirectory
   ) where
@@ -192,9 +193,10 @@ sourcePersonalisedSheetFiles :: forall m.
                                 )
                              => CourseId
                              -> Maybe SheetId
+                             -> Maybe (Set UserId)
                              -> PersonalisedSheetFilesDownloadAnonymous
                              -> ConduitT () (Either PersonalisedSheetFile File) (SqlPersistT m) ()
-sourcePersonalisedSheetFiles cId mbsid anonMode = do
+sourcePersonalisedSheetFiles cId mbsid mbuids anonMode = do
   (mbIdx, cIDKey) <- lift . newPersonalisedFilesKey $ maybe (Left cId) Right mbsid
   let
     genSuffixes uid = case anonMode of
@@ -223,7 +225,9 @@ sourcePersonalisedSheetFiles cId mbsid anonMode = do
       E.on $ E.just (courseParticipant E.^. CourseParticipantUser) E.==. personalisedSheetFile E.?. PersonalisedSheetFileUser
        E.&&. E.val mbsid E.==. personalisedSheetFile E.?. PersonalisedSheetFileSheet
       E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. E.val cId
-      E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
+      case mbuids of
+        Just uids -> E.where_ $ courseParticipant E.^. CourseParticipantUser `E.in_` E.valList (Set.toList uids)
+        Nothing -> E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
       return (courseParticipant, personalisedSheetFile)
 
     toRefs = awaitForever $ \(Entity _ cPart@CourseParticipant{..}, mbPFile) -> do
@@ -370,7 +374,7 @@ getPersonalFilesR cId mbsid = do
     archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack) . ap getMessageRender . pure $ case mbSheet of
       Nothing -> MsgCoursePersonalisedSheetFilesArchiveName courseTerm courseSchool courseShorthand
       Just Sheet{..} -> MsgPersonalisedSheetFilesArchiveName courseTerm courseSchool courseShorthand sheetName
-    sendResponse <=< serveZipArchive' archiveName $ sourcePersonalisedSheetFiles cId mbsid anonMode
+    sendResponse <=< serveZipArchive' archiveName $ sourcePersonalisedSheetFiles cId mbsid Nothing anonMode
   
   isModal <- hasCustomHeader HeaderIsModal
 

templates/course-participants.hamlet

@@ -4,4 +4,4 @@ $#
 $# participantTable : widget table
 
 ^{participantTable}
-_{MsgCourseMembersCountOf numParticipants (courseCapacity course)}.
+_{MsgCourseMembersCountOf numParticipants courseCapacity}.

test/Handler/Sheet/PersonalisedFilesSpec.hs

@@ -76,7 +76,7 @@ spec = withApp . describe "Personalised sheet file zip encoding" $ do
       isDirectory = either (is _Nothing . personalisedSheetFileContent) (is _Nothing . fileContent)
 
     recoveredFiles <- runConduit $
-         sourcePersonalisedSheetFiles cid (Just shid) anonMode
+         sourcePersonalisedSheetFiles cid (Just shid) Nothing anonMode
       .| resolvePersonalisedSheetFiles fpL isDirectory cid shid
       .| C.foldMap pure