fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor(sheets): prepare for sheet-scoped statements

Browse Source
This commit is contained in:
Sarah Vaupel 2021-06-09 14:09:40 +02:00 committed by Gregor Kleen
parent 1d8a2cef60
commit 6e7e8a2b20
6 changed files with 90 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
models/sheets.model
View File

@ -15,7 +15,7 @@ Sheet -- exercise sheet for a given course
anonymousCorrection Bool default=true
requireExamRegistration ExamId Maybe -- Students may only submit if they are registered for the given exam
allowNonPersonalisedSubmission Bool default=true
authorshipStatement AuthorshipStatementDefinitionId Maybe
-- authorshipStatement AuthorshipStatementDefinitionId Maybe -- TODO: sheet-specific authorship statement; for exam-unrelated sheets and for exam setting overrides
CourseSheet course name
deriving Generic
SheetEdit -- who edited when a row in table "Course", kept indefinitely
@ -65,4 +65,4 @@ FallbackPersonalisedSheetFilesKey
secret ByteString
generated UTCTime
UniqueFallbackPersonalisedSheetFilesKey course index
deriving Generic
deriving Generic

51
src/Handler/Sheet/Edit.hs
View File

@ -22,15 +22,20 @@ import Handler.Sheet.PersonalisedFiles
getSEditR, postSEditR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
getSEditR = postSEditR
postSEditR tid ssh csh shn = do
(Entity sid Sheet{..}, sheetFileIds, currentLoads, hasPersonalisedFiles, mAuthorshipStatement) <- runDB $ do
ent@(Entity sid Sheet{..}) <- fetchSheet tid ssh csh shn
(Entity sid Sheet{..}, sheetFileIds, currentLoads, hasPersonalisedFiles) <- runDB $ do
ent@(Entity sid _) <- fetchSheet tid ssh csh shn
fti <- getFtIdMap $ entityKey ent
cLoads <- Map.union
<$> fmap (foldMap $ \(Entity _ SheetCorrector{..}) -> Map.singleton (Right sheetCorrectorUser) (InvDBDataSheetCorrector sheetCorrectorLoad sheetCorrectorState, InvTokenDataSheetCorrector)) (selectList [ SheetCorrectorSheet ==. sid ] [])
<*> fmap (fmap (, InvTokenDataSheetCorrector) . Map.mapKeysMonotonic Left) (sourceInvitationsF sid)
hasPersonalisedFiles <- exists [ PersonalisedSheetFileSheet ==. sid ]
mAuthorshipStatement <- maybe (pure Nothing) get sheetAuthorshipStatement
return (ent, fti, cLoads, hasPersonalisedFiles, mAuthorshipStatement)
-- TODO: update statement if school authorship statement was updated?
-- mSchoolAuthorshipStatement <- runMaybeT $ do
-- Entity _ School{..} <- MaybeT . getEntity $ ssh
-- definitionId <- MaybeT . return $ schoolSheetAuthorshipStatementDefinition
-- MaybeT . getEntity $ definitionId
-- mAuthorshipStatement <- maybe (pure Nothing) getEntity sheetAuthorshipStatement
return (ent, fti, cLoads, hasPersonalisedFiles)
let template = Just $ SheetForm
{ sfName = sheetName
, sfDescription = sheetDescription
@ -56,7 +61,6 @@ postSEditR tid ssh csh shn = do
, spffAllowNonPersonalisedSubmission = sheetAllowNonPersonalisedSubmission
, spffFiles = Nothing
}
, sfAuthorshipStatement = authorshipStatementDefinitionContent <$> mAuthorshipStatement
}
let action = uniqueReplace sid -- More specific error message for edit old sheet could go here by using myReplaceUnique instead
@ -73,18 +77,29 @@ handleSheetEdit tid ssh csh msId template dbAction = do
saveOkay <- runDBJobs $ do
actTime <- liftIO getCurrentTime
let insertNewOrKeepStatement mNewStatement = do
mOldAuthorshipStatement <- runMaybeT $ do
sId <- MaybeT . return $ msId
Entity _ Sheet{..} <- MaybeT $ getEntity sId
statementId <- MaybeT . return $ sheetAuthorshipStatement
MaybeT $ getEntity statementId
if
| Just newDef@(AuthorshipStatementDefinition newContent) <- mNewStatement
, maybe True ((/=) newContent . authorshipStatementDefinitionContent . entityVal) mOldAuthorshipStatement
-> Just <$> (insert newDef)
| otherwise -> return $ entityKey <$> mOldAuthorshipStatement
mNewAuthorshipStatementId <- insertNewOrKeepStatement $ AuthorshipStatementDefinition <$> sfAuthorshipStatement
-- let insertNewOrKeepStatement = \case
-- -- statement disabled:
-- Nothing -> pure Nothing
-- -- use school preset (i.e. return the id of a *copy*):
-- Just Nothing -> runMaybeT $ do
-- Entity _ School{..} <- MaybeT . getEntity $ ssh
-- schoolStatementId <- MaybeT . return $ schoolSheetAuthorshipStatementDefinition
-- Entity _ AuthorshipStatementDefinition{..} <- MaybeT . getEntity $ schoolStatementId
-- lift . insert $ AuthorshipStatementDefinition authorshipStatementDefinitionContent
-- -- use custom statement:
-- Just (Just newContent) -> do
-- mOldAuthorshipStatement <- runMaybeT $ do
-- sId <- MaybeT . return $ msId
-- Entity _ Sheet{..} <- MaybeT . getEntity $ sId
-- statementId <- MaybeT . return $ sheetAuthorshipStatement
-- MaybeT . getEntity $ statementId
-- if
-- -- statement modified: insert new statement
-- | maybe True ((/=) newContent . authorshipStatementDefinitionContent . entityVal) mOldAuthorshipStatement
-- -> Just <$> (insert $ AuthorshipStatementDefinition newContent)
-- -- statement not modified: return id of old statement
-- | otherwise -> return $ entityKey <$> mOldAuthorshipStatement
-- mNewAuthorshipStatementId <- insertNewOrKeepStatement sfAuthorshipStatement
let newSheet = Sheet
{ sheetCourse = cid
@ -103,7 +118,7 @@ handleSheetEdit tid ssh csh msId template dbAction = do
, sheetAnonymousCorrection = sfAnonymousCorrection
, sheetRequireExamRegistration = sfRequireExamRegistration
, sheetAllowNonPersonalisedSubmission = maybe True spffAllowNonPersonalisedSubmission sfPersonalF
, sheetAuthorshipStatement = mNewAuthorshipStatementId
-- , sheetAuthorshipStatement = Nothing -- TODO: implement sheet-specific statements
}
mbsid <- dbAction newSheet
case mbsid of

