refactor(sheets): prepare for sheet-scoped statements

models/sheets.model

@@ -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

src/Handler/Sheet/Edit.hs

@@ -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
+  (Entity sid Sheet{..}, sheetFileIds, currentLoads, hasPersonalisedFiles) <- runDB $ do
-    ent@(Entity sid Sheet{..}) <- fetchSheet tid ssh csh shn
+    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
+    -- TODO: update statement if school authorship statement was updated?
-    return (ent, fti, cLoads, hasPersonalisedFiles, mAuthorshipStatement)
+    -- 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
+       -- let insertNewOrKeepStatement = \case
-              mOldAuthorshipStatement <- runMaybeT $ do
+       --       -- statement disabled:
-                sId <- MaybeT . return $ msId
+       --       Nothing -> pure Nothing
-                Entity _ Sheet{..} <- MaybeT $ getEntity sId
+       --       -- use school preset (i.e. return the id of a *copy*):
-                statementId <- MaybeT . return $ sheetAuthorshipStatement
+       --       Just Nothing -> runMaybeT $ do
-                MaybeT $ getEntity statementId
+       --         Entity _ School{..} <- MaybeT . getEntity $ ssh
-              if
+       --         schoolStatementId <- MaybeT . return $ schoolSheetAuthorshipStatementDefinition
-                | Just newDef@(AuthorshipStatementDefinition newContent) <- mNewStatement
+       --         Entity _ AuthorshipStatementDefinition{..} <- MaybeT . getEntity $ schoolStatementId
-                , maybe True ((/=) newContent . authorshipStatementDefinitionContent . entityVal) mOldAuthorshipStatement
+       --         lift . insert $ AuthorshipStatementDefinition authorshipStatementDefinitionContent
-                -> Just <$> (insert newDef)
+       --       -- use custom statement:
-                | otherwise -> return $ entityKey <$> mOldAuthorshipStatement
+       --       Just (Just newContent) -> do
-        mNewAuthorshipStatementId <- insertNewOrKeepStatement $ AuthorshipStatementDefinition <$> sfAuthorshipStatement
+       --         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

src/Handler/Sheet/Form.hs

@@ -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
+    -- TODO: use
-      Entity _ Course{courseSchool} <- MaybeT . getEntity $ cId
+    ((_school, _mSchoolAuthorshipStatement), _course) <- liftHandler . runDB $ do
-      Entity _ School{..} <- MaybeT . getEntity $ courseSchool
+      course@Course{courseSchool} <- get404 cId
-      statementId <- MaybeT . return $ bool Nothing schoolSheetAuthorshipStatementDefinition (schoolSheetAuthorshipStatementMode /= SchoolAuthorshipStatementModeNone)
+      school@School{..} <- get404 courseSchool
-      MaybeT . getEntity $ statementId
+      mSchoolAuthorshipStatement <- runMaybeT $ do
-      -- TODO: compare versions: school > msId if school statement is newer than msId statement, msId > school otherwise (TODO: add lastEdited to model)
+        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
+      -- <*  aformSection MsgSheetAuthorshipStatementSection
-      <*> 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
+      -- 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: 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: authorship statement definition must not be empty when statement is required
+      --   TODO: if school prevents custom statements, statement must match current school statement
 
 correctorForm :: Loads -> AForm Handler Loads
 correctorForm loads' = wFormToAForm $ do

src/Handler/Sheet/New.hs

@@ -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
+        -- mAuthorshipStatement = E.subSelect . E.from $ \authorshipStatementDefinition -> do
-          E.where_ $ E.just (authorshipStatementDefinition E.^. AuthorshipStatementDefinitionId) E.==. sheet E.^. SheetAuthorshipStatement
+        --   E.where_ $ E.just (authorshipStatementDefinition E.^. AuthorshipStatementDefinitionId) E.==. sheet E.^. SheetAuthorshipStatement
-          return $ authorshipStatementDefinition E.^. AuthorshipStatementDefinitionContent
+        --   return $ authorshipStatementDefinition E.^. AuthorshipStatementDefinitionContent
-      return (sheet, firstEdit, mAuthorshipStatement)
+      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

src/Handler/Sheet/Show.hs

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

templates/sheetShow.hamlet

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