feat(sheets): add required flag and definition

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).

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).

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

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

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

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