From 541dd7688ffa36be8a968f26f920507ed5aae646 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Wed, 2 Jun 2021 23:16:02 +0200 Subject: [PATCH] feat(sheets): add required flag and definition --- .../categories/courses/sheet/de-de-formal.msg | 6 ++++- .../categories/courses/sheet/en-eu.msg | 6 ++++- models/sheets.model | 4 +-- src/Handler/Sheet/Edit.hs | 25 ++++++++++++++++--- src/Handler/Sheet/Form.hs | 10 +++++++- src/Handler/Sheet/New.hs | 16 ++++++++---- 6 files changed, 54 insertions(+), 13 deletions(-) diff --git a/messages/uniworx/categories/courses/sheet/de-de-formal.msg b/messages/uniworx/categories/courses/sheet/de-de-formal.msg index 4a19ad8df..26940c441 100644 --- a/messages/uniworx/categories/courses/sheet/de-de-formal.msg +++ b/messages/uniworx/categories/courses/sheet/de-de-formal.msg @@ -152,4 +152,8 @@ SheetGradingPassPoints maxPoints@Points passingPoints@Points: Bestanden ab #{pas SheetGradingPassBinary: Bestanden/Nicht Bestanden SheetGradingPassAlways: Automatisch bestanden, sobald korrigiert - +SheetAuthorshipStatement: Eigenständigkeitserklärung +SheetAuthorshipStatementRequired: Eigenständigkeitserklärung einfordern? +SheetAuthorshipStatementRequiredTip: Soll jeder Abgebender (bei Gruppenabgaben jedes Gruppenmitglied der Abgabegruppe) vor dem Anlegen einer Abgabe dazu aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren? +SheetAuthorshipStatementDefinition: Eigenständigkeitserklärung +SheetAuthorshipStatementDefinitionTip: Wird eine Eigenständigkeitserklärung eingefordert, so müssen Abgebende diesen Text akzeptieren (durch Setzen eines Hakens). diff --git a/messages/uniworx/categories/courses/sheet/en-eu.msg b/messages/uniworx/categories/courses/sheet/en-eu.msg index 461fc347d..45bb059c4 100644 --- a/messages/uniworx/categories/courses/sheet/en-eu.msg +++ b/messages/uniworx/categories/courses/sheet/en-eu.msg @@ -151,4 +151,8 @@ SheetGradingPassPoints maxPoints passingPoints: Pass with #{passingPoints} of #{ SheetGradingPassBinary: Pass/Fail SheetGradingPassAlways: Automatically passed when corrected - +SheetAuthorshipStatement: Statement of Authorship +SheetAuthorshipStatementRequired: Require Statement of Authorship for submissions? +SheetAuthorshipStatementRequiredTip: Should submittors (in case of group submissions every submission group member) be required to accept a Statement of Authorship upon creating a submission? +SheetAuthorshipStatementDefinition: Statement of Authorship +SheetAuthorshipStatementDefinitionTip: If a Statement of Authorship is required, submittors are required to accept this statement (by ticking a checkbox). diff --git a/models/sheets.model b/models/sheets.model index c4f622f84..20e3d8912 100644 --- a/models/sheets.model +++ b/models/sheets.model @@ -15,8 +15,8 @@ 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 --- authorshipStatementRequired Bool default=false --- authorshipStatementDefinition AuthorshipStatementDefinitionId Maybe + authorshipStatementRequired Bool default=false + authorshipStatementDefinition AuthorshipStatementDefinitionId Maybe CourseSheet course name deriving Generic SheetEdit -- who edited when a row in table "Course", kept indefinitely diff --git a/src/Handler/Sheet/Edit.hs b/src/Handler/Sheet/Edit.hs index 5ac173421..3f4df896d 100644 --- a/src/Handler/Sheet/Edit.hs +++ b/src/Handler/Sheet/Edit.hs @@ -22,14 +22,15 @@ 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) <- runDB $ do - ent@(Entity sid _) <- fetchSheet tid ssh csh shn + (Entity sid Sheet{..}, sheetFileIds, currentLoads, hasPersonalisedFiles, mAuthorshipStatement) <- runDB $ do + ent@(Entity sid Sheet{..}) <- 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 ] - return (ent, fti, cLoads, hasPersonalisedFiles) + mAuthorshipStatement <- maybe (pure Nothing) get sheetAuthorshipStatementDefinition + return (ent, fti, cLoads, hasPersonalisedFiles, mAuthorshipStatement) let template = Just $ SheetForm { sfName = sheetName , sfDescription = sheetDescription @@ -55,6 +56,8 @@ postSEditR tid ssh csh shn = do , spffAllowNonPersonalisedSubmission = sheetAllowNonPersonalisedSubmission , spffFiles = Nothing } + , sfAuthorshipStatementRequired = sheetAuthorshipStatementRequired + , sfAuthorshipStatementDefinition = authorshipStatementDefinitionContent <$> mAuthorshipStatement } let action = uniqueReplace sid -- More specific error message for edit old sheet could go here by using myReplaceUnique instead @@ -70,6 +73,20 @@ handleSheetEdit tid ssh csh msId template dbAction = do (FormSuccess SheetForm{..}) -> 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 $ sheetAuthorshipStatementDefinition + MaybeT $ getEntity statementId + if + | Just newDef@(AuthorshipStatementDefinition newContent) <- mNewStatement + , maybe True ((/=) newContent . authorshipStatementDefinitionContent . entityVal) mOldAuthorshipStatement + -> Just <$> (insert newDef) + | otherwise -> return $ entityKey <$> mOldAuthorshipStatement + mNewAuthorshipStatementId <- insertNewOrKeepStatement $ bool Nothing (AuthorshipStatementDefinition <$> sfAuthorshipStatementDefinition) sfAuthorshipStatementRequired + let newSheet = Sheet { sheetCourse = cid , sheetName = sfName @@ -87,6 +104,8 @@ handleSheetEdit tid ssh csh msId template dbAction = do , sheetAnonymousCorrection = sfAnonymousCorrection , sheetRequireExamRegistration = sfRequireExamRegistration , sheetAllowNonPersonalisedSubmission = maybe True spffAllowNonPersonalisedSubmission sfPersonalF + , sheetAuthorshipStatementRequired = sfAuthorshipStatementRequired + , sheetAuthorshipStatementDefinition = mNewAuthorshipStatementId } mbsid <- dbAction newSheet case mbsid of diff --git a/src/Handler/Sheet/Form.hs b/src/Handler/Sheet/Form.hs index 4cd5ba324..b7ddf1fa4 100644 --- a/src/Handler/Sheet/Form.hs +++ b/src/Handler/Sheet/Form.hs @@ -42,7 +42,8 @@ data SheetForm = SheetForm , sfMarkingText :: Maybe StoredMarkup , sfAnonymousCorrection :: Bool , sfCorrectors :: Loads - -- Keine SheetId im Formular! + , sfAuthorshipStatementRequired :: Bool + , sfAuthorshipStatementDefinition :: Maybe StoredMarkup } data SheetPersonalisedFilesForm = SheetPersonalisedFilesForm @@ -98,6 +99,9 @@ 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 + <*> apopt checkBoxField (fslI MsgSheetAuthorshipStatementRequired & setTooltip MsgSheetAuthorshipStatementRequiredTip) (sfAuthorshipStatementRequired <$> template) -- TODO: this checkBoxField needs to be disabled and set accordingly if the school settings do not allow other statements + <*> aopt htmlField (fslI MsgSheetAuthorshipStatementDefinition & setTooltip MsgSheetAuthorshipStatementDefinitionTip) (sfAuthorshipStatementDefinition <$> template) -- TODO: use school definition where makeSheetPersonalisedFilesForm :: Maybe SheetPersonalisedFilesForm -> MForm Handler (AForm Handler SheetPersonalisedFilesForm) makeSheetPersonalisedFilesForm template' = do @@ -156,6 +160,10 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS $ classifySubmissionMode sfSubmissionMode /= SubmissionModeNone || 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 + correctorForm :: Loads -> AForm Handler Loads correctorForm loads' = wFormToAForm $ do currentRoute <- fromMaybe (error "correctorForm called from 404-handler") <$> liftHandler getCurrentRoute diff --git a/src/Handler/Sheet/New.hs b/src/Handler/Sheet/New.hs index 8d8bd1c2b..c61f90204 100644 --- a/src/Handler/Sheet/New.hs +++ b/src/Handler/Sheet/New.hs @@ -34,16 +34,20 @@ postSheetNewR tid ssh csh = do searchShn sheet E.orderBy [E.desc (sheet E.^. SheetActiveFrom)] E.limit 1 - let firstEdit = E.subSelectMaybe . E.from $ \sheetEdit -> do - E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId - return . E.min_ $ sheetEdit E.^. SheetEditTime - return (sheet, firstEdit) + let + 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.^. SheetAuthorshipStatementDefinition + return $ authorshipStatementDefinition E.^. AuthorshipStatementDefinitionContent + return (sheet, firstEdit, mAuthorshipStatement) 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):_) -> + ((Entity {entityVal=Sheet{..}}, E.Value fEdit, E.Value mAuthorshipStatement):_) -> let addTime = addWeeks $ max 1 $ weeksToAdd (fromMaybe (UTCTime systemEpochDay 0) $ sheetActiveTo <|> fEdit) now in Just $ SheetForm { sfName = stepTextCounterCI sheetName @@ -66,6 +70,8 @@ postSheetNewR tid ssh csh = do , sfAnonymousCorrection = sheetAnonymousCorrection , sfRequireExamRegistration = Nothing , sfPersonalF = Nothing + , sfAuthorshipStatementRequired = sheetAuthorshipStatementRequired + , sfAuthorshipStatementDefinition = mAuthorshipStatement } _other -> Nothing let action = -- More specific error message for new sheet could go here, if insertUnique returns Nothing