diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 8eedf0420..33fdc1b7e 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/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 diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index edb236913..09c4ab421 100644 --- a/messages/uniworx/en-eu.msg +++ b/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 diff --git a/src/Handler/Course/Users.hs b/src/Handler/Course/Users.hs index 5573269c5..e9a17d8da 100644 --- a/src/Handler/Course/Users.hs +++ b/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 diff --git a/src/Handler/Sheet/PersonalisedFiles.hs b/src/Handler/Sheet/PersonalisedFiles.hs index cb31b63ff..362c73d29 100644 --- a/src/Handler/Sheet/PersonalisedFiles.hs +++ b/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 diff --git a/templates/course-participants.hamlet b/templates/course-participants.hamlet index 53460bdda..963e9fe54 100644 --- a/templates/course-participants.hamlet +++ b/templates/course-participants.hamlet @@ -4,4 +4,4 @@ $# $# participantTable : widget table ^{participantTable} -_{MsgCourseMembersCountOf numParticipants (courseCapacity course)}. +_{MsgCourseMembersCountOf numParticipants courseCapacity}. diff --git a/test/Handler/Sheet/PersonalisedFilesSpec.hs b/test/Handler/Sheet/PersonalisedFilesSpec.hs index 0abcfd34b..f2c0c3039 100644 --- a/test/Handler/Sheet/PersonalisedFilesSpec.hs +++ b/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