53
src/Handler/Sheet/Form.hs
View File

@ -42,7 +42,7 @@ data SheetForm = SheetForm
, sfMarkingText :: Maybe StoredMarkup
, sfAnonymousCorrection :: Bool
, sfCorrectors :: Loads
, sfAuthorshipStatement :: Maybe StoredMarkup
-- , sfAuthorshipStatement :: Maybe (Either AuthorshipStatementDefinitionId StoredMarkup) -- TODO: exam-unrelated statement, override for exam setting
}
data SheetPersonalisedFilesForm = SheetPersonalisedFilesForm
@ -66,12 +66,14 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS
(Just sId) -> liftHandler $ runDB $ getFtIdMap sId
MsgRenderer mr <- getMsgRenderer
ctime <- ceilingQuarterHour <$> liftIO getCurrentTime
mSchoolAuthorshipStatement <- liftHandler . runDB . runMaybeT $ do
Entity _ Course{courseSchool} <- MaybeT . getEntity $ cId
Entity _ School{..} <- MaybeT . getEntity $ courseSchool
statementId <- MaybeT . return $ bool Nothing schoolSheetAuthorshipStatementDefinition (schoolSheetAuthorshipStatementMode /= SchoolAuthorshipStatementModeNone)
MaybeT . getEntity $ statementId
-- TODO: compare versions: school > msId if school statement is newer than msId statement, msId > school otherwise (TODO: add lastEdited to model)
-- TODO: use
((_school, _mSchoolAuthorshipStatement), _course) <- liftHandler . runDB $ do
course@Course{courseSchool} <- get404 cId
school@School{..} <- get404 courseSchool
mSchoolAuthorshipStatement <- runMaybeT $ do
statementId <- MaybeT . return $ schoolSheetAuthorshipStatementDefinition
MaybeT . getEntity $ statementId
return ((school, mSchoolAuthorshipStatement), course)
sheetPersonalisedFilesForm <- makeSheetPersonalisedFilesForm $ template >>= sfPersonalF
flip (renderAForm FormStandard) html $ SheetForm
<$> areq (textField & cfStrip & cfCI) (fslI MsgSheetName) (sfName <$> template)
@ -104,8 +106,37 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS
<*> aopt htmlField (fslI MsgSheetMarking) (sfMarkingText <$> template)
<*> apopt checkBoxField (fslI MsgSheetAnonymousCorrection & setTooltip MsgSheetAnonymousCorrectionTip) (sfAnonymousCorrection <$> template)
<*> correctorForm (maybe mempty sfCorrectors template)
<* aformSection MsgSheetAuthorshipStatement
<*> optionalActionA (apreq htmlField (fslI MsgSheetAuthorshipStatement) (join (sfAuthorshipStatement <$> template) <|> authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement)) (fslI MsgSheetAuthorshipStatementRequired & setTooltip MsgSheetAuthorshipStatementRequiredTip) ((is _Just . sfAuthorshipStatement <$> template) <|> (pure $ is _Just mSchoolAuthorshipStatement)) -- TODO: disable option and set accordingly if school mode prevents edits
-- <* aformSection MsgSheetAuthorshipStatementSection
-- TODO: add info: applies to exam-unrelated sheets only, will be overriden if sheet is related to an exam and this exam has an authorship statement
-- TODO: compare versions: school > msId if school statement is newer than msId statement, msId > school otherwise (TODO: add lastEdited to model)
-- <*> optionalActionA
-- ( optionalActionA
-- ( apreq htmlField
-- (fslI MsgSheetAuthorshipStatementCustom)
-- (join (join (sfAuthorshipStatement <$> template) <|> (Just . authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement)))
-- )
-- ( fslI MsgSheetAuthorshipStatementUseSchoolDefault
-- & setTooltip MsgSheetAuthorshipStatementUseSchoolDefaultTip
-- -- TODO: disable if school mode prevents custom statements
-- -- & addAttr "disabled" "disabled"
-- )
-- (
-- -- TODO: set accordingly if school mode prevents custom statements
-- pure $ is _Just mSchoolAuthorshipStatement
-- )
-- -- TODO: display current school statement
-- -- <* maybe (pure ()) (authorshipStatementDefinitionContent . entityVal) mSchoolAuthorshipStatement
-- )
-- ( fslI MsgSheetAuthorshipStatementRequired
-- & setTooltip MsgSheetAuthorshipStatementRequiredTip
-- -- TODO: disable if school mode enforces/disables statements for this sheet
-- -- & addAttr "disabled" "disabled"
-- )
-- (
-- -- TODO: set accordingly if school mode enforces/disables statements for this sheet
-- -- TODO: school statement > template iff the school statement is newer
-- (is _Just . sfAuthorshipStatement <$> template) <|> (pure $ is _Just mSchoolAuthorshipStatement)
-- )
where
makeSheetPersonalisedFilesForm :: Maybe SheetPersonalisedFilesForm -> MForm Handler (AForm Handler SheetPersonalisedFilesForm)
makeSheetPersonalisedFilesForm template' = do
@ -165,8 +196,8 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS
|| sfType == NotGraded
-- TODO: do authorship statement validation
-- TODO: if school mode is none or required for this sheet (exam-related/exam-umrelated?), statementRequired must be set accordingly
-- TODO: authorship statement definition must not be empty when statement is required
-- TODO: if school mode is none or required for this sheet (exam-related/exam-umrelated?), statement must be set accordingly (Just for required, Nothing for none)
-- TODO: if school prevents custom statements, statement must match current school statement
correctorForm :: Loads -> AForm Handler Loads
correctorForm loads' = wFormToAForm $ do

