feat(personalised-sheet-files): participant interaction
This commit is contained in:
Gregor Kleen
parent
1fe63a23a0
commit
db205f635d
@ -337,7 +337,8 @@ SheetRequireExamTip: Wenn die Anmeldung zu einer Prüfung vorausgesetzt wird, k
|
||||
SheetRequiredExam: Prüfung
|
||||
SheetShowRequiredExam: Vorausgesetze Prüfungsanmeldung
|
||||
SheetSubmissionExamRegistrationRequired: Um die Angabe für dieses Übungsblatt herunterzuladen oder Abzugeben ist eine Anmeldung zur genannten Prüfung erforderlich.
|
||||
SheetFilesExamRegistrationRequired: Um die Angabe für dieses Übungsblatt herunterzuladen oder Abzugeben ist eine Anmeldung zu der oben genannten Prüfung erforderlich.
|
||||
SheetFilesExamRegistrationRequired: Um die Dateien dieses Übungsblattes herunterzuladen oder Abzugeben ist eine Anmeldung zu der oben genannten Prüfung erforderlich.
|
||||
SheetFilesMissingPersonalisedFiles: Um Abzugeben muss zunächst ein Kursverwalter personalisierte Übungsblatt-Dateien für Sie hinterlegen.
|
||||
|
||||
SheetArchiveFileTypeDirectoryExercise: aufgabenstellung
|
||||
SheetArchiveFileTypeDirectoryHint: hinweis
|
||||
@ -477,6 +478,7 @@ UnauthorizedTutorialTime: Dieses Tutorium erlaubt momentan keine Anmeldungen.
|
||||
UnauthorizedCourseNewsTime: Diese Nachricht ist momentan nicht freigegeben.
|
||||
UnauthorizedExamTime: Diese Prüfung ist momentan nicht freigegeben.
|
||||
UnauthorizedSubmissionOwner: Sie sind an dieser Abgabe nicht beteiligt.
|
||||
UnauthorizedSubmissionPersonalisedSheetFiles: Ihnen wurden keine personalisierten Übungsblatt-Dateien zugeteilt und die Abgabe ist ohne diese nicht gestattet.
|
||||
UnauthorizedSubmissionRated: Diese Abgabe ist noch nicht korrigiert.
|
||||
UnauthorizedSubmissionCorrector: Sie sind nicht der Korrektor für diese Abgabe.
|
||||
UnauthorizedUserSubmission: Nutzer dürfen für dieses Übungsblatt keine Abgaben erstellen.
|
||||
@ -1458,6 +1460,7 @@ AuthTagCapacity: Kapazität ist ausreichend
|
||||
AuthTagEmpty: Kurs hat keine Teilnehmer
|
||||
AuthTagMaterials: Kursmaterialien sind freigegeben
|
||||
AuthTagOwner: Nutzer ist Besitzer
|
||||
AuthTagPersonalisedSheetFiles: Nutzer verfügt über personalisierte Übungsblatt-Dateien
|
||||
AuthTagRated: Korrektur ist bewertet
|
||||
AuthTagUserSubmissions: Abgaben erfolgen durch Kursteilnehmer
|
||||
AuthTagCorrectorSubmissions: Abgaben erfolgen durch Korrektoren
|
||||
@ -2692,6 +2695,9 @@ PersonalisedSheetFilesDownloadAnonymousField: Anonymisierung
|
||||
PersonalisedSheetFilesDownloadAnonymousFieldTip: Soll das Archiv von personalisierten Dateien anonymisiert werden (es enthält dann keinerlei sofort persönlich identifizierende Informationen zu den Kursteilnehmern) oder sollen die Verzeichnisnamen mit einem Merkmal versehen werden und die Metainformations-Dateien zusätzlich persönliche Daten enthalten?
|
||||
PersonalisedSheetFilesIgnored count@Int64: Es #{pluralDE count "wurde" "wurden"} #{count} hochgeladene #{pluralDE count "Datei" "Dateien"} ignoriert, da sie keinem Übungsblattdatei-Typ oder keinem Kursteilnehmer zugeordnet werden #{pluralDE count "konnte" "konnten"}.
|
||||
PersonalisedSheetFilesIgnoredIntro: Es wurden die folgenden Dateien ignoriert:
|
||||
CourseUserHasPersonalisedSheetFilesFilter: Teilnehmer hat personalisierte Übungsblatt-Dateien für
|
||||
SheetPersonalisedFilesUsersList: Liste von Teilnehmern mit personalisierten Übungsblatt-Dateien
|
||||
|
||||
AdminCrontabNotGenerated: (Noch) keine Crontab generiert
|
||||
CronMatchAsap: ASAP
|
||||
CronMatchNone: Nie
|
||||
8
routes
8
routes
@ -152,15 +152,15 @@
|
||||
/edit SEditR GET POST
|
||||
/delete SDelR GET POST
|
||||
/subs SSubsR GET POST -- for lecturer only
|
||||
!/subs/new SubmissionNewR GET POST !timeANDcourse-registeredANDuser-submissionsANDsubmission-groupANDexam-registered
|
||||
!/subs/new SubmissionNewR GET POST !timeANDcourse-registeredANDuser-submissionsANDsubmission-groupANDexam-registeredANDpersonalised-sheet-files
|
||||
!/subs/own SubmissionOwnR GET !free -- just redirect
|
||||
!/subs/assign SAssignR GET POST !lecturerANDtime
|
||||
/subs/#CryptoFileNameSubmission SubmissionR:
|
||||
/ SubShowR GET POST !ownerANDtimeANDuser-submissionsANDsubmission-groupANDexam-registered !ownerANDread !correctorANDread
|
||||
/delete SubDelR GET POST !ownerANDtimeANDuser-submissionsANDexam-registered
|
||||
/ SubShowR GET POST !ownerANDtimeANDuser-submissionsANDsubmission-groupANDexam-registeredANDpersonalised-sheet-files !ownerANDread !correctorANDread
|
||||
/delete SubDelR GET POST !ownerANDtimeANDuser-submissionsANDexam-registeredANDpersonalised-sheet-files
|
||||
/assign SubAssignR GET POST !lecturerANDtime
|
||||
/correction CorrectionR GET POST !corrector !ownerANDreadANDrated
|
||||
/invite SInviteR GET POST !ownerANDtimeANDuser-submissionsANDsubmission-groupANDexam-registered
|
||||
/invite SInviteR GET POST !ownerANDtimeANDuser-submissionsANDsubmission-groupANDexam-registeredANDpersonalised-sheet-files
|
||||
!/#SubmissionFileType SubArchiveR GET !owner !corrector
|
||||
!/#SubmissionFileType/*FilePath SubDownloadR GET !owner !corrector
|
||||
/iscorrector SIsCorrR GET !corrector -- Route is used to check for corrector access to this sheet
|
||||
|
||||
@ -3,6 +3,7 @@
|
||||
|
||||
module Database.Esqueleto.Utils
|
||||
( true, false
|
||||
, justVal, justValList
|
||||
, isJust
|
||||
, isInfixOf, hasInfix
|
||||
, or, and
|
||||
@ -67,6 +68,12 @@ true = E.val True
|
||||
false :: E.SqlExpr (E.Value Bool)
|
||||
false = E.val False
|
||||
|
||||
justVal :: PersistField typ => typ -> E.SqlExpr (E.Value (Maybe typ))
|
||||
justVal = E.val . Just
|
||||
|
||||
justValList :: PersistField typ => [typ] -> E.SqlExpr (E.ValueList (Maybe typ))
|
||||
justValList = E.valList . map Just
|
||||
|
||||
-- | Negation of `isNothing` which is missing
|
||||
isJust :: PersistField typ => E.SqlExpr (E.Value (Maybe typ)) -> E.SqlExpr (E.Value Bool)
|
||||
isJust = E.not_ . E.isNothing
|
||||
|
||||
@ -1374,6 +1374,21 @@ tagAccessPredicate AuthOwner = APDB $ \mAuthId route _ -> case route of
|
||||
void . maybeMExceptT (unauthorizedI MsgUnauthorizedSubmissionOwner) . getBy $ UniqueSubmissionUser authId sid
|
||||
return Authorized
|
||||
r -> $unsupportedAuthPredicate AuthOwner r
|
||||
tagAccessPredicate AuthPersonalisedSheetFiles = APDB $ \mAuthId route _ -> case route of
|
||||
CSheetR tid ssh csh shn _ -> $cachedHereBinary (mAuthId, tid, ssh, csh, shn) . exceptT return return $ do
|
||||
Entity shId Sheet{..} <- maybeTMExceptT (unauthorizedI MsgUnauthorizedSubmissionPersonalisedSheetFiles) $ do
|
||||
cid <- MaybeT . $cachedHereBinary (tid, ssh, csh) . getKeyBy $ TermSchoolCourseShort tid ssh csh
|
||||
MaybeT . $cachedHereBinary (cid, shn) . getBy $ CourseSheet cid shn
|
||||
if | sheetAllowNonPersonalisedSubmission -> return Authorized
|
||||
| otherwise -> do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
flip guardMExceptT (unauthorizedI MsgUnauthorizedSubmissionPersonalisedSheetFiles) <=< $cachedHereBinary (shId, authId) . lift $
|
||||
E.selectExists . E.from $ \psFile ->
|
||||
E.where_ $ psFile E.^. PersonalisedSheetFileSheet E.==. E.val shId
|
||||
E.&&. psFile E.^. PersonalisedSheetFileUser E.==. E.val authId
|
||||
E.&&. E.not_ (E.isNothing $ psFile E.^. PersonalisedSheetFileContent) -- directories don't count
|
||||
return Authorized
|
||||
r -> $unsupportedAuthPredicate AuthPersonalisedSheetFiles r
|
||||
tagAccessPredicate AuthRated = APDB $ \_ route _ -> case route of
|
||||
CSubmissionR _ _ _ _ cID _ -> $cachedHereBinary cID . maybeT (unauthorizedI MsgUnauthorizedSubmissionRated) $ do
|
||||
sid <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
|
||||
|
||||
@ -353,6 +353,16 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
|
||||
tutorials <- selectList [ TutorialCourse ==. cid ] []
|
||||
exams <- selectList [ ExamCourse ==. cid ] []
|
||||
sheets <- 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
|
||||
-- -- psValidator has default sorting and filtering
|
||||
showSex <- getShowSex
|
||||
let dbtIdent = "courseUsers" :: Text
|
||||
@ -465,6 +475,13 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
|
||||
-- , ("course-user-note", error "TODO") -- TODO
|
||||
, single $ ("submission-group", FilterColumn $ E.mkContainsFilter $ querySubmissionGroup >>> (E.?. SubmissionGroupName))
|
||||
, single $ ("active", FilterColumn $ E.mkExactFilter $ queryParticipant >>> (E.==. E.val CourseParticipantActive) . (E.^. CourseParticipantState))
|
||||
, single $ ("has-personalised-sheet-files", FilterColumn $ \t (Last criterion) -> flip (maybe E.true) criterion $ \shn
|
||||
-> E.exists . E.from $ \(psFile `E.InnerJoin` sheet) -> do
|
||||
E.on $ psFile E.^. PersonalisedSheetFileSheet E.==. sheet E.^. SheetId
|
||||
E.where_ $ psFile E.^. PersonalisedSheetFileUser E.==. queryParticipant t E.^. CourseParticipantUser
|
||||
E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
|
||||
E.&&. sheet E.^. SheetName E.==. E.val shn
|
||||
)
|
||||
]
|
||||
where single = uncurry Map.singleton
|
||||
dbtFilterUI mPrev = mconcat $
|
||||
@ -478,6 +495,9 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
|
||||
, prismAForm (singletonFilter "submission-group") mPrev $ aopt textField (fslI MsgSubmissionGroup)
|
||||
, prismAForm (singletonFilter "tutorial") mPrev $ aopt textField (fslI MsgCourseUserTutorial)
|
||||
, prismAForm (singletonFilter "exam") mPrev $ aopt textField (fslI MsgCourseUserExam)
|
||||
] ++
|
||||
[ prismAForm (singletonFilter "has-personalised-sheet-files". maybePrism _PathPiece) mPrev $ aopt (selectField' (Just $ SomeMessage MsgNoFilter) . optionsF $ map E.unValue personalisedSheets) (fslI MsgCourseUserHasPersonalisedSheetFilesFilter)
|
||||
| not $ null personalisedSheets
|
||||
]
|
||||
dbtParams = DBParamsForm
|
||||
{ dbParamsFormMethod = POST
|
||||
|
||||
@ -16,6 +16,7 @@ import qualified Database.Esqueleto.Utils as E
|
||||
getSArchiveR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler TypedContent
|
||||
getSArchiveR tid ssh csh shn = do
|
||||
shId <- runDB $ fetchSheetId tid ssh csh shn
|
||||
muid <- maybeAuthId
|
||||
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
let archiveName = flip addExtension (unpack extensionZip) . unpack . mr $ MsgSheetArchiveName tid ssh csh shn
|
||||
@ -23,42 +24,75 @@ getSArchiveR tid ssh csh shn = do
|
||||
allowedSFTs <- filterM (hasReadAccessTo . sftArchive) universeF
|
||||
multipleSFTs <- if
|
||||
| length allowedSFTs < 2 -> return False
|
||||
| otherwise -> runDB . E.selectExists . E.from $ \(sheet `E.InnerJoin` (sFile1 `E.InnerJoin` sFile2)) -> do
|
||||
E.on $ sFile1 E.^. SheetFileType E.!=. sFile2 E.^. SheetFileType
|
||||
E.&&. sFile1 E.^. SheetFileTitle E.==. sFile2 E.^. SheetFileTitle
|
||||
E.on $ sheet E.^. SheetId E.==. sFile1 E.^. SheetFileSheet
|
||||
E.&&. sheet E.^. SheetId E.==. sFile2 E.^. SheetFileSheet
|
||||
| otherwise -> runDB . E.selectExists . E.from $ \(sheet `E.InnerJoin` ((psFile1 `E.FullOuterJoin` sFile1) `E.InnerJoin` (psFile2 `E.FullOuterJoin` sFile2))) -> do
|
||||
E.on $ sFile2 E.?. SheetFileSheet E.==. psFile2 E.?. PersonalisedSheetFileSheet
|
||||
E.&&. sFile2 E.?. SheetFileType E.==. psFile2 E.?. PersonalisedSheetFileType
|
||||
E.&&. sFile2 E.?. SheetFileTitle E.==. psFile2 E.?. PersonalisedSheetFileTitle
|
||||
E.&&. psFile2 E.?. PersonalisedSheetFileUser E.==. E.val muid
|
||||
|
||||
E.on $ ( sFile1 E.?. SheetFileType E.!=. sFile2 E.?. SheetFileType
|
||||
E.||. psFile1 E.?. PersonalisedSheetFileType E.!=. psFile2 E.?. PersonalisedSheetFileType
|
||||
E.||. sFile1 E.?. SheetFileType E.!=. psFile2 E.?. PersonalisedSheetFileType
|
||||
E.||. sFile2 E.?. SheetFileType E.!=. psFile1 E.?. PersonalisedSheetFileType
|
||||
)
|
||||
E.&&. ( sFile1 E.?. SheetFileTitle E.==. sFile2 E.?. SheetFileTitle
|
||||
E.||. psFile1 E.?. PersonalisedSheetFileTitle E.==. psFile2 E.?. PersonalisedSheetFileTitle
|
||||
E.||. sFile1 E.?. SheetFileTitle E.==. psFile2 E.?. PersonalisedSheetFileTitle
|
||||
E.||. sFile2 E.?. SheetFileTitle E.==. psFile1 E.?. PersonalisedSheetFileTitle
|
||||
)
|
||||
|
||||
E.on $ sFile1 E.?. SheetFileSheet E.==. psFile1 E.?. PersonalisedSheetFileSheet
|
||||
E.&&. sFile1 E.?. SheetFileType E.==. psFile1 E.?. PersonalisedSheetFileType
|
||||
E.&&. sFile1 E.?. SheetFileTitle E.==. psFile1 E.?. PersonalisedSheetFileTitle
|
||||
E.&&. psFile1 E.?. PersonalisedSheetFileUser E.==. E.val muid
|
||||
|
||||
|
||||
E.on $ (E.just (sheet E.^. SheetId) E.==. sFile1 E.?. SheetFileSheet E.||. E.just (sheet E.^. SheetId) E.==. psFile1 E.?. PersonalisedSheetFileSheet)
|
||||
E.&&. (E.just (sheet E.^. SheetId) E.==. sFile2 E.?. SheetFileSheet E.||. E.just (sheet E.^. SheetId) E.==. psFile2 E.?. PersonalisedSheetFileSheet)
|
||||
E.where_ $ sheet E.^. SheetId E.==. E.val shId
|
||||
E.&&. sFile1 E.^. SheetFileType `E.in_` E.valList allowedSFTs
|
||||
E.&&. sFile2 E.^. SheetFileType `E.in_` E.valList allowedSFTs
|
||||
let modifyTitles SheetFile{..}
|
||||
| not multipleSFTs = SheetFile{..}
|
||||
| otherwise = SheetFile
|
||||
{ sheetFileTitle = unpack (mr $ SheetArchiveFileTypeDirectory sheetFileType) </> sheetFileTitle
|
||||
, ..
|
||||
}
|
||||
E.&&. (sFile1 E.?. SheetFileType `E.in_` E.justValList allowedSFTs E.||. psFile1 E.?. PersonalisedSheetFileType `E.in_` E.justValList allowedSFTs)
|
||||
E.&&. (sFile2 E.?. SheetFileType `E.in_` E.justValList allowedSFTs E.||. psFile2 E.?. PersonalisedSheetFileType `E.in_` E.justValList allowedSFTs)
|
||||
E.&&. E.maybe E.true (\psfUser -> E.just psfUser E.==. E.val muid) (psFile1 E.?. PersonalisedSheetFileUser)
|
||||
E.&&. E.maybe E.true (\psfUser -> E.just psfUser E.==. E.val muid) (psFile2 E.?. PersonalisedSheetFileUser)
|
||||
|
||||
let
|
||||
modifyTitles :: forall record. HasFileReference record => (record -> SheetFileType) -> record -> record
|
||||
modifyTitles sft f
|
||||
| not multipleSFTs = f
|
||||
| otherwise = f & _FileReference . _1 . _fileReferenceTitle %~ (unpack (mr $ SheetArchiveFileTypeDirectory (sft f)) <//>)
|
||||
sftDirectories <- if
|
||||
| not multipleSFTs -> return mempty
|
||||
| otherwise -> runDB . fmap (mapMaybe $ \(sft, mTime) -> (sft, ) <$> mTime) . forM allowedSFTs $ \sft -> fmap ((sft, ) . (=<<) E.unValue) . E.selectMaybe . E.from $ \sFile -> do
|
||||
E.where_ $ sFile E.^. SheetFileSheet E.==. E.val shId
|
||||
E.&&. sFile E.^. SheetFileType E.==. E.val sft
|
||||
return . E.max_ $ sFile E.^. SheetFileModified
|
||||
| otherwise -> runDB . fmap (mapMaybe $ \(sft, mTime) -> (sft, ) <$> mTime) . forM allowedSFTs $ \sft -> fmap ((sft, ) . (=<<) E.unValue) . E.selectMaybe . E.from $ \(sFile `E.FullOuterJoin` psFile) -> do
|
||||
E.on $ sFile E.?. SheetFileSheet E.==. psFile E.?. PersonalisedSheetFileSheet
|
||||
E.&&. sFile E.?. SheetFileType E.==. psFile E.?. PersonalisedSheetFileType
|
||||
E.&&. sFile E.?. SheetFileTitle E.==. psFile E.?. PersonalisedSheetFileTitle
|
||||
E.&&. psFile E.?. PersonalisedSheetFileUser E.==. E.val muid
|
||||
E.where_ $ (sFile E.?. SheetFileSheet E.==. E.justVal shId E.||. psFile E.?. PersonalisedSheetFileSheet E.==. E.justVal shId)
|
||||
E.&&. (sFile E.?. SheetFileType E.==. E.justVal sft E.||. psFile E.?. PersonalisedSheetFileType E.==. E.justVal sft)
|
||||
E.&&. E.maybe E.true (\psfUser -> E.just psfUser E.==. E.val muid) (psFile E.?. PersonalisedSheetFileUser)
|
||||
return . E.max_ $ E.unsafeCoalesce
|
||||
[ sFile E.?. SheetFileModified
|
||||
, psFile E.?. PersonalisedSheetFileModified
|
||||
]
|
||||
|
||||
serveZipArchive archiveName $ do
|
||||
forM_ sftDirectories $ \(sft, mTime) -> yield $ SheetFile
|
||||
forM_ sftDirectories $ \(sft, mTime) -> yield . Left $ SheetFile
|
||||
{ sheetFileType = sft
|
||||
, sheetFileTitle = unpack . mr $ SheetArchiveFileTypeDirectory sft
|
||||
, sheetFileModified = mTime
|
||||
, sheetFileContent = Nothing
|
||||
, sheetFileSheet = shId
|
||||
}
|
||||
sheetFilesSFTsQuery tid ssh csh shn allowedSFTs .| C.map entityVal .| C.map modifyTitles
|
||||
sheetFilesSFTsQuery tid ssh csh shn muid allowedSFTs .| C.map (entityVal `bimap` entityVal) .| C.map (modifyTitles sheetFileType `bimap` modifyTitles personalisedSheetFileType)
|
||||
|
||||
getSFileR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SheetFileType -> FilePath -> Handler TypedContent
|
||||
getSFileR tid ssh csh shn sft file = serveOneFile $ sheetFileQuery tid ssh csh shn sft file .| C.map entityVal
|
||||
getSFileR tid ssh csh shn sft file = do
|
||||
muid <- maybeAuthId
|
||||
serveOneFile $ sheetFileQuery tid ssh csh shn muid sft file
|
||||
|
||||
getSZipR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SheetFileType -> Handler TypedContent
|
||||
getSZipR tid ssh csh shn sft = do
|
||||
muid <- maybeAuthId
|
||||
sft' <- ap getMessageRender $ pure sft
|
||||
archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack). ap getMessageRender . pure $ MsgSheetTypeArchiveName tid ssh csh shn sft'
|
||||
serveSomeFiles archiveName $ sheetFilesAllQuery tid ssh csh shn sft .| C.map entityVal
|
||||
serveSomeFiles archiveName $ sheetFilesAllQuery tid ssh csh shn muid sft
|
||||
|
||||
@ -107,12 +107,31 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS
|
||||
let downloadRoute = case mbSheet of
|
||||
Just Sheet{..} -> CSheetR courseTerm courseSchool courseShorthand sheetName SPersonalFilesR
|
||||
Nothing -> CourseR courseTerm courseSchool courseShorthand CPersonalFilesR
|
||||
downloadTrigger
|
||||
= [whamlet|
|
||||
$newline never
|
||||
#{iconFileZip}
|
||||
\ _{MsgMenuSheetPersonalisedFiles}
|
||||
|]
|
||||
listRoute <- for mbSheet $ \(sheetName -> shn) -> toTextUrl
|
||||
( CourseR courseTerm courseSchool courseShorthand CUsersR
|
||||
, [ ("courseUsers-has-personalised-sheet-files"
|
||||
, toPathPiece shn
|
||||
)
|
||||
]
|
||||
)
|
||||
guardM $ hasReadAccessTo downloadRoute
|
||||
messageIconWidget Info IconFileZip
|
||||
messageIconWidget Info IconFileUser
|
||||
[whamlet|
|
||||
$newline never
|
||||
_{MsgSheetPersonalisedFilesDownloadTemplateHere}<br />
|
||||
^{modal (i18n MsgMenuSheetPersonalisedFiles) (Left (SomeRoute downloadRoute))}
|
||||
<div>
|
||||
_{MsgSheetPersonalisedFilesDownloadTemplateHere}
|
||||
<br />
|
||||
^{modal downloadTrigger (Left (SomeRoute downloadRoute))}
|
||||
$maybe lRoute <- listRoute
|
||||
<p .explanation>
|
||||
<a href=#{lRoute} target="_blank">
|
||||
_{MsgSheetPersonalisedFilesUsersList}
|
||||
|]
|
||||
return $ SheetPersonalisedFilesForm
|
||||
<$ maybe (pure ()) aformMessage templateDownloadMessage
|
||||
|
||||
@ -117,10 +117,10 @@ getSheetListR tid ssh csh = do
|
||||
, dbtSQLQuery = \dt@(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` _submissionUser)) -> do
|
||||
sheetData dt
|
||||
let existFiles = -- check whether files exist for given type
|
||||
( hasSheetFileQuery sheet SheetExercise
|
||||
, hasSheetFileQuery sheet SheetHint
|
||||
, hasSheetFileQuery sheet SheetSolution
|
||||
, hasSheetFileQuery sheet SheetMarking
|
||||
( hasSheetFileQuery sheet (E.val muid) SheetExercise
|
||||
, hasSheetFileQuery sheet (E.val muid) SheetHint
|
||||
, hasSheetFileQuery sheet (E.val muid) SheetSolution
|
||||
, hasSheetFileQuery sheet (E.val muid) SheetMarking
|
||||
)
|
||||
return (sheet, lastSheetEdit sheet, submission, existFiles)
|
||||
, dbtRowKey = \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetId
|
||||
|
||||
@ -11,13 +11,14 @@ import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
import qualified Data.Map as Map
|
||||
|
||||
|
||||
import Handler.Sheet.Pseudonym
|
||||
import Utils.Sheet
|
||||
|
||||
|
||||
getSShowR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
|
||||
getSShowR tid ssh csh shn = do
|
||||
now <- liftIO getCurrentTime
|
||||
muid <- maybeAuthId
|
||||
Entity sid sheet <- runDB $ fetchSheet tid ssh csh shn
|
||||
seeAllModificationTimestamps <- hasReadAccessTo $ CSheetR tid ssh csh shn SIsCorrR -- ordinary users should not see modification dates older than visibility
|
||||
|
||||
@ -32,12 +33,20 @@ getSShowR tid ssh csh shn = do
|
||||
| NTop (Just mtime) > NTop (sheetFileTypeDates sheet sft) = dateTimeCell mtime
|
||||
| otherwise = mempty
|
||||
|
||||
let fileData sheetFile = do
|
||||
let fileData (sheetFile `E.FullOuterJoin` psFile) = do
|
||||
E.on $ sheetFile E.?. SheetFileTitle E.==. psFile E.?. PersonalisedSheetFileTitle
|
||||
E.&&. sheetFile E.?. SheetFileType E.==. psFile E.?. PersonalisedSheetFileType
|
||||
E.&&. sheetFile E.?. SheetFileSheet E.==. psFile E.?. PersonalisedSheetFileSheet
|
||||
E.&&. psFile E.?. PersonalisedSheetFileUser E.==. E.val muid
|
||||
-- filter to requested file
|
||||
E.where_ $ sheetFile E.^. SheetFileSheet E.==. E.val sid
|
||||
E.&&. E.not_ (E.isNothing $ sheetFile E.^. SheetFileContent) -- don't show directories
|
||||
E.where_ $ (sheetFile E.?. SheetFileSheet E.==. E.justVal sid E.||. psFile E.?. PersonalisedSheetFileSheet E.==. E.justVal sid)
|
||||
E.&&. E.maybe (E.isJust . E.joinV $ sheetFile E.?. SheetFileContent) E.isJust (psFile E.?. PersonalisedSheetFileContent) -- don't show directories
|
||||
E.&&. E.maybe E.true (\psfUser -> E.just psfUser E.==. E.val muid) (psFile E.?. PersonalisedSheetFileUser)
|
||||
-- return desired columns
|
||||
return (sheetFile E.^. SheetFileTitle, sheetFile E.^. SheetFileModified, sheetFile E.^. SheetFileType)
|
||||
return ( E.unsafeCoalesce [psFile E.?. PersonalisedSheetFileTitle, sheetFile E.?. SheetFileTitle]
|
||||
, E.unsafeCoalesce [psFile E.?. PersonalisedSheetFileModified, sheetFile E.?. SheetFileModified]
|
||||
, E.unsafeCoalesce [psFile E.?. PersonalisedSheetFileType, sheetFile E.?. SheetFileType]
|
||||
)
|
||||
let colonnadeFiles = widgetColonnade $ mconcat
|
||||
[ sortable (Just "type") (i18nCell MsgSheetFileTypeHeader) $ \(_,_, E.Value ftype) ->
|
||||
let link = CSheetR tid ssh csh shn $ SZipR ftype in
|
||||
@ -59,7 +68,7 @@ getSShowR tid ssh csh shn = do
|
||||
& forceFilter "may-access" (Any True)
|
||||
(Any hasFiles, fileTable) <- runDB $ dbTable psValidator DBTable
|
||||
{ dbtSQLQuery = fileData
|
||||
, dbtRowKey = (E.^. SheetFileId)
|
||||
, dbtRowKey = \(sheetFile `E.FullOuterJoin` psFile) -> (sheetFile E.?. SheetFileId, psFile E.?. PersonalisedSheetFileId)
|
||||
, dbtColonnade = colonnadeFiles
|
||||
, dbtProj = return . dbrOutput :: DBRow _ -> DB (E.Value FilePath, E.Value UTCTime, E.Value SheetFileType)
|
||||
, dbtStyle = def
|
||||
@ -72,16 +81,16 @@ getSShowR tid ssh csh shn = do
|
||||
, dbtIdent = "files" :: Text
|
||||
, dbtSorting = Map.fromList
|
||||
[ ( "type"
|
||||
, SortColumn $ \sheetFile -> E.orderByEnum $ sheetFile E.^. SheetFileType
|
||||
, SortColumn $ \(sheetFile `E.FullOuterJoin` psFile) -> E.orderByEnum $ E.unsafeCoalesce [sheetFile E.?. SheetFileType, psFile E.?. PersonalisedSheetFileType]
|
||||
)
|
||||
, ( "path"
|
||||
, SortColumn $ \sheetFile -> sheetFile E.^. SheetFileTitle
|
||||
, SortColumn $ \(sheetFile `E.FullOuterJoin` psFile) -> E.unsafeCoalesce [sheetFile E.?. SheetFileTitle, psFile E.?. PersonalisedSheetFileTitle]
|
||||
)
|
||||
-- , ( "visible"
|
||||
-- , SortColumn $ \(sheetFile `E.InnerJoin` _file) -> sheetFileTypeDates sheet $ sheetFile E.^. SheetFileType -- not possible without another join for the sheet
|
||||
-- )
|
||||
, ( "time"
|
||||
, SortColumn $ \sheetFile -> sheetFile E.^. SheetFileModified
|
||||
, SortColumn $ \(sheetFile `E.FullOuterJoin` psFile) -> E.unsafeCoalesce [sheetFile E.?. SheetFileModified, psFile E.?. PersonalisedSheetFileModified]
|
||||
)
|
||||
]
|
||||
, dbtParams = def
|
||||
@ -89,8 +98,12 @@ getSShowR tid ssh csh shn = do
|
||||
, dbtCsvDecode = Nothing
|
||||
}
|
||||
(hasHints, hasSolution) <- runDB $ do
|
||||
hasHints <- (/= 0) <$> count [ SheetFileSheet ==. sid, SheetFileType ==. SheetHint ]
|
||||
hasSolution <- (/= 0) <$> count [ SheetFileSheet ==. sid, SheetFileType ==. SheetSolution ]
|
||||
hasHints <- E.selectExists . E.from $ \sheet' ->
|
||||
E.where_ $ hasSheetFileQuery sheet' (E.val muid) SheetHint
|
||||
E.&&. sheet' E.^. SheetId E.==. E.val sid
|
||||
hasSolution <- E.selectExists . E.from $ \sheet' ->
|
||||
E.where_ $ hasSheetFileQuery sheet' (E.val muid) SheetSolution
|
||||
E.&&. sheet' E.^. SheetId E.==. E.val sid
|
||||
return (hasHints, hasSolution)
|
||||
mPseudonym <- runMaybeT $ do
|
||||
uid <- MaybeT maybeAuthId
|
||||
@ -116,6 +129,15 @@ getSShowR tid ssh csh shn = do
|
||||
uid <- MaybeT maybeAuthId
|
||||
lift . fmap not . runDB $ exists [ ExamRegistrationExam ==. eId, ExamRegistrationUser ==. uid ]
|
||||
|
||||
let checkPersonalisedFiles
|
||||
= not (sheetAllowNonPersonalisedSubmission sheet)
|
||||
&& NTop (sheetActiveFrom sheet) <= NTop (Just now)
|
||||
&& NTop (sheetActiveTo sheet) >= NTop (Just now)
|
||||
mMissingPersonalisedFiles <- for (guardOnM checkPersonalisedFiles muid) $ \uid -> runDB $
|
||||
fmap not . E.selectExists . E.from $ \psFile ->
|
||||
E.where_ $ psFile E.^. PersonalisedSheetFileUser E.==. E.val uid
|
||||
E.&&. psFile E.^. PersonalisedSheetFileSheet E.==. E.val sid
|
||||
|
||||
defaultLayout $ do
|
||||
setTitleI $ prependCourseTitle tid ssh csh $ SomeMessage shn
|
||||
let zipLink = CSheetR tid ssh csh shn SArchiveR
|
||||
|
||||
@ -417,10 +417,10 @@ colFileModificationWhen condition row2time = sortable (Just "time") (i18nCell Ms
|
||||
where conDTCell = ifCell condition dateTimeCell $ const mempty
|
||||
|
||||
|
||||
sortFilePath :: (HasFileReference record, IsString s) => (t -> E.SqlExpr (Entity record)) -> (s, SortColumn t r')
|
||||
sortFilePath :: (IsFileReference record, IsString s) => (t -> E.SqlExpr (Entity record)) -> (s, SortColumn t r')
|
||||
sortFilePath queryPath = ("path", SortColumn $ queryPath >>> (E.^. fileReferenceTitleField))
|
||||
|
||||
sortFileModification :: (HasFileReference record, IsString s) => (t -> E.SqlExpr (Entity record)) -> (s, SortColumn t r')
|
||||
sortFileModification :: (IsFileReference record, IsString s) => (t -> E.SqlExpr (Entity record)) -> (s, SortColumn t r')
|
||||
sortFileModification queryModification = ("time", SortColumn $ queryModification >>> (E.^. fileReferenceModifiedField))
|
||||
|
||||
defaultSortingByFileTitle :: PSValidator m x -> PSValidator m x
|
||||
|
||||
@ -78,6 +78,7 @@ instance HasFileReference CourseApplicationFile where
|
||||
}
|
||||
)
|
||||
|
||||
instance IsFileReference CourseApplicationFile where
|
||||
fileReferenceTitleField = CourseApplicationFileTitle
|
||||
fileReferenceContentField = CourseApplicationFileContent
|
||||
fileReferenceModifiedField = CourseApplicationFileModified
|
||||
@ -106,6 +107,7 @@ instance HasFileReference CourseAppInstructionFile where
|
||||
}
|
||||
)
|
||||
|
||||
instance IsFileReference CourseAppInstructionFile where
|
||||
fileReferenceTitleField = CourseAppInstructionFileTitle
|
||||
fileReferenceContentField = CourseAppInstructionFileContent
|
||||
fileReferenceModifiedField = CourseAppInstructionFileModified
|
||||
@ -139,6 +141,7 @@ instance HasFileReference SheetFile where
|
||||
}
|
||||
)
|
||||
|
||||
instance IsFileReference SheetFile where
|
||||
fileReferenceTitleField = SheetFileTitle
|
||||
fileReferenceContentField = SheetFileContent
|
||||
fileReferenceModifiedField = SheetFileModified
|
||||
@ -175,6 +178,7 @@ instance HasFileReference PersonalisedSheetFile where
|
||||
}
|
||||
)
|
||||
|
||||
instance IsFileReference PersonalisedSheetFile where
|
||||
fileReferenceTitleField = PersonalisedSheetFileTitle
|
||||
fileReferenceContentField = PersonalisedSheetFileContent
|
||||
fileReferenceModifiedField = PersonalisedSheetFileModified
|
||||
@ -211,6 +215,7 @@ instance HasFileReference SubmissionFile where
|
||||
}
|
||||
)
|
||||
|
||||
instance IsFileReference SubmissionFile where
|
||||
fileReferenceTitleField = SubmissionFileTitle
|
||||
fileReferenceContentField = SubmissionFileContent
|
||||
fileReferenceModifiedField = SubmissionFileModified
|
||||
@ -239,6 +244,7 @@ instance HasFileReference CourseNewsFile where
|
||||
}
|
||||
)
|
||||
|
||||
instance IsFileReference CourseNewsFile where
|
||||
fileReferenceTitleField = CourseNewsFileTitle
|
||||
fileReferenceContentField = CourseNewsFileContent
|
||||
fileReferenceModifiedField = CourseNewsFileModified
|
||||
@ -269,6 +275,7 @@ instance HasFileReference MaterialFile where
|
||||
}
|
||||
)
|
||||
|
||||
instance IsFileReference MaterialFile where
|
||||
fileReferenceTitleField = MaterialFileTitle
|
||||
fileReferenceContentField = MaterialFileContent
|
||||
fileReferenceModifiedField = MaterialFileModified
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
module Model.Types.File
|
||||
( File(..), _fileTitle, _fileContent, _fileModified
|
||||
, FileReference(..), _fileReferenceTitle, _fileReferenceContent, _fileReferenceModified
|
||||
, HasFileReference(..)
|
||||
, HasFileReference(..), IsFileReference(..), FileReferenceResidual(..)
|
||||
) where
|
||||
|
||||
import Import.NoModel
|
||||
@ -27,11 +27,34 @@ data FileReference = FileReference
|
||||
makeLenses_ ''FileReference
|
||||
|
||||
|
||||
class PersistEntity record => HasFileReference record where
|
||||
class HasFileReference record where
|
||||
data FileReferenceResidual record :: *
|
||||
|
||||
_FileReference :: Iso' record (FileReference, FileReferenceResidual record)
|
||||
|
||||
instance HasFileReference FileReference where
|
||||
data FileReferenceResidual FileReference = FileReferenceResidual
|
||||
_FileReference = iso (, FileReferenceResidual) $ view _1
|
||||
|
||||
instance (HasFileReference a, HasFileReference b) => HasFileReference (Either a b) where
|
||||
newtype FileReferenceResidual (Either a b) = FileReferenceResidualEither { unFileReferenceResidualEither :: Either (FileReferenceResidual a) (FileReferenceResidual b) }
|
||||
_FileReference = iso doSplit doJoin
|
||||
where doSplit (Right r) = over _2 (FileReferenceResidualEither . Right) $ r ^. _FileReference
|
||||
doSplit (Left r) = over _2 (FileReferenceResidualEither . Left ) $ r ^. _FileReference
|
||||
doJoin (fRef, FileReferenceResidualEither (Right res)) = Right $ _FileReference # (fRef, res)
|
||||
doJoin (fRef, FileReferenceResidualEither (Left res)) = Left $ _FileReference # (fRef, res)
|
||||
|
||||
instance HasFileReference record => HasFileReference (Entity record) where
|
||||
data FileReferenceResidual (Entity record) = FileReferenceResidualEntity
|
||||
{ fileReferenceResidualEntityKey :: Key record
|
||||
, fileReferenceResidualEntityResidual :: FileReferenceResidual record
|
||||
}
|
||||
_FileReference = iso doSplit doJoin
|
||||
where doSplit Entity{..} = (fRef, FileReferenceResidualEntity entityKey res)
|
||||
where (fRef, res) = entityVal ^. _FileReference
|
||||
doJoin (fRef, FileReferenceResidualEntity entityKey res) = Entity{ entityVal = _FileReference # (fRef, res), .. }
|
||||
|
||||
class (PersistEntity record, HasFileReference record) => IsFileReference record where
|
||||
fileReferenceTitleField :: EntityField record FilePath
|
||||
fileReferenceContentField :: EntityField record (Maybe FileContentReference)
|
||||
fileReferenceModifiedField :: EntityField record UTCTime
|
||||
|
||||
@ -68,6 +68,7 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä
|
||||
| AuthAllocationTime
|
||||
| AuthMaterials
|
||||
| AuthOwner
|
||||
| AuthPersonalisedSheetFiles
|
||||
| AuthRated
|
||||
| AuthUserSubmissions
|
||||
| AuthCorrectorSubmissions
|
||||
|
||||
@ -81,7 +81,7 @@ sinkFile' file residual = do
|
||||
type FileUploads = ConduitT () FileReference (HandlerFor UniWorX) ()
|
||||
|
||||
replaceFileReferences' :: ( MonadIO m, MonadThrow m
|
||||
, HasFileReference record
|
||||
, IsFileReference record
|
||||
, PersistEntityBackend record ~ SqlBackend
|
||||
)
|
||||
=> (FileReferenceResidual record -> [Filter record])
|
||||
@ -116,7 +116,7 @@ replaceFileReferences' mkFilter residual = do
|
||||
|
||||
replaceFileReferences :: ( MonadHandler m, MonadThrow m
|
||||
, HandlerSite m ~ UniWorX
|
||||
, HasFileReference record
|
||||
, IsFileReference record
|
||||
, PersistEntityBackend record ~ SqlBackend
|
||||
)
|
||||
=> (FileReferenceResidual record -> [Filter record])
|
||||
|
||||
@ -85,6 +85,7 @@ data Icon
|
||||
| IconMissingAllocationPriority
|
||||
| IconFileUploadSession
|
||||
| IconStandaloneFieldError
|
||||
| IconFileUser
|
||||
deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable)
|
||||
|
||||
iconText :: Icon -> Text
|
||||
@ -148,6 +149,7 @@ iconText = \case
|
||||
IconMissingAllocationPriority -> "empty-set"
|
||||
IconFileUploadSession -> "file-upload"
|
||||
IconStandaloneFieldError -> "exclamation"
|
||||
IconFileUser -> "file-user"
|
||||
|
||||
instance Universe Icon
|
||||
instance Finite Icon
|
||||
|
||||
@ -4,6 +4,8 @@ import Import.NoFoundation
|
||||
import qualified Database.Esqueleto as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
import qualified Data.Conduit.Combinators as C
|
||||
|
||||
-- DB Queries for Sheets that are used in several places
|
||||
|
||||
sheetCurrent :: MonadIO m => TermId -> SchoolId -> CourseShorthand -> SqlReadT m (Maybe SheetName)
|
||||
@ -46,60 +48,91 @@ sheetOldUnassigned tid ssh csh = do
|
||||
_ -> error "SQL Query with limit 1 returned more than one result"
|
||||
|
||||
-- | Return a specfic file from a `Sheet`
|
||||
sheetFileQuery :: MonadResource m => TermId -> SchoolId -> CourseShorthand -> SheetName -> SheetFileType -> FilePath -> ConduitT () (Entity SheetFile) (SqlPersistT m) ()
|
||||
sheetFileQuery tid ssh csh shn sft title = E.selectSource $ E.from $
|
||||
\(course `E.InnerJoin` sheet `E.InnerJoin` sFile) -> do
|
||||
-- Restrict to consistent rows that correspond to each other
|
||||
E.on (sFile E.^. SheetFileSheet E.==. sheet E.^. SheetId)
|
||||
E.on (sheet E.^. SheetCourse E.==. course E.^. CourseId)
|
||||
-- filter to requested file
|
||||
E.where_ ((sFile E.^. SheetFileTitle E.==. E.val title)
|
||||
E.&&. (sFile E.^. SheetFileType E.==. E.val sft )
|
||||
E.&&. (sheet E.^. SheetName E.==. E.val shn )
|
||||
E.&&. (course E.^. CourseShorthand E.==. E.val csh )
|
||||
E.&&. (course E.^. CourseSchool E.==. E.val ssh )
|
||||
E.&&. (course E.^. CourseTerm E.==. E.val tid )
|
||||
)
|
||||
-- return file entity
|
||||
return sFile
|
||||
sheetFileQuery :: MonadResource m => TermId -> SchoolId -> CourseShorthand -> SheetName -> Maybe UserId -> SheetFileType -> FilePath -> ConduitT () (Either (Entity SheetFile) (Entity PersonalisedSheetFile)) (SqlPersistT m) ()
|
||||
sheetFileQuery tid ssh csh shn muid sft title = sqlSelect .| C.map toEither
|
||||
where
|
||||
sqlSelect = E.selectSource . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` (sFile `E.FullOuterJoin` psFile)) -> do
|
||||
-- Restrict to consistent rows that correspond to each other
|
||||
E.on $ psFile E.?. PersonalisedSheetFileType E.==. sFile E.?. SheetFileType
|
||||
E.&&. psFile E.?. PersonalisedSheetFileTitle E.==. sFile E.?. SheetFileTitle
|
||||
E.&&. psFile E.?. PersonalisedSheetFileSheet E.==. sFile E.?. SheetFileSheet
|
||||
E.&&. psFile E.?. PersonalisedSheetFileUser E.==. E.val muid
|
||||
E.on $ sFile E.?. SheetFileSheet E.==. E.just (sheet E.^. SheetId)
|
||||
E.||. psFile E.?. PersonalisedSheetFileSheet E.==. E.just (sheet E.^. SheetId)
|
||||
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
|
||||
-- filter to requested file
|
||||
E.where_ $ (sFile E.?. SheetFileTitle E.==. E.justVal title E.||. psFile E.?. PersonalisedSheetFileTitle E.==. E.justVal title)
|
||||
E.&&. (sFile E.?. SheetFileType E.==. E.justVal sft E.||. psFile E.?. PersonalisedSheetFileType E.==. E.justVal sft)
|
||||
E.&&. sheet E.^. SheetName E.==. E.val shn
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. E.maybe E.true (\psfUser -> E.just psfUser E.==. E.val muid) (psFile E.?. PersonalisedSheetFileUser)
|
||||
-- return file entity
|
||||
return (sFile, psFile)
|
||||
toEither (_, Just psFile) = Right psFile
|
||||
toEither (Just sFile, _) = Left sFile
|
||||
toEither _ = error "sqlSelect returned incoherent result"
|
||||
|
||||
-- | Return all files of a certain `SheetFileType` for a `Sheet`
|
||||
sheetFilesAllQuery :: MonadResource m => TermId -> SchoolId -> CourseShorthand -> SheetName -> SheetFileType -> ConduitT () (Entity SheetFile) (SqlPersistT m) ()
|
||||
sheetFilesAllQuery tid ssh csh shn sft = E.selectSource $ E.from $
|
||||
\(course `E.InnerJoin` sheet `E.InnerJoin` sFile) -> do
|
||||
-- Restrict to consistent rows that correspond to each other
|
||||
E.on (sFile E.^. SheetFileSheet E.==. sheet E.^. SheetId)
|
||||
E.on (sheet E.^. SheetCourse E.==. course E.^. CourseId)
|
||||
-- filter to requested file
|
||||
E.where_ ((sheet E.^. SheetName E.==. E.val shn )
|
||||
E.&&. (course E.^. CourseShorthand E.==. E.val csh )
|
||||
E.&&. (course E.^. CourseSchool E.==. E.val ssh )
|
||||
E.&&. (course E.^. CourseTerm E.==. E.val tid )
|
||||
E.&&. (sFile E.^. SheetFileType E.==. E.val sft )
|
||||
)
|
||||
-- return file entity
|
||||
return sFile
|
||||
sheetFilesAllQuery :: MonadResource m => TermId -> SchoolId -> CourseShorthand -> SheetName -> Maybe UserId -> SheetFileType -> ConduitT () (Either (Entity SheetFile) (Entity PersonalisedSheetFile)) (SqlPersistT m) ()
|
||||
sheetFilesAllQuery tid ssh csh shn muid sft = sqlSelect .| C.map toEither
|
||||
where
|
||||
sqlSelect = E.selectSource . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` (sFile `E.FullOuterJoin` psFile)) -> do
|
||||
-- Restrict to consistent rows that correspond to each other
|
||||
E.on $ psFile E.?. PersonalisedSheetFileType E.==. sFile E.?. SheetFileType
|
||||
E.&&. psFile E.?. PersonalisedSheetFileTitle E.==. sFile E.?. SheetFileTitle
|
||||
E.&&. psFile E.?. PersonalisedSheetFileSheet E.==. sFile E.?. SheetFileSheet
|
||||
E.&&. psFile E.?. PersonalisedSheetFileUser E.==. E.val muid
|
||||
E.on $ sFile E.?. SheetFileSheet E.==. E.just (sheet E.^. SheetId)
|
||||
E.||. psFile E.?. PersonalisedSheetFileSheet E.==. E.just (sheet E.^. SheetId)
|
||||
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
|
||||
-- filter to requested file
|
||||
E.where_ $ (sFile E.?. SheetFileType E.==. E.justVal sft E.||. psFile E.?. PersonalisedSheetFileType E.==. E.justVal sft)
|
||||
E.&&. sheet E.^. SheetName E.==. E.val shn
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. E.maybe E.true (\psfUser -> E.just psfUser E.==. E.val muid) (psFile E.?. PersonalisedSheetFileUser)
|
||||
-- return file entity
|
||||
return (sFile, psFile)
|
||||
toEither (_, Just psFile) = Right psFile
|
||||
toEither (Just sFile, _) = Left sFile
|
||||
toEither _ = error "sqlSelect returned incoherent result"
|
||||
|
||||
-- | Return all files of certain `SheetFileTypes` for a `Sheet`
|
||||
sheetFilesSFTsQuery :: MonadResource m => TermId -> SchoolId -> CourseShorthand -> SheetName -> [SheetFileType] -> ConduitT () (Entity SheetFile) (SqlPersistT m) ()
|
||||
sheetFilesSFTsQuery tid ssh csh shn sfts = E.selectSource $ E.from $
|
||||
\(course `E.InnerJoin` sheet `E.InnerJoin` sFile) -> do
|
||||
-- Restrict to consistent rows that correspond to each other
|
||||
E.on (sFile E.^. SheetFileSheet E.==. sheet E.^. SheetId)
|
||||
E.on (sheet E.^. SheetCourse E.==. course E.^. CourseId)
|
||||
-- filter to requested file
|
||||
E.where_ ((sheet E.^. SheetName E.==. E.val shn )
|
||||
E.&&. (course E.^. CourseShorthand E.==. E.val csh )
|
||||
E.&&. (course E.^. CourseSchool E.==. E.val ssh )
|
||||
E.&&. (course E.^. CourseTerm E.==. E.val tid )
|
||||
E.&&. (sFile E.^. SheetFileType `E.in_` E.valList sfts )
|
||||
)
|
||||
-- return file entity
|
||||
return sFile
|
||||
sheetFilesSFTsQuery :: MonadResource m => TermId -> SchoolId -> CourseShorthand -> SheetName -> Maybe UserId -> [SheetFileType] -> ConduitT () (Either (Entity SheetFile) (Entity PersonalisedSheetFile)) (SqlPersistT m) ()
|
||||
sheetFilesSFTsQuery tid ssh csh shn muid sfts = sqlSelect .| C.map toEither
|
||||
where
|
||||
sqlSelect = E.selectSource . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` (sFile `E.FullOuterJoin` psFile)) -> do
|
||||
-- Restrict to consistent rows that correspond to each other
|
||||
E.on $ psFile E.?. PersonalisedSheetFileType E.==. sFile E.?. SheetFileType
|
||||
E.&&. psFile E.?. PersonalisedSheetFileTitle E.==. sFile E.?. SheetFileTitle
|
||||
E.&&. psFile E.?. PersonalisedSheetFileSheet E.==. sFile E.?. SheetFileSheet
|
||||
E.&&. psFile E.?. PersonalisedSheetFileUser E.==. E.val muid
|
||||
E.on $ sFile E.?. SheetFileSheet E.==. E.just (sheet E.^. SheetId)
|
||||
E.||. psFile E.?. PersonalisedSheetFileSheet E.==. E.just (sheet E.^. SheetId)
|
||||
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
|
||||
-- filter to requested file
|
||||
E.where_ $ (sFile E.?. SheetFileType `E.in_` E.justValList sfts E.||. psFile E.?. PersonalisedSheetFileType `E.in_` E.justValList sfts)
|
||||
E.&&. sheet E.^. SheetName E.==. E.val shn
|
||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. E.maybe E.true (\psfUser -> E.just psfUser E.==. E.val muid) (psFile E.?. PersonalisedSheetFileUser)
|
||||
-- return file entity
|
||||
return (sFile, psFile)
|
||||
toEither (_, Just psFile) = Right psFile
|
||||
toEither (Just sFile, _) = Left sFile
|
||||
toEither _ = error "sqlSelect returned incoherent result"
|
||||
|
||||
-- | Check whether a sheet has any files for a given file type
|
||||
hasSheetFileQuery :: E.SqlExpr (Entity Sheet) -> SheetFileType -> E.SqlExpr (E.Value Bool)
|
||||
hasSheetFileQuery sheet sft =
|
||||
E.exists $ E.from $ \sFile ->
|
||||
E.where_ ((sFile E.^. SheetFileSheet E.==. sheet E.^. SheetId)
|
||||
E.&&. (sFile E.^. SheetFileType E.==. E.val sft ))
|
||||
hasSheetFileQuery :: E.SqlExpr (Entity Sheet) -> E.SqlExpr (E.Value (Maybe UserId)) -> SheetFileType -> E.SqlExpr (E.Value Bool)
|
||||
hasSheetFileQuery sheet muid sft = sheetFile E.||. personalisedSheetFile
|
||||
where sheetFile = E.exists . E.from $ \sFile ->
|
||||
E.where_ $ sFile E.^. SheetFileSheet E.==. sheet E.^. SheetId
|
||||
E.&&. sFile E.^. SheetFileType E.==. E.val sft
|
||||
personalisedSheetFile = E.exists . E.from $ \psFile ->
|
||||
E.where_ $ psFile E.^. PersonalisedSheetFileSheet E.==. sheet E.^. SheetId
|
||||
E.&&. psFile E.^. PersonalisedSheetFileType E.==. E.val sft
|
||||
E.&&. E.just (psFile E.^. PersonalisedSheetFileUser) E.==. muid
|
||||
|
||||
@ -71,10 +71,14 @@ $maybe marktxt <- markingText
|
||||
<p>
|
||||
#{marktxt}
|
||||
|
||||
$if fromMaybe False mMissingPersonalisedFiles
|
||||
<section>
|
||||
^{notificationWidget NotificationBroad Warning (i18n MsgSheetFilesMissingPersonalisedFiles)}
|
||||
$elseif fromMaybe False mMissingExamRegistration
|
||||
<section>
|
||||
^{notificationWidget NotificationBroad Warning (i18n MsgSheetFilesExamRegistrationRequired)}
|
||||
|
||||
$if hasFiles
|
||||
<section>
|
||||
<h2>^{simpleLinkI (SomeMessage MsgSheetFiles) zipLink}
|
||||
^{fileTable}
|
||||
$elseif fromMaybe False mMissingExamRegistration
|
||||
<section>
|
||||
^{notificationWidget NotificationBroad Warning (i18n MsgSheetFilesExamRegistrationRequired)}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user