12
src/Handler/Sheet/New.hs
View File

@ -38,16 +38,16 @@ postSheetNewR tid ssh csh = do
firstEdit = E.subSelectMaybe . E.from $ \sheetEdit -> do
E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId
return . E.min_ $ sheetEdit E.^. SheetEditTime
mAuthorshipStatement = E.subSelect . E.from $ \authorshipStatementDefinition -> do
E.where_ $ E.just (authorshipStatementDefinition E.^. AuthorshipStatementDefinitionId) E.==. sheet E.^. SheetAuthorshipStatement
return $ authorshipStatementDefinition E.^. AuthorshipStatementDefinitionContent
return (sheet, firstEdit, mAuthorshipStatement)
-- mAuthorshipStatement = E.subSelect . E.from $ \authorshipStatementDefinition -> do
-- E.where_ $ E.just (authorshipStatementDefinition E.^. AuthorshipStatementDefinitionId) E.==. sheet E.^. SheetAuthorshipStatement
-- return $ authorshipStatementDefinition E.^. AuthorshipStatementDefinitionContent
return (sheet, firstEdit)
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
loads <- defaultLoads cid
return (lSheets, loads)
now <- liftIO getCurrentTime
let template = case lastSheets of
((Entity {entityVal=Sheet{..}}, E.Value fEdit, E.Value mAuthorshipStatement):_) ->
((Entity {entityVal=Sheet{..}}, E.Value fEdit):_) ->
let addTime = addWeeks $ max 1 $ weeksToAdd (fromMaybe (UTCTime systemEpochDay 0) $ sheetActiveTo <|> fEdit) now
in Just $ SheetForm
{ sfName = stepTextCounterCI sheetName
@ -70,7 +70,7 @@ postSheetNewR tid ssh csh = do
, sfAnonymousCorrection = sheetAnonymousCorrection
, sfRequireExamRegistration = Nothing
, sfPersonalF = Nothing
, sfAuthorshipStatement = mAuthorshipStatement
-- , sfAuthorshipStatement = mAuthorshipStatement
}
_other -> Nothing
let action = -- More specific error message for new sheet could go here, if insertUnique returns Nothing

4
src/Handler/Sheet/Show.hs
View File

@ -22,8 +22,8 @@ getSShowR tid ssh csh shn = do
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
mayEdit <- hasWriteAccessTo $ CSheetR tid ssh csh shn SEditR
maySubmit <- hasWriteAccessTo $ CSheetR tid ssh csh shn SubmissionNewR
-- mayEdit <- hasWriteAccessTo $ CSheetR tid ssh csh shn SEditR
-- maySubmit <- hasWriteAccessTo $ CSheetR tid ssh csh shn SubmissionNewR
let sftVisible :: IsDBTable m a => SheetFileType -> DBCell m a
sftVisible sft | Just dts <- sheetFileTypeDates sheet sft

10
templates/sheetShow.hamlet
View File

@ -70,11 +70,11 @@ $maybe descr <- sheetDescription sheet
_{MsgTableSheetType}
<dd .deflist__dd>
^{sTypeDesc tr}
$if mayEdit || maySubmit
<dt .deflist__dt>
_{MsgSheetAuthorshipStatementSection}
<dd .deflist__dd>
_{maybe MsgSheetAuthorshipStatementIsRequiredFalse (const MsgSheetAuthorshipStatementIsRequiredTrue) (sheetAuthorshipStatement sheet)}
$# $if mayEdit || maySubmit
$# <dt .deflist__dt>
$# _{MsgSheetAuthorshipStatementSection}
$# <dd .deflist__dd>
$# _{maybe MsgSheetAuthorshipStatementIsRequiredFalse (const MsgSheetAuthorshipStatementIsRequiredTrue) (sheetAuthorshipStatement sheet)}
$maybe marktxt <- markingText
<section>