From 3646e42d3fa841629e7285ededca30dd4b213d37 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 5 Jul 2021 16:38:55 +0200 Subject: [PATCH 001/120] chore(db-fill): student system-function --- test/Database/Fill.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index c6c0d4ffb..5d8755b7b 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -436,6 +436,8 @@ fillDb = do sdMst = StudyDegreeKey' 88 sdLAR = StudyDegreeKey' 33 sdLAG = StudyDegreeKey' 35 + for_ (maxMuster : tinaTester : manyUsers) $ \uid -> + void . insert' $ UserSystemFunction uid SystemStudent False False repsert sdBsc $ StudyDegree 82 (Just "BSc") (Just "Bachelor" ) repsert sdMst $ StudyDegree 88 (Just "MSc") (Just "Master" ) repsert sdLAR $ StudyDegree 33 (Just "LAR") Nothing -- intentionally left unknown From c7ce1679de799285ec7a9a0a62c0a202b9078eb3 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 5 Jul 2021 16:42:41 +0200 Subject: [PATCH 002/120] fix: typo course-assistant --- messages/uniworx/categories/courses/courses/de-de-formal.msg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/messages/uniworx/categories/courses/courses/de-de-formal.msg b/messages/uniworx/categories/courses/courses/de-de-formal.msg index fb33d8c9f..eb106d048 100644 --- a/messages/uniworx/categories/courses/courses/de-de-formal.msg +++ b/messages/uniworx/categories/courses/courses/de-de-formal.msg @@ -242,9 +242,9 @@ CourseAllApplicationsArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand: #{ CourseLecInviteHeading courseName@Text: Einladung zum/zur Kursverwalter/Kursverwalterin für #{courseName} CourseLecInviteExplanation: Sie wurden eingeladen, Verwalter:in für einen Kurs zu sein. CourseUserHasPersonalisedSheetFilesFilter: Teilnehmer:in hat personalisierte Übungsblatt-Dateien für -HeadingCourseMembers: Teilnehmer +HeadingCourseMembers: Teilnehmer:innen -CourseAssistant: Assitent +CourseAssistant: Assistent:in CourseParticipantStateIsInactive: Teilnehmer:in ist nicht aktiv CourseParticipantStateIsActive: Teilnehmer:in ist aktiv CourseUserSendMail: Nachricht an Teilnehmer:in senden From 90e4a620f0c1671ff332db1910c176e58ccbac06 Mon Sep 17 00:00:00 2001 From: ros Date: Mon, 31 May 2021 16:23:51 +0200 Subject: [PATCH 003/120] feat(course material): first two filters --- .../courses/material/de-de-formal.msg | 2 ++ .../categories/courses/material/en-eu.msg | 2 ++ src/Application.hs | 8 ++++++ src/Handler/Material.hs | 25 +++++++++++++------ test/Database/Fill.hs | 18 +++++++++++++ 5 files changed, 48 insertions(+), 7 deletions(-) diff --git a/messages/uniworx/categories/courses/material/de-de-formal.msg b/messages/uniworx/categories/courses/material/de-de-formal.msg index 63311eb1d..e8fe8430c 100644 --- a/messages/uniworx/categories/courses/material/de-de-formal.msg +++ b/messages/uniworx/categories/courses/material/de-de-formal.msg @@ -30,3 +30,5 @@ MaterialVideoDownload: Herunterladen MaterialFree: Kursmaterialien ohne Anmeldung zugänglich AccessibleSince: Verfügbar seit VisibleFrom: Veröffentlicht +FilterMaterialNameSearch !ident-ok: Name +FilterMaterialTypeAndDescriptionSearch: Art oder Beschreibung \ No newline at end of file diff --git a/messages/uniworx/categories/courses/material/en-eu.msg b/messages/uniworx/categories/courses/material/en-eu.msg index 8c2b0c202..4cc59f300 100644 --- a/messages/uniworx/categories/courses/material/en-eu.msg +++ b/messages/uniworx/categories/courses/material/en-eu.msg @@ -30,3 +30,5 @@ MaterialVideoDownload: Download MaterialFree: Course material is publicly available. AccessibleSince: Accessible since VisibleFrom: Published +FilterMaterialNameSearch !ident-ok: Name +FilterMaterialTypeAndDescriptionSearch: Type or description \ No newline at end of file diff --git a/src/Application.hs b/src/Application.hs index 0c0fcbbd5..9d5e8ebce 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -710,3 +710,11 @@ addPWEntry User{ userAuthentication = _, ..} (Text.encodeUtf8 -> pw) = db' $ do PWHashConf{..} <- getsYesod $ view _appAuthPWHash (AuthPWHash . Text.decodeUtf8 -> userAuthentication) <- liftIO $ makePasswordWith pwHashAlgorithm pw pwHashStrength void $ insert User{..} + + + + + + + + diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index 2e0e961b5..a09ea741a 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -102,17 +102,17 @@ getMaterialListR tid ssh csh = do & forceFilter "may-access" (Any True) dbTableWidget' psValidator DBTable { dbtIdent = "material-list" :: Text - , dbtStyle = def + , dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } , dbtParams = def - , dbtSQLQuery = \material -> do + , dbtSQLQuery = \material -> do E.where_ $ material E.^. MaterialCourse E.==. E.val cid let filesNum :: E.SqlExpr (E.Value Int64) filesNum = E.subSelectCount . E.from $ \materialFile -> E.where_ $ materialFile E.^. MaterialFileMaterial E.==. material E.^. MaterialId return (material, filesNum) , dbtRowKey = (E.^. MaterialId) - , dbtProj = dbtProjFilteredPostId - , dbtColonnade = widgetColonnade $ mconcat + , dbtProj = dbtProjFilteredPostId + , dbtColonnade = widgetColonnade $ mconcat [ -- dbRow, sortable (Just "type") (i18nCell MsgMaterialType) $ foldMap (textCell . CI.original) . materialType . row2material @@ -138,10 +138,21 @@ getMaterialListR tid ssh csh = do , ( "last-edit" , SortColumn (E.^. MaterialLastEdit) ) ] , dbtFilter = mconcat - [ singletonMap "may-access" . mkFilterProjectedPost $ \(Any b) dbr - -> (== b) <$> hasReadAccessTo (matLink . materialName $ row2material dbr) :: DB Bool + [ (singletonMap "may-access" . mkFilterProjectedPost $ \(Any b) dbr + -> (== b) <$> hasReadAccessTo (matLink . materialName $ row2material dbr) :: DB Bool) + , (singletonMap "searchName". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of + Nothing -> E.val True :: E.SqlExpr (E.Value Bool) + Just needle -> (E.castString (material E.^. MaterialName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))) + , (singletonMap "searchTypeAndDescription". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of + Nothing -> E.val True :: E.SqlExpr (E.Value Bool) + Just needle -> (E.castString (material E.^. MaterialType) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) + --E.||. (E.castString (material E.^. MaterialDescription) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) + ) + ] - , dbtFilterUI = mempty + , dbtFilterUI = \mPrev -> mconcat $ catMaybes + [ Just $ prismAForm (singletonFilter "searchName") mPrev $ aopt textField (fslI MsgFilterMaterialNameSearch) + , Just $ prismAForm (singletonFilter "searchTypeAndDescription") mPrev $ aopt textField (fslI MsgFilterMaterialTypeAndDescriptionSearch) ] , dbtCsvEncode = noCsvEncode , dbtCsvDecode = Nothing , dbtExtraReps = [] diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 5d8755b7b..b97ed31e3 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -730,6 +730,24 @@ fillDb = do } , examStaff = Just "Hofmann" } + _ <- insert' Material + { materialCourse = ffp + , materialName = "Material 1" + , materialType = Just "Typ 1" + , materialDescription = Just $ htmlToStoredMarkup [shamlet|Folien für die Zentralübung|] + , materialVisibleFrom = Just now + , materialLastEdit = now + } + + _ <- insert' Material + { materialCourse = ffp + , materialName = "Material 2" + , materialType = Just "Typ 2" + , materialDescription = Just $ htmlToStoredMarkup [shamlet|Videos für die Vorlesung|] + , materialVisibleFrom = Just now + , materialLastEdit = now + } + void . insertMany $ map (\u -> ExamRegistration examFFP u Nothing now) [ fhamann , maxMuster From 89e9887fe1112cbc21517e4b501ead33f5a969ba Mon Sep 17 00:00:00 2001 From: ros Date: Sun, 6 Jun 2021 11:22:13 +0200 Subject: [PATCH 004/120] feat(course material): materialDescription in progress --- src/Application.hs | 5 ----- src/Handler/Material.hs | 5 +---- 2 files changed, 1 insertion(+), 9 deletions(-) diff --git a/src/Application.hs b/src/Application.hs index 9d5e8ebce..29eb69e05 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -713,8 +713,3 @@ addPWEntry User{ userAuthentication = _, ..} (Text.encodeUtf8 -> pw) = db' $ do - - - - - diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index a09ea741a..226fbd28d 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -146,9 +146,7 @@ getMaterialListR tid ssh csh = do , (singletonMap "searchTypeAndDescription". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of Nothing -> E.val True :: E.SqlExpr (E.Value Bool) Just needle -> (E.castString (material E.^. MaterialType) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) - --E.||. (E.castString (material E.^. MaterialDescription) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) - ) - + E.||. (E.castString (material E.^. MaterialDescription) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))) ] , dbtFilterUI = \mPrev -> mconcat $ catMaybes [ Just $ prismAForm (singletonFilter "searchName") mPrev $ aopt textField (fslI MsgFilterMaterialNameSearch) @@ -400,4 +398,3 @@ getMArchiveR tid ssh csh mnm = do let getMatQuery = materialArchiveSource tid ssh csh mnm serveSomeFiles archiveName getMatQuery - From 3a9622dfb8474d9f3764f5870197e317a96d9de3 Mon Sep 17 00:00:00 2001 From: ros Date: Fri, 11 Jun 2021 16:04:01 +0200 Subject: [PATCH 005/120] feat(course material): materialdescription search implemented --- src/Application.hs | 5 +---- src/Handler/Material.hs | 3 ++- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/src/Application.hs b/src/Application.hs index 29eb69e05..001d87096 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -709,7 +709,4 @@ addPWEntry :: User addPWEntry User{ userAuthentication = _, ..} (Text.encodeUtf8 -> pw) = db' $ do PWHashConf{..} <- getsYesod $ view _appAuthPWHash (AuthPWHash . Text.decodeUtf8 -> userAuthentication) <- liftIO $ makePasswordWith pwHashAlgorithm pw pwHashStrength - void $ insert User{..} - - - + void $ insert User{..} \ No newline at end of file diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index 226fbd28d..147c79344 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -18,6 +18,7 @@ import qualified Data.CaseInsensitive as CI -- import qualified Data.Text.Encoding as Text import qualified Database.Esqueleto.Legacy as E +import qualified Database.Esqueleto.Utils as E import Utils.Form import Handler.Utils @@ -146,7 +147,7 @@ getMaterialListR tid ssh csh = do , (singletonMap "searchTypeAndDescription". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of Nothing -> E.val True :: E.SqlExpr (E.Value Bool) Just needle -> (E.castString (material E.^. MaterialType) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) - E.||. (E.castString (material E.^. MaterialDescription) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))) + E.||. (E.maybe (E.val mempty) (E.castString.esqueletoMarkupOutput) (material E.^. MaterialDescription) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))) ] , dbtFilterUI = \mPrev -> mconcat $ catMaybes [ Just $ prismAForm (singletonFilter "searchName") mPrev $ aopt textField (fslI MsgFilterMaterialNameSearch) From decdda359d16cce429a7e7a07d4674840e5fe6af Mon Sep 17 00:00:00 2001 From: ros Date: Mon, 21 Jun 2021 15:18:45 +0200 Subject: [PATCH 006/120] =?UTF-8?q?feat(course=20material):=20auto=20vorsc?= =?UTF-8?q?hl=C3=A4ge=20f=C3=BCr=20materialtype?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Application.hs | 6 +++++- src/Handler/Material.hs | 14 ++++++++++++-- 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/src/Application.hs b/src/Application.hs index 001d87096..d9a64a0f9 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -709,4 +709,8 @@ addPWEntry :: User addPWEntry User{ userAuthentication = _, ..} (Text.encodeUtf8 -> pw) = db' $ do PWHashConf{..} <- getsYesod $ view _appAuthPWHash (AuthPWHash . Text.decodeUtf8 -> userAuthentication) <- liftIO $ makePasswordWith pwHashAlgorithm pw pwHashStrength - void $ insert User{..} \ No newline at end of file + void $ insert User{..} + + + + diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index 147c79344..88e496565 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -81,6 +81,16 @@ fetchMaterial tid ssh csh mnm = getMaterialListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getMaterialListR tid ssh csh = do + cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh + let typeOptions :: HandlerFor UniWorX (OptionList Text) + typeOptions = do + previouslyUsed <- runDB $ + E.select $ E.from $ \material -> + E.distinctOnOrderBy [E.asc $ material E.^. MaterialType] $ do + E.where_ $ material E.^. MaterialCourse E.==. E.val cid + E.&&. E.not_ (E.isNothing $ material E.^. MaterialType) + return $ material E.^. MaterialType + return . mkOptionList $ map (\t -> Option t t t) (map CI.original (Set.toAscList (Set.fromList (mapMaybe E.unValue previouslyUsed)))) let matLink :: MaterialName -> Route UniWorX matLink = CourseR tid ssh csh . flip MaterialR MShowR @@ -97,7 +107,7 @@ getMaterialListR tid ssh csh = do seeAllModificationTimestamps <- hasWriteAccessTo $ CourseR tid ssh csh MaterialNewR -- ordinary users should not see modification dates older than visibility MsgRenderer mr <- getMsgRenderer table <- runDB $ do - cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh + --cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh let row2material = view $ _dbrOutput . _1 . _entityVal psValidator = def & defaultSorting [SortDescBy "last-edit"] & forceFilter "may-access" (Any True) @@ -151,7 +161,7 @@ getMaterialListR tid ssh csh = do ] , dbtFilterUI = \mPrev -> mconcat $ catMaybes [ Just $ prismAForm (singletonFilter "searchName") mPrev $ aopt textField (fslI MsgFilterMaterialNameSearch) - , Just $ prismAForm (singletonFilter "searchTypeAndDescription") mPrev $ aopt textField (fslI MsgFilterMaterialTypeAndDescriptionSearch) ] + , Just $ prismAForm (singletonFilter "searchTypeAndDescription") mPrev $ aopt (textField & addDatalist typeOptions) (fslI MsgFilterMaterialTypeAndDescriptionSearch)] , dbtCsvEncode = noCsvEncode , dbtCsvDecode = Nothing , dbtExtraReps = [] From d8b1f9788c74ea5d7dc4f1f45432649d9601106a Mon Sep 17 00:00:00 2001 From: ros Date: Mon, 21 Jun 2021 16:00:55 +0200 Subject: [PATCH 007/120] feat(course material): small empty-bug fixed --- src/Application.hs | 1 + src/Handler/Material.hs | 3 +-- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Application.hs b/src/Application.hs index d9a64a0f9..d1d7195f2 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -714,3 +714,4 @@ addPWEntry User{ userAuthentication = _, ..} (Text.encodeUtf8 -> pw) = db' $ do + diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index 88e496565..ad378b383 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -107,7 +107,6 @@ getMaterialListR tid ssh csh = do seeAllModificationTimestamps <- hasWriteAccessTo $ CourseR tid ssh csh MaterialNewR -- ordinary users should not see modification dates older than visibility MsgRenderer mr <- getMsgRenderer table <- runDB $ do - --cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh let row2material = view $ _dbrOutput . _1 . _entityVal psValidator = def & defaultSorting [SortDescBy "last-edit"] & forceFilter "may-access" (Any True) @@ -156,7 +155,7 @@ getMaterialListR tid ssh csh = do Just needle -> (E.castString (material E.^. MaterialName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))) , (singletonMap "searchTypeAndDescription". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of Nothing -> E.val True :: E.SqlExpr (E.Value Bool) - Just needle -> (E.castString (material E.^. MaterialType) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) + Just needle -> (E.maybe (E.val mempty) E.castString (material E.^. MaterialType) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) E.||. (E.maybe (E.val mempty) (E.castString.esqueletoMarkupOutput) (material E.^. MaterialDescription) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))) ] , dbtFilterUI = \mPrev -> mconcat $ catMaybes From 95d1b41c606a2abb4f09a9c7499119d9d108ba91 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 21 Jun 2021 14:06:34 +0000 Subject: [PATCH 008/120] Apply 1 suggestion(s) to 1 file(s) --- src/Handler/Material.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index ad378b383..55c9ced2c 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -90,7 +90,7 @@ getMaterialListR tid ssh csh = do E.where_ $ material E.^. MaterialCourse E.==. E.val cid E.&&. E.not_ (E.isNothing $ material E.^. MaterialType) return $ material E.^. MaterialType - return . mkOptionList $ map (\t -> Option t t t) (map CI.original (Set.toAscList (Set.fromList (mapMaybe E.unValue previouslyUsed)))) + return . mkOptionList . map (\(CI.original -> t) -> Option t t t) . Set.toAscList . Set.fromList $ mapMaybe E.unValue previouslyUsed let matLink :: MaterialName -> Route UniWorX matLink = CourseR tid ssh csh . flip MaterialR MShowR From a7b41e9cc89f794ecaadb0c4d52207c773467b78 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 21 Jun 2021 14:07:01 +0000 Subject: [PATCH 009/120] Apply 1 suggestion(s) to 1 file(s) --- src/Handler/Material.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index 55c9ced2c..a803b5f8d 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -148,8 +148,8 @@ getMaterialListR tid ssh csh = do , ( "last-edit" , SortColumn (E.^. MaterialLastEdit) ) ] , dbtFilter = mconcat - [ (singletonMap "may-access" . mkFilterProjectedPost $ \(Any b) dbr - -> (== b) <$> hasReadAccessTo (matLink . materialName $ row2material dbr) :: DB Bool) + [ singletonMap "may-access" . mkFilterProjectedPost $ \(Any b) dbr + -> (== b) <$> hasReadAccessTo (matLink . materialName $ row2material dbr) :: DB Bool , (singletonMap "searchName". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of Nothing -> E.val True :: E.SqlExpr (E.Value Bool) Just needle -> (E.castString (material E.^. MaterialName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))) From 08ec676616814809d7b0a30933e6e73391ac3037 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 21 Jun 2021 14:07:28 +0000 Subject: [PATCH 010/120] Apply 1 suggestion(s) to 1 file(s) --- src/Handler/Material.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index a803b5f8d..81aa47187 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -150,7 +150,7 @@ getMaterialListR tid ssh csh = do , dbtFilter = mconcat [ singletonMap "may-access" . mkFilterProjectedPost $ \(Any b) dbr -> (== b) <$> hasReadAccessTo (matLink . materialName $ row2material dbr) :: DB Bool - , (singletonMap "searchName". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of + , (singletonMap "searchName" . FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of Nothing -> E.val True :: E.SqlExpr (E.Value Bool) Just needle -> (E.castString (material E.^. MaterialName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))) , (singletonMap "searchTypeAndDescription". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of From c09acbbf8a7b95176b3d52449b3b9d26e315ccd6 Mon Sep 17 00:00:00 2001 From: ros Date: Mon, 21 Jun 2021 16:17:52 +0200 Subject: [PATCH 011/120] =?UTF-8?q?feat(course=20material):=20runDB=20f?= =?UTF-8?q?=C3=BCr=20cid=20nur=20einmal?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Application.hs | 7 +------ src/Handler/Material.hs | 26 +++++++++++++------------- 2 files changed, 14 insertions(+), 19 deletions(-) diff --git a/src/Application.hs b/src/Application.hs index d1d7195f2..001d87096 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -709,9 +709,4 @@ addPWEntry :: User addPWEntry User{ userAuthentication = _, ..} (Text.encodeUtf8 -> pw) = db' $ do PWHashConf{..} <- getsYesod $ view _appAuthPWHash (AuthPWHash . Text.decodeUtf8 -> userAuthentication) <- liftIO $ makePasswordWith pwHashAlgorithm pw pwHashStrength - void $ insert User{..} - - - - - + void $ insert User{..} \ No newline at end of file diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index 81aa47187..5f095626a 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -81,16 +81,6 @@ fetchMaterial tid ssh csh mnm = getMaterialListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getMaterialListR tid ssh csh = do - cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh - let typeOptions :: HandlerFor UniWorX (OptionList Text) - typeOptions = do - previouslyUsed <- runDB $ - E.select $ E.from $ \material -> - E.distinctOnOrderBy [E.asc $ material E.^. MaterialType] $ do - E.where_ $ material E.^. MaterialCourse E.==. E.val cid - E.&&. E.not_ (E.isNothing $ material E.^. MaterialType) - return $ material E.^. MaterialType - return . mkOptionList . map (\(CI.original -> t) -> Option t t t) . Set.toAscList . Set.fromList $ mapMaybe E.unValue previouslyUsed let matLink :: MaterialName -> Route UniWorX matLink = CourseR tid ssh csh . flip MaterialR MShowR @@ -107,6 +97,16 @@ getMaterialListR tid ssh csh = do seeAllModificationTimestamps <- hasWriteAccessTo $ CourseR tid ssh csh MaterialNewR -- ordinary users should not see modification dates older than visibility MsgRenderer mr <- getMsgRenderer table <- runDB $ do + cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh + let typeOptions :: HandlerFor UniWorX (OptionList Text) + typeOptions = do + previouslyUsed <- runDB $ + E.select $ E.from $ \material -> + E.distinctOnOrderBy [E.asc $ material E.^. MaterialType] $ do + E.where_ $ material E.^. MaterialCourse E.==. E.val cid + E.&&. E.not_ (E.isNothing $ material E.^. MaterialType) + return $ material E.^. MaterialType + return . mkOptionList $ map (\t -> Option t t t) (map CI.original (Set.toAscList (Set.fromList (mapMaybe E.unValue previouslyUsed)))) let row2material = view $ _dbrOutput . _1 . _entityVal psValidator = def & defaultSorting [SortDescBy "last-edit"] & forceFilter "may-access" (Any True) @@ -148,9 +148,9 @@ getMaterialListR tid ssh csh = do , ( "last-edit" , SortColumn (E.^. MaterialLastEdit) ) ] , dbtFilter = mconcat - [ singletonMap "may-access" . mkFilterProjectedPost $ \(Any b) dbr - -> (== b) <$> hasReadAccessTo (matLink . materialName $ row2material dbr) :: DB Bool - , (singletonMap "searchName" . FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of + [ (singletonMap "may-access" . mkFilterProjectedPost $ \(Any b) dbr + -> (== b) <$> hasReadAccessTo (matLink . materialName $ row2material dbr) :: DB Bool) + , (singletonMap "searchName". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of Nothing -> E.val True :: E.SqlExpr (E.Value Bool) Just needle -> (E.castString (material E.^. MaterialName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))) , (singletonMap "searchTypeAndDescription". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of From bee8f84eb3528286349bef4b9ea23f1c6240e1d1 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Fri, 25 Jun 2021 12:22:22 +0000 Subject: [PATCH 012/120] Apply 1 suggestion(s) to 1 file(s) --- src/Handler/Material.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index 5f095626a..84d3a142c 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -159,7 +159,7 @@ getMaterialListR tid ssh csh = do E.||. (E.maybe (E.val mempty) (E.castString.esqueletoMarkupOutput) (material E.^. MaterialDescription) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))) ] , dbtFilterUI = \mPrev -> mconcat $ catMaybes - [ Just $ prismAForm (singletonFilter "searchName") mPrev $ aopt textField (fslI MsgFilterMaterialNameSearch) + [ Just $ prismAForm (singletonFilter "name") mPrev $ aopt textField (fslI MsgFilterMaterialNameSearch) , Just $ prismAForm (singletonFilter "searchTypeAndDescription") mPrev $ aopt (textField & addDatalist typeOptions) (fslI MsgFilterMaterialTypeAndDescriptionSearch)] , dbtCsvEncode = noCsvEncode , dbtCsvDecode = Nothing From 363762081ebd7e5f854ba7966c5d0398ffaf310b Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Fri, 25 Jun 2021 12:22:29 +0000 Subject: [PATCH 013/120] Apply 1 suggestion(s) to 1 file(s) --- src/Handler/Material.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index 84d3a142c..dfe10d2d9 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -160,7 +160,7 @@ getMaterialListR tid ssh csh = do ] , dbtFilterUI = \mPrev -> mconcat $ catMaybes [ Just $ prismAForm (singletonFilter "name") mPrev $ aopt textField (fslI MsgFilterMaterialNameSearch) - , Just $ prismAForm (singletonFilter "searchTypeAndDescription") mPrev $ aopt (textField & addDatalist typeOptions) (fslI MsgFilterMaterialTypeAndDescriptionSearch)] + , Just $ prismAForm (singletonFilter "type-and-description") mPrev $ aopt (textField & addDatalist typeOptions) (fslI MsgFilterMaterialTypeAndDescriptionSearch)] , dbtCsvEncode = noCsvEncode , dbtCsvDecode = Nothing , dbtExtraReps = [] From bc09bedb84787a22feec2f310aa77e8d27bc4996 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Fri, 25 Jun 2021 12:23:09 +0000 Subject: [PATCH 014/120] Apply 1 suggestion(s) to 1 file(s) --- src/Handler/Material.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index dfe10d2d9..0b6fcc9cf 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -153,7 +153,7 @@ getMaterialListR tid ssh csh = do , (singletonMap "searchName". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of Nothing -> E.val True :: E.SqlExpr (E.Value Bool) Just needle -> (E.castString (material E.^. MaterialName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))) - , (singletonMap "searchTypeAndDescription". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of + , (singletonMap "type-and-description". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of Nothing -> E.val True :: E.SqlExpr (E.Value Bool) Just needle -> (E.maybe (E.val mempty) E.castString (material E.^. MaterialType) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) E.||. (E.maybe (E.val mempty) (E.castString.esqueletoMarkupOutput) (material E.^. MaterialDescription) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))) From 617eb7ff948b47b65c6e153c3e581926fd56880b Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Fri, 25 Jun 2021 12:23:16 +0000 Subject: [PATCH 015/120] Apply 1 suggestion(s) to 1 file(s) --- src/Handler/Material.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index 0b6fcc9cf..0a8edb3a7 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -150,7 +150,7 @@ getMaterialListR tid ssh csh = do , dbtFilter = mconcat [ (singletonMap "may-access" . mkFilterProjectedPost $ \(Any b) dbr -> (== b) <$> hasReadAccessTo (matLink . materialName $ row2material dbr) :: DB Bool) - , (singletonMap "searchName". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of + , (singletonMap "name". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of Nothing -> E.val True :: E.SqlExpr (E.Value Bool) Just needle -> (E.castString (material E.^. MaterialName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))) , (singletonMap "type-and-description". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of From d1cdb0d1da792ee593ad2167d319dd232e43bcc9 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 25 Jun 2021 12:25:25 +0000 Subject: [PATCH 016/120] Apply 1 suggestion(s) to 1 file(s) --- messages/uniworx/categories/courses/material/de-de-formal.msg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/messages/uniworx/categories/courses/material/de-de-formal.msg b/messages/uniworx/categories/courses/material/de-de-formal.msg index e8fe8430c..7d3ab8df6 100644 --- a/messages/uniworx/categories/courses/material/de-de-formal.msg +++ b/messages/uniworx/categories/courses/material/de-de-formal.msg @@ -31,4 +31,4 @@ MaterialFree: Kursmaterialien ohne Anmeldung zugänglich AccessibleSince: Verfügbar seit VisibleFrom: Veröffentlicht FilterMaterialNameSearch !ident-ok: Name -FilterMaterialTypeAndDescriptionSearch: Art oder Beschreibung \ No newline at end of file +FilterMaterialTypeAndDescriptionSearch: Art und Beschreibung \ No newline at end of file From 86234e9624675a8a4a650f31a2316ee171853dd5 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 25 Jun 2021 12:25:32 +0000 Subject: [PATCH 017/120] Apply 1 suggestion(s) to 1 file(s) --- messages/uniworx/categories/courses/material/en-eu.msg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/messages/uniworx/categories/courses/material/en-eu.msg b/messages/uniworx/categories/courses/material/en-eu.msg index 4cc59f300..55d202c82 100644 --- a/messages/uniworx/categories/courses/material/en-eu.msg +++ b/messages/uniworx/categories/courses/material/en-eu.msg @@ -31,4 +31,4 @@ MaterialFree: Course material is publicly available. AccessibleSince: Accessible since VisibleFrom: Published FilterMaterialNameSearch !ident-ok: Name -FilterMaterialTypeAndDescriptionSearch: Type or description \ No newline at end of file +FilterMaterialTypeAndDescriptionSearch: Type and description \ No newline at end of file From dc5fc3f710363f0644c43866505e32095b41ce92 Mon Sep 17 00:00:00 2001 From: ros Date: Fri, 25 Jun 2021 14:47:25 +0200 Subject: [PATCH 018/120] feat(course material): merge-request suggestions --- .../categories/courses/material/de-de-formal.msg | 2 +- .../uniworx/categories/courses/material/en-eu.msg | 2 +- src/Handler/Material.hs | 14 +++++++------- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/messages/uniworx/categories/courses/material/de-de-formal.msg b/messages/uniworx/categories/courses/material/de-de-formal.msg index 7d3ab8df6..6e244f71c 100644 --- a/messages/uniworx/categories/courses/material/de-de-formal.msg +++ b/messages/uniworx/categories/courses/material/de-de-formal.msg @@ -31,4 +31,4 @@ MaterialFree: Kursmaterialien ohne Anmeldung zugänglich AccessibleSince: Verfügbar seit VisibleFrom: Veröffentlicht FilterMaterialNameSearch !ident-ok: Name -FilterMaterialTypeAndDescriptionSearch: Art und Beschreibung \ No newline at end of file +FilterMaterialTypeAndDescriptionSearch: Art/Beschreibung \ No newline at end of file diff --git a/messages/uniworx/categories/courses/material/en-eu.msg b/messages/uniworx/categories/courses/material/en-eu.msg index 55d202c82..4fa16fd7e 100644 --- a/messages/uniworx/categories/courses/material/en-eu.msg +++ b/messages/uniworx/categories/courses/material/en-eu.msg @@ -31,4 +31,4 @@ MaterialFree: Course material is publicly available. AccessibleSince: Accessible since VisibleFrom: Published FilterMaterialNameSearch !ident-ok: Name -FilterMaterialTypeAndDescriptionSearch: Type and description \ No newline at end of file +FilterMaterialTypeAndDescriptionSearch: Type/description \ No newline at end of file diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index 0a8edb3a7..31336fe1c 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -106,7 +106,7 @@ getMaterialListR tid ssh csh = do E.where_ $ material E.^. MaterialCourse E.==. E.val cid E.&&. E.not_ (E.isNothing $ material E.^. MaterialType) return $ material E.^. MaterialType - return . mkOptionList $ map (\t -> Option t t t) (map CI.original (Set.toAscList (Set.fromList (mapMaybe E.unValue previouslyUsed)))) + return . mkOptionList . map (\(CI.original -> t) -> Option t t t) . Set.toAscList . Set.fromList $ mapMaybe E.unValue previouslyUsed let row2material = view $ _dbrOutput . _1 . _entityVal psValidator = def & defaultSorting [SortDescBy "last-edit"] & forceFilter "may-access" (Any True) @@ -148,15 +148,15 @@ getMaterialListR tid ssh csh = do , ( "last-edit" , SortColumn (E.^. MaterialLastEdit) ) ] , dbtFilter = mconcat - [ (singletonMap "may-access" . mkFilterProjectedPost $ \(Any b) dbr - -> (== b) <$> hasReadAccessTo (matLink . materialName $ row2material dbr) :: DB Bool) - , (singletonMap "name". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of + [ singletonMap "may-access" . mkFilterProjectedPost $ \(Any b) dbr + -> (== b) <$> hasReadAccessTo (matLink . materialName $ row2material dbr) :: DB Bool + , singletonMap "name". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of Nothing -> E.val True :: E.SqlExpr (E.Value Bool) - Just needle -> (E.castString (material E.^. MaterialName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))) - , (singletonMap "type-and-description". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of + Just needle -> (E.castString (material E.^. MaterialName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) + , singletonMap "type-and-description". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of Nothing -> E.val True :: E.SqlExpr (E.Value Bool) Just needle -> (E.maybe (E.val mempty) E.castString (material E.^. MaterialType) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) - E.||. (E.maybe (E.val mempty) (E.castString.esqueletoMarkupOutput) (material E.^. MaterialDescription) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))) + E.||. (E.maybe (E.val mempty) (E.castString.esqueletoMarkupOutput) (material E.^. MaterialDescription) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) ] , dbtFilterUI = \mPrev -> mconcat $ catMaybes [ Just $ prismAForm (singletonFilter "name") mPrev $ aopt textField (fslI MsgFilterMaterialNameSearch) From 5c5cbaddf8b33f455ff18789806a3e0f9ac447ed Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 5 Jul 2021 17:56:07 +0200 Subject: [PATCH 019/120] fix(workflows): workflow-definition edit translations --- src/Handler/Utils/Form/MassInput.hs | 2 +- src/Handler/Workflow/Definition/Edit.hs | 32 ++++++++++++++----------- 2 files changed, 19 insertions(+), 15 deletions(-) diff --git a/src/Handler/Utils/Form/MassInput.hs b/src/Handler/Utils/Form/MassInput.hs index 582e4193f..526ee5d9b 100644 --- a/src/Handler/Utils/Form/MassInput.hs +++ b/src/Handler/Utils/Form/MassInput.hs @@ -632,7 +632,7 @@ massInputAccumEdit miAdd' miCell' miButtonAction miLayout miIdent fSettings fReq miCell :: ListPosition -> cellData -> Maybe cellData -> (Text -> Text) -> (Markup -> MForm handler (FormResult cellData, Widget)) - miCell _pos dat _mPrev nudge = miCell' nudge dat + miCell _pos dat mPrev' nudge = miCell' nudge $ fromMaybe dat mPrev' miDelete :: MassInputDelete ListLength miDelete = miDeleteList diff --git a/src/Handler/Workflow/Definition/Edit.hs b/src/Handler/Workflow/Definition/Edit.hs index 1967fc958..b7865df88 100644 --- a/src/Handler/Workflow/Definition/Edit.hs +++ b/src/Handler/Workflow/Definition/Edit.hs @@ -54,22 +54,26 @@ postAWDEditR wds' wdn = do , workflowDefinitionInstanceCategory = wdfInstanceCategory } - when (is _Nothing insConflict) . iforM_ wdfDescriptions $ \wddLang (wddTitle, wddDesc) -> do + when (is _Nothing insConflict) $ do deleteWhere [WorkflowDefinitionDescriptionDefinition ==. wdId] - insert WorkflowDefinitionDescription - { workflowDefinitionDescriptionDefinition = wdId - , workflowDefinitionDescriptionLanguage = wddLang - , workflowDefinitionDescriptionTitle = wddTitle - , workflowDefinitionDescriptionDescription = wddDesc - } - when (is _Nothing insConflict) . iforM_ wdfInstanceDescriptions $ \wddLang (wddTitle, wddDesc) -> do + insertMany_ $ do + (wddLang, (wddTitle, wddDesc)) <- Map.toList wdfDescriptions + return WorkflowDefinitionDescription + { workflowDefinitionDescriptionDefinition = wdId + , workflowDefinitionDescriptionLanguage = wddLang + , workflowDefinitionDescriptionTitle = wddTitle + , workflowDefinitionDescriptionDescription = wddDesc + } + deleteWhere [WorkflowDefinitionInstanceDescriptionDefinition ==. wdId] - insert WorkflowDefinitionInstanceDescription - { workflowDefinitionInstanceDescriptionDefinition = wdId - , workflowDefinitionInstanceDescriptionLanguage = wddLang - , workflowDefinitionInstanceDescriptionTitle = wddTitle - , workflowDefinitionInstanceDescriptionDescription = wddDesc - } + insertMany_ $ do + (wddLang, (wddTitle, wddDesc)) <- Map.toList wdfInstanceDescriptions + return WorkflowDefinitionInstanceDescription + { workflowDefinitionInstanceDescriptionDefinition = wdId + , workflowDefinitionInstanceDescriptionLanguage = wddLang + , workflowDefinitionInstanceDescriptionTitle = wddTitle + , workflowDefinitionInstanceDescriptionDescription = wddDesc + } case insConflict of Just (UniqueWorkflowDefinition wdn' wds'') -> return . Just $ From f9391c32433be78eeed84b48a424a93141fa9092 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 5 Jul 2021 17:56:45 +0200 Subject: [PATCH 020/120] chore: bump workflows --- testdata/workflows | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testdata/workflows b/testdata/workflows index cf7dcf58c..ea616bce8 160000 --- a/testdata/workflows +++ b/testdata/workflows @@ -1 +1 @@ -Subproject commit cf7dcf58c524176bbdd27ff279d68a5ab90cd06e +Subproject commit ea616bce889da4c923bd2aa35d176f70f3a7ca8f From 29de9106333cd222fc4f25a5016e6783111a19cd Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 5 Jul 2021 19:44:36 +0200 Subject: [PATCH 021/120] refactor: hlint --- src/Handler/Material.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index 31336fe1c..021ab7865 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -152,7 +152,7 @@ getMaterialListR tid ssh csh = do -> (== b) <$> hasReadAccessTo (matLink . materialName $ row2material dbr) :: DB Bool , singletonMap "name". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of Nothing -> E.val True :: E.SqlExpr (E.Value Bool) - Just needle -> (E.castString (material E.^. MaterialName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) + Just needle -> E.castString (material E.^. MaterialName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%) , singletonMap "type-and-description". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of Nothing -> E.val True :: E.SqlExpr (E.Value Bool) Just needle -> (E.maybe (E.val mempty) E.castString (material E.^. MaterialType) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)) From 32efdae839b1a3e43ed4161d20e598964970f15e Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 5 Jul 2021 22:13:00 +0200 Subject: [PATCH 022/120] feat(workflows): update instances from definitions --- frontend/src/app.sass | 7 +- .../categories/workflows/de-de-formal.msg | 9 +- .../uniworx/categories/workflows/en-eu.msg | 7 ++ .../navigation/breadcrumbs/de-de-formal.msg | 1 + .../utils/navigation/breadcrumbs/en-eu.msg | 1 + .../utils/navigation/menu/de-de-formal.msg | 1 + .../uniworx/utils/navigation/menu/en-eu.msg | 1 + routes | 2 + src/Foundation/Navigation.hs | 2 + src/Handler/Utils/Workflow/CanonicalRoute.hs | 6 +- src/Handler/Workflow/Instance.hs | 1 + src/Handler/Workflow/Instance/List.hs | 34 ++++- src/Handler/Workflow/Instance/Update.hs | 117 ++++++++++++++++++ templates/workflows/instances.hamlet | 4 +- 14 files changed, 182 insertions(+), 11 deletions(-) create mode 100644 src/Handler/Workflow/Instance/Update.hs diff --git a/frontend/src/app.sass b/frontend/src/app.sass index 0b3dcfd32..017d9d98a 100644 --- a/frontend/src/app.sass +++ b/frontend/src/app.sass @@ -103,8 +103,8 @@ body .emph font-style: italic -a, -a:visited +a:not(.btn), +a:visited:not(.btn) text-decoration: none font-weight: 600 transition: color .2s ease, background-color .2s ease @@ -275,6 +275,9 @@ button:not(.btn-link), display: grid grid: min-content / auto-flow max-content + > form + margin: 0 !important + .buttongroup--inline display: inline-grid diff --git a/messages/uniworx/categories/workflows/de-de-formal.msg b/messages/uniworx/categories/workflows/de-de-formal.msg index 32456b267..b9beb0e01 100644 --- a/messages/uniworx/categories/workflows/de-de-formal.msg +++ b/messages/uniworx/categories/workflows/de-de-formal.msg @@ -146,4 +146,11 @@ YAMLFieldDecodeFailure yamlFailure@String: Konnte YAML nicht parsen: #{yamlFailu WGFTextInput: Textfeld WGFFileUpload: Dateifeld -WorkflowWorkflowListPersons: Beteiligte Benutzer \ No newline at end of file +WorkflowWorkflowListPersons: Beteiligte Benutzer + +BtnWorkflowInstanceUpdate !ident-ok: Update +WorkflowInstanceUpdateNoActions: Keine Updates verfügbar +WorkflowInstanceUpdateUpdatedGraph: Definitions-Update erfolgreich angewandt +WorkflowInstanceUpdateUpdatedCategory: Kategorie-Update erfolgreich angewandt +WorkflowInstanceUpdateDeletedDescriptionLanguage lang@Lang: Beschreibung/Titel in Sprache „#{lang}“ gelöscht +WorkflowInstanceUpdateUpdatedDescriptionLanguage lang@Lang: Beschreibung/Titel-Update für Sprache „#{lang}“ angewandt \ No newline at end of file diff --git a/messages/uniworx/categories/workflows/en-eu.msg b/messages/uniworx/categories/workflows/en-eu.msg index 41684ae60..1a1225136 100644 --- a/messages/uniworx/categories/workflows/en-eu.msg +++ b/messages/uniworx/categories/workflows/en-eu.msg @@ -147,3 +147,10 @@ YAMLFieldDecodeFailure yamlFailure: Could not parse YAML: #{yamlFailure} WGFTextInput: Text field WGFFileUpload: File field WorkflowWorkflowListPersons: Involved users + +BtnWorkflowInstanceUpdate: Update +WorkflowInstanceUpdateNoActions: No updates available +WorkflowInstanceUpdateUpdatedGraph: Successfully applied updated definition +WorkflowInstanceUpdateUpdatedCategory: Successfully applied updated category +WorkflowInstanceUpdateDeletedDescriptionLanguage lang: Successfully deleted description/title for language “#{lang}” +WorkflowInstanceUpdateUpdatedDescriptionLanguage lang: Successfully applied updated description/title for language “#{lang}” diff --git a/messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg b/messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg index a38672835..2c7b12fdd 100644 --- a/messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg @@ -96,6 +96,7 @@ BreadcrumbWorkflowInstanceWorkflowList: Laufende Workflows BreadcrumbWorkflowInstanceInitiate: Workflow starten BreadcrumbWorkflowInstanceList !ident-ok: Workflows BreadcrumbWorkflowInstanceNew: Neuer Workflow +BreadcrumbWorkflowInstanceUpdate !ident-ok: Update BreadcrumbWorkflowWorkflowList: Laufende Workflows BreadcrumbWorkflowWorkflow workflow@CryptoFileNameWorkflowWorkflow !ident-ok: #{toPathPiece workflow} BreadcrumbWorkflowWorkflowFiles: Dateien diff --git a/messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg b/messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg index f7fd04c97..d88d37830 100644 --- a/messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg +++ b/messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg @@ -96,6 +96,7 @@ BreadcrumbWorkflowInstanceWorkflowList: Running workflows BreadcrumbWorkflowInstanceInitiate: Start workflow BreadcrumbWorkflowInstanceList: Workflows BreadcrumbWorkflowInstanceNew: New workflow +BreadcrumbWorkflowInstanceUpdate !ident-ok: Update BreadcrumbWorkflowWorkflowList: Running workflows BreadcrumbWorkflowWorkflow workflow: #{toPathPiece workflow} BreadcrumbWorkflowWorkflowFiles: Files diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index 383616869..69bc2b39d 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/menu/de-de-formal.msg @@ -121,6 +121,7 @@ MenuAdminWorkflowDefinitionDelete: Löschen MenuAdminWorkflowInstanceList: Workflow-Instanzen MenuAdminWorkflowInstanceNew: Neue Workflow-Instanz MenuAdminWorkflowDefinitionInstantiate: Instanziieren +MenuWorkflowInstanceUpdate !ident-ok: Update MenuWorkflowInstanceDelete: Löschen MenuWorkflowInstanceWorkflows: Laufende Workflows MenuWorkflowInstanceInitiate: Workflow starten diff --git a/messages/uniworx/utils/navigation/menu/en-eu.msg b/messages/uniworx/utils/navigation/menu/en-eu.msg index 7a02ce02a..3a4a45a16 100644 --- a/messages/uniworx/utils/navigation/menu/en-eu.msg +++ b/messages/uniworx/utils/navigation/menu/en-eu.msg @@ -122,6 +122,7 @@ MenuAdminWorkflowDefinitionDelete: Delete MenuAdminWorkflowInstanceList: Workflow instances MenuAdminWorkflowInstanceNew: New workflow instance MenuAdminWorkflowDefinitionInstantiate: Instantiate +MenuWorkflowInstanceUpdate !ident-ok: Update MenuWorkflowInstanceDelete: Delete MenuWorkflowInstanceWorkflows: Running workflows MenuWorkflowInstanceInitiate: Start workflow diff --git a/routes b/routes index c9b45f88c..85106d88f 100644 --- a/routes +++ b/routes @@ -80,6 +80,7 @@ /delete GWIDeleteR GET POST /workflows GWIWorkflowsR GET !¬empty /initiate GWIInitiateR GET POST !workflow + /update GWIUpdateR POST /global-workflows GlobalWorkflowWorkflowListR GET !free !/global-workflows/#CryptoFileNameWorkflowWorkflow GlobalWorkflowWorkflowR: / GWWWorkflowR GET POST !workflow @@ -146,6 +147,7 @@ /delete SWIDeleteR GET POST /workflows SWIWorkflowsR GET !¬empty /initiate SWIInitiateR GET POST !workflow + /update SWIUpdateR POST /workflows SchoolWorkflowWorkflowListR GET !free !/workflows/#CryptoFileNameWorkflowWorkflow SchoolWorkflowWorkflowR: / SWWWorkflowR GET POST !workflow diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 5be9cbd42..05495331a 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -141,6 +141,7 @@ breadcrumb (SchoolR ssh sRoute) = case sRoute of i18nCrumb MsgBreadcrumbWorkflowInstanceInitiate . Just . SchoolR ssh $ if | mayEdit -> SchoolWorkflowInstanceR win SWIEditR | otherwise -> SchoolWorkflowInstanceListR + SWIUpdateR -> i18nCrumb MsgBreadcrumbWorkflowInstanceUpdate . Just . SchoolR ssh $ SchoolWorkflowInstanceR win SWIEditR SchoolWorkflowWorkflowListR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowList . Just $ SchoolR ssh SchoolWorkflowInstanceListR SchoolWorkflowWorkflowR cID sRoute' -> case sRoute' of SWWWorkflowR -> i18nCrumb (MsgBreadcrumbWorkflowWorkflow cID) . Just $ SchoolR ssh SchoolWorkflowWorkflowListR @@ -428,6 +429,7 @@ breadcrumb (GlobalWorkflowInstanceR win sRoute) = case sRoute of i18nCrumb MsgBreadcrumbWorkflowInstanceInitiate . Just $ if | mayEdit -> GlobalWorkflowInstanceR win GWIEditR | otherwise -> GlobalWorkflowInstanceListR + GWIUpdateR -> i18nCrumb MsgBreadcrumbWorkflowInstanceUpdate . Just $ GlobalWorkflowInstanceR win GWIEditR breadcrumb GlobalWorkflowWorkflowListR = i18nCrumb MsgBreadcrumbWorkflowWorkflowList $ Just GlobalWorkflowInstanceListR breadcrumb (GlobalWorkflowWorkflowR cID sRoute) = case sRoute of GWWWorkflowR -> i18nCrumb (MsgBreadcrumbWorkflowWorkflow cID) $ Just GlobalWorkflowWorkflowListR diff --git a/src/Handler/Utils/Workflow/CanonicalRoute.hs b/src/Handler/Utils/Workflow/CanonicalRoute.hs index cb3117475..507da9cee 100644 --- a/src/Handler/Utils/Workflow/CanonicalRoute.hs +++ b/src/Handler/Utils/Workflow/CanonicalRoute.hs @@ -16,7 +16,7 @@ data WorkflowScopeRoute deriving (Eq, Ord, Read, Show, Generic, Typeable) data WorkflowInstanceR - = WIEditR | WIDeleteR | WIWorkflowsR | WIInitiateR + = WIEditR | WIDeleteR | WIWorkflowsR | WIInitiateR | WIUpdateR deriving (Eq, Ord, Read, Show, Generic, Typeable) data WorkflowWorkflowR @@ -36,6 +36,7 @@ _WorkflowScopeRoute = prism' (uncurry toRoute) toWorkflowScopeRoute WIDeleteR -> GWIDeleteR WIWorkflowsR -> GWIWorkflowsR WIInitiateR -> GWIInitiateR + WIUpdateR -> GWIUpdateR WorkflowWorkflowListR -> GlobalWorkflowWorkflowListR WorkflowWorkflowR wwCID subRoute -> GlobalWorkflowWorkflowR wwCID $ case subRoute of WWWorkflowR -> GWWWorkflowR @@ -50,6 +51,7 @@ _WorkflowScopeRoute = prism' (uncurry toRoute) toWorkflowScopeRoute WIDeleteR -> SWIDeleteR WIWorkflowsR -> SWIWorkflowsR WIInitiateR -> SWIInitiateR + WIUpdateR -> SWIUpdateR WorkflowWorkflowListR -> SchoolWorkflowWorkflowListR WorkflowWorkflowR wwCID subRoute -> SchoolWorkflowWorkflowR wwCID $ case subRoute of WWWorkflowR -> SWWWorkflowR @@ -65,6 +67,7 @@ _WorkflowScopeRoute = prism' (uncurry toRoute) toWorkflowScopeRoute GWIDeleteR -> WIDeleteR GWIWorkflowsR -> WIWorkflowsR GWIInitiateR -> WIInitiateR + GWIUpdateR -> WIUpdateR GlobalWorkflowWorkflowListR -> Just ( WSGlobal, WorkflowWorkflowListR ) GlobalWorkflowWorkflowR wwCID subRoute -> Just . (WSGlobal, ) . WorkflowWorkflowR wwCID $ case subRoute of GWWWorkflowR -> WWWorkflowR @@ -79,6 +82,7 @@ _WorkflowScopeRoute = prism' (uncurry toRoute) toWorkflowScopeRoute SWIDeleteR -> WIDeleteR SWIWorkflowsR -> WIWorkflowsR SWIInitiateR -> WIInitiateR + SWIUpdateR -> WIUpdateR SchoolWorkflowWorkflowListR -> Just ( WSSchool ssh, WorkflowWorkflowListR ) SchoolWorkflowWorkflowR wwCID subRoute -> Just . (WSSchool ssh, ) . WorkflowWorkflowR wwCID $ case subRoute of SWWWorkflowR -> WWWorkflowR diff --git a/src/Handler/Workflow/Instance.hs b/src/Handler/Workflow/Instance.hs index 836fa52be..4c9e1c883 100644 --- a/src/Handler/Workflow/Instance.hs +++ b/src/Handler/Workflow/Instance.hs @@ -7,3 +7,4 @@ import Handler.Workflow.Instance.New as Handler.Workflow.Instance import Handler.Workflow.Instance.Edit as Handler.Workflow.Instance import Handler.Workflow.Instance.Delete as Handler.Workflow.Instance import Handler.Workflow.Instance.Initiate as Handler.Workflow.Instance +import Handler.Workflow.Instance.Update as Handler.Workflow.Instance diff --git a/src/Handler/Workflow/Instance/List.hs b/src/Handler/Workflow/Instance/List.hs index 944109f1c..e2af7d31c 100644 --- a/src/Handler/Workflow/Instance/List.hs +++ b/src/Handler/Workflow/Instance/List.hs @@ -13,6 +13,7 @@ import Import import Handler.Utils import Utils.Workflow import Handler.Utils.Workflow.CanonicalRoute +import Handler.Workflow.Instance.Update import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Utils as E @@ -151,10 +152,12 @@ workflowInstanceListR rScope = do mayInitiate <- lift . hasWriteAccessTo $ toInitiateRoute workflowInstanceName mayEdit <- lift . hasReadAccessTo $ toEditRoute workflowInstanceName mayList <- lift . hasReadAccessTo $ toListRoute workflowInstanceName - guard $ mayInitiate || mayEdit || mayList - return (wi, desc) + mayUpdate <- lift . hasWriteAccessTo $ toUpdateRoute workflowInstanceName + guard $ mayInitiate || mayEdit || mayList || mayUpdate + canUpdate <- lift $ workflowInstanceCanUpdate wiId + return (wi, desc, canUpdate) - return . flip sortOn wis' $ \(Entity _ WorkflowInstance{..}, mDesc) + return . flip sortOn wis' $ \(Entity _ WorkflowInstance{..}, mDesc, _) -> ( NTop workflowInstanceCategory , workflowInstanceDescriptionTitle <$> mDesc , workflowInstanceName @@ -168,11 +171,19 @@ workflowInstanceListR rScope = do siteLayoutMsg heading $ do setTitleI title let mPitch = Just $(i18nWidgetFile "workflow-instance-list-explanation") + updateForm win = maybeT mempty . guardMOnM (lift . hasWriteAccessTo $ toUpdateRoute win) $ do + (updateWdgt, updateEnctype) <- liftHandler . generateFormPost . buttonForm' $ pure BtnWorkflowInstanceUpdate + lift $ wrapForm updateWdgt def + { formAction = Just . SomeRoute $ toUpdateRoute win + , formEncoding = updateEnctype + , formSubmit = FormNoSubmit + } $(widgetFile "workflows/instances") where toInitiateRoute win = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIInitiateR) toEditRoute win = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIEditR) toListRoute win = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIWorkflowsR) + toUpdateRoute win = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIUpdateR) getTopWorkflowInstanceListR :: Handler Html getTopWorkflowInstanceListR = do @@ -192,10 +203,12 @@ getTopWorkflowInstanceListR = do mayInitiate <- lift . hasWriteAccessTo $ toInitiateRoute' rScope workflowInstanceName mayEdit <- lift . hasReadAccessTo $ toEditRoute' rScope workflowInstanceName mayList <- lift . hasReadAccessTo $ toListRoute' rScope workflowInstanceName - guard $ mayInitiate || mayEdit || mayList - return (rScope, [(wi, desc)]) + mayUpdate <- lift . hasWriteAccessTo $ toUpdateRoute' rScope workflowInstanceName + guard $ mayInitiate || mayEdit || mayList || mayUpdate + canUpdate <- lift $ workflowInstanceCanUpdate wiId + return (rScope, [(wi, desc, canUpdate)]) - let iSortProj (Entity _ WorkflowInstance{..}, mDesc) + let iSortProj (Entity _ WorkflowInstance{..}, mDesc, _) = ( NTop workflowInstanceCategory , workflowInstanceDescriptionTitle <$> mDesc , workflowInstanceName @@ -209,8 +222,16 @@ getTopWorkflowInstanceListR = do toInitiateRoute = toInitiateRoute' rScope toEditRoute = toEditRoute' rScope toListRoute = toListRoute' rScope + toUpdateRoute = toUpdateRoute' rScope mPitch :: Maybe Widget mPitch = Nothing + updateForm win = maybeT mempty . guardMOnM (lift . hasWriteAccessTo $ toUpdateRoute win) $ do + (updateWdgt, updateEnctype) <- liftHandler . generateFormPost . buttonForm' $ pure BtnWorkflowInstanceUpdate + lift $ wrapForm updateWdgt def + { formAction = Just . SomeRoute $ toUpdateRoute win + , formEncoding = updateEnctype + , formSubmit = FormNoSubmit + } showHeadings = Map.keys gInstances /= [WSGlobal] pitch = $(i18nWidgetFile "workflow-instance-list-explanation") @@ -220,3 +241,4 @@ getTopWorkflowInstanceListR = do toInitiateRoute' rScope win = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIInitiateR) toEditRoute' rScope win = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIEditR) toListRoute' rScope win = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIWorkflowsR) + toUpdateRoute' rScope win = _WorkflowScopeRoute # (rScope, WorkflowInstanceR win WIUpdateR) diff --git a/src/Handler/Workflow/Instance/Update.hs b/src/Handler/Workflow/Instance/Update.hs new file mode 100644 index 000000000..ebd018209 --- /dev/null +++ b/src/Handler/Workflow/Instance/Update.hs @@ -0,0 +1,117 @@ +module Handler.Workflow.Instance.Update + ( WorkflowInstanceUpdateButton(..) + , workflowInstanceCanUpdate + , postGWIUpdateR, postSWIUpdateR + ) where + +import Import +import Utils.Form +import Utils.Workflow + +import Handler.Utils.Workflow.CanonicalRoute + +import qualified Data.CaseInsensitive as CI + +import qualified Data.Set as Set +import qualified Data.Map.Strict as Map + + +data WorkflowInstanceUpdateButton + = BtnWorkflowInstanceUpdate + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) + deriving anyclass (Universe, Finite) + +nullaryPathPiece ''WorkflowInstanceUpdateButton $ camelToPathPiece' 3 +embedRenderMessage ''UniWorX ''WorkflowInstanceUpdateButton id + +instance Button UniWorX WorkflowInstanceUpdateButton where + btnClasses _ = [BCIsButton] + + +data WorkflowInstanceUpdateAction + = WIUpdateGraph SharedWorkflowGraphId + | WIUpdateCategory (Maybe WorkflowInstanceCategory) + | WIUpdateInstanceDescription Lang (Maybe (Text, Maybe StoredMarkup)) + deriving (Eq, Ord, Read, Show, Generic, Typeable) + + +workflowInstanceUpdates :: WorkflowInstanceId + -> DB (Set WorkflowInstanceUpdateAction) +workflowInstanceUpdates wiId = execWriterT . maybeT_ $ do + WorkflowInstance{..} <- MaybeT . lift $ get wiId + wdId <- hoistMaybe workflowInstanceDefinition + WorkflowDefinition{..} <- MaybeT . lift $ get wdId + + when (workflowDefinitionGraph /= workflowInstanceGraph) $ + tellPoint $ WIUpdateGraph workflowDefinitionGraph + + when (workflowDefinitionInstanceCategory /= workflowInstanceCategory) $ + tellPoint $ WIUpdateCategory workflowDefinitionInstanceCategory + + iDescs <- lift . lift $ selectList [WorkflowInstanceDescriptionInstance ==. wiId] [] + dDescs <- lift . lift $ selectList [WorkflowDefinitionInstanceDescriptionDefinition ==. wdId] [] + + let iDescs' = Map.fromList $ map (\(Entity _ WorkflowInstanceDescription{..}) -> (CI.mk workflowInstanceDescriptionLanguage, (workflowInstanceDescriptionTitle, workflowInstanceDescriptionDescription))) iDescs + dDescs' = Map.fromList $ map (\(Entity _ WorkflowDefinitionInstanceDescription{..}) -> (CI.mk workflowDefinitionInstanceDescriptionLanguage, (workflowDefinitionInstanceDescriptionTitle, workflowDefinitionInstanceDescriptionDescription))) dDescs + + forM_ (Map.keysSet iDescs' `Set.union` Map.keysSet dDescs') $ \lang -> if + | Just iDesc <- Map.lookup lang iDescs' + , Just dDesc <- Map.lookup lang dDescs' + , iDesc /= dDesc + -> tellPoint . WIUpdateInstanceDescription (CI.original lang) $ Just dDesc + | Just dDesc <- Map.lookup lang dDescs' + , not $ Map.member lang iDescs' + -> tellPoint . WIUpdateInstanceDescription (CI.original lang) $ Just dDesc + | Map.member lang iDescs' + , not $ Map.member lang dDescs' + -> tellPoint $ WIUpdateInstanceDescription (CI.original lang) Nothing + | otherwise + -> return () + +workflowInstanceCanUpdate :: WorkflowInstanceId + -> DB Bool +workflowInstanceCanUpdate wiId = not . null <$> workflowInstanceUpdates wiId + + +postGWIUpdateR :: WorkflowInstanceName -> Handler Void +postGWIUpdateR = updateR WSGlobal + +postSWIUpdateR :: SchoolId -> WorkflowInstanceName -> Handler Void +postSWIUpdateR ssh = updateR $ WSSchool ssh + + +updateR :: RouteWorkflowScope -> WorkflowInstanceName -> Handler a +updateR rScope win = do + runDB $ do + scope <- maybeT notFound $ fromRouteWorkflowScope rScope + wiId <- getKeyBy404 . UniqueWorkflowInstance win $ scope ^. _DBWorkflowScope + updates <- workflowInstanceUpdates wiId + + when (null updates) $ + addMessageI Warning MsgWorkflowInstanceUpdateNoActions + + forM_ updates $ \case + WIUpdateGraph graphId -> do + update wiId [ WorkflowInstanceGraph =. graphId ] + addMessageI Success MsgWorkflowInstanceUpdateUpdatedGraph + WIUpdateCategory iCat -> do + update wiId [ WorkflowInstanceCategory =. iCat ] + addMessageI Success MsgWorkflowInstanceUpdateUpdatedCategory + WIUpdateInstanceDescription lang Nothing -> do + deleteBy $ UniqueWorkflowInstanceDescription wiId lang + addMessageI Success $ MsgWorkflowInstanceUpdateDeletedDescriptionLanguage lang + WIUpdateInstanceDescription lang (Just (title, mDesc)) -> do + void $ upsertBy + (UniqueWorkflowInstanceDescription wiId lang) + WorkflowInstanceDescription + { workflowInstanceDescriptionInstance = wiId + , workflowInstanceDescriptionLanguage = lang + , workflowInstanceDescriptionTitle = title + , workflowInstanceDescriptionDescription = mDesc + } + [ WorkflowInstanceDescriptionTitle =. title + , WorkflowInstanceDescriptionDescription =. mDesc + ] + addMessageI Success $ MsgWorkflowInstanceUpdateUpdatedDescriptionLanguage lang + + redirect $ _WorkflowScopeRoute # ( rScope, WorkflowInstanceListR ) diff --git a/templates/workflows/instances.hamlet b/templates/workflows/instances.hamlet index 07895b7fc..7886eefcd 100644 --- a/templates/workflows/instances.hamlet +++ b/templates/workflows/instances.hamlet @@ -4,7 +4,7 @@ $maybe pitch <- mPitch ^{pitch}
    - $forall (Entity _ WorkflowInstance{workflowInstanceName}, mDesc) <- instances + $forall (Entity _ WorkflowInstance{workflowInstanceName}, mDesc, canUpdate) <- instances
  • $maybe WorkflowInstanceDescription{workflowInstanceDescriptionTitle} <- mDesc

    @@ -17,6 +17,8 @@ $maybe pitch <- mPitch ^{linkButton mempty (i18n MsgMenuWorkflowInstanceWorkflows) [BCIsButton, BCPrimary] $ SomeRoute $ toListRoute workflowInstanceName} ^{linkButton mempty (i18n MsgMenuWorkflowInstanceInitiate) [BCIsButton] $ SomeRoute $ toInitiateRoute workflowInstanceName} ^{linkButton mempty (i18n MsgMenuWorkflowInstanceEdit) [BCIsButton] $ SomeRoute $ toEditRoute workflowInstanceName} + $if canUpdate + ^{updateForm workflowInstanceName} $maybe desc <- workflowInstanceDescriptionDescription =<< mDesc

    From 0dd6b8d88022c82bf0551c808c52b3a6a3396d7f Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 5 Jul 2021 22:45:53 +0200 Subject: [PATCH 023/120] chore(release): 25.15.0 --- CHANGELOG.md | 20 ++++++++++++++++++++ package-lock.json | 2 +- package.json | 2 +- package.yaml | 2 +- 4 files changed, 23 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7b5266122..c32d1048e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,26 @@ All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. +## [25.15.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.14.2...v25.15.0) (2021-07-05) + + +### Features + +* **course material:** auto vorschläge für materialtype ([decdda3](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/decdda359d16cce429a7e7a07d4674840e5fe6af)) +* **course material:** first two filters ([90e4a62](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/90e4a620f0c1671ff332db1910c176e58ccbac06)) +* **course material:** materialDescription in progress ([89e9887](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/89e9887fe1112cbc21517e4b501ead33f5a969ba)) +* **course material:** materialdescription search implemented ([3a9622d](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/3a9622dfb8474d9f3764f5870197e317a96d9de3)) +* **course material:** merge-request suggestions ([dc5fc3f](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/dc5fc3f710363f0644c43866505e32095b41ce92)) +* **course material:** runDB für cid nur einmal ([c09acbb](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/c09acbbf8a7b95176b3d52449b3b9d26e315ccd6)) +* **course material:** small empty-bug fixed ([d8b1f97](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/d8b1f9788c74ea5d7dc4f1f45432649d9601106a)) +* **workflows:** update instances from definitions ([32efdae](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/32efdae839b1a3e43ed4161d20e598964970f15e)) + + +### Bug Fixes + +* **workflows:** workflow-definition edit translations ([5c5cbad](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/5c5cbaddf8b33f455ff18789806a3e0f9ac447ed)) +* typo course-assistant ([c7ce167](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/c7ce1679de799285ec7a9a0a62c0a202b9078eb3)) + ## [25.14.2](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.14.1...v25.14.2) (2021-06-28) diff --git a/package-lock.json b/package-lock.json index 35762cf3b..a82b5a249 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "25.14.2", + "version": "25.15.0", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index dded55446..34aa720ad 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "25.14.2", + "version": "25.15.0", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index d0306488d..7777ceb7f 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 25.14.2 +version: 25.15.0 dependencies: - base - yesod From ef7fde937ebf1bc31e3706fba1da166bb82133c5 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 6 Jul 2021 10:18:07 +0200 Subject: [PATCH 024/120] fix(cache): atomicity & workflow instance invalidations --- src/Foundation/Authorization.hs | 6 +++--- src/Foundation/Navigation.hs | 2 +- src/Handler/Utils/Memcached.hs | 5 +++-- src/Handler/Workflow/Instance/Update.hs | 6 ++++++ src/Utils/ARC.hs | 15 ++++++++++----- 5 files changed, 23 insertions(+), 11 deletions(-) diff --git a/src/Foundation/Authorization.hs b/src/Foundation/Authorization.hs index 5d3f9a697..cef8e26ea 100644 --- a/src/Foundation/Authorization.hs +++ b/src/Foundation/Authorization.hs @@ -1720,7 +1720,7 @@ tagAccessPredicate AuthWorkflow = APDB $ \evalCtx eval' mAuthId route isWrite -> wInitiate win rScope = selectLanguageI18n <=< $memcacheAuthHere' (Right diffDay) (evalCtx, route, mAuthId) . maybeT (unauthorizedI18n MsgUnauthorizedWorkflowInitiate) $ do -- @isWrite@ not included since it should make no difference regarding initiation (in the end that will always be a write) - roles <- memcacheAuth' (Right diffDay) (AuthCacheWorkflowInstanceInitiators win rScope) $ do + roles <- memcacheAuth' @(Set (WorkflowRole UserId)) (Right diffDay) (AuthCacheWorkflowInstanceInitiators win rScope) $ do scope <- MaybeT . $cachedHereBinary rScope . runMaybeT $ fromRouteWorkflowScope rScope Entity _ WorkflowInstance{..} <- $cachedHereBinary (win, scope) . MaybeT . getBy . UniqueWorkflowInstance win $ scope ^. _DBWorkflowScope wiGraph <- lift $ getSharedIdWorkflowGraph workflowInstanceGraph @@ -1753,7 +1753,7 @@ tagAccessPredicate AuthWorkflow = APDB $ \evalCtx eval' mAuthId route isWrite -> guardM . fmap (is _Authorized) $ ofoldl1' orAR' . mapNonNull evalRole =<< hoistMaybe (fromNullable $ otoList edges) return Authorized | otherwise = flip orAR' (wWorkflow True cID) . maybeT (unauthorizedI MsgUnauthorizedWorkflowRead) $ do - (wwId, roles) <- memcacheAuth' (Right diffDay) (AuthCacheWorkflowWorkflowViewers cID) $ do + (wwId, roles) <- memcacheAuth' @(WorkflowWorkflowId, Set (WorkflowRole UserId)) (Right diffDay) (AuthCacheWorkflowWorkflowViewers cID) $ do wwId <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID WorkflowWorkflow{..} <- MaybeT . $cachedHereBinary wwId $ get wwId wwGraph <- lift $ getSharedIdWorkflowGraph workflowWorkflowGraph @@ -1772,7 +1772,7 @@ tagAccessPredicate AuthWorkflow = APDB $ \evalCtx eval' mAuthId route isWrite -> guard $ Map.lookup payload (workflowStateCurrentPayloads prevActs) /= Map.lookup payload (wpPayload act) fmap (toNullable . wpvViewers) . hoistMaybe $ Map.lookup payload . wgnPayloadView =<< Map.lookup (wpTo prevAct) (wgNodes wwGraph) - return (wwId, fold nodeViewers <> fold payloadViewers :: (Set (WorkflowRole UserId))) + return (wwId, fold nodeViewers <> fold payloadViewers) let evalRole role = lift . evalWriterT $ evalWorkflowRoleFor' eval' mAuthId (Just wwId) role route isWrite diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 05495331a..3f2f77b37 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -2734,7 +2734,7 @@ haveTopWorkflowInstances, haveTopWorkflowWorkflows ) => ReaderT backend m Bool haveTopWorkflowInstances = hoist liftHandler . withReaderT (projectBackend @SqlReadBackend) . $cachedHere . maybeT (return False) $ do - roles <- memcachedBy (Just $ Right diffDay) NavCacheHaveTopWorkflowInstancesRoles $ do + roles <- memcachedBy @(Set ((RouteWorkflowScope, WorkflowInstanceName), WorkflowRole UserId)) (Just $ Right diffDay) NavCacheHaveTopWorkflowInstancesRoles $ do let getInstances = E.selectSource . E.from $ \workflowInstance -> do E.where_ . isTopWorkflowScopeSql $ workflowInstance E.^. WorkflowInstanceScope diff --git a/src/Handler/Utils/Memcached.hs b/src/Handler/Utils/Memcached.hs index 41dd2aecc..937a26d32 100644 --- a/src/Handler/Utils/Memcached.hs +++ b/src/Handler/Utils/Memcached.hs @@ -356,7 +356,8 @@ memcached :: ( MonadHandler m, HandlerSite m ~ UniWorX => Maybe Expiry -> m a -> m a memcached mExp = memcachedWith (memcachedGet, \x -> x <$ memcachedSet mExp x) -memcachedBy :: ( MonadHandler m, HandlerSite m ~ UniWorX +memcachedBy :: forall a m k. + ( MonadHandler m, HandlerSite m ~ UniWorX , MonadThrow m , Typeable a, Binary a, NFData a , Binary k @@ -550,7 +551,7 @@ memcacheAuth k mx = cachedByBinary k $ do | otherwise -> evalWriterT mx -memcacheAuth' :: forall m k a. +memcacheAuth' :: forall a m k. ( MonadHandler m, HandlerSite m ~ UniWorX , MonadThrow m , Typeable a, Binary a, NFData a diff --git a/src/Handler/Workflow/Instance/Update.hs b/src/Handler/Workflow/Instance/Update.hs index ebd018209..5453fba79 100644 --- a/src/Handler/Workflow/Instance/Update.hs +++ b/src/Handler/Workflow/Instance/Update.hs @@ -15,6 +15,8 @@ import qualified Data.CaseInsensitive as CI import qualified Data.Set as Set import qualified Data.Map.Strict as Map +import Handler.Utils.Memcached + data WorkflowInstanceUpdateButton = BtnWorkflowInstanceUpdate @@ -113,5 +115,9 @@ updateR rScope win = do , WorkflowInstanceDescriptionDescription =. mDesc ] addMessageI Success $ MsgWorkflowInstanceUpdateUpdatedDescriptionLanguage lang + memcachedByInvalidate (AuthCacheWorkflowInstanceInitiators win rScope) $ Proxy @(Set (WorkflowRole UserId)) + memcachedByInvalidate (AuthCacheWorkflowInstanceWorkflowViewers win rScope) $ Proxy @(WorkflowWorkflowId, Set (WorkflowRole UserId)) + when (isTopWorkflowScope rScope) $ + memcachedByInvalidate NavCacheHaveTopWorkflowInstancesRoles $ Proxy @(Set ((RouteWorkflowScope, WorkflowInstanceName), WorkflowRole UserId)) redirect $ _WorkflowScopeRoute # ( rScope, WorkflowInstanceListR ) diff --git a/src/Utils/ARC.hs b/src/Utils/ARC.hs index 1545ebf08..62726eb62 100644 --- a/src/Utils/ARC.hs +++ b/src/Utils/ARC.hs @@ -277,20 +277,25 @@ cachedARC' :: forall k w v m. cachedARC' (ARCHandle arcVar) k f = do oldVal <- lookupARC k <$> readIORef arcVar newVal <- f oldVal - modifyIORef' arcVar $ uncurry (insertARC k newVal) + atomicModifyIORef' arcVar $ (, ()) . uncurry (insertARC k newVal) -- Using `modifyIORef'` instead of `atomicModifyIORef'` might very -- well drop newer values computed during the update. -- - -- Currently we accept that to reduce lock contention. + -- This was deemed unacceptable due to the risk of cache + -- invalidations being silently dropped -- -- Another alternative would be to use "optimistic locking", -- i.e. read the current value of `arcVar`, compute an updated -- version, and write it back atomically iff the `ARCTick` hasn't -- changed. -- - -- This was not implemented to avoid the overhead and contention - -- likely associated with the atomic transaction required for the - -- "compare and swap" + -- This was not implemented in the hopes that atomicModifyIORef' + -- already offers sufficient performance. + -- + -- If optimistic locking is implemented there is a risk of + -- performance issues due to the overhead and contention likely + -- associated with the atomic transaction required for the "compare + -- and swap" return $ view _1 <$> newVal cachedARC :: forall k w v m. From 59b0b8caf27ce1e6dd77b9b7de80097e4231a251 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 6 Jul 2021 10:39:03 +0200 Subject: [PATCH 025/120] chore(release): 25.15.1 --- CHANGELOG.md | 7 +++++++ package-lock.json | 2 +- package.json | 2 +- package.yaml | 2 +- 4 files changed, 10 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c32d1048e..b52362485 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,13 @@ All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. +## [25.15.1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.15.0...v25.15.1) (2021-07-06) + + +### Bug Fixes + +* **cache:** atomicity & workflow instance invalidations ([ef7fde9](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/ef7fde937ebf1bc31e3706fba1da166bb82133c5)) + ## [25.15.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.14.2...v25.15.0) (2021-07-05) diff --git a/package-lock.json b/package-lock.json index a82b5a249..a7685af03 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "25.15.0", + "version": "25.15.1", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index 34aa720ad..74e023fc1 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "25.15.0", + "version": "25.15.1", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index 7777ceb7f..07edecf3f 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 25.15.0 +version: 25.15.1 dependencies: - base - yesod From 627a2df7adf41651e698d8cd9d632d066fc2f868 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 6 Jul 2021 16:30:30 +0200 Subject: [PATCH 026/120] fix(explained-selection-field): support linebreak in titles --- frontend/src/utils/form/form.sass | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/frontend/src/utils/form/form.sass b/frontend/src/utils/form/form.sass index 6cc61d189..a6eac0455 100644 --- a/frontend/src/utils/form/form.sass +++ b/frontend/src/utils/form/form.sass @@ -43,7 +43,7 @@ fieldset display: grid grid-gap: 0 7px grid-template-columns: 25px 1fr - grid-template-rows: 25px 1fr + grid-template-rows: minmax(25px, auto) 1fr grid-template-areas: 'radiobox title' '. explanation' margin: 5px width: calc(33.33% - 10px) From c1c87a61046222dc9d680f61a8b1df0460730b61 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 6 Jul 2021 17:30:30 +0200 Subject: [PATCH 027/120] chore: bump esqueleto --- stack.yaml | 3 +++ stack.yaml.lock | 11 +++++++++++ 2 files changed, 14 insertions(+) diff --git a/stack.yaml b/stack.yaml index dd314a232..3dd0e2dab 100644 --- a/stack.yaml +++ b/stack.yaml @@ -83,6 +83,9 @@ extra-deps: - git: git@gitlab2.rz.ifi.lmu.de:uni2work/cryptonite.git commit: 71a630edaf5f22c464e24fac8d9d310f4055ea1f + - git: git@gitlab2.rz.ifi.lmu.de:uni2work/esqueleto.git + commit: b9987d94af9d7403eded8ca75ad761eb7fc06e4c + - classy-prelude-yesod-1.5.0@sha256:8f7e183bdfd6d2ea9674284c4f285294ab086aff60d9be4e5d7d2f3c1a2b05b7,1330 - acid-state-0.16.0.1@sha256:d43f6ee0b23338758156c500290c4405d769abefeb98e9bc112780dae09ece6f,6207 # - commonmark-0.1.1.2@sha256:c06ab05f0f224ab7982502a96e17952823a9b6dae8505fb35194b0baa9e2a975,3278 diff --git a/stack.yaml.lock b/stack.yaml.lock index ab8c4dbba..531c27d3f 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -426,6 +426,17 @@ packages: original: git: git@gitlab2.rz.ifi.lmu.de:uni2work/cryptonite.git commit: 71a630edaf5f22c464e24fac8d9d310f4055ea1f +- completed: + name: esqueleto + version: 3.5.2.0 + git: git@gitlab2.rz.ifi.lmu.de:uni2work/esqueleto.git + pantry-tree: + size: 5630 + sha256: b949af2533893ffd16407825d22c0a524ffa48cdd0eab91644cbe0dc4b2c8319 + commit: b9987d94af9d7403eded8ca75ad761eb7fc06e4c + original: + git: git@gitlab2.rz.ifi.lmu.de:uni2work/esqueleto.git + commit: b9987d94af9d7403eded8ca75ad761eb7fc06e4c - completed: hackage: classy-prelude-yesod-1.5.0@sha256:8f7e183bdfd6d2ea9674284c4f285294ab086aff60d9be4e5d7d2f3c1a2b05b7,1330 pantry-tree: From f441d432ab85c96e0a16bd2d2f985591f475b712 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 6 Jul 2021 17:31:04 +0200 Subject: [PATCH 028/120] chore(release): 25.15.2 --- CHANGELOG.md | 7 +++++++ package-lock.json | 2 +- package.json | 2 +- package.yaml | 2 +- 4 files changed, 10 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index b52362485..f6f9ff6ea 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,13 @@ All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. +## [25.15.2](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.15.1...v25.15.2) (2021-07-06) + + +### Bug Fixes + +* **explained-selection-field:** support linebreak in titles ([627a2df](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/627a2df7adf41651e698d8cd9d632d066fc2f868)) + ## [25.15.1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.15.0...v25.15.1) (2021-07-06) diff --git a/package-lock.json b/package-lock.json index a7685af03..7a7939951 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "25.15.1", + "version": "25.15.2", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index 74e023fc1..e39b644bc 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "25.15.1", + "version": "25.15.2", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index 07edecf3f..b17f7f306 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 25.15.1 +version: 25.15.2 dependencies: - base - yesod From 0b8890d1f2116e86e8c80534ee8d19681fb8cbbb Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 8 Jul 2021 15:58:31 +0200 Subject: [PATCH 029/120] chore: prevent creating nested .stack-work --- clean.sh | 8 ++++---- ghci.sh | 8 ++++---- haddock.sh | 8 ++++---- hlint.sh | 8 ++++---- hoogle.sh | 8 ++++---- start.sh | 8 ++++---- test.sh | 8 ++++---- 7 files changed, 28 insertions(+), 28 deletions(-) diff --git a/clean.sh b/clean.sh index d63a4deab..0d7a3017b 100755 --- a/clean.sh +++ b/clean.sh @@ -24,15 +24,15 @@ if [[ "${target}" != ".stack-work" ]]; then move-back() { if [[ -d .stack-work ]]; then - mv -v .stack-work "${target}" + mv -vT .stack-work "${target}" else mkdir -v "${target}" fi - [[ -d .stack-work-clean ]] && mv -v .stack-work-clean .stack-work + [[ -d .stack-work-clean ]] && mv -vT .stack-work-clean .stack-work } - mv -v .stack-work .stack-work-clean - mv -v "${target}" .stack-work + mv -vT .stack-work .stack-work-clean + mv -vT "${target}" .stack-work trap move-back EXIT fi diff --git a/ghci.sh b/ghci.sh index ab5479c78..2772f30d6 100755 --- a/ghci.sh +++ b/ghci.sh @@ -16,13 +16,13 @@ unset HOST move-back() { - mv -v .stack-work .stack-work-ghci - [[ -d .stack-work-build ]] && mv -v .stack-work-build .stack-work + mv -vT .stack-work .stack-work-ghci + [[ -d .stack-work-build ]] && mv -vT .stack-work-build .stack-work } if [[ -d .stack-work-ghci ]]; then - [[ -d .stack-work ]] && mv -v .stack-work .stack-work-build - mv -v .stack-work-ghci .stack-work + [[ -d .stack-work ]] && mv -vT .stack-work .stack-work-build + mv -vT .stack-work-ghci .stack-work trap move-back EXIT fi diff --git a/haddock.sh b/haddock.sh index 00308065f..582d2381d 100755 --- a/haddock.sh +++ b/haddock.sh @@ -5,13 +5,13 @@ set -e [ "${FLOCKER}" != "$0" ] && exec env FLOCKER="$0" flock -en .stack-work.lock "$0" "$@" || : move-back() { - mv -v .stack-work .stack-work-doc - [[ -d .stack-work-build ]] && mv -v .stack-work-build .stack-work + mv -vT .stack-work .stack-work-doc + [[ -d .stack-work-build ]] && mv -vT .stack-work-build .stack-work } if [[ -d .stack-work-doc ]]; then - [[ -d .stack-work ]] && mv -v .stack-work .stack-work-build - mv -v .stack-work-doc .stack-work + [[ -d .stack-work ]] && mv -vT .stack-work .stack-work-build + mv -vT .stack-work-doc .stack-work trap move-back EXIT fi diff --git a/hlint.sh b/hlint.sh index 5f30751cc..20acc727e 100755 --- a/hlint.sh +++ b/hlint.sh @@ -5,13 +5,13 @@ set -e [ "${FLOCKER}" != "$0" ] && exec env FLOCKER="$0" flock -en .stack-work.lock "$0" "$@" || : move-back() { - mv -v .stack-work .stack-work-test - [[ -d .stack-work-build ]] && mv -v .stack-work-build .stack-work + mv -vT .stack-work .stack-work-test + [[ -d .stack-work-build ]] && mv -vT .stack-work-build .stack-work } if [[ -d .stack-work-test ]]; then - [[ -d .stack-work ]] && mv -v .stack-work .stack-work-build - mv -v .stack-work-test .stack-work + [[ -d .stack-work ]] && mv -vT .stack-work .stack-work-build + mv -vT .stack-work-test .stack-work trap move-back EXIT fi diff --git a/hoogle.sh b/hoogle.sh index e11f9a92e..f3bcb8bf8 100755 --- a/hoogle.sh +++ b/hoogle.sh @@ -5,13 +5,13 @@ set -e [ "${FLOCKER}" != "$0" ] && exec env FLOCKER="$0" flock -en .stack-work.lock "$0" "$@" || : move-back() { - mv -v .stack-work .stack-work-doc - [[ -d .stack-work-build ]] && mv -v .stack-work-build .stack-work + mv -vT .stack-work .stack-work-doc + [[ -d .stack-work-build ]] && mv -vT .stack-work-build .stack-work } if [[ -d .stack-work-doc ]]; then - [[ -d .stack-work ]] && mv -v .stack-work .stack-work-build - mv -v .stack-work-doc .stack-work + [[ -d .stack-work ]] && mv -vT .stack-work .stack-work-build + mv -vT .stack-work-doc .stack-work trap move-back EXIT fi diff --git a/start.sh b/start.sh index 7f9765589..82015828e 100755 --- a/start.sh +++ b/start.sh @@ -20,13 +20,13 @@ export APPROOT=${APPROOT:-http://localhost:$((${PORT_OFFSET:-0} + 3000))} unset HOST move-back() { - mv -v .stack-work .stack-work-run - [[ -d .stack-work-build ]] && mv -v .stack-work-build .stack-work + mv -vT .stack-work .stack-work-run + [[ -d .stack-work-build ]] && mv -vT .stack-work-build .stack-work } if [[ -d .stack-work-run ]]; then - [[ -d .stack-work ]] && mv -v .stack-work .stack-work-build - mv -v .stack-work-run .stack-work + [[ -d .stack-work ]] && mv -vT .stack-work .stack-work-build + mv -vT .stack-work-run .stack-work trap move-back EXIT fi diff --git a/test.sh b/test.sh index e0ef0b657..14d8361fd 100755 --- a/test.sh +++ b/test.sh @@ -7,13 +7,13 @@ set -e [ "${FLOCKER}" != "$0" ] && exec env FLOCKER="$0" flock -en .stack-work.lock "$0" "$@" || : move-back() { - mv -v .stack-work .stack-work-test - [[ -d .stack-work-build ]] && mv -v .stack-work-build .stack-work + mv -vT .stack-work .stack-work-test + [[ -d .stack-work-build ]] && mv -vT .stack-work-build .stack-work } if [[ -d .stack-work-test ]]; then - [[ -d .stack-work ]] && mv -v .stack-work .stack-work-build - mv -v .stack-work-test .stack-work + [[ -d .stack-work ]] && mv -vT .stack-work .stack-work-build + mv -vT .stack-work-test .stack-work trap move-back EXIT fi From 576fccb5222a5dbd19db69f142a39b4155b7486d Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 8 Jul 2021 20:20:40 +0200 Subject: [PATCH 030/120] fix: avoid subSelectForeign join issues --- src/Jobs/Handler/Files.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Jobs/Handler/Files.hs b/src/Jobs/Handler/Files.hs index deaedd332..7ab592eb1 100644 --- a/src/Jobs/Handler/Files.hs +++ b/src/Jobs/Handler/Files.hs @@ -198,14 +198,14 @@ dispatchJobPruneUnreferencedFiles numIterations epoch iteration = JobHandlerAtom ) E.delete . E.from $ \fileContentChunkUnreferenced -> do - let unreferencedChunkHash = E.subSelectForeign fileContentChunkUnreferenced FileContentChunkUnreferencedHash (E.^. FileContentChunkHash) + let unreferencedChunkHash = E.unKey $ fileContentChunkUnreferenced E.^. FileContentChunkUnreferencedHash E.where_ . E.subSelectOr . E.from $ \fileContentEntry -> do E.where_ $ fileContentEntry E.^. FileContentEntryChunkHash E.==. unreferencedChunkHash return $ E.any E.exists (fileReferences $ fileContentEntry E.^. FileContentEntryHash) E.where_ $ chunkIdFilter unreferencedChunkHash let unmarkWorkflowFiles (otoList -> fRefs) = E.delete . E.from $ \fileContentChunkUnreferenced -> do - let unreferencedChunkHash = E.subSelectForeign fileContentChunkUnreferenced FileContentChunkUnreferencedHash (E.^. FileContentChunkHash) + let unreferencedChunkHash = E.unKey $ fileContentChunkUnreferenced E.^. FileContentChunkUnreferencedHash E.where_ . E.subSelectOr . E.from $ \fileContentEntry -> do E.where_ $ fileContentEntry E.^. FileContentEntryChunkHash E.==. unreferencedChunkHash return $ fileContentEntry E.^. FileContentEntryHash `E.in_` E.valList fRefs @@ -216,7 +216,7 @@ dispatchJobPruneUnreferencedFiles numIterations epoch iteration = JobHandlerAtom let getEntryCandidates = E.selectSource . E.from $ \fileContentEntry -> do let unreferencedSince = E.subSelectMaybe . E.from $ \(fileContentEntry' `E.InnerJoin` fileContentChunkUnreferenced) -> do - let unreferencedChunkHash = E.subSelectForeign fileContentChunkUnreferenced FileContentChunkUnreferencedHash (E.^. FileContentChunkHash) + let unreferencedChunkHash = E.unKey $ fileContentChunkUnreferenced E.^. FileContentChunkUnreferencedHash E.on $ fileContentEntry' E.^. FileContentEntryChunkHash E.==. unreferencedChunkHash E.where_ $ fileContentEntry' E.^. FileContentEntryHash E.==. fileContentEntry E.^. FileContentEntryHash E.where_ $ chunkIdFilter unreferencedChunkHash @@ -240,7 +240,7 @@ dispatchJobPruneUnreferencedFiles numIterations epoch iteration = JobHandlerAtom let getChunkCandidates = E.selectSource . E.from $ \fileContentChunkUnreferenced -> do - let unreferencedChunkHash = E.subSelectForeign fileContentChunkUnreferenced FileContentChunkUnreferencedHash (E.^. FileContentChunkHash) + let unreferencedChunkHash = E.unKey $ fileContentChunkUnreferenced E.^. FileContentChunkUnreferencedHash E.where_ $ fileContentChunkUnreferenced E.^. FileContentChunkUnreferencedSince E.<. E.val (addUTCTime (-keep) now) E.where_ . E.not_ . E.exists . E.from $ \fileContentEntry -> E.where_ $ fileContentEntry E.^. FileContentEntryChunkHash E.==. unreferencedChunkHash From ad7bf881bd69f086b7204e1575db53dbfbd1fbc4 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 8 Jul 2021 20:43:04 +0200 Subject: [PATCH 031/120] chore(release): 25.15.3 --- CHANGELOG.md | 7 +++++++ package-lock.json | 2 +- package.json | 2 +- package.yaml | 2 +- 4 files changed, 10 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f6f9ff6ea..b0c3c128c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,13 @@ All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. +## [25.15.3](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.15.2...v25.15.3) (2021-07-08) + + +### Bug Fixes + +* avoid subSelectForeign join issues ([576fccb](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/576fccb5222a5dbd19db69f142a39b4155b7486d)) + ## [25.15.2](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.15.1...v25.15.2) (2021-07-06) diff --git a/package-lock.json b/package-lock.json index 7a7939951..6334ca460 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "25.15.2", + "version": "25.15.3", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index e39b644bc..961d0d6a0 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "25.15.2", + "version": "25.15.3", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index b17f7f306..651fb9faf 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 25.15.2 +version: 25.15.3 dependencies: - base - yesod From cf679452928c14200e1eb3877987ee299fbf9f6f Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 13 Jul 2021 10:46:23 +0200 Subject: [PATCH 032/120] feat(personalised-sheet-files): seeds --- .../categories/courses/sheet/de-de-formal.msg | 2 + .../categories/courses/sheet/en-eu.msg | 2 + models/sheets.model | 8 +- shell.nix | 8 +- src/Application.hs | 8 +- src/Audit/Types.hs | 6 +- src/Foundation/Type.hs | 4 +- src/Handler/Sheet/PersonalisedFiles.hs | 36 +++--- src/Handler/Sheet/PersonalisedFiles/Meta.hs | 21 +++- src/Handler/Sheet/PersonalisedFiles/Types.hs | 78 ++++++++++++- src/Handler/Utils/Users.hs | 13 +++ src/Import/NoModel.hs | 1 + src/Jobs/HealthReport.hs | 4 + src/Model/Types/TH/Binary.hs | 103 ++++++++++++++++++ src/Settings/Cluster.hs | 9 ++ ...ised-sheet-files-seeds.de-de-formal.hamlet | 3 + ...ersonalised-sheet-files-seeds.en-eu.hamlet | 3 + 17 files changed, 282 insertions(+), 27 deletions(-) create mode 100644 src/Model/Types/TH/Binary.hs create mode 100644 templates/i18n/changelog/personalised-sheet-files-seeds.de-de-formal.hamlet create mode 100644 templates/i18n/changelog/personalised-sheet-files-seeds.en-eu.hamlet diff --git a/messages/uniworx/categories/courses/sheet/de-de-formal.msg b/messages/uniworx/categories/courses/sheet/de-de-formal.msg index c6d9e7959..4a19ad8df 100644 --- a/messages/uniworx/categories/courses/sheet/de-de-formal.msg +++ b/messages/uniworx/categories/courses/sheet/de-de-formal.msg @@ -42,6 +42,8 @@ SheetPersonalisedFilesAllowNonPersonalisedSubmission: Nicht-personalisierte Abga SheetPersonalisedFilesAllowNonPersonalisedSubmissionTip: Sollen auch Kursteilnehmer:innen abgeben dürfen, für die keine personalisierten Dateien hinterlegt wurden? SheetPersonalisedFilesDownloadTemplateHere: Sie können hier ein Vorlage-Archiv für die vom System erwartete Verzeichnisstruktur für personalisierte Übungsblatt-Dateien herunterladen: SheetPersonalisedFilesUsersList: Liste von Teilnehmern mit personalisierten Übungsblatt-Dateien +SheetPersonalisedFilesMetaYAMLSeedComment: Dieser String wird in einem kryptographischen Verfahren aus Daten generiert, die Benutzer:in und Übungsblatt eindeutig identifizieren. Er ist geeignet als Seed für einen Pseudozufallsgenerator verwendet zu werden um personalisierte Dateien (teil-)zufällig zu erzeugen. +SheetPersonalisedFilesMetaYAMLNoSeedComment: Damit genügend Informationen vorhanden sind um Anhand von Daten des/der Benutzer/Benutzerin an dieser Stelle einen String zu erzeugen, der als Seed für einen Pseudozufallsgenerator geeignet ist, muss das Übungsblatt zunächst in Uni2work angelegt werden. SheetActiveFromTip: Download der Aufgabenstellung und Abgabe erst ab diesem Datum möglich. Ohne Datum keine Abgabe und keine Herausgabe der Aufgabenstellung SheetActiveToTip: Abgabe nur bis zu diesem Datum möglich. Ohne Datum unbeschränkte Abgabe möglich (soweit gefordert). SheetHintFrom: Hinweis ab diff --git a/messages/uniworx/categories/courses/sheet/en-eu.msg b/messages/uniworx/categories/courses/sheet/en-eu.msg index 32292cc68..461fc347d 100644 --- a/messages/uniworx/categories/courses/sheet/en-eu.msg +++ b/messages/uniworx/categories/courses/sheet/en-eu.msg @@ -42,6 +42,8 @@ SheetPersonalisedFilesAllowNonPersonalisedSubmission: Allow non-personalised sub SheetPersonalisedFilesAllowNonPersonalisedSubmissionTip: Should course participants with no assigned personalised files be allowed to submit anyway? SheetPersonalisedFilesDownloadTemplateHere: You can download a template for a ZIP-archive of personalised sheet files with the structure that Uni2work expects here: SheetPersonalisedFilesUsersList: List of course participants who have personalised sheet files +SheetPersonalisedFilesMetaYAMLSeedComment: This string was generated cryptographically from data uniquely identifying the user and exercise sheet. You can use it as a seed for a pseudorandom generator for generating (parts of) the personalised files. +SheetPersonalisedFilesMetaYAMLNoSeedComment: There is not enough information available to generate a seed. You will have to create the exercise sheet in Uni2work first. Once seeds can be generated they will be generated cryptographically and you may use them to generate (parts of) the personalised files. SheetActiveFromTip: The exercise sheet's assignment will only be available for download and submission starting at this time. If left empty no submission or download of assignment is ever allowed SheetActiveToTip: Submission will only be possible until this time. If left empty submissions are allowed forever (if at all possible) SheetHintFrom: Hint from diff --git a/models/sheets.model b/models/sheets.model index 57213ec7b..08073eed3 100644 --- a/models/sheets.model +++ b/models/sheets.model @@ -59,9 +59,9 @@ PersonalisedSheetFile deriving Eq Ord Read Show Typeable Generic FallbackPersonalisedSheetFilesKey - course CourseId OnDeleteCascade OnUpdateCascade - index Word24 - secret ByteString - generated UTCTime + course CourseId OnDeleteCascade OnUpdateCascade + index Word24 + secret ByteString + generated UTCTime UniqueFallbackPersonalisedSheetFilesKey course index deriving Generic \ No newline at end of file diff --git a/shell.nix b/shell.nix index 8280c7d5f..10eb9dfcd 100644 --- a/shell.nix +++ b/shell.nix @@ -252,8 +252,14 @@ let sleep 1 done ''; + + diffRunning = pkgs.writeScriptBin "diff-running" '' + #!${pkgs.zsh}/bin/zsh + + git diff $(cut -d '-' -f 1 <(curl -sH 'Accept: text/plain' https://uni2work.ifi.lmu.de/version)) + ''; in pkgs.mkShell { name = "uni2work"; - nativeBuildInputs = [develop inDevelop killallUni2work] ++ (with pkgs; [ nodejs-14_x postgresql_12 openldap google-chrome exiftool memcached minio minio-client gup ]) ++ (with pkgs.haskellPackages; [ stack yesod-bin hlint cabal-install weeder profiteur ]); + nativeBuildInputs = [develop inDevelop killallUni2work diffRunning] ++ (with pkgs; [ nodejs-14_x postgresql_12 openldap google-chrome exiftool memcached minio minio-client gup ]) ++ (with pkgs.haskellPackages; [ stack yesod-bin hlint cabal-install weeder profiteur ]); } diff --git a/src/Application.hs b/src/Application.hs index 001d87096..9cd0fa810 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -213,7 +213,7 @@ makeFoundation appSettings''@AppSettings{..} = do -- from there, and then create the real foundation. let mkFoundation :: _ -> (forall m. MonadIO m => Custom.Pool' m DBConnLabel DBConnUseState SqlBackend) -> _ - mkFoundation appSettings' appConnPool appSmtpPool appLdapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appMemcachedLocal appUploadCache appVerpSecret appAuthKey = UniWorX {..} + mkFoundation appSettings' appConnPool appSmtpPool appLdapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appMemcachedLocal appUploadCache appVerpSecret appAuthKey appPersonalisedSheetFilesSeedKey = UniWorX {..} -- The UniWorX {..} syntax is an example of record wild cards. For more -- information, see: -- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html @@ -233,6 +233,7 @@ makeFoundation appSettings''@AppSettings{..} = do (error "MinioConn forced in tempFoundation") (error "VerpSecret forced in tempFoundation") (error "AuthKey forced in tempFoundation") + (error "PersonalisedSheetFilesSeedKey forced in tempFoundation") runAppLoggingT tempFoundation $ do $logInfoS "InstanceID" $ UUID.toText appInstanceID @@ -293,6 +294,7 @@ makeFoundation appSettings''@AppSettings{..} = do appClusterID <- clusterSetting (Proxy :: Proxy 'ClusterId) `customRunSqlPool` sqlPool appVerpSecret <- clusterSetting (Proxy :: Proxy 'ClusterVerpSecret) `customRunSqlPool` sqlPool appAuthKey <- clusterSetting (Proxy :: Proxy 'ClusterAuthKey) `customRunSqlPool` sqlPool + appPersonalisedSheetFilesSeedKey <- clusterSetting (Proxy :: Proxy 'ClusterPersonalisedSheetFilesSeedKey) `customRunSqlPool` sqlPool needsRechunk <- exists [FileContentChunkContentBased !=. True] `customRunSqlPool` sqlPool let appSettings' = appSettings'' @@ -326,7 +328,7 @@ makeFoundation appSettings''@AppSettings{..} = do $logDebugS "Runtime configuration" $ tshow appSettings' - let foundation = mkFoundation appSettings' sqlPool smtpPool ldapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appMemcachedLocal appUploadCache appVerpSecret appAuthKey + let foundation = mkFoundation appSettings' sqlPool smtpPool ldapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appMemcachedLocal appUploadCache appVerpSecret appAuthKey appPersonalisedSheetFilesSeedKey -- Return the foundation $logDebugS "setup" "Done" @@ -709,4 +711,4 @@ addPWEntry :: User addPWEntry User{ userAuthentication = _, ..} (Text.encodeUtf8 -> pw) = db' $ do PWHashConf{..} <- getsYesod $ view _appAuthPWHash (AuthPWHash . Text.decodeUtf8 -> userAuthentication) <- liftIO $ makePasswordWith pwHashAlgorithm pw pwHashStrength - void $ insert User{..} \ No newline at end of file + void $ insert User{..} diff --git a/src/Audit/Types.hs b/src/Audit/Types.hs index b5c3d1cf7..c9d118fe9 100644 --- a/src/Audit/Types.hs +++ b/src/Audit/Types.hs @@ -169,9 +169,13 @@ data Transaction } | TransactionUserAssimilated - { transactionUser :: UserId + { transactionUser , transactionAssimilatedUser :: UserId } + | TransactionUserIdentChanged + { transactionOldUserIdent + , transactionNewUserIdent :: UserIdent + } | TransactionAllocationUserEdited { transactionUser :: UserId diff --git a/src/Foundation/Type.hs b/src/Foundation/Type.hs index 3b7494d3c..52be76c44 100644 --- a/src/Foundation/Type.hs +++ b/src/Foundation/Type.hs @@ -10,7 +10,7 @@ module Foundation.Type , AppMemcachedLocal(..) , _memcachedLocalARC , SMTPPool - , _appSettings', _appStatic, _appConnPool, _appSmtpPool, _appLdapPool, _appWidgetMemcached, _appHttpManager, _appLogger, _appLogSettings, _appCryptoIDKey, _appClusterID, _appInstanceID, _appJobState, _appSessionStore, _appSecretBoxKey, _appJSONWebKeySet, _appHealthReport, _appMemcached, _appUploadCache, _appVerpSecret, _appAuthKey + , _appSettings', _appStatic, _appConnPool, _appSmtpPool, _appLdapPool, _appWidgetMemcached, _appHttpManager, _appLogger, _appLogSettings, _appCryptoIDKey, _appClusterID, _appInstanceID, _appJobState, _appSessionStore, _appSecretBoxKey, _appJSONWebKeySet, _appHealthReport, _appMemcached, _appUploadCache, _appVerpSecret, _appAuthKey, _appPersonalisedSheetFilesSeedKey , DB, Form, MsgRenderer, MailM, DBFile ) where @@ -37,6 +37,7 @@ import Utils.Metrics (DBConnUseState) import qualified Data.ByteString.Lazy as Lazy import Data.Time.Clock.POSIX (POSIXTime) import GHC.Fingerprint (Fingerprint) +import Handler.Sheet.PersonalisedFiles.Types (PersonalisedSheetFilesSeedKey) type SMTPPool = Pool SMTPConnection @@ -93,6 +94,7 @@ data UniWorX = UniWorX , appFileSourceARC :: Maybe (ARCHandle (FileContentChunkReference, (Int, Int)) Int ByteString) , appFileSourcePrewarm :: Maybe (LRUHandle (FileContentChunkReference, (Int, Int)) UTCTime Int ByteString) , appFileInjectInhibit :: TVar (IntervalMap UTCTime (Set FileContentReference)) + , appPersonalisedSheetFilesSeedKey :: PersonalisedSheetFilesSeedKey } deriving (Typeable) makeLenses_ ''UniWorX diff --git a/src/Handler/Sheet/PersonalisedFiles.hs b/src/Handler/Sheet/PersonalisedFiles.hs index f1276f124..532181664 100644 --- a/src/Handler/Sheet/PersonalisedFiles.hs +++ b/src/Handler/Sheet/PersonalisedFiles.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + module Handler.Sheet.PersonalisedFiles ( sinkPersonalisedSheetFiles , getSPersonalFilesR, getCPersonalFilesR @@ -74,6 +76,9 @@ data PersonalisedSheetFilesForm = PersonalisedSheetFilesForm } deriving (Eq, Ord, Read, Show, Generic, Typeable) +embedRenderMessage ''UniWorX ''PersonalisedSheetFilesDownloadAnonymous id + + personalisedSheetFileTypes :: [SheetFileType] personalisedSheetFileTypes = filter (/= SheetMarking) universeF @@ -103,8 +108,8 @@ resolvePersonalisedSheetFiles fpL isDir cid sid = do let getUid :: _ -> _ -> MemoStateT _ _ _ (SqlPersistT m) (Maybe UserId) getUid mbIdx' cID' = runMaybeT $ do - cIDKey <- catchMPlus (Proxy @PersonalisedSheetFilesKeyException) . lift . lift $ getPersonalisedFilesKey cid (Just sid) mbIdx' - uid <- either (const mzero) return . (runReaderT ?? cIDKey) $ I.decrypt cID' + kSet <- catchMPlus (Proxy @PersonalisedSheetFilesKeyException) . lift . lift $ getPersonalisedFilesKey cid (Just sid) mbIdx' + uid <- either (const mzero) return . (runReaderT ?? psfksCryptoID kSet) $ I.decrypt cID' guardM . lift . lift $ exists [CourseParticipantUser ==. uid, CourseParticipantCourse ==. cid] return uid @@ -213,7 +218,7 @@ sourcePersonalisedSheetFiles :: forall m. -> Set PersonalisedSheetFilesRestriction -> ConduitT () (Either PersonalisedSheetFile DBFile) (SqlPersistT m) () sourcePersonalisedSheetFiles cId mbsid mbuids anonMode restrs = do - (mbIdx, cIDKey) <- lift . newPersonalisedFilesKey $ maybe (Left cId) Right mbsid + (mbIdx, kSet) <- lift . newPersonalisedFilesKey $ maybe (Left cId) Right mbsid let genSuffixes uid = case anonMode of PersonalisedSheetFilesDownloadGroups -> do @@ -260,7 +265,7 @@ sourcePersonalisedSheetFiles cId mbsid mbuids anonMode restrs = do suf <- lift . lift $ genSuffixes courseParticipantUser _sufCache %= Map.insert courseParticipantUser suf return suf - cID <- throwLeft . (runReaderT ?? cIDKey) $ I.encrypt courseParticipantUser + cID <- throwLeft . (runReaderT ?? psfksCryptoID kSet) $ I.encrypt courseParticipantUser let dirName = unpack . Text.intercalate "_" . map pack $ suffix `snoc` mkPersonalisedFilesDirectory mbIdx cID unlessM (uses _dirCache $ Set.member dirName) $ do yield $ Right File @@ -275,7 +280,8 @@ sourcePersonalisedSheetFiles cId mbsid mbuids anonMode restrs = do , fileModified = courseParticipantRegistration } yieldM . fmap Right $ do - fileContent' <- lift $ formatPersonalisedSheetFilesMeta anonMode cPart cID + mr' <- getMsgRenderer + fileContent' <- lift $ formatPersonalisedSheetFilesMeta mr' anonMode cPart cID (mkPersonalisedSheetFilesSeed <$> psfksSeed kSet) let fileTitle = (dirName ) . ensureExtension "yaml" . unpack . mr $ MsgPersonalisedSheetFilesMetaFilename cID fileModified = courseParticipantRegistration fileContent = Just $ C.sourceLazy fileContent' @@ -307,21 +313,24 @@ newPersonalisedFilesKey :: forall m. , HandlerSite m ~ UniWorX , MonadThrow m, MonadRandom m ) - => Either CourseId SheetId -> SqlPersistT m (Maybe Word24, CryptoIDKey) -newPersonalisedFilesKey (Right shId) = cryptoIDKey $ \cIDKey -> fmap (Nothing,) $ - either (const $ throwM PersonalisedSheetFilesKeyCouldNotDecodeRandom) (views _3 return) . Binary.decodeOrFail . fromStrict . BA.convert $ - Crypto.kmac @(SHAKE256 CryptoIDCipherKeySize) (encodeUtf8 . (pack :: String -> Text) $ nameBase 'newPersonalisedFilesKey) (toStrict $ Binary.encode shId) cIDKey + => Either CourseId SheetId -> SqlPersistT m (Maybe Word24, PersonalisedSheetFilesKeySet) +newPersonalisedFilesKey (Right shId) = (Nothing, ) <$> do + psfksCryptoID <- cryptoIDKey $ \cIDKey -> + either (const $ throwM PersonalisedSheetFilesKeyCouldNotDecodeRandom) (views _3 return) . Binary.decodeOrFail . fromStrict . BA.convert $ + Crypto.kmac @(SHAKE256 CryptoIDCipherKeySize) (encodeUtf8 . (pack :: String -> Text) $ nameBase 'newPersonalisedFilesKey) (toStrict $ Binary.encode shId) cIDKey + psfksSeed <- fmap Just . getsYesod . views _appPersonalisedSheetFilesSeedKey . flip derivePersonalisedSheetFilesSeedKey . toStrict $ Binary.encode (nameBase 'newPersonalisedFilesKey, shId) + return PersonalisedSheetFilesKeySet{..} newPersonalisedFilesKey (Left cId) = do now <- liftIO getCurrentTime secret <- CryptoID.genKey let secret' = toStrict $ Binary.encode secret firstN <- getRandom - let loop :: Word24 -> SqlPersistT m (Maybe Word24, CryptoIDKey) + let loop :: Word24 -> SqlPersistT m (Maybe Word24, PersonalisedSheetFilesKeySet) loop n = do didInsert <- is _Just <$> insertUnique (FallbackPersonalisedSheetFilesKey cId n secret' now) if | didInsert - -> return (Just n, secret) + -> return (Just n, PersonalisedSheetFilesKeySet secret Nothing) | (firstN == minBound && n == maxBound) || n == pred firstN -> throwM FallbackPersonalisedSheetFilesKeysExhausted @@ -336,12 +345,13 @@ getPersonalisedFilesKey :: forall m. , HandlerSite m ~ UniWorX , MonadThrow m, MonadRandom m ) - => CourseId -> Maybe SheetId -> Maybe Word24 -> SqlPersistT m CryptoIDKey + => CourseId -> Maybe SheetId -> Maybe Word24 -> SqlPersistT m PersonalisedSheetFilesKeySet getPersonalisedFilesKey _ Nothing Nothing = throwM PersonalisedSheetFilesKeyInsufficientContext getPersonalisedFilesKey _ (Just shId) Nothing = view _2 <$> newPersonalisedFilesKey (Right shId) getPersonalisedFilesKey cId _ (Just idx) = maybeT (throwM PersonalisedSheetFilesKeyNotFound) $ do Entity _ FallbackPersonalisedSheetFilesKey{..} <- MaybeT . getBy $ UniqueFallbackPersonalisedSheetFilesKey cId idx - either (const $ throwM PersonalisedSheetFilesKeyCouldNotDecodeRandom) (views _3 return) . Binary.decodeOrFail . fromStrict $ BA.convert fallbackPersonalisedSheetFilesKeySecret + psfksCryptoID <- either (const $ throwM PersonalisedSheetFilesKeyCouldNotDecodeRandom) (views _3 return) . Binary.decodeOrFail $ fromStrict fallbackPersonalisedSheetFilesKeySecret + return $ PersonalisedSheetFilesKeySet{ psfksSeed = Nothing, .. } mkPersonalisedFilesDirectory :: Maybe Word24 -> CryptoFileNameUser -> FilePath mkPersonalisedFilesDirectory Nothing cID = unpack $ toPathPiece cID diff --git a/src/Handler/Sheet/PersonalisedFiles/Meta.hs b/src/Handler/Sheet/PersonalisedFiles/Meta.hs index e95993ae8..2b0713041 100644 --- a/src/Handler/Sheet/PersonalisedFiles/Meta.hs +++ b/src/Handler/Sheet/PersonalisedFiles/Meta.hs @@ -27,16 +27,20 @@ data PrettifyState = PrettifyInitial | PrettifyFlowSequence PrettifyState | PrettifyBlockSequence PrettifyState + | PrettifySeed | PrettifySeedDone deriving (Eq, Ord, Read, Show, Generic, Typeable) + formatPersonalisedSheetFilesMeta :: MonadIO m - => PersonalisedSheetFilesDownloadAnonymous + => MsgRendererS UniWorX + -> PersonalisedSheetFilesDownloadAnonymous -> CourseParticipant -> CryptoFileNameUser + -> Maybe (UserIdent -> PersonalisedSheetFilesSeed) -> SqlPersistT m Lazy.ByteString -formatPersonalisedSheetFilesMeta anonMode CourseParticipant{..} cID = do +formatPersonalisedSheetFilesMeta (MsgRenderer mr) anonMode CourseParticipant{..} cID mkSeed = do User{..} <- getJust courseParticipantUser exams <- E.select . E.from $ \(exam `E.InnerJoin` examRegistration) -> E.distinctOnOrderBy [E.asc $ exam E.^. ExamName] $ do E.on $ exam E.^. ExamId E.==. examRegistration E.^. ExamRegistrationExam @@ -50,6 +54,7 @@ formatPersonalisedSheetFilesMeta anonMode CourseParticipant{..} cID = do , YAML.Event.MappingStart Nothing YAML.untagged YAML.Event.Block ] , mapEvents (str' "user") (str $ toPathPiece cID) + , mapEvents (str' "seed") (maybe (YAML.Scalar () YAML.SNull) (str . toPathPiece . ($ userIdent)) mkSeed) , guardOnM (isn't _PersonalisedSheetFilesDownloadAnonymous anonMode) $ concat [ mapEvents (str' "display_name") (str userDisplayName) , mapEvents (str' "surname") (str userSurname) @@ -113,6 +118,11 @@ formatPersonalisedSheetFilesMeta anonMode CourseParticipant{..} cID = do in (before <> ann1 <> fromStrict (encodeUtf8 $ ann3 event'') <> fromStrict (encodeUtf8 $ ann2 ws) <> after, pos1') transduce :: PrettifyState -> YAML.Event.Event -> ((Text, Text -> Text, Text -> Text), PrettifyState) + transduce PrettifyInitial (YAML.Event.Scalar _ _ _ k) + | k == "seed", is _Just mkSeed = (("\n# " <> mr MsgSheetPersonalisedFilesMetaYAMLSeedComment <> "\n", id, id), PrettifySeed) + | k == "seed" = (("\n# " <> mr MsgSheetPersonalisedFilesMetaYAMLNoSeedComment <> "\n", id, id), PrettifySeed) + transduce PrettifySeed YAML.Event.Scalar{} + = ((mempty, id, beforeBreak "\n"), PrettifySeedDone) transduce cState (YAML.Event.SequenceStart _ _ YAML.Event.Flow) = ((mempty, id, bool " " mempty . null), PrettifyFlowSequence cState) transduce (PrettifyFlowSequence pState) YAML.Event.SequenceEnd = ((mempty, id, id), pState) transduce cState@(PrettifyFlowSequence _) _ = ((mempty, f, bool " " mempty . null), cState) @@ -124,4 +134,11 @@ formatPersonalisedSheetFilesMeta anonMode CourseParticipant{..} cID = do transduce cState@(PrettifyBlockSequence _) _ = ((mempty, Text.replace "\n-" "\n -", id), cState) transduce cState _ = ((mempty, id, id), cState) -- transduce cState _ = (("<", id, \ws -> "|" <> ws <> ">"), cState) -- TODO + + beforeBreak :: Text -> Text -> Text + beforeBreak ins ws = before <> ins <> break' <> after + where (before', after) = Text.breakOnEnd "\n" ws + before = Text.dropWhileEnd (== '\n') before' + break' = Text.takeWhileEnd (== '\n') before' + return prettyYAML diff --git a/src/Handler/Sheet/PersonalisedFiles/Types.hs b/src/Handler/Sheet/PersonalisedFiles/Types.hs index c3f5a5ca8..b53d3c055 100644 --- a/src/Handler/Sheet/PersonalisedFiles/Types.hs +++ b/src/Handler/Sheet/PersonalisedFiles/Types.hs @@ -1,9 +1,33 @@ module Handler.Sheet.PersonalisedFiles.Types ( PersonalisedSheetFilesDownloadAnonymous(..) , _PersonalisedSheetFilesDownloadAnonymous, _PersonalisedSheetFilesDownloadSurnames, _PersonalisedSheetFilesDownloadMatriculations, _PersonalisedSheetFilesDownloadGroups + , PersonalisedSheetFilesSeed(..) + , mkPersonalisedSheetFilesSeed + , PersonalisedSheetFilesSeedKey + , derivePersonalisedSheetFilesSeedKey, newPersonalisedSheetFilesSeedKey + , PersonalisedSheetFilesKeySet(..) ) where -import Import +import Import.NoModel +import Model.Types.Common (UserIdent) + +import Web.HttpApiData (ToHttpApiData, FromHttpApiData) +import Data.ByteArray (ByteArrayAccess) +import qualified Data.ByteArray as BA + +import Crypto.Hash.Algorithms (SHAKE256) +import qualified Crypto.MAC.KMAC as Crypto +import qualified Crypto.Random as Crypto +import qualified Data.Binary as Binary + +import qualified Data.CaseInsensitive as CI + +import Data.CryptoID.ByteString (CryptoIDKey) + +import Data.Typeable (typeOf) + +import Data.Binary.Put (putByteString) +import Data.Binary.Get (getByteString) data PersonalisedSheetFilesDownloadAnonymous @@ -14,6 +38,56 @@ data PersonalisedSheetFilesDownloadAnonymous deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) deriving anyclass (Universe, Finite) nullaryPathPiece ''PersonalisedSheetFilesDownloadAnonymous $ camelToPathPiece' 4 -embedRenderMessage ''UniWorX ''PersonalisedSheetFilesDownloadAnonymous id makePrisms ''PersonalisedSheetFilesDownloadAnonymous + + +newtype PersonalisedSheetFilesSeed = PersonalisedSheetFilesSeed (Digest (SHAKE256 144)) + deriving (Eq, Ord, Read, Show, Lift, Generic, Typeable) + deriving newtype ( PersistField + , PathPiece, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON + , Hashable, NFData + , ByteArrayAccess + , Binary + ) + +newtype PersonalisedSheetFilesSeedKey = PersonalisedSheetFilesSeedKey { psfskKeyMaterial :: ByteString } + deriving (Typeable) + deriving newtype (ByteArrayAccess) + +-- | Does not actually show any key material +instance Show PersonalisedSheetFilesSeedKey where + show = show . typeOf + +instance Binary PersonalisedSheetFilesSeedKey where + put = putByteString . psfskKeyMaterial + get = PersonalisedSheetFilesSeedKey <$> getByteString 16 + +instance Eq PersonalisedSheetFilesSeedKey where + (==) = BA.constEq + +derivePersistFieldBinary ''PersonalisedSheetFilesSeedKey +deriveJSONBinary ''PersonalisedSheetFilesSeedKey + + +derivePersonalisedSheetFilesSeedKey :: ByteArrayAccess ba => PersonalisedSheetFilesSeedKey -> ba -> PersonalisedSheetFilesSeedKey +derivePersonalisedSheetFilesSeedKey k = PersonalisedSheetFilesSeedKey . BA.convert . Crypto.kmac @(SHAKE256 128) (enc 'derivePersonalisedSheetFilesSeedKey) k + where + enc :: forall a. Binary a => a -> ByteString + enc = toStrict . Binary.encode + +newPersonalisedSheetFilesSeedKey :: Crypto.MonadRandom m => m PersonalisedSheetFilesSeedKey +newPersonalisedSheetFilesSeedKey = PersonalisedSheetFilesSeedKey <$> Crypto.getRandomBytes 16 + +mkPersonalisedSheetFilesSeed :: PersonalisedSheetFilesSeedKey + -> UserIdent + -> PersonalisedSheetFilesSeed +mkPersonalisedSheetFilesSeed k u = PersonalisedSheetFilesSeed . Crypto.kmacGetDigest $ Crypto.kmac (enc 'mkPersonalisedSheetFilesSeed) k (enc $ CI.foldedCase u) + where + enc :: forall a. Binary a => a -> ByteString + enc = toStrict . Binary.encode + +data PersonalisedSheetFilesKeySet = PersonalisedSheetFilesKeySet + { psfksCryptoID :: CryptoIDKey + , psfksSeed :: Maybe PersonalisedSheetFilesSeedKey + } deriving (Show, Typeable) diff --git a/src/Handler/Utils/Users.hs b/src/Handler/Utils/Users.hs index fc411d16f..f851d4fc9 100644 --- a/src/Handler/Utils/Users.hs +++ b/src/Handler/Utils/Users.hs @@ -24,6 +24,7 @@ import qualified Data.Aeson as JSON import qualified Data.Aeson.Types as JSON import qualified Data.Set as Set +import qualified Data.List as List import qualified Data.CaseInsensitive as CI import qualified Database.Esqueleto.Legacy as E @@ -200,6 +201,7 @@ data UserAssimilateExceptionReason | UserAssimilateExamResultDifferentResult (Entity ExamResult) (Entity ExamResult) | UserAssimilatePersonalisedSheetFileDifferentContent (Entity PersonalisedSheetFile) (Entity PersonalisedSheetFile) | UserAssimilateTutorialParticipantCollidingRegGroups (Entity TutorialParticipant) (Entity TutorialParticipant) + | UserAssimilateCouldNotDetermineUserIdents deriving (Eq, Ord, Show, Generic, Typeable) assimilateUser :: UserId -- ^ @newUserId@ @@ -773,6 +775,17 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do delete oldSFId in runConduit $ getStudyFeatures .| C.mapM_ upsertStudyFeatures + userIdents <- E.select . E.from $ \user -> do + E.where_ $ user E.^. UserId `E.in_` E.valList [newUserId, oldUserId] + return ( user E.^. UserId + , user E.^. UserIdent + ) + case (,) <$> List.lookup (E.Value oldUserId) userIdents <*> List.lookup (E.Value newUserId) userIdents of + Just (E.Value oldIdent, E.Value newIdent') + | oldIdent /= newIdent' -> audit $ TransactionUserIdentChanged oldIdent newIdent' + | otherwise -> return () + _other -> tellError UserAssimilateCouldNotDetermineUserIdents + delete oldUserId audit $ TransactionUserAssimilated newUserId oldUserId where diff --git a/src/Import/NoModel.hs b/src/Import/NoModel.hs index 2bd19bc28..491f640f5 100644 --- a/src/Import/NoModel.hs +++ b/src/Import/NoModel.hs @@ -30,6 +30,7 @@ import UnliftIO.Async.Utils as Import import Model.Types.TH.JSON as Import import Model.Types.TH.Wordlist as Import +import Model.Types.TH.Binary as Import import Mail as Import diff --git a/src/Jobs/HealthReport.hs b/src/Jobs/HealthReport.hs index bbee11bd1..54e0317ec 100644 --- a/src/Jobs/HealthReport.hs +++ b/src/Jobs/HealthReport.hs @@ -71,6 +71,10 @@ dispatchHealthCheckMatchingClusterConfig ourSetting <- getsYesod appAuthKey dbSetting <- clusterSetting @'ClusterAuthKey return $ Just ourSetting == dbSetting + clusterSettingMatches ClusterPersonalisedSheetFilesSeedKey = do + ourSetting <- getsYesod appPersonalisedSheetFilesSeedKey + dbSetting <- clusterSetting @'ClusterPersonalisedSheetFilesSeedKey + return $ Just ourSetting == dbSetting clusterSetting :: forall key. diff --git a/src/Model/Types/TH/Binary.hs b/src/Model/Types/TH/Binary.hs new file mode 100644 index 000000000..e896e89e4 --- /dev/null +++ b/src/Model/Types/TH/Binary.hs @@ -0,0 +1,103 @@ +module Model.Types.TH.Binary where + +import ClassyPrelude.Yesod hiding (Proxy(..)) +import Database.Persist.Sql + +import qualified Data.ByteString.Lazy as LBS + +import Language.Haskell.TH +import Language.Haskell.TH.Datatype +import qualified Language.Haskell.TH.Syntax as TH + +import Utils.Persist +import Data.Proxy + +import Data.Binary (Binary) +import qualified Data.Binary as Binary + +import Data.List (foldl) + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Types as Aeson + +import qualified Data.ByteString.Base64.URL as Base64 + +import Control.Monad.Fail + + +toPersistValueBinary :: Binary a => a -> PersistValue +toPersistValueBinary = PersistByteString . LBS.toStrict . Binary.encode + +fromPersistValueBinary :: forall a. (Binary a, PersistFieldSql a, Typeable a) => PersistValue -> Either Text a +fromPersistValueBinary = \case + PersistByteString bs + | Right (rest, _, v) <- Binary.decodeOrFail $ fromStrict bs + , null rest + -> Right v + x -> Left $ fromPersistValueErrorSql (Proxy @a) x + +sqlTypeBinary :: SqlType +sqlTypeBinary = SqlBlob + + +derivePersistFieldBinary :: Name -> DecsQ +derivePersistFieldBinary tName = do + DatatypeInfo{..} <- reifyDatatype tName + vars <- forM datatypeVars (const $ newName "a") + let t = foldl (\t' n' -> t' `appT` varT n') (conT tName) vars + iCxt + | null vars = cxt [] + | otherwise = cxt [[t|Binary|] `appT` t, [t|Typeable|] `appT` t] + sqlCxt + | null vars = cxt [] + | otherwise = cxt [[t|PersistField|] `appT` t] + sequence + [ instanceD iCxt ([t|PersistField|] `appT` t) + [ funD 'toPersistValue + [ clause [] (normalB [e|toPersistValueBinary|]) [] + ] + , funD 'fromPersistValue + [ clause [] (normalB [e|fromPersistValueBinary|]) [] + ] + ] + , instanceD sqlCxt ([t|PersistFieldSql|] `appT` t) + [ funD 'sqlType + [ clause [wildP] (normalB [e|sqlTypeBinary|]) [] + ] + ] + ] + + +toJSONBinary :: Binary a => a -> Aeson.Value +toJSONBinary = Aeson.String . decodeUtf8 . Base64.encode . toStrict . Binary.encode + +parseJSONBinary :: Binary a => Name -> Aeson.Value -> Aeson.Parser a +parseJSONBinary n = Aeson.withText (nameBase n) $ \t -> do + bytes <- either fail (return . fromStrict) . Base64.decode $ encodeUtf8 t + case Binary.decodeOrFail bytes of + Left (_, _, err) -> fail err + Right (bs, _, ret) + | null bs -> return ret + | otherwise -> fail $ show (length bs) ++ " extra bytes" + + +deriveJSONBinary :: Name -> DecsQ +deriveJSONBinary tName = do + DatatypeInfo{..} <- reifyDatatype tName + vars <- forM datatypeVars (const $ newName "a") + let t = foldl (\t' n' -> t' `appT` varT n') (conT tName) vars + iCxt + | null vars = cxt [] + | otherwise = cxt [[t|Binary|] `appT` t, [t|Typeable|] `appT` t] + sequence + [ instanceD iCxt ([t|ToJSON|] `appT` t) + [ funD 'toJSON + [ clause [] (normalB [e|toJSONBinary|]) [] + ] + ] + , instanceD iCxt ([t|FromJSON|] `appT` t) + [ funD 'parseJSON + [ clause [] (normalB [e|parseJSONBinary $(TH.lift tName)|]) [] + ] + ] + ] diff --git a/src/Settings/Cluster.hs b/src/Settings/Cluster.hs index faa409b08..6e3eb1e2a 100644 --- a/src/Settings/Cluster.hs +++ b/src/Settings/Cluster.hs @@ -40,6 +40,8 @@ import Model.Types.TH.PathPiece import Data.ByteArray (ByteArray, ByteArrayAccess) import qualified Crypto.Random as Crypto +import Handler.Sheet.PersonalisedFiles.Types (PersonalisedSheetFilesSeedKey, newPersonalisedSheetFilesSeedKey) + data ClusterSettingsKey = ClusterCryptoIDKey @@ -50,6 +52,7 @@ data ClusterSettingsKey | ClusterMemcachedKey | ClusterVerpSecret | ClusterAuthKey + | ClusterPersonalisedSheetFilesSeedKey deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable) deriving anyclass (Universe, Finite, NFData) @@ -160,3 +163,9 @@ instance ClusterSetting 'ClusterAuthKey where type ClusterSettingValue 'ClusterAuthKey = Auth.Key initClusterSetting _ = liftIO Auth.newKey knownClusterSetting _ = ClusterAuthKey + + +instance ClusterSetting 'ClusterPersonalisedSheetFilesSeedKey where + type ClusterSettingValue 'ClusterPersonalisedSheetFilesSeedKey = PersonalisedSheetFilesSeedKey + initClusterSetting _ = liftIO newPersonalisedSheetFilesSeedKey + knownClusterSetting _ = ClusterPersonalisedSheetFilesSeedKey diff --git a/templates/i18n/changelog/personalised-sheet-files-seeds.de-de-formal.hamlet b/templates/i18n/changelog/personalised-sheet-files-seeds.de-de-formal.hamlet new file mode 100644 index 000000000..d76ba6826 --- /dev/null +++ b/templates/i18n/changelog/personalised-sheet-files-seeds.de-de-formal.hamlet @@ -0,0 +1,3 @@ +$newline never + +Die Metainformationsdateien, die zum Anlegen von personalisierten Übungsblattdateien erzeugt werden, enthalten nun einen Seed für Pseudozufallsgeneratoren. diff --git a/templates/i18n/changelog/personalised-sheet-files-seeds.en-eu.hamlet b/templates/i18n/changelog/personalised-sheet-files-seeds.en-eu.hamlet new file mode 100644 index 000000000..eea3bacdf --- /dev/null +++ b/templates/i18n/changelog/personalised-sheet-files-seeds.en-eu.hamlet @@ -0,0 +1,3 @@ +$newline never + +Metadata files created when adding personalised files to exercise sheets now contain a seed for pseudorandom generators. From 2cbf015075f9acddaf88ebb241d6006a9de2914c Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 13 Jul 2021 11:00:05 +0200 Subject: [PATCH 033/120] chore(release): 25.16.0 --- CHANGELOG.md | 7 +++++++ package-lock.json | 2 +- package.json | 2 +- package.yaml | 2 +- 4 files changed, 10 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index b0c3c128c..c3d0465ab 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,13 @@ All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. +## [25.16.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.15.3...v25.16.0) (2021-07-13) + + +### Features + +* **personalised-sheet-files:** seeds ([cf67945](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/cf679452928c14200e1eb3877987ee299fbf9f6f)) + ## [25.15.3](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.15.2...v25.15.3) (2021-07-08) diff --git a/package-lock.json b/package-lock.json index 6334ca460..20aaf35db 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "25.15.3", + "version": "25.16.0", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index 961d0d6a0..be6d6f6c0 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "25.15.3", + "version": "25.16.0", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index 651fb9faf..99a6c01f5 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 25.15.3 +version: 25.16.0 dependencies: - base - yesod From 15b4b25f5c4762b2fe3f342254c6f5006fb5c375 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sun, 18 Jul 2021 00:15:49 +0200 Subject: [PATCH 034/120] chore(nix): fix maildev --- shell.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/shell.nix b/shell.nix index 10eb9dfcd..0e93c7272 100644 --- a/shell.nix +++ b/shell.nix @@ -157,7 +157,7 @@ let [[ -n "$maildev_pid" ]] && kill $maildev_pid } - ${pkgs.nodePackages.maildev}/bin/maildev --smtp $(($PORT_OFFSET + 1025)) --web $(($PORT_OFFSET + 8080)) --ip localhost --web-ip localhost &>/dev/null & + TMPDIR=''${XDG_RUNTIME_DIR} ${pkgs.nodePackages.maildev}/bin/maildev --smtp $(($PORT_OFFSET + 1025)) --web $(($PORT_OFFSET + 8080)) --ip localhost --web-ip localhost &>/dev/null & maildev_pid=$! export SMTPHOST=localhost From cb8e3385889c0c4c13418bc69af091b9c8a3f22f Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Mon, 31 May 2021 17:32:11 +0200 Subject: [PATCH 035/120] feat(schools): add school settings regarding authorship statements --- .../categories/school/de-de-formal.msg | 14 +++++++++++ messages/uniworx/categories/school/en-eu.msg | 14 +++++++++++ models/schools.model | 4 ++++ src/Foundation/I18n.hs | 9 +++++++ src/Handler/School.hs | 24 +++++++++++++++++++ src/Model/Types/School.hs | 13 ++++++++++ test/Database/Fill.hs | 4 ++-- 7 files changed, 80 insertions(+), 2 deletions(-) diff --git a/messages/uniworx/categories/school/de-de-formal.msg b/messages/uniworx/categories/school/de-de-formal.msg index 28cf19c0e..d4feac656 100644 --- a/messages/uniworx/categories/school/de-de-formal.msg +++ b/messages/uniworx/categories/school/de-de-formal.msg @@ -4,6 +4,8 @@ SchoolName !ident-ok: Name SchoolLdapOrganisations: Assoziierte LDAP-Fragmente SchoolLdapOrganisationsTip: Beim Login via LDAP werden dem Nutzer/der Nutzerin alle Institute zugeordnet deren assoziierte LDAP-Fragmente im Eintrag des Nutzer/der Nutzerin gefunden werden SchoolLdapOrganisationMissing: LDAP-Fragment wird benötigt + +SchoolExamSection: Prüfungen SchoolExamMinimumRegisterBeforeStart: Minimale Tage zwischen Anmeldebeginn und Termin für Prüfungen SchoolExamMinimumRegisterBeforeStartTip: Wenn angegeben werden Dozierende gezwungen Anmeldezeitraum und Prüfungstermin stets zusammen einzustellen. SchoolExamMinimumRegisterDuration: Minimale Anmeldedauer für Prüfungen @@ -12,6 +14,18 @@ SchoolExamRequireModeForRegistration: Prüfungsmodus erforderlich für Anmeldung SchoolExamRequireModeForRegistrationTip: Sollen Dozierende gezwungen werden Prüfungsmodus und Anmeldefrist stets zusammen einzustellen? SchoolExamDiscouragedModes: Prüfungsmodi mit Warnung ExamCloseMode: Prüfungs-Abschluss + +SchoolAuthorshipStatementSection: Eigenständigkeitserklärungen +SchoolAuthorshipStatementModeNone: Keine Eigenständigkeitserklärung erlauben +SchoolAuthorshipStatementModeOptional: Eigenständigkeitserklärung optional einforderbar +SchoolAuthorshipStatementModeRequired: Eigenständigkeitserklärung immer erforderlich +SchoolSheetAuthorshipStatementMode: Modus für nicht-prüfungsrelevante Übungsblattabgaben +SchoolSheetAuthorshipStatementExamMode: Modus für prüfungsrelevante Übungsblattabgaben +SchoolSheetAuthorshipStatementText: Eigenständigkeitserklärung +SchoolSheetAuthorshipStatementTextTip: Dieser Text dient als Standard-Eigenständigkeitserklärung beim Anlegen eines neuen Übungsblattes innerhalb eines Kurses dieses Instituts. Wenn Anpassungen erlaubt sind, kann diese Erklärung pro Übungsblatt durch einen Dozierenden überschrieben werden. +SchoolSheetAuthorshipStatementAllowOther: Anpassungen erlauben? +SchoolSheetAuthorshipStatementAllowOtherTip: Soll es Dozierenden erlaubt sein, pro Übungsblatt eine abweichende Eigenständigkeitserklärung anzugeben? + SchoolUpdated ssh@SchoolId: #{ssh} erfolgreich angepasst SchoolTitle ssh@SchoolId: Institut „#{ssh}“ TitleSchoolNew: Neues Institut anlegen diff --git a/messages/uniworx/categories/school/en-eu.msg b/messages/uniworx/categories/school/en-eu.msg index c15e02e7a..aa7d295fc 100644 --- a/messages/uniworx/categories/school/en-eu.msg +++ b/messages/uniworx/categories/school/en-eu.msg @@ -4,6 +4,8 @@ SchoolName: Name SchoolLdapOrganisations: Associated LDAP fragments SchoolLdapOrganisationsTip: When logging in users are associated with any departments whose associated LDAP fragments are found in the users LDAP entry SchoolLdapOrganisationMissing: LDAP-fragment is required + +SchoolExamSection: Exams SchoolExamMinimumRegisterBeforeStart: Minimum number of days between start of registration period and start of exams SchoolExamMinimumRegisterBeforeStartTip: If specified course administrators will be forced to specify the start of the registration period and the start of the exam at the same time. SchoolExamMinimumRegisterDuration: Minimum duration of registration period for exams @@ -12,6 +14,18 @@ SchoolExamRequireModeForRegistration: Exam design required for registration SchoolExamRequireModeForRegistrationTip: Should course administrators be forced to fully specify their exam design when setting a registration period? SchoolExamDiscouragedModes: Exam designs to warn against ExamCloseMode: Exam closure + +SchoolAuthorshipStatementSection: Statements of Authorship +SchoolAuthorshipStatementModeNone: No Statement of Authorship allowed +SchoolAuthorshipStatementModeOptional: Statement of Authorship optionally activatable +SchoolAuthorshipStatementModeRequired: Statement of Authorship always required +SchoolSheetAuthorshipStatementMode: Mode for exam-unrelated exercise sheets +SchoolSheetAuthorshipStatementExamMode: Mode for exam-related sheets +SchoolSheetAuthorshipStatementText: Statement of Authorship +SchoolSheetAuthorshipStatementTextTip: This text serves as default Statement of Authorship upon creating a new exercise sheet in a course of this school. This statement may be overriden by a course administrator per exercise sheet if adaptations are allowed. +SchoolSheetAuthorshipStatementAllowOther: Allow adaptations? +SchoolSheetAuthorshipStatementAllowOtherTip: Should course administrators be allowed to specify an alternative Statement of Authorship? + SchoolUpdated ssh: Successfully edited #{ssh} SchoolTitle ssh: Department „#{ssh}“ TitleSchoolNew: Create new department diff --git a/models/schools.model b/models/schools.model index 33975b7a3..b686b7964 100644 --- a/models/schools.model +++ b/models/schools.model @@ -8,6 +8,10 @@ School json examRequireModeForRegistration Bool default=false examDiscouragedModes ExamModeDNF examCloseMode ExamCloseMode default='separate' + sheetAuthorshipStatementMode SchoolAuthorshipStatementMode default='optional' + sheetAuthorshipStatementExamMode SchoolAuthorshipStatementMode default='optional' + sheetAuthorshipStatementText Text Maybe + sheetAuthorshipStatementAllowOther Bool default=true UniqueSchool name UniqueSchoolShorthand shorthand -- required for Normalisation of CI Text Primary shorthand -- newtype Key School = SchoolKey { unSchoolKey :: SchoolShorthand } diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs index b720355c6..17f4d418b 100644 --- a/src/Foundation/I18n.hs +++ b/src/Foundation/I18n.hs @@ -404,6 +404,15 @@ instance RenderMessage UniWorX ExamCloseMode where mr :: RenderMessage UniWorX msg => msg -> Text mr = renderMessage foundation ls +instance RenderMessage UniWorX SchoolAuthorshipStatementMode where + renderMessage foundation ls = \case + SchoolAuthorshipStatementModeNone -> mr MsgSchoolAuthorshipStatementModeNone + SchoolAuthorshipStatementModeOptional -> mr MsgSchoolAuthorshipStatementModeOptional + SchoolAuthorshipStatementModeRequired -> mr MsgSchoolAuthorshipStatementModeRequired + where + mr :: RenderMessage UniWorX msg => msg -> Text + mr = renderMessage foundation ls + -- ToMessage instances for converting raw numbers to Text (no internationalization) -- FIXME: Use RenderMessage always diff --git a/src/Handler/School.hs b/src/Handler/School.hs index c6373ae23..38cc9bf18 100644 --- a/src/Handler/School.hs +++ b/src/Handler/School.hs @@ -68,6 +68,10 @@ data SchoolForm = SchoolForm , sfExamRequireModeForRegistration :: Bool , sfExamDiscouragedModes :: ExamModeDNF , sfExamCloseMode :: ExamCloseMode + , sfSheetAuthorshipStatementMode :: SchoolAuthorshipStatementMode + , sfSheetAuthorshipStatementExamMode :: SchoolAuthorshipStatementMode + , sfSheetAuthorshipStatementText :: Maybe Text + , sfSheetAuthorshipStatementAllowOther :: Bool } mkSchoolForm :: Maybe SchoolId -> Maybe SchoolForm -> Form SchoolForm @@ -75,11 +79,17 @@ mkSchoolForm mSsh template = renderAForm FormStandard $ SchoolForm <$> maybe (\f fs -> areq f fs (sfShorthand <$> template)) (\ssh f fs -> aforced f fs (unSchoolKey ssh)) mSsh (textField & cfStrip & cfCI) (fslI MsgSchoolShort) <*> areq (textField & cfStrip & cfCI) (fslI MsgSchoolName) (sfName <$> template) <*> (Set.fromList . mapMaybe (fmap CI.mk . assertM' (not . Text.null) . Text.strip . CI.original) <$> massInputListA (ciField & addDatalist ldapOrgs) (const "") MsgSchoolLdapOrganisationMissing (const Nothing) ("ldap-organisations" :: Text) (fslI MsgSchoolLdapOrganisations & setTooltip MsgSchoolLdapOrganisationsTip) False (Set.toList . sfOrgUnits <$> template)) + <* aformSection MsgSchoolExamSection <*> aopt daysField (fslI MsgSchoolExamMinimumRegisterBeforeStart & setTooltip MsgSchoolExamMinimumRegisterBeforeStartTip) (sfExamMinimumRegisterBeforeStart <$> template) <*> aopt daysField (fslI MsgSchoolExamMinimumRegisterDuration & setTooltip MsgSchoolExamMinimumRegisterDurationTip) (sfExamMinimumRegisterDuration <$> template) <*> apopt checkBoxField (fslI MsgSchoolExamRequireModeForRegistration & setTooltip MsgSchoolExamRequireModeForRegistration) (sfExamRequireModeForRegistration <$> template) <*> areq pathPieceField (fslI MsgSchoolExamDiscouragedModes) (sfExamDiscouragedModes <$> template <|> pure (ExamModeDNF predDNFFalse)) <*> apopt (selectField optionsFinite) (fslI MsgExamCloseMode) (sfExamCloseMode <$> template <|> pure ExamCloseSeparate) + <* aformSection MsgSchoolAuthorshipStatementSection + <*> apopt (selectField optionsFinite) (fslI MsgSchoolSheetAuthorshipStatementMode) (sfSheetAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) + <*> apopt (selectField optionsFinite) (fslI MsgSchoolSheetAuthorshipStatementExamMode) (sfSheetAuthorshipStatementExamMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) + <*> aopt (textField & cfStrip) (fslI MsgSchoolSheetAuthorshipStatementText & setTooltip MsgSchoolSheetAuthorshipStatementTextTip) (sfSheetAuthorshipStatementText <$> template) -- TODO: use htmlField + <*> apopt checkBoxField (fslI MsgSchoolSheetAuthorshipStatementAllowOther & setTooltip MsgSchoolSheetAuthorshipStatementAllowOtherTip) (sfSheetAuthorshipStatementAllowOther <$> template <|> pure True) where ldapOrgs :: HandlerFor UniWorX (OptionList (CI Text)) ldapOrgs = fmap (mkOptionList . map (\t -> Option (CI.original t) t (CI.original t)) . Set.toAscList) . runDB $ @@ -98,6 +108,10 @@ schoolToForm ssh = do , sfExamRequireModeForRegistration = schoolExamRequireModeForRegistration , sfExamDiscouragedModes = schoolExamDiscouragedModes , sfExamCloseMode = schoolExamCloseMode + , sfSheetAuthorshipStatementMode = schoolSheetAuthorshipStatementMode + , sfSheetAuthorshipStatementExamMode = schoolSheetAuthorshipStatementExamMode + , sfSheetAuthorshipStatementText = schoolSheetAuthorshipStatementText + , sfSheetAuthorshipStatementAllowOther = schoolSheetAuthorshipStatementAllowOther } @@ -108,6 +122,8 @@ postSchoolEditR ssh = do ((sfResult, sfView), sfEnctype) <- runFormPost sForm + -- TODO: validate Form: when AuthorshipStatement required, the statement text must be `Just t` with `t` non-empty + formResult sfResult $ \SchoolForm{..} -> do runDB $ do update ssh @@ -117,6 +133,10 @@ postSchoolEditR ssh = do , SchoolExamRequireModeForRegistration =. sfExamRequireModeForRegistration , SchoolExamDiscouragedModes =. sfExamDiscouragedModes , SchoolExamCloseMode =. sfExamCloseMode + , SchoolSheetAuthorshipStatementMode =. sfSheetAuthorshipStatementMode + , SchoolSheetAuthorshipStatementExamMode =. sfSheetAuthorshipStatementExamMode + , SchoolSheetAuthorshipStatementText =. sfSheetAuthorshipStatementText + , SchoolSheetAuthorshipStatementAllowOther =. sfSheetAuthorshipStatementAllowOther ] forM_ sfOrgUnits $ \schoolLdapOrgUnit -> void $ upsert SchoolLdap @@ -159,6 +179,10 @@ postSchoolNewR = do , schoolExamRequireModeForRegistration = sfExamRequireModeForRegistration , schoolExamDiscouragedModes = sfExamDiscouragedModes , schoolExamCloseMode = sfExamCloseMode + , schoolSheetAuthorshipStatementMode = sfSheetAuthorshipStatementMode + , schoolSheetAuthorshipStatementExamMode = sfSheetAuthorshipStatementExamMode + , schoolSheetAuthorshipStatementText = sfSheetAuthorshipStatementText + , schoolSheetAuthorshipStatementAllowOther = sfSheetAuthorshipStatementAllowOther } when didInsert $ do insert_ UserFunction diff --git a/src/Model/Types/School.hs b/src/Model/Types/School.hs index 0b9f65634..bb739f563 100644 --- a/src/Model/Types/School.hs +++ b/src/Model/Types/School.hs @@ -17,3 +17,16 @@ pathPieceJSON ''SchoolFunction pathPieceJSONKey ''SchoolFunction derivePersistFieldPathPiece ''SchoolFunction pathPieceBinary ''SchoolFunction + +data SchoolAuthorshipStatementMode + = SchoolAuthorshipStatementModeNone + | SchoolAuthorshipStatementModeOptional + | SchoolAuthorshipStatementModeRequired + deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable) + deriving anyclass (Universe, Finite, NFData) + +nullaryPathPiece ''SchoolAuthorshipStatementMode $ camelToPathPiece' 4 +pathPieceJSON ''SchoolAuthorshipStatementMode +pathPieceJSONKey ''SchoolAuthorshipStatementMode +derivePersistFieldPathPiece ''SchoolAuthorshipStatementMode +pathPieceBinary ''SchoolAuthorshipStatementMode diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index b97ed31e3..e3a22a6c4 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -411,8 +411,8 @@ fillDb = do , termLectureEnd } void . insert_ $ TermActive (TermKey term) (toMidnight $ addDays (-60) termStart) (Just . beforeMidnight $ addDays 60 termEnd) Nothing - ifi <- insert' $ School "Institut für Informatik" "IfI" (Just $ 14 * nominalDay) (Just $ 10 * nominalDay) True (ExamModeDNF predDNFFalse) (ExamCloseOnFinished True) - mi <- insert' $ School "Institut für Mathematik" "MI" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False) + ifi <- insert' $ School "Institut für Informatik" "IfI" (Just $ 14 * nominalDay) (Just $ 10 * nominalDay) True (ExamModeDNF predDNFFalse) (ExamCloseOnFinished True) SchoolAuthorshipStatementModeOptional SchoolAuthorshipStatementModeRequired (Just "Erklärung über die eigenständige Bearbeitung\n\nHiermit erkläre ich, dass ich die vorliegende Abgabe vollständig selbstständig angefertigt habe, bzw. dass bei einer Gruppen-Abgabe nur die bei der Abgabe benannten Personen mitgewirkt haben.\n\nQuellen und Hilfsmittel über den Rahmen der Lehrveranstaltung hinaus sind als solche markiert und angegeben. Direkte Zitate sind als solche kenntlich gemacht.\n\nIch bin mir darüber im Klaren, dass Verstöße durch Plagiate oder Zusammenarbeit mit Dritten zum Ausschluss von der Veranstaltung führen.") False + mi <- insert' $ School "Institut für Mathematik" "MI" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False) SchoolAuthorshipStatementModeNone SchoolAuthorshipStatementModeOptional Nothing True void . insert' $ UserFunction gkleen ifi SchoolAdmin void . insert' $ UserFunction gkleen mi SchoolAdmin void . insert' $ UserFunction fhamann ifi SchoolAdmin From 09927ae14004f7a27f816ad874704969641dad83 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Mon, 31 May 2021 18:39:06 +0200 Subject: [PATCH 036/120] feat(schools): store school authorship statements as html --- models/schools.model | 2 +- src/Handler/School.hs | 4 ++-- test/Database/Fill.hs | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/models/schools.model b/models/schools.model index b686b7964..93bab5eb7 100644 --- a/models/schools.model +++ b/models/schools.model @@ -10,7 +10,7 @@ School json examCloseMode ExamCloseMode default='separate' sheetAuthorshipStatementMode SchoolAuthorshipStatementMode default='optional' sheetAuthorshipStatementExamMode SchoolAuthorshipStatementMode default='optional' - sheetAuthorshipStatementText Text Maybe + sheetAuthorshipStatementText Html Maybe sheetAuthorshipStatementAllowOther Bool default=true UniqueSchool name UniqueSchoolShorthand shorthand -- required for Normalisation of CI Text diff --git a/src/Handler/School.hs b/src/Handler/School.hs index 38cc9bf18..f97d64097 100644 --- a/src/Handler/School.hs +++ b/src/Handler/School.hs @@ -70,7 +70,7 @@ data SchoolForm = SchoolForm , sfExamCloseMode :: ExamCloseMode , sfSheetAuthorshipStatementMode :: SchoolAuthorshipStatementMode , sfSheetAuthorshipStatementExamMode :: SchoolAuthorshipStatementMode - , sfSheetAuthorshipStatementText :: Maybe Text + , sfSheetAuthorshipStatementText :: Maybe StoredMarkup , sfSheetAuthorshipStatementAllowOther :: Bool } @@ -88,7 +88,7 @@ mkSchoolForm mSsh template = renderAForm FormStandard $ SchoolForm <* aformSection MsgSchoolAuthorshipStatementSection <*> apopt (selectField optionsFinite) (fslI MsgSchoolSheetAuthorshipStatementMode) (sfSheetAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) <*> apopt (selectField optionsFinite) (fslI MsgSchoolSheetAuthorshipStatementExamMode) (sfSheetAuthorshipStatementExamMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) - <*> aopt (textField & cfStrip) (fslI MsgSchoolSheetAuthorshipStatementText & setTooltip MsgSchoolSheetAuthorshipStatementTextTip) (sfSheetAuthorshipStatementText <$> template) -- TODO: use htmlField + <*> aopt htmlField (fslI MsgSchoolSheetAuthorshipStatementText & setTooltip MsgSchoolSheetAuthorshipStatementTextTip) (sfSheetAuthorshipStatementText <$> template) <*> apopt checkBoxField (fslI MsgSchoolSheetAuthorshipStatementAllowOther & setTooltip MsgSchoolSheetAuthorshipStatementAllowOtherTip) (sfSheetAuthorshipStatementAllowOther <$> template <|> pure True) where ldapOrgs :: HandlerFor UniWorX (OptionList (CI Text)) diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index e3a22a6c4..fe3480ff7 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -411,7 +411,7 @@ fillDb = do , termLectureEnd } void . insert_ $ TermActive (TermKey term) (toMidnight $ addDays (-60) termStart) (Just . beforeMidnight $ addDays 60 termEnd) Nothing - ifi <- insert' $ School "Institut für Informatik" "IfI" (Just $ 14 * nominalDay) (Just $ 10 * nominalDay) True (ExamModeDNF predDNFFalse) (ExamCloseOnFinished True) SchoolAuthorshipStatementModeOptional SchoolAuthorshipStatementModeRequired (Just "Erklärung über die eigenständige Bearbeitung\n\nHiermit erkläre ich, dass ich die vorliegende Abgabe vollständig selbstständig angefertigt habe, bzw. dass bei einer Gruppen-Abgabe nur die bei der Abgabe benannten Personen mitgewirkt haben.\n\nQuellen und Hilfsmittel über den Rahmen der Lehrveranstaltung hinaus sind als solche markiert und angegeben. Direkte Zitate sind als solche kenntlich gemacht.\n\nIch bin mir darüber im Klaren, dass Verstöße durch Plagiate oder Zusammenarbeit mit Dritten zum Ausschluss von der Veranstaltung führen.") False + ifi <- insert' $ School "Institut für Informatik" "IfI" (Just $ 14 * nominalDay) (Just $ 10 * nominalDay) True (ExamModeDNF predDNFFalse) (ExamCloseOnFinished True) SchoolAuthorshipStatementModeOptional SchoolAuthorshipStatementModeRequired (Just "Erklärung über die eigenständige Bearbeitung

    Hiermit erkläre ich, dass ich die vorliegende Abgabe vollständig selbstständig angefertigt habe, bzw. dass bei einer Gruppen-Abgabe nur die bei der Abgabe benannten Personen mitgewirkt haben.

    Quellen und Hilfsmittel über den Rahmen der Lehrveranstaltung hinaus sind als solche markiert und angegeben. Direkte Zitate sind als solche kenntlich gemacht.

    Ich bin mir darüber im Klaren, dass Verstöße durch Plagiate oder Zusammenarbeit mit Dritten zum Ausschluss von der Veranstaltung führen.") False mi <- insert' $ School "Institut für Mathematik" "MI" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False) SchoolAuthorshipStatementModeNone SchoolAuthorshipStatementModeOptional Nothing True void . insert' $ UserFunction gkleen ifi SchoolAdmin void . insert' $ UserFunction gkleen mi SchoolAdmin From 67c30165ae90603e8a97ad2661d2bacb92e2e53f Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Mon, 31 May 2021 18:58:00 +0200 Subject: [PATCH 037/120] fix(schools): use StoredMarkup instead of Html for authorship statement --- models/schools.model | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/models/schools.model b/models/schools.model index 93bab5eb7..1db8cd10d 100644 --- a/models/schools.model +++ b/models/schools.model @@ -10,7 +10,7 @@ School json examCloseMode ExamCloseMode default='separate' sheetAuthorshipStatementMode SchoolAuthorshipStatementMode default='optional' sheetAuthorshipStatementExamMode SchoolAuthorshipStatementMode default='optional' - sheetAuthorshipStatementText Html Maybe + sheetAuthorshipStatementText StoredMarkup Maybe sheetAuthorshipStatementAllowOther Bool default=true UniqueSchool name UniqueSchoolShorthand shorthand -- required for Normalisation of CI Text From 960bd76acafc9cd077b831b67a281eb7b20e703c Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Tue, 1 Jun 2021 22:53:46 +0200 Subject: [PATCH 038/120] feat(schools): more school-wide configuration authorship statements --- .../categories/school/de-de-formal.msg | 12 +++-- messages/uniworx/categories/school/en-eu.msg | 12 +++-- models/authorship-statements.model | 17 +++++++ models/schools.model | 6 ++- models/sheets.model | 2 + src/Handler/School.hs | 47 ++++++++++++++----- src/Model/Migration/Definitions.hs | 3 ++ test/Database/Fill.hs | 5 +- 8 files changed, 79 insertions(+), 25 deletions(-) create mode 100644 models/authorship-statements.model diff --git a/messages/uniworx/categories/school/de-de-formal.msg b/messages/uniworx/categories/school/de-de-formal.msg index d4feac656..88f5088f1 100644 --- a/messages/uniworx/categories/school/de-de-formal.msg +++ b/messages/uniworx/categories/school/de-de-formal.msg @@ -20,11 +20,13 @@ SchoolAuthorshipStatementModeNone: Keine Eigenständigkeitserklärung erlauben SchoolAuthorshipStatementModeOptional: Eigenständigkeitserklärung optional einforderbar SchoolAuthorshipStatementModeRequired: Eigenständigkeitserklärung immer erforderlich SchoolSheetAuthorshipStatementMode: Modus für nicht-prüfungsrelevante Übungsblattabgaben -SchoolSheetAuthorshipStatementExamMode: Modus für prüfungsrelevante Übungsblattabgaben -SchoolSheetAuthorshipStatementText: Eigenständigkeitserklärung -SchoolSheetAuthorshipStatementTextTip: Dieser Text dient als Standard-Eigenständigkeitserklärung beim Anlegen eines neuen Übungsblattes innerhalb eines Kurses dieses Instituts. Wenn Anpassungen erlaubt sind, kann diese Erklärung pro Übungsblatt durch einen Dozierenden überschrieben werden. -SchoolSheetAuthorshipStatementAllowOther: Anpassungen erlauben? -SchoolSheetAuthorshipStatementAllowOtherTip: Soll es Dozierenden erlaubt sein, pro Übungsblatt eine abweichende Eigenständigkeitserklärung anzugeben? +SchoolSheetAuthorshipStatementDefinition: Eigenständigkeitserklärung für nicht-prüfungsrelevante Übungsblattabgaben +SchoolSheetAuthorshipStatementDefinitionTip: Deutsch und Englisch +SchoolSheetAuthorshipStatementAllowOther: Abweichende Erklärungen für nicht-prüfungsrelevante Übungsblätter erlauben? +SchoolSheetExamAuthorshipStatementMode: Modus für prüfungsrelevante Übungsblattabgaben +SchoolSheetExamAuthorshipStatementDefinition: Eigenständigkeitserklärung für prüfungsrelevante Übungsblattabgaben +SchoolSheetExamAuthorshipStatementDefinitionTip: Deutsch und Englisch +SchoolSheetExamAuthorshipStatementAllowOther: Abweichende Erklärungen für prüfungsrelevante Übungsblätter erlauben? SchoolUpdated ssh@SchoolId: #{ssh} erfolgreich angepasst SchoolTitle ssh@SchoolId: Institut „#{ssh}“ diff --git a/messages/uniworx/categories/school/en-eu.msg b/messages/uniworx/categories/school/en-eu.msg index aa7d295fc..16b256eef 100644 --- a/messages/uniworx/categories/school/en-eu.msg +++ b/messages/uniworx/categories/school/en-eu.msg @@ -20,11 +20,13 @@ SchoolAuthorshipStatementModeNone: No Statement of Authorship allowed SchoolAuthorshipStatementModeOptional: Statement of Authorship optionally activatable SchoolAuthorshipStatementModeRequired: Statement of Authorship always required SchoolSheetAuthorshipStatementMode: Mode for exam-unrelated exercise sheets -SchoolSheetAuthorshipStatementExamMode: Mode for exam-related sheets -SchoolSheetAuthorshipStatementText: Statement of Authorship -SchoolSheetAuthorshipStatementTextTip: This text serves as default Statement of Authorship upon creating a new exercise sheet in a course of this school. This statement may be overriden by a course administrator per exercise sheet if adaptations are allowed. -SchoolSheetAuthorshipStatementAllowOther: Allow adaptations? -SchoolSheetAuthorshipStatementAllowOtherTip: Should course administrators be allowed to specify an alternative Statement of Authorship? +SchoolSheetAuthorshipStatementDefinition: Statement of Authorship for exam-unrelated exercise sheets +SchoolSheetAuthorshipStatementDefinitionTip: German and English +SchoolSheetAuthorshipStatementAllowOther: Allow adaptations for exam-unrelated exercise sheets? +SchoolSheetExamAuthorshipStatementMode: Mode for exam-related exercise sheets +SchoolSheetExamAuthorshipStatementDefinition: Statement of Authorship for exam-related exercise sheets +SchoolSheetExamAuthorshipStatementDefinitionTip: German and English +SchoolSheetExamAuthorshipStatementAllowOther: Allow adaptations for exam-related exercise sheets? SchoolUpdated ssh: Successfully edited #{ssh} SchoolTitle ssh: Department „#{ssh}“ diff --git a/models/authorship-statements.model b/models/authorship-statements.model new file mode 100644 index 000000000..184071798 --- /dev/null +++ b/models/authorship-statements.model @@ -0,0 +1,17 @@ +AuthorshipStatementDefinition + content StoredMarkup -- must contain statements in all relevant languages for now, TODO: refactor (use translations as below) + deriving Generic +-- AuthorshipStatementDefinitionTranslation +-- definition AuthorshipStatementDefinitionId +-- language Lang +-- content StoredMarkup +-- UniqueAuthorshipStatementDefinitionTranslation definition language +-- deriving Generic + +-- Statement of Authorship to be issued upon submitting a solution for an exercise sheet +-- TODO: maybe move to SubmissionUser? (With statementSigned :: Bool, statement :: Maybe StoredMarkup) +AuthorshipStatementSubmission + submissionUser SubmissionUserId + statement StoredMarkup -- stored as plain StoredMarkup as the "signed" statement needs to be persisted + UniqueAuthorshipStatementSubmission submissionUser + deriving Generic diff --git a/models/schools.model b/models/schools.model index 1db8cd10d..0c96091c9 100644 --- a/models/schools.model +++ b/models/schools.model @@ -9,9 +9,11 @@ School json examDiscouragedModes ExamModeDNF examCloseMode ExamCloseMode default='separate' sheetAuthorshipStatementMode SchoolAuthorshipStatementMode default='optional' - sheetAuthorshipStatementExamMode SchoolAuthorshipStatementMode default='optional' - sheetAuthorshipStatementText StoredMarkup Maybe + sheetAuthorshipStatementDefinition AuthorshipStatementDefinitionId Maybe sheetAuthorshipStatementAllowOther Bool default=true + sheetExamAuthorshipStatementMode SchoolAuthorshipStatementMode default='optional' + sheetExamAuthorshipStatementDefinition AuthorshipStatementDefinitionId Maybe + sheetExamAuthorshipStatementAllowOther Bool default=true UniqueSchool name UniqueSchoolShorthand shorthand -- required for Normalisation of CI Text Primary shorthand -- newtype Key School = SchoolKey { unSchoolKey :: SchoolShorthand } diff --git a/models/sheets.model b/models/sheets.model index 08073eed3..c4f622f84 100644 --- a/models/sheets.model +++ b/models/sheets.model @@ -15,6 +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 CourseSheet course name deriving Generic SheetEdit -- who edited when a row in table "Course", kept indefinitely diff --git a/src/Handler/School.hs b/src/Handler/School.hs index f97d64097..9ce5c2748 100644 --- a/src/Handler/School.hs +++ b/src/Handler/School.hs @@ -69,9 +69,11 @@ data SchoolForm = SchoolForm , sfExamDiscouragedModes :: ExamModeDNF , sfExamCloseMode :: ExamCloseMode , sfSheetAuthorshipStatementMode :: SchoolAuthorshipStatementMode - , sfSheetAuthorshipStatementExamMode :: SchoolAuthorshipStatementMode - , sfSheetAuthorshipStatementText :: Maybe StoredMarkup + , sfSheetAuthorshipStatementDefinition :: Maybe StoredMarkup -- TODO: Must contain statements in all relevant languages for now; later use `Maybe (Map Lang StoredMarkup)` instead , sfSheetAuthorshipStatementAllowOther :: Bool + , sfSheetExamAuthorshipStatementMode :: SchoolAuthorshipStatementMode + , sfSheetExamAuthorshipStatementDefinition :: Maybe StoredMarkup -- TODO: Must contain statements in all relevant languages for now; later use `Maybe (Map Lang StoredMarkup)` instead + , sfSheetExamAuthorshipStatementAllowOther :: Bool } mkSchoolForm :: Maybe SchoolId -> Maybe SchoolForm -> Form SchoolForm @@ -87,9 +89,11 @@ mkSchoolForm mSsh template = renderAForm FormStandard $ SchoolForm <*> apopt (selectField optionsFinite) (fslI MsgExamCloseMode) (sfExamCloseMode <$> template <|> pure ExamCloseSeparate) <* aformSection MsgSchoolAuthorshipStatementSection <*> apopt (selectField optionsFinite) (fslI MsgSchoolSheetAuthorshipStatementMode) (sfSheetAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) - <*> apopt (selectField optionsFinite) (fslI MsgSchoolSheetAuthorshipStatementExamMode) (sfSheetAuthorshipStatementExamMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) - <*> aopt htmlField (fslI MsgSchoolSheetAuthorshipStatementText & setTooltip MsgSchoolSheetAuthorshipStatementTextTip) (sfSheetAuthorshipStatementText <$> template) - <*> apopt checkBoxField (fslI MsgSchoolSheetAuthorshipStatementAllowOther & setTooltip MsgSchoolSheetAuthorshipStatementAllowOtherTip) (sfSheetAuthorshipStatementAllowOther <$> template <|> pure True) + <*> aopt htmlField (fslI MsgSchoolSheetAuthorshipStatementDefinition & setTooltip MsgSchoolSheetAuthorshipStatementDefinitionTip) (sfSheetAuthorshipStatementDefinition <$> template) + <*> apopt checkBoxField (fslI MsgSchoolSheetAuthorshipStatementAllowOther) (sfSheetAuthorshipStatementAllowOther <$> template <|> pure True) + <*> apopt (selectField optionsFinite) (fslI MsgSchoolSheetExamAuthorshipStatementMode) (sfSheetExamAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) + <*> aopt htmlField (fslI MsgSchoolSheetExamAuthorshipStatementDefinition & setTooltip MsgSchoolSheetExamAuthorshipStatementDefinitionTip) (sfSheetExamAuthorshipStatementDefinition <$> template) + <*> apopt checkBoxField (fslI MsgSchoolSheetExamAuthorshipStatementAllowOther) (sfSheetExamAuthorshipStatementAllowOther <$> template <|> pure True) where ldapOrgs :: HandlerFor UniWorX (OptionList (CI Text)) ldapOrgs = fmap (mkOptionList . map (\t -> Option (CI.original t) t (CI.original t)) . Set.toAscList) . runDB $ @@ -99,6 +103,15 @@ schoolToForm :: SchoolId -> DB (Form SchoolForm) schoolToForm ssh = do School{..} <- get404 ssh ldapFrags <- selectList [SchoolLdapSchool ==. Just ssh] [] + + -- TODO: allow for separate translations + -- let getAuthorshipStatementDefs = maybe (return Nothing) (\definitionId -> Just <$> selectList [ AuthorshipStatementDefinitionTranslationDefinition ==. definitionId ] []) + -- authorshipStatementDefs <- getAuthorshipStatementDefs schoolSheetAuthorshipStatementDefinition + -- examAuthorshipStatementDefs <- getAuthorshipStatementDefs schoolSheetExamAuthorshipStatementDefinition + + mSheetAuthorshipStatementDefinition <- maybe (return Nothing) get schoolSheetAuthorshipStatementDefinition + mSheetExamAuthorshipStatementDefinition <- maybe (return Nothing) get schoolSheetExamAuthorshipStatementDefinition + return . mkSchoolForm (Just ssh) $ Just SchoolForm { sfShorthand = schoolShorthand , sfName = schoolName @@ -109,9 +122,11 @@ schoolToForm ssh = do , sfExamDiscouragedModes = schoolExamDiscouragedModes , sfExamCloseMode = schoolExamCloseMode , sfSheetAuthorshipStatementMode = schoolSheetAuthorshipStatementMode - , sfSheetAuthorshipStatementExamMode = schoolSheetAuthorshipStatementExamMode - , sfSheetAuthorshipStatementText = schoolSheetAuthorshipStatementText + , sfSheetAuthorshipStatementDefinition = authorshipStatementDefinitionContent <$> mSheetAuthorshipStatementDefinition , sfSheetAuthorshipStatementAllowOther = schoolSheetAuthorshipStatementAllowOther + , sfSheetExamAuthorshipStatementMode = schoolSheetExamAuthorshipStatementMode + , sfSheetExamAuthorshipStatementDefinition = authorshipStatementDefinitionContent <$> mSheetExamAuthorshipStatementDefinition + , sfSheetExamAuthorshipStatementAllowOther = schoolSheetExamAuthorshipStatementAllowOther } @@ -126,6 +141,9 @@ postSchoolEditR ssh = do formResult sfResult $ \SchoolForm{..} -> do runDB $ do + let + mAuthorshipStatementId = error "WIP upsert authorship statement" + mExamAuthorshipStatementId = error "WIP upsert exam authorship statement" update ssh [ SchoolName =. sfName , SchoolExamMinimumRegisterBeforeStart =. sfExamMinimumRegisterBeforeStart @@ -134,9 +152,11 @@ postSchoolEditR ssh = do , SchoolExamDiscouragedModes =. sfExamDiscouragedModes , SchoolExamCloseMode =. sfExamCloseMode , SchoolSheetAuthorshipStatementMode =. sfSheetAuthorshipStatementMode - , SchoolSheetAuthorshipStatementExamMode =. sfSheetAuthorshipStatementExamMode - , SchoolSheetAuthorshipStatementText =. sfSheetAuthorshipStatementText + , SchoolSheetAuthorshipStatementDefinition =. mAuthorshipStatementId , SchoolSheetAuthorshipStatementAllowOther =. sfSheetAuthorshipStatementAllowOther + , SchoolSheetExamAuthorshipStatementMode =. sfSheetExamAuthorshipStatementMode + , SchoolSheetExamAuthorshipStatementDefinition =. mExamAuthorshipStatementId + , SchoolSheetExamAuthorshipStatementAllowOther =. sfSheetExamAuthorshipStatementAllowOther ] forM_ sfOrgUnits $ \schoolLdapOrgUnit -> void $ upsert SchoolLdap @@ -171,6 +191,9 @@ postSchoolNewR = do formResult sfResult $ \SchoolForm{..} -> do let ssh = SchoolKey sfShorthand insertOkay <- runDB $ do + let + mAuthorshipStatementId = error "WIP insert authorship statement" + mExamAuthorshipStatementId = error "WIP insert exam authorship statement" didInsert <- is _Just <$> insertUnique School { schoolShorthand = sfShorthand , schoolName = sfName @@ -180,9 +203,11 @@ postSchoolNewR = do , schoolExamDiscouragedModes = sfExamDiscouragedModes , schoolExamCloseMode = sfExamCloseMode , schoolSheetAuthorshipStatementMode = sfSheetAuthorshipStatementMode - , schoolSheetAuthorshipStatementExamMode = sfSheetAuthorshipStatementExamMode - , schoolSheetAuthorshipStatementText = sfSheetAuthorshipStatementText + , schoolSheetAuthorshipStatementDefinition = mAuthorshipStatementId , schoolSheetAuthorshipStatementAllowOther = sfSheetAuthorshipStatementAllowOther + , schoolSheetExamAuthorshipStatementMode = sfSheetExamAuthorshipStatementMode + , schoolSheetExamAuthorshipStatementDefinition = mExamAuthorshipStatementId + , schoolSheetExamAuthorshipStatementAllowOther = sfSheetExamAuthorshipStatementAllowOther } when didInsert $ do insert_ UserFunction diff --git a/src/Model/Migration/Definitions.hs b/src/Model/Migration/Definitions.hs index 537127fb5..78ac1db9e 100644 --- a/src/Model/Migration/Definitions.hs +++ b/src/Model/Migration/Definitions.hs @@ -103,6 +103,9 @@ data ManualMigration | Migration20210208StudyFeaturesRelevanceCachedUUIDs | Migration20210318CrontabSubmissionRatedNotification | Migration20210608SeparateTermActive + -- TODO: migration regarding authorship statements + -- - apply desired non-default modes for IfI + -- - set authorship statement texts for IfI deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) deriving anyclass (Universe, Finite) diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index fe3480ff7..f510ab53c 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -411,8 +411,9 @@ fillDb = do , termLectureEnd } void . insert_ $ TermActive (TermKey term) (toMidnight $ addDays (-60) termStart) (Just . beforeMidnight $ addDays 60 termEnd) Nothing - ifi <- insert' $ School "Institut für Informatik" "IfI" (Just $ 14 * nominalDay) (Just $ 10 * nominalDay) True (ExamModeDNF predDNFFalse) (ExamCloseOnFinished True) SchoolAuthorshipStatementModeOptional SchoolAuthorshipStatementModeRequired (Just "Erklärung über die eigenständige Bearbeitung

    Hiermit erkläre ich, dass ich die vorliegende Abgabe vollständig selbstständig angefertigt habe, bzw. dass bei einer Gruppen-Abgabe nur die bei der Abgabe benannten Personen mitgewirkt haben.

    Quellen und Hilfsmittel über den Rahmen der Lehrveranstaltung hinaus sind als solche markiert und angegeben. Direkte Zitate sind als solche kenntlich gemacht.

    Ich bin mir darüber im Klaren, dass Verstöße durch Plagiate oder Zusammenarbeit mit Dritten zum Ausschluss von der Veranstaltung führen.") False - mi <- insert' $ School "Institut für Mathematik" "MI" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False) SchoolAuthorshipStatementModeNone SchoolAuthorshipStatementModeOptional Nothing True + ifiAuthorshipStatement <- insert $ AuthorshipStatementDefinition "Erklärung über die eigenständige Bearbeitung

    Hiermit erkläre ich, dass ich die vorliegende Abgabe vollständig selbstständig angefertigt habe, bzw. dass bei einer Gruppen-Abgabe nur die bei der Abgabe benannten Personen mitgewirkt haben. Quellen und Hilfsmittel über den Rahmen der Lehrveranstaltung hinaus sind als solche markiert und angegeben. Direkte Zitate sind als solche kenntlich gemacht. Ich bin mir darüber im Klaren, dass Verstöße durch Plagiate oder Zusammenarbeit mit Dritten zum Ausschluss von der Veranstaltung führen.

    Statement of Authorship

    TODO English version

    " + ifi <- insert' $ School "Institut für Informatik" "IfI" (Just $ 14 * nominalDay) (Just $ 10 * nominalDay) True (ExamModeDNF predDNFFalse) (ExamCloseOnFinished True) SchoolAuthorshipStatementModeOptional (Just ifiAuthorshipStatement) True SchoolAuthorshipStatementModeRequired (Just ifiAuthorshipStatement) False + mi <- insert' $ School "Institut für Mathematik" "MI" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False) SchoolAuthorshipStatementModeNone Nothing True SchoolAuthorshipStatementModeOptional Nothing True void . insert' $ UserFunction gkleen ifi SchoolAdmin void . insert' $ UserFunction gkleen mi SchoolAdmin void . insert' $ UserFunction fhamann ifi SchoolAdmin From 579371cffd87c247805bf4ead8bc2c278269a5ee Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Wed, 2 Jun 2021 07:53:11 +0200 Subject: [PATCH 039/120] fix(schools): perform authorship statement inserts --- src/Handler/School.hs | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/src/Handler/School.hs b/src/Handler/School.hs index 9ce5c2748..56e6c68e0 100644 --- a/src/Handler/School.hs +++ b/src/Handler/School.hs @@ -137,13 +137,11 @@ postSchoolEditR ssh = do ((sfResult, sfView), sfEnctype) <- runFormPost sForm - -- TODO: validate Form: when AuthorshipStatement required, the statement text must be `Just t` with `t` non-empty - formResult sfResult $ \SchoolForm{..} -> do runDB $ do - let - mAuthorshipStatementId = error "WIP upsert authorship statement" - mExamAuthorshipStatementId = error "WIP upsert exam authorship statement" + let insertAuthorshipStatement = maybe (pure Nothing) $ fmap Just . insert . AuthorshipStatementDefinition + mSheetAuthorshipStatementId <- insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition + mSheetExamAuthorshipStatementId <- insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition update ssh [ SchoolName =. sfName , SchoolExamMinimumRegisterBeforeStart =. sfExamMinimumRegisterBeforeStart @@ -152,10 +150,10 @@ postSchoolEditR ssh = do , SchoolExamDiscouragedModes =. sfExamDiscouragedModes , SchoolExamCloseMode =. sfExamCloseMode , SchoolSheetAuthorshipStatementMode =. sfSheetAuthorshipStatementMode - , SchoolSheetAuthorshipStatementDefinition =. mAuthorshipStatementId + , SchoolSheetAuthorshipStatementDefinition =. mSheetAuthorshipStatementId , SchoolSheetAuthorshipStatementAllowOther =. sfSheetAuthorshipStatementAllowOther , SchoolSheetExamAuthorshipStatementMode =. sfSheetExamAuthorshipStatementMode - , SchoolSheetExamAuthorshipStatementDefinition =. mExamAuthorshipStatementId + , SchoolSheetExamAuthorshipStatementDefinition =. mSheetExamAuthorshipStatementId , SchoolSheetExamAuthorshipStatementAllowOther =. sfSheetExamAuthorshipStatementAllowOther ] forM_ sfOrgUnits $ \schoolLdapOrgUnit -> @@ -191,9 +189,9 @@ postSchoolNewR = do formResult sfResult $ \SchoolForm{..} -> do let ssh = SchoolKey sfShorthand insertOkay <- runDB $ do - let - mAuthorshipStatementId = error "WIP insert authorship statement" - mExamAuthorshipStatementId = error "WIP insert exam authorship statement" + let insertAuthorshipStatement = maybe (pure Nothing) $ fmap Just . insert . AuthorshipStatementDefinition + mSheetAuthorshipStatementId <- insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition + mSheetExamAuthorshipStatementId <- insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition didInsert <- is _Just <$> insertUnique School { schoolShorthand = sfShorthand , schoolName = sfName @@ -203,10 +201,10 @@ postSchoolNewR = do , schoolExamDiscouragedModes = sfExamDiscouragedModes , schoolExamCloseMode = sfExamCloseMode , schoolSheetAuthorshipStatementMode = sfSheetAuthorshipStatementMode - , schoolSheetAuthorshipStatementDefinition = mAuthorshipStatementId + , schoolSheetAuthorshipStatementDefinition = mSheetAuthorshipStatementId , schoolSheetAuthorshipStatementAllowOther = sfSheetAuthorshipStatementAllowOther , schoolSheetExamAuthorshipStatementMode = sfSheetExamAuthorshipStatementMode - , schoolSheetExamAuthorshipStatementDefinition = mExamAuthorshipStatementId + , schoolSheetExamAuthorshipStatementDefinition = mSheetExamAuthorshipStatementId , schoolSheetExamAuthorshipStatementAllowOther = sfSheetExamAuthorshipStatementAllowOther } when didInsert $ do From 541dd7688ffa36be8a968f26f920507ed5aae646 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Wed, 2 Jun 2021 23:16:02 +0200 Subject: [PATCH 040/120] 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 From 996262c3274d43178d301a406a5fc2afc2e20d64 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 3 Jun 2021 00:15:50 +0200 Subject: [PATCH 041/120] chore: set authorship statements in db-fill --- test/Database/Fill.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index f510ab53c..216c915a4 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -657,6 +657,8 @@ fillDb = do , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True + , sheetAuthorshipStatementRequired = False + , sheetAuthorshipStatementDefinition = Just ifiAuthorshipStatement } insert_ $ SheetEdit gkleen now adhoc feste <- insert Sheet @@ -676,6 +678,8 @@ fillDb = do , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True + , sheetAuthorshipStatementRequired = False + , sheetAuthorshipStatementDefinition = Just ifiAuthorshipStatement } insert_ $ SheetEdit gkleen now feste keine <- insert Sheet @@ -695,6 +699,8 @@ fillDb = do , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True + , sheetAuthorshipStatementRequired = False + , sheetAuthorshipStatementDefinition = Just ifiAuthorshipStatement } insert_ $ SheetEdit gkleen now keine void . insertMany $ map (\u -> CourseParticipant ffp u now Nothing CourseParticipantActive) @@ -939,6 +945,8 @@ fillDb = do , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True + , sheetAuthorshipStatementRequired = False + , sheetAuthorshipStatementDefinition = Just ifiAuthorshipStatement } void . insert $ SheetEdit jost now shId when (submissionModeCorrector sheetSubmissionMode) $ @@ -1182,6 +1190,8 @@ fillDb = do , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True + , sheetAuthorshipStatementRequired = shNr == 14 + , sheetAuthorshipStatementDefinition = Just ifiAuthorshipStatement } manyUsers' <- shuffleM $ take 1024 manyUsers groupSizes <- getRandomRs (1, 3) From 0735c05a7489957ed500bac1c006f4ecfdab74f3 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 3 Jun 2021 14:52:34 +0200 Subject: [PATCH 042/120] feat(sheets): eliminate authship statement required Bool --- .../categories/courses/sheet/de-de-formal.msg | 4 +--- .../uniworx/categories/courses/sheet/en-eu.msg | 4 +--- models/sheets.model | 3 +-- src/Handler/Sheet/Edit.hs | 12 +++++------- src/Handler/Sheet/Form.hs | 6 ++---- src/Handler/Sheet/New.hs | 5 ++--- test/Database/Fill.hs | 15 +++++---------- 7 files changed, 17 insertions(+), 32 deletions(-) diff --git a/messages/uniworx/categories/courses/sheet/de-de-formal.msg b/messages/uniworx/categories/courses/sheet/de-de-formal.msg index 26940c441..c10f81e0c 100644 --- a/messages/uniworx/categories/courses/sheet/de-de-formal.msg +++ b/messages/uniworx/categories/courses/sheet/de-de-formal.msg @@ -154,6 +154,4 @@ 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). +SheetAuthorshipStatementRequiredTip: Soll jeder Abgebende (bei Abgabegruppen jedes Mitglied der Abgabegruppe) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren? diff --git a/messages/uniworx/categories/courses/sheet/en-eu.msg b/messages/uniworx/categories/courses/sheet/en-eu.msg index 45bb059c4..4b04a2380 100644 --- a/messages/uniworx/categories/courses/sheet/en-eu.msg +++ b/messages/uniworx/categories/courses/sheet/en-eu.msg @@ -153,6 +153,4 @@ 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). +SheetAuthorshipStatementRequiredTip: Should each submittor (in case of submission groups each group member) be required to accept a Statement of Authorship? diff --git a/models/sheets.model b/models/sheets.model index 20e3d8912..6b78c7d36 100644 --- a/models/sheets.model +++ b/models/sheets.model @@ -15,8 +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 - authorshipStatementRequired Bool default=false - authorshipStatementDefinition AuthorshipStatementDefinitionId Maybe + authorshipStatement 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 3f4df896d..bf6e031c8 100644 --- a/src/Handler/Sheet/Edit.hs +++ b/src/Handler/Sheet/Edit.hs @@ -29,7 +29,7 @@ postSEditR tid ssh csh shn = do <$> 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 sheetAuthorshipStatementDefinition + mAuthorshipStatement <- maybe (pure Nothing) get sheetAuthorshipStatement return (ent, fti, cLoads, hasPersonalisedFiles, mAuthorshipStatement) let template = Just $ SheetForm { sfName = sheetName @@ -56,8 +56,7 @@ postSEditR tid ssh csh shn = do , spffAllowNonPersonalisedSubmission = sheetAllowNonPersonalisedSubmission , spffFiles = Nothing } - , sfAuthorshipStatementRequired = sheetAuthorshipStatementRequired - , sfAuthorshipStatementDefinition = authorshipStatementDefinitionContent <$> mAuthorshipStatement + , sfAuthorshipStatement = authorshipStatementDefinitionContent <$> mAuthorshipStatement } let action = uniqueReplace sid -- More specific error message for edit old sheet could go here by using myReplaceUnique instead @@ -78,14 +77,14 @@ handleSheetEdit tid ssh csh msId template dbAction = do mOldAuthorshipStatement <- runMaybeT $ do sId <- MaybeT . return $ msId Entity _ Sheet{..} <- MaybeT $ getEntity sId - statementId <- MaybeT . return $ sheetAuthorshipStatementDefinition + 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 $ bool Nothing (AuthorshipStatementDefinition <$> sfAuthorshipStatementDefinition) sfAuthorshipStatementRequired + mNewAuthorshipStatementId <- insertNewOrKeepStatement $ AuthorshipStatementDefinition <$> sfAuthorshipStatement let newSheet = Sheet { sheetCourse = cid @@ -104,8 +103,7 @@ handleSheetEdit tid ssh csh msId template dbAction = do , sheetAnonymousCorrection = sfAnonymousCorrection , sheetRequireExamRegistration = sfRequireExamRegistration , sheetAllowNonPersonalisedSubmission = maybe True spffAllowNonPersonalisedSubmission sfPersonalF - , sheetAuthorshipStatementRequired = sfAuthorshipStatementRequired - , sheetAuthorshipStatementDefinition = mNewAuthorshipStatementId + , sheetAuthorshipStatement = mNewAuthorshipStatementId } mbsid <- dbAction newSheet case mbsid of diff --git a/src/Handler/Sheet/Form.hs b/src/Handler/Sheet/Form.hs index b7ddf1fa4..64155bdad 100644 --- a/src/Handler/Sheet/Form.hs +++ b/src/Handler/Sheet/Form.hs @@ -42,8 +42,7 @@ data SheetForm = SheetForm , sfMarkingText :: Maybe StoredMarkup , sfAnonymousCorrection :: Bool , sfCorrectors :: Loads - , sfAuthorshipStatementRequired :: Bool - , sfAuthorshipStatementDefinition :: Maybe StoredMarkup + , sfAuthorshipStatement :: Maybe StoredMarkup } data SheetPersonalisedFilesForm = SheetPersonalisedFilesForm @@ -100,8 +99,7 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS <*> 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 + <*> optionalActionA (apreq htmlField (fslI MsgSheetAuthorshipStatement) (join $ sfAuthorshipStatement <$> template)) (fslI MsgSheetAuthorshipStatementRequired & setTooltip MsgSheetAuthorshipStatementRequiredTip) (is _Just . sfAuthorshipStatement <$> template) -- TODO: if template is empty, use school definition as default -- TODO: disable option and set accordingly if school mode prevents edits where makeSheetPersonalisedFilesForm :: Maybe SheetPersonalisedFilesForm -> MForm Handler (AForm Handler SheetPersonalisedFilesForm) makeSheetPersonalisedFilesForm template' = do diff --git a/src/Handler/Sheet/New.hs b/src/Handler/Sheet/New.hs index c61f90204..3b2dc8ea1 100644 --- a/src/Handler/Sheet/New.hs +++ b/src/Handler/Sheet/New.hs @@ -39,7 +39,7 @@ postSheetNewR tid ssh csh = 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 + E.where_ $ E.just (authorshipStatementDefinition E.^. AuthorshipStatementDefinitionId) E.==. sheet E.^. SheetAuthorshipStatement return $ authorshipStatementDefinition E.^. AuthorshipStatementDefinitionContent return (sheet, firstEdit, mAuthorshipStatement) cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh @@ -70,8 +70,7 @@ postSheetNewR tid ssh csh = do , sfAnonymousCorrection = sheetAnonymousCorrection , sfRequireExamRegistration = Nothing , sfPersonalF = Nothing - , sfAuthorshipStatementRequired = sheetAuthorshipStatementRequired - , sfAuthorshipStatementDefinition = mAuthorshipStatement + , sfAuthorshipStatement = mAuthorshipStatement } _other -> Nothing let action = -- More specific error message for new sheet could go here, if insertUnique returns Nothing diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 216c915a4..2539f2c4b 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -657,8 +657,7 @@ fillDb = do , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True - , sheetAuthorshipStatementRequired = False - , sheetAuthorshipStatementDefinition = Just ifiAuthorshipStatement + , sheetAuthorshipStatement = Nothing } insert_ $ SheetEdit gkleen now adhoc feste <- insert Sheet @@ -678,8 +677,7 @@ fillDb = do , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True - , sheetAuthorshipStatementRequired = False - , sheetAuthorshipStatementDefinition = Just ifiAuthorshipStatement + , sheetAuthorshipStatement = Nothing } insert_ $ SheetEdit gkleen now feste keine <- insert Sheet @@ -699,8 +697,7 @@ fillDb = do , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True - , sheetAuthorshipStatementRequired = False - , sheetAuthorshipStatementDefinition = Just ifiAuthorshipStatement + , sheetAuthorshipStatement = Nothing } insert_ $ SheetEdit gkleen now keine void . insertMany $ map (\u -> CourseParticipant ffp u now Nothing CourseParticipantActive) @@ -945,8 +942,7 @@ fillDb = do , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True - , sheetAuthorshipStatementRequired = False - , sheetAuthorshipStatementDefinition = Just ifiAuthorshipStatement + , sheetAuthorshipStatement = Nothing } void . insert $ SheetEdit jost now shId when (submissionModeCorrector sheetSubmissionMode) $ @@ -1190,8 +1186,7 @@ fillDb = do , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True - , sheetAuthorshipStatementRequired = shNr == 14 - , sheetAuthorshipStatementDefinition = Just ifiAuthorshipStatement + , sheetAuthorshipStatement = if shNr == 14 then Just ifiAuthorshipStatement else Nothing } manyUsers' <- shuffleM $ take 1024 manyUsers groupSizes <- getRandomRs (1, 3) From 44473b45756c5df20e6a81927867de191cf70366 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 3 Jun 2021 15:29:24 +0200 Subject: [PATCH 043/120] feat(sheets): display authship req on SShowR --- messages/uniworx/categories/courses/sheet/de-de-formal.msg | 2 ++ messages/uniworx/categories/courses/sheet/en-eu.msg | 2 ++ src/Handler/Sheet/Show.hs | 3 +++ templates/sheetShow.hamlet | 5 +++++ 4 files changed, 12 insertions(+) diff --git a/messages/uniworx/categories/courses/sheet/de-de-formal.msg b/messages/uniworx/categories/courses/sheet/de-de-formal.msg index c10f81e0c..5ab5fc427 100644 --- a/messages/uniworx/categories/courses/sheet/de-de-formal.msg +++ b/messages/uniworx/categories/courses/sheet/de-de-formal.msg @@ -155,3 +155,5 @@ SheetGradingPassAlways: Automatisch bestanden, sobald korrigiert SheetAuthorshipStatement: Eigenständigkeitserklärung SheetAuthorshipStatementRequired: Eigenständigkeitserklärung einfordern? SheetAuthorshipStatementRequiredTip: Soll jeder Abgebende (bei Abgabegruppen jedes Mitglied der Abgabegruppe) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren? +SheetAuthorshipStatementIsRequiredTrue: Erforderlich +SheetAuthorshipStatementIsRequiredFalse: Keine diff --git a/messages/uniworx/categories/courses/sheet/en-eu.msg b/messages/uniworx/categories/courses/sheet/en-eu.msg index 4b04a2380..e7434d7f0 100644 --- a/messages/uniworx/categories/courses/sheet/en-eu.msg +++ b/messages/uniworx/categories/courses/sheet/en-eu.msg @@ -154,3 +154,5 @@ SheetGradingPassAlways: Automatically passed when corrected SheetAuthorshipStatement: Statement of Authorship SheetAuthorshipStatementRequired: Require Statement of Authorship for submissions? SheetAuthorshipStatementRequiredTip: Should each submittor (in case of submission groups each group member) be required to accept a Statement of Authorship? +SheetAuthorshipStatementIsRequiredTrue: Required +SheetAuthorshipStatementIsRequiredFalse: None diff --git a/src/Handler/Sheet/Show.hs b/src/Handler/Sheet/Show.hs index 045d8d631..772649a4e 100644 --- a/src/Handler/Sheet/Show.hs +++ b/src/Handler/Sheet/Show.hs @@ -20,7 +20,10 @@ 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 + 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 diff --git a/templates/sheetShow.hamlet b/templates/sheetShow.hamlet index 4f18e2ab9..e7915deca 100644 --- a/templates/sheetShow.hamlet +++ b/templates/sheetShow.hamlet @@ -70,6 +70,11 @@ $maybe descr <- sheetDescription sheet _{MsgTableSheetType}
    ^{sTypeDesc tr} + $if mayEdit || maySubmit +
    + _{MsgSheetAuthorshipStatement} +
    + _{maybe MsgSheetAuthorshipStatementIsRequiredFalse (const MsgSheetAuthorshipStatementIsRequiredTrue) (sheetAuthorshipStatement sheet)} $maybe marktxt <- markingText
    From a39a0d7c8763e158dae5750afac8a78bd953dcdf Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 3 Jun 2021 16:11:14 +0200 Subject: [PATCH 044/120] feat(sheets): fetch school statement as statement default --- src/Handler/Sheet/Form.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/Handler/Sheet/Form.hs b/src/Handler/Sheet/Form.hs index 64155bdad..9d827f9a9 100644 --- a/src/Handler/Sheet/Form.hs +++ b/src/Handler/Sheet/Form.hs @@ -66,6 +66,12 @@ 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) sheetPersonalisedFilesForm <- makeSheetPersonalisedFilesForm $ template >>= sfPersonalF flip (renderAForm FormStandard) html $ SheetForm <$> areq (textField & cfStrip & cfCI) (fslI MsgSheetName) (sfName <$> template) @@ -99,7 +105,7 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS <*> apopt checkBoxField (fslI MsgSheetAnonymousCorrection & setTooltip MsgSheetAnonymousCorrectionTip) (sfAnonymousCorrection <$> template) <*> correctorForm (maybe mempty sfCorrectors template) <* aformSection MsgSheetAuthorshipStatement - <*> optionalActionA (apreq htmlField (fslI MsgSheetAuthorshipStatement) (join $ sfAuthorshipStatement <$> template)) (fslI MsgSheetAuthorshipStatementRequired & setTooltip MsgSheetAuthorshipStatementRequiredTip) (is _Just . sfAuthorshipStatement <$> template) -- TODO: if template is empty, use school definition as default -- TODO: disable option and set accordingly if school mode prevents edits + <*> 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 where makeSheetPersonalisedFilesForm :: Maybe SheetPersonalisedFilesForm -> MForm Handler (AForm Handler SheetPersonalisedFilesForm) makeSheetPersonalisedFilesForm template' = do From 202fd769403bc4a57832142607669cda18e53d81 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Tue, 8 Jun 2021 15:19:06 +0200 Subject: [PATCH 045/120] refactor: create authorship statement message category --- .../authorship_statement/de-de-formal.msg | 25 +++++++++++++++++++ .../categories/authorship_statement/en-eu.msg | 25 +++++++++++++++++++ .../categories/courses/sheet/de-de-formal.msg | 6 ----- .../categories/courses/sheet/en-eu.msg | 6 ----- .../categories/school/de-de-formal.msg | 13 ---------- messages/uniworx/categories/school/en-eu.msg | 13 ---------- src/Foundation/I18n.hs | 7 +++--- 7 files changed, 54 insertions(+), 41 deletions(-) create mode 100644 messages/uniworx/categories/authorship_statement/de-de-formal.msg create mode 100644 messages/uniworx/categories/authorship_statement/en-eu.msg diff --git a/messages/uniworx/categories/authorship_statement/de-de-formal.msg b/messages/uniworx/categories/authorship_statement/de-de-formal.msg new file mode 100644 index 000000000..cf57b5fe1 --- /dev/null +++ b/messages/uniworx/categories/authorship_statement/de-de-formal.msg @@ -0,0 +1,25 @@ +Statement: Eigenständigkeitserklärung +Section: Eigenständigkeitserklärungen + +SchoolModeNone: Keine Eigenständigkeitserklärung erlauben +SchoolModeOptional: Eigenständigkeitserklärung optional einforderbar +SchoolModeRequired: Eigenständigkeitserklärung immer erforderlich +SchoolSheetMode: Modus für nicht-prüfungsrelevante Übungsblattabgaben +SchoolSheetDefinition: Eigenständigkeitserklärung für nicht-prüfungsrelevante Übungsblattabgaben +SchoolSheetDefinitionTip: Deutsch und Englisch +SchoolSheetAllowOther: Abweichende Erklärungen für nicht-prüfungsrelevante Übungsblätter erlauben? +SchoolSheetExamMode: Modus für prüfungsrelevante Übungsblattabgaben +SchoolSheetExamDefinition: Eigenständigkeitserklärung für prüfungsrelevante Übungsblattabgaben +SchoolSheetExamDefinitionTip: Deutsch und Englisch +SchoolSheetExamAllowOther: Abweichende Erklärungen für prüfungsrelevante Übungsblätter erlauben? + +SheetRequired: Falls nicht-prüfungsrelevant: Eigenständigkeitserklärung einfordern? +SheetRequiredTip: Soll jeder Abgebende (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren? +SheetRequiredDisabled: Eigenständigkeitserklärungen für nicht-prüfungsrelevante Übungsblattabgaben sind institutsweit deaktiviert. +SheetRequiredForced: Es ist institutsweit vorgeschrieben, dass bei Übungsblattabgaben jeder Abgebende (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden muss, eine Eigenständigkeitserklärung zu akzeptieren. +SheetIsRequiredTrue: Erforderlich +SheetIsRequiredFalse: Keine +SheetUseSchoolDefault: Vorgabe des Instituts verwenden? +SheetUseSchoolDefaultTip: Soll die aktuelle Vorgabe des Instituts (siehe unten) verwendet werden? (Hinweis: Um über alle Abgaben eines Blattes hinweg konsistente Eigenständigkeitserklärungen zu gewährleisten, werden Änderungen an der Vorgabe des Instituts nur für neue Blätter angewandt.) +SheetCustom: Benutzerdefinierte Erklärung +SheetSchoolDefault: Vorgabe des Instituts diff --git a/messages/uniworx/categories/authorship_statement/en-eu.msg b/messages/uniworx/categories/authorship_statement/en-eu.msg new file mode 100644 index 000000000..f2e624a0d --- /dev/null +++ b/messages/uniworx/categories/authorship_statement/en-eu.msg @@ -0,0 +1,25 @@ +Statement: Statement of Authorship +Section: Statements of Authorship + +SchoolModeNone: No Statement of Authorship allowed +SchoolModeOptional: Statement of Authorship optionally activatable +SchoolModeRequired: Statement of Authorship always required +SchoolSheetMode: Mode for exam-unrelated exercise sheets +SchoolSheetDefinition: Statement of Authorship for exam-unrelated exercise sheets +SchoolSheetDefinitionTip: German and English +SchoolSheetAllowOther: Allow adaptations for exam-unrelated exercise sheets? +SchoolSheetExamMode: Mode for exam-related exercise sheets +SchoolSheetExamDefinition: Statement of Authorship for exam-related exercise sheets +SchoolSheetExamDefinitionTip: German and English +SchoolSheetExamAllowOther: Allow adaptations for exam-related exercise sheets? + +SheetRequired: For exam-unrelated sheets: Require Statement of Authorship for submissions? +SheetRequiredTip: Should each submittor (in case of submission groups each group member) be required to accept a Statement of Authorship? +SheetRequiredDisabled: The school settings prohibit Statements of Authorship for exam-unrelated exercise sheet submissions. +SheetRequiredForced: The school settings enforce that each submittor (in case of submission groups each group member) is required to accept a Statement of Authorship. +SheetIsRequiredTrue: Required +SheetIsRequiredFalse: None +SheetUseSchoolDefault: Use school preset? +SheetUseSchoolDefaultTip: Should the school-wide preset be used? (Hint: To ensure consistent statements across all submissions for a sheet, changes of the school-wide preset will only apply to new exercise sheets.) +SheetCustom: Custom statement +SheetSchoolDefault: School preset diff --git a/messages/uniworx/categories/courses/sheet/de-de-formal.msg b/messages/uniworx/categories/courses/sheet/de-de-formal.msg index 5ab5fc427..e35dbc9e9 100644 --- a/messages/uniworx/categories/courses/sheet/de-de-formal.msg +++ b/messages/uniworx/categories/courses/sheet/de-de-formal.msg @@ -151,9 +151,3 @@ SheetGradingPoints maxPoints@Points: #{maxPoints} #{pluralDE maxPoints "Punkt" " SheetGradingPassPoints maxPoints@Points passingPoints@Points: Bestanden ab #{passingPoints} von #{maxPoints} #{pluralDE maxPoints "Punkt" "Punkten"} SheetGradingPassBinary: Bestanden/Nicht Bestanden SheetGradingPassAlways: Automatisch bestanden, sobald korrigiert - -SheetAuthorshipStatement: Eigenständigkeitserklärung -SheetAuthorshipStatementRequired: Eigenständigkeitserklärung einfordern? -SheetAuthorshipStatementRequiredTip: Soll jeder Abgebende (bei Abgabegruppen jedes Mitglied der Abgabegruppe) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren? -SheetAuthorshipStatementIsRequiredTrue: Erforderlich -SheetAuthorshipStatementIsRequiredFalse: Keine diff --git a/messages/uniworx/categories/courses/sheet/en-eu.msg b/messages/uniworx/categories/courses/sheet/en-eu.msg index e7434d7f0..793b9c397 100644 --- a/messages/uniworx/categories/courses/sheet/en-eu.msg +++ b/messages/uniworx/categories/courses/sheet/en-eu.msg @@ -150,9 +150,3 @@ SheetGradingPoints maxPoints: #{maxPoints} #{pluralEN maxPoints "point" "points" SheetGradingPassPoints maxPoints passingPoints: Pass with #{passingPoints} of #{maxPoints} #{pluralEN maxPoints "point" "points"} SheetGradingPassBinary: Pass/Fail SheetGradingPassAlways: Automatically passed when corrected - -SheetAuthorshipStatement: Statement of Authorship -SheetAuthorshipStatementRequired: Require Statement of Authorship for submissions? -SheetAuthorshipStatementRequiredTip: Should each submittor (in case of submission groups each group member) be required to accept a Statement of Authorship? -SheetAuthorshipStatementIsRequiredTrue: Required -SheetAuthorshipStatementIsRequiredFalse: None diff --git a/messages/uniworx/categories/school/de-de-formal.msg b/messages/uniworx/categories/school/de-de-formal.msg index 88f5088f1..b2afee856 100644 --- a/messages/uniworx/categories/school/de-de-formal.msg +++ b/messages/uniworx/categories/school/de-de-formal.msg @@ -15,19 +15,6 @@ SchoolExamRequireModeForRegistrationTip: Sollen Dozierende gezwungen werden Prü SchoolExamDiscouragedModes: Prüfungsmodi mit Warnung ExamCloseMode: Prüfungs-Abschluss -SchoolAuthorshipStatementSection: Eigenständigkeitserklärungen -SchoolAuthorshipStatementModeNone: Keine Eigenständigkeitserklärung erlauben -SchoolAuthorshipStatementModeOptional: Eigenständigkeitserklärung optional einforderbar -SchoolAuthorshipStatementModeRequired: Eigenständigkeitserklärung immer erforderlich -SchoolSheetAuthorshipStatementMode: Modus für nicht-prüfungsrelevante Übungsblattabgaben -SchoolSheetAuthorshipStatementDefinition: Eigenständigkeitserklärung für nicht-prüfungsrelevante Übungsblattabgaben -SchoolSheetAuthorshipStatementDefinitionTip: Deutsch und Englisch -SchoolSheetAuthorshipStatementAllowOther: Abweichende Erklärungen für nicht-prüfungsrelevante Übungsblätter erlauben? -SchoolSheetExamAuthorshipStatementMode: Modus für prüfungsrelevante Übungsblattabgaben -SchoolSheetExamAuthorshipStatementDefinition: Eigenständigkeitserklärung für prüfungsrelevante Übungsblattabgaben -SchoolSheetExamAuthorshipStatementDefinitionTip: Deutsch und Englisch -SchoolSheetExamAuthorshipStatementAllowOther: Abweichende Erklärungen für prüfungsrelevante Übungsblätter erlauben? - SchoolUpdated ssh@SchoolId: #{ssh} erfolgreich angepasst SchoolTitle ssh@SchoolId: Institut „#{ssh}“ TitleSchoolNew: Neues Institut anlegen diff --git a/messages/uniworx/categories/school/en-eu.msg b/messages/uniworx/categories/school/en-eu.msg index 16b256eef..4bb741369 100644 --- a/messages/uniworx/categories/school/en-eu.msg +++ b/messages/uniworx/categories/school/en-eu.msg @@ -15,19 +15,6 @@ SchoolExamRequireModeForRegistrationTip: Should course administrators be forced SchoolExamDiscouragedModes: Exam designs to warn against ExamCloseMode: Exam closure -SchoolAuthorshipStatementSection: Statements of Authorship -SchoolAuthorshipStatementModeNone: No Statement of Authorship allowed -SchoolAuthorshipStatementModeOptional: Statement of Authorship optionally activatable -SchoolAuthorshipStatementModeRequired: Statement of Authorship always required -SchoolSheetAuthorshipStatementMode: Mode for exam-unrelated exercise sheets -SchoolSheetAuthorshipStatementDefinition: Statement of Authorship for exam-unrelated exercise sheets -SchoolSheetAuthorshipStatementDefinitionTip: German and English -SchoolSheetAuthorshipStatementAllowOther: Allow adaptations for exam-unrelated exercise sheets? -SchoolSheetExamAuthorshipStatementMode: Mode for exam-related exercise sheets -SchoolSheetExamAuthorshipStatementDefinition: Statement of Authorship for exam-related exercise sheets -SchoolSheetExamAuthorshipStatementDefinitionTip: German and English -SchoolSheetExamAuthorshipStatementAllowOther: Allow adaptations for exam-related exercise sheets? - SchoolUpdated ssh: Successfully edited #{ssh} SchoolTitle ssh: Department „#{ssh}“ TitleSchoolNew: Create new department diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs index 17f4d418b..c8e8a2900 100644 --- a/src/Foundation/I18n.hs +++ b/src/Foundation/I18n.hs @@ -183,6 +183,7 @@ mkMessageAddition ''UniWorX "ModelTypes" "messages/uniworx/categories/model_type mkMessageAddition ''UniWorX "Send" "messages/uniworx/categories/send" "de-de-formal" mkMessageAddition ''UniWorX "YesodMiddleware" "messages/uniworx/categories/yesod_middleware" "de-de-formal" mkMessageAddition ''UniWorX "User" "messages/uniworx/categories/user" "de-de-formal" +mkMessageAddition ''UniWorX "AuthorshipStatement" "messages/uniworx/categories/authorship_statement" "de-de-formal" mkMessageAddition ''UniWorX "Button" "messages/uniworx/utils/buttons" "de-de-formal" mkMessageAddition ''UniWorX "Form" "messages/uniworx/utils/handler_form" "de-de-formal" mkMessageAddition ''UniWorX "TableColumn" "messages/uniworx/utils/table_column" "de-de-formal" @@ -406,9 +407,9 @@ instance RenderMessage UniWorX ExamCloseMode where instance RenderMessage UniWorX SchoolAuthorshipStatementMode where renderMessage foundation ls = \case - SchoolAuthorshipStatementModeNone -> mr MsgSchoolAuthorshipStatementModeNone - SchoolAuthorshipStatementModeOptional -> mr MsgSchoolAuthorshipStatementModeOptional - SchoolAuthorshipStatementModeRequired -> mr MsgSchoolAuthorshipStatementModeRequired + SchoolAuthorshipStatementModeNone -> mr MsgSchoolModeNone + SchoolAuthorshipStatementModeOptional -> mr MsgSchoolModeOptional + SchoolAuthorshipStatementModeRequired -> mr MsgSchoolModeRequired where mr :: RenderMessage UniWorX msg => msg -> Text mr = renderMessage foundation ls From c3a75d3a754e91e88b597cb2ad3a88247fd87265 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Wed, 9 Jun 2021 13:02:42 +0200 Subject: [PATCH 046/120] refactor(messages): move to categories --- .../authorship_statement/de-de-formal.msg | 25 ------------------- .../categories/authorship_statement/en-eu.msg | 25 ------------------- .../courses/exam/exam/de-de-formal.msg | 8 +++++- .../categories/courses/exam/exam/en-eu.msg | 8 +++++- .../categories/courses/sheet/de-de-formal.msg | 12 +++++++++ .../categories/courses/sheet/en-eu.msg | 12 +++++++++ .../categories/school/de-de-formal.msg | 15 ++++++++++- messages/uniworx/categories/school/en-eu.msg | 15 ++++++++++- src/Foundation/I18n.hs | 7 +++--- 9 files changed, 69 insertions(+), 58 deletions(-) delete mode 100644 messages/uniworx/categories/authorship_statement/de-de-formal.msg delete mode 100644 messages/uniworx/categories/authorship_statement/en-eu.msg diff --git a/messages/uniworx/categories/authorship_statement/de-de-formal.msg b/messages/uniworx/categories/authorship_statement/de-de-formal.msg deleted file mode 100644 index cf57b5fe1..000000000 --- a/messages/uniworx/categories/authorship_statement/de-de-formal.msg +++ /dev/null @@ -1,25 +0,0 @@ -Statement: Eigenständigkeitserklärung -Section: Eigenständigkeitserklärungen - -SchoolModeNone: Keine Eigenständigkeitserklärung erlauben -SchoolModeOptional: Eigenständigkeitserklärung optional einforderbar -SchoolModeRequired: Eigenständigkeitserklärung immer erforderlich -SchoolSheetMode: Modus für nicht-prüfungsrelevante Übungsblattabgaben -SchoolSheetDefinition: Eigenständigkeitserklärung für nicht-prüfungsrelevante Übungsblattabgaben -SchoolSheetDefinitionTip: Deutsch und Englisch -SchoolSheetAllowOther: Abweichende Erklärungen für nicht-prüfungsrelevante Übungsblätter erlauben? -SchoolSheetExamMode: Modus für prüfungsrelevante Übungsblattabgaben -SchoolSheetExamDefinition: Eigenständigkeitserklärung für prüfungsrelevante Übungsblattabgaben -SchoolSheetExamDefinitionTip: Deutsch und Englisch -SchoolSheetExamAllowOther: Abweichende Erklärungen für prüfungsrelevante Übungsblätter erlauben? - -SheetRequired: Falls nicht-prüfungsrelevant: Eigenständigkeitserklärung einfordern? -SheetRequiredTip: Soll jeder Abgebende (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren? -SheetRequiredDisabled: Eigenständigkeitserklärungen für nicht-prüfungsrelevante Übungsblattabgaben sind institutsweit deaktiviert. -SheetRequiredForced: Es ist institutsweit vorgeschrieben, dass bei Übungsblattabgaben jeder Abgebende (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden muss, eine Eigenständigkeitserklärung zu akzeptieren. -SheetIsRequiredTrue: Erforderlich -SheetIsRequiredFalse: Keine -SheetUseSchoolDefault: Vorgabe des Instituts verwenden? -SheetUseSchoolDefaultTip: Soll die aktuelle Vorgabe des Instituts (siehe unten) verwendet werden? (Hinweis: Um über alle Abgaben eines Blattes hinweg konsistente Eigenständigkeitserklärungen zu gewährleisten, werden Änderungen an der Vorgabe des Instituts nur für neue Blätter angewandt.) -SheetCustom: Benutzerdefinierte Erklärung -SheetSchoolDefault: Vorgabe des Instituts diff --git a/messages/uniworx/categories/authorship_statement/en-eu.msg b/messages/uniworx/categories/authorship_statement/en-eu.msg deleted file mode 100644 index f2e624a0d..000000000 --- a/messages/uniworx/categories/authorship_statement/en-eu.msg +++ /dev/null @@ -1,25 +0,0 @@ -Statement: Statement of Authorship -Section: Statements of Authorship - -SchoolModeNone: No Statement of Authorship allowed -SchoolModeOptional: Statement of Authorship optionally activatable -SchoolModeRequired: Statement of Authorship always required -SchoolSheetMode: Mode for exam-unrelated exercise sheets -SchoolSheetDefinition: Statement of Authorship for exam-unrelated exercise sheets -SchoolSheetDefinitionTip: German and English -SchoolSheetAllowOther: Allow adaptations for exam-unrelated exercise sheets? -SchoolSheetExamMode: Mode for exam-related exercise sheets -SchoolSheetExamDefinition: Statement of Authorship for exam-related exercise sheets -SchoolSheetExamDefinitionTip: German and English -SchoolSheetExamAllowOther: Allow adaptations for exam-related exercise sheets? - -SheetRequired: For exam-unrelated sheets: Require Statement of Authorship for submissions? -SheetRequiredTip: Should each submittor (in case of submission groups each group member) be required to accept a Statement of Authorship? -SheetRequiredDisabled: The school settings prohibit Statements of Authorship for exam-unrelated exercise sheet submissions. -SheetRequiredForced: The school settings enforce that each submittor (in case of submission groups each group member) is required to accept a Statement of Authorship. -SheetIsRequiredTrue: Required -SheetIsRequiredFalse: None -SheetUseSchoolDefault: Use school preset? -SheetUseSchoolDefaultTip: Should the school-wide preset be used? (Hint: To ensure consistent statements across all submissions for a sheet, changes of the school-wide preset will only apply to new exercise sheets.) -SheetCustom: Custom statement -SheetSchoolDefault: School preset diff --git a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg index 32713c799..9e8168802 100644 --- a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg +++ b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg @@ -311,4 +311,10 @@ TitleExamAutoOccurrence tid@TermId ssh@SchoolId csh@CourseShorthand examn@ExamNa ExamGradingPass: Bestanden/Nicht Bestanden ExamGradingGrades: Numerische Noten ExamGradingMixed: Gemischt -ExamFinished: Ergebnisse sichtbar ab \ No newline at end of file +ExamFinished: Ergebnisse sichtbar ab + +ExamAuthorshipStatementSection: Eigenständigkeitserklärung +ExamAuthorshipStatementRequired: Eigenständigkeitserklärung für zugehörige Übungsblattabgaben einfordern? +ExamAuthorshipStatementRequiredTip: Sollen für alle zu dieser Prüfung zugehörige Übungsblätter die Abgebenden (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren? +ExamAuthorshipStatementUseSchoolDefinition: Eigenständigkeitserklärung des Instituts verwenden +ExamAuthorshipStatementCustom: Benutzerdefinierte Eigenständigkeitserklärung \ No newline at end of file diff --git a/messages/uniworx/categories/courses/exam/exam/en-eu.msg b/messages/uniworx/categories/courses/exam/exam/en-eu.msg index 20325610a..4a33f8383 100644 --- a/messages/uniworx/categories/courses/exam/exam/en-eu.msg +++ b/messages/uniworx/categories/courses/exam/exam/en-eu.msg @@ -309,4 +309,10 @@ TitleExamAutoOccurrence tid ssh csh examn: #{tid} - #{ssh} - #{csh} #{examn}: Au ExamGradingPass: Passed/Failed ExamGradingGrades: Numeric grades ExamGradingMixed: Mixed -ExamFinished: Results visible from \ No newline at end of file +ExamFinished: Results visible from + +ExamAuthorshipStatementSection: Statement of Authorship +ExamAuthorshipStatementRequired: Require Statement of Authorship for exam-related exercise sheet submissions? +ExamAuthorshipStatementRequiredTip: Should submittors (in case of submission groups each group member) be required to accept a Statement of Authorship for all exercise sheets related to this exam? +ExamAuthorshipStatementUseSchoolDefinition: Use school-wide Statement of Authorship +ExamAuthorshipStatementCustom: Custom Statement of Authorship \ No newline at end of file diff --git a/messages/uniworx/categories/courses/sheet/de-de-formal.msg b/messages/uniworx/categories/courses/sheet/de-de-formal.msg index e35dbc9e9..f830472ee 100644 --- a/messages/uniworx/categories/courses/sheet/de-de-formal.msg +++ b/messages/uniworx/categories/courses/sheet/de-de-formal.msg @@ -151,3 +151,15 @@ SheetGradingPoints maxPoints@Points: #{maxPoints} #{pluralDE maxPoints "Punkt" " SheetGradingPassPoints maxPoints@Points passingPoints@Points: Bestanden ab #{passingPoints} von #{maxPoints} #{pluralDE maxPoints "Punkt" "Punkten"} SheetGradingPassBinary: Bestanden/Nicht Bestanden SheetGradingPassAlways: Automatisch bestanden, sobald korrigiert + +SheetAuthorshipStatementSection: Eigenständigkeitserklärung +SheetAuthorshipStatementRequired: Falls nicht-prüfungsrelevant: Eigenständigkeitserklärung einfordern? +SheetAuthorshipStatementRequiredTip: Soll jeder Abgebende (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren? +SheetAuthorshipStatementRequiredDisabled: Eigenständigkeitserklärungen für nicht-prüfungsrelevante Übungsblattabgaben sind institutsweit deaktiviert. +SheetAuthorshipStatementRequiredForced: Es ist institutsweit vorgeschrieben, dass bei Übungsblattabgaben jeder Abgebende (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden muss, eine Eigenständigkeitserklärung zu akzeptieren. +SheetAuthorshipStatementIsRequiredTrue: Erforderlich +SheetAuthorshipStatementIsRequiredFalse: Keine +SheetAuthorshipStatementUseSchoolDefault: Vorgabe des Instituts verwenden? +SheetAuthorshipStatementUseSchoolDefaultTip: Soll die aktuelle Vorgabe des Instituts (siehe unten) verwendet werden? (Hinweis: Um über alle Abgaben eines Blattes hinweg konsistente Eigenständigkeitserklärungen zu gewährleisten, werden Änderungen an der Vorgabe des Instituts nur für neue Blätter angewandt.) +SheetAuthorshipStatementCustom: Benutzerdefinierte Erklärung +SheetAuthorshipStatementSchoolDefault: Vorgabe des Instituts diff --git a/messages/uniworx/categories/courses/sheet/en-eu.msg b/messages/uniworx/categories/courses/sheet/en-eu.msg index 793b9c397..0ce9116f1 100644 --- a/messages/uniworx/categories/courses/sheet/en-eu.msg +++ b/messages/uniworx/categories/courses/sheet/en-eu.msg @@ -150,3 +150,15 @@ SheetGradingPoints maxPoints: #{maxPoints} #{pluralEN maxPoints "point" "points" SheetGradingPassPoints maxPoints passingPoints: Pass with #{passingPoints} of #{maxPoints} #{pluralEN maxPoints "point" "points"} SheetGradingPassBinary: Pass/Fail SheetGradingPassAlways: Automatically passed when corrected + +SheetAuthorshipStatementSection: Statement of Authorship +SheetAuthorshipStatementRequired: For exam-unrelated sheets: Require Statement of Authorship for submissions? +SheetAuthorshipStatementRequiredTip: Should each submittor (in case of submission groups each group member) be required to accept a Statement of Authorship? +SheetAuthorshipStatementRequiredDisabled: The school settings prohibit Statements of Authorship for exam-unrelated exercise sheet submissions. +SheetAuthorshipStatementRequiredForced: The school settings enforce that each submittor (in case of submission groups each group member) is required to accept a Statement of Authorship. +SheetAuthorshipStatementIsRequiredTrue: Required +SheetAuthorshipStatementIsRequiredFalse: None +SheetAuthorshipStatementUseSchoolDefault: Use school preset? +SheetAuthorshipStatementUseSchoolDefaultTip: Should the school-wide preset be used? (Hint: To ensure consistent statements across all submissions for a sheet, changes of the school-wide preset will only apply to new exercise sheets.) +SheetAuthorshipStatementCustom: Custom statement +SheetAuthorshipStatementSchoolDefault: School preset diff --git a/messages/uniworx/categories/school/de-de-formal.msg b/messages/uniworx/categories/school/de-de-formal.msg index b2afee856..8a0c21c8e 100644 --- a/messages/uniworx/categories/school/de-de-formal.msg +++ b/messages/uniworx/categories/school/de-de-formal.msg @@ -24,4 +24,17 @@ SchoolLecturer: Dozent:in SchoolEvaluation: Kursumfragenverwaltung SchoolExamOffice: Prüfungsverwaltung SchoolAllocation: Zentralanmeldungs-Administration -SchoolAdmin !ident-ok: Admin \ No newline at end of file +SchoolAdmin !ident-ok: Admin + +SchoolAuthorshipStatementSection: Eigenständigkeitserklärung +SchoolAuthorshipStatementModeNone: Keine Eigenständigkeitserklärung erlauben +SchoolAuthorshipStatementModeOptional: Eigenständigkeitserklärung optional einforderbar +SchoolAuthorshipStatementModeRequired: Eigenständigkeitserklärung immer erforderlich +SchoolAuthorshipStatementSheetMode: Modus für nicht-prüfungsrelevante Übungsblattabgaben +SchoolAuthorshipStatementSheetDefinition: Eigenständigkeitserklärung für nicht-prüfungsrelevante Übungsblattabgaben +SchoolAuthorshipStatementSheetDefinitionTip: Deutsch und Englisch +SchoolAuthorshipStatementSheetAllowOther: Abweichende Erklärungen für nicht-prüfungsrelevante Übungsblätter erlauben? +SchoolAuthorshipStatementSheetExamMode: Modus für prüfungsrelevante Übungsblattabgaben +SchoolAuthorshipStatementSheetExamDefinition: Eigenständigkeitserklärung für prüfungsrelevante Übungsblattabgaben +SchoolAuthorshipStatementSheetExamDefinitionTip: Deutsch und Englisch +SchoolAuthorshipStatementSheetExamAllowOther: Abweichende Erklärungen für prüfungsrelevante Übungsblätter erlauben? \ No newline at end of file diff --git a/messages/uniworx/categories/school/en-eu.msg b/messages/uniworx/categories/school/en-eu.msg index 4bb741369..008b44ed2 100644 --- a/messages/uniworx/categories/school/en-eu.msg +++ b/messages/uniworx/categories/school/en-eu.msg @@ -24,4 +24,17 @@ SchoolAdmin: Admin SchoolLecturer: Lecturer SchoolEvaluation: Course evaluation SchoolExamOffice: Exam office -SchoolAllocation: Administration of central allocations \ No newline at end of file +SchoolAllocation: Administration of central allocations + +SchoolAuthorshipStatementSection: Statement of Authorship +SchoolAuthorshipStatementModeNone: No Statement of Authorship allowed +SchoolAuthorshipStatementModeOptional: Statement of Authorship optionally activatable +SchoolAuthorshipStatementModeRequired: Statement of Authorship always required +SchoolAuthorshipStatementSheetMode: Mode for exam-unrelated exercise sheets +SchoolAuthorshipStatementSheetDefinition: Statement of Authorship for exam-unrelated exercise sheets +SchoolAuthorshipStatementSheetDefinitionTip: German and English +SchoolAuthorshipStatementSheetAllowOther: Allow adaptations for exam-unrelated exercise sheets? +SchoolAuthorshipStatementSheetExamMode: Mode for exam-related exercise sheets +SchoolAuthorshipStatementSheetExamDefinition: Statement of Authorship for exam-related exercise sheets +SchoolAuthorshipStatementSheetExamDefinitionTip: German and English +SchoolAuthorshipStatementSheetExamAllowOther: Allow adaptations for exam-related exercise sheets? \ No newline at end of file diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs index c8e8a2900..17f4d418b 100644 --- a/src/Foundation/I18n.hs +++ b/src/Foundation/I18n.hs @@ -183,7 +183,6 @@ mkMessageAddition ''UniWorX "ModelTypes" "messages/uniworx/categories/model_type mkMessageAddition ''UniWorX "Send" "messages/uniworx/categories/send" "de-de-formal" mkMessageAddition ''UniWorX "YesodMiddleware" "messages/uniworx/categories/yesod_middleware" "de-de-formal" mkMessageAddition ''UniWorX "User" "messages/uniworx/categories/user" "de-de-formal" -mkMessageAddition ''UniWorX "AuthorshipStatement" "messages/uniworx/categories/authorship_statement" "de-de-formal" mkMessageAddition ''UniWorX "Button" "messages/uniworx/utils/buttons" "de-de-formal" mkMessageAddition ''UniWorX "Form" "messages/uniworx/utils/handler_form" "de-de-formal" mkMessageAddition ''UniWorX "TableColumn" "messages/uniworx/utils/table_column" "de-de-formal" @@ -407,9 +406,9 @@ instance RenderMessage UniWorX ExamCloseMode where instance RenderMessage UniWorX SchoolAuthorshipStatementMode where renderMessage foundation ls = \case - SchoolAuthorshipStatementModeNone -> mr MsgSchoolModeNone - SchoolAuthorshipStatementModeOptional -> mr MsgSchoolModeOptional - SchoolAuthorshipStatementModeRequired -> mr MsgSchoolModeRequired + SchoolAuthorshipStatementModeNone -> mr MsgSchoolAuthorshipStatementModeNone + SchoolAuthorshipStatementModeOptional -> mr MsgSchoolAuthorshipStatementModeOptional + SchoolAuthorshipStatementModeRequired -> mr MsgSchoolAuthorshipStatementModeRequired where mr :: RenderMessage UniWorX msg => msg -> Text mr = renderMessage foundation ls From 0e6207376043af8fe0929019e3c39f80bcfea9a6 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Wed, 9 Jun 2021 13:07:02 +0200 Subject: [PATCH 047/120] fix(schools): rename messages --- src/Handler/School.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Handler/School.hs b/src/Handler/School.hs index 56e6c68e0..423f0f4a4 100644 --- a/src/Handler/School.hs +++ b/src/Handler/School.hs @@ -88,12 +88,12 @@ mkSchoolForm mSsh template = renderAForm FormStandard $ SchoolForm <*> areq pathPieceField (fslI MsgSchoolExamDiscouragedModes) (sfExamDiscouragedModes <$> template <|> pure (ExamModeDNF predDNFFalse)) <*> apopt (selectField optionsFinite) (fslI MsgExamCloseMode) (sfExamCloseMode <$> template <|> pure ExamCloseSeparate) <* aformSection MsgSchoolAuthorshipStatementSection - <*> apopt (selectField optionsFinite) (fslI MsgSchoolSheetAuthorshipStatementMode) (sfSheetAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) - <*> aopt htmlField (fslI MsgSchoolSheetAuthorshipStatementDefinition & setTooltip MsgSchoolSheetAuthorshipStatementDefinitionTip) (sfSheetAuthorshipStatementDefinition <$> template) - <*> apopt checkBoxField (fslI MsgSchoolSheetAuthorshipStatementAllowOther) (sfSheetAuthorshipStatementAllowOther <$> template <|> pure True) - <*> apopt (selectField optionsFinite) (fslI MsgSchoolSheetExamAuthorshipStatementMode) (sfSheetExamAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) - <*> aopt htmlField (fslI MsgSchoolSheetExamAuthorshipStatementDefinition & setTooltip MsgSchoolSheetExamAuthorshipStatementDefinitionTip) (sfSheetExamAuthorshipStatementDefinition <$> template) - <*> apopt checkBoxField (fslI MsgSchoolSheetExamAuthorshipStatementAllowOther) (sfSheetExamAuthorshipStatementAllowOther <$> template <|> pure True) + <*> apopt (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetMode) (sfSheetAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) + <*> aopt htmlField (fslI MsgSchoolAuthorshipStatementSheetDefinition & setTooltip MsgSchoolAuthorshipStatementSheetDefinitionTip) (sfSheetAuthorshipStatementDefinition <$> template) + <*> apopt checkBoxField (fslI MsgSchoolAuthorshipStatementSheetAllowOther) (sfSheetAuthorshipStatementAllowOther <$> template <|> pure True) + <*> apopt (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetExamMode) (sfSheetExamAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) + <*> aopt htmlField (fslI MsgSchoolAuthorshipStatementSheetExamDefinition & setTooltip MsgSchoolAuthorshipStatementSheetExamDefinitionTip) (sfSheetExamAuthorshipStatementDefinition <$> template) + <*> apopt checkBoxField (fslI MsgSchoolAuthorshipStatementSheetExamAllowOther) (sfSheetExamAuthorshipStatementAllowOther <$> template <|> pure True) where ldapOrgs :: HandlerFor UniWorX (OptionList (CI Text)) ldapOrgs = fmap (mkOptionList . map (\t -> Option (CI.original t) t (CI.original t)) . Set.toAscList) . runDB $ From 1d8a2cef60a688bd514d529f8e1230e462811f1e Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Wed, 9 Jun 2021 13:18:38 +0200 Subject: [PATCH 048/120] fix(sheet-show): move message --- templates/sheetShow.hamlet | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/templates/sheetShow.hamlet b/templates/sheetShow.hamlet index e7915deca..fd378a60a 100644 --- a/templates/sheetShow.hamlet +++ b/templates/sheetShow.hamlet @@ -72,7 +72,7 @@ $maybe descr <- sheetDescription sheet ^{sTypeDesc tr} $if mayEdit || maySubmit
    - _{MsgSheetAuthorshipStatement} + _{MsgSheetAuthorshipStatementSection}
    _{maybe MsgSheetAuthorshipStatementIsRequiredFalse (const MsgSheetAuthorshipStatementIsRequiredTrue) (sheetAuthorshipStatement sheet)} From 6e7e8a2b207c482936b835f7674bceed1e1ff281 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Wed, 9 Jun 2021 14:09:40 +0200 Subject: [PATCH 049/120] refactor(sheets): prepare for sheet-scoped statements --- models/sheets.model | 4 +-- src/Handler/Sheet/Edit.hs | 51 +++++++++++++++++++++++------------- src/Handler/Sheet/Form.hs | 53 ++++++++++++++++++++++++++++++-------- src/Handler/Sheet/New.hs | 12 ++++----- src/Handler/Sheet/Show.hs | 4 +-- templates/sheetShow.hamlet | 10 +++---- 6 files changed, 90 insertions(+), 44 deletions(-) diff --git a/models/sheets.model b/models/sheets.model index 6b78c7d36..796ebbe76 100644 --- a/models/sheets.model +++ b/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 \ No newline at end of file + deriving Generic diff --git a/src/Handler/Sheet/Edit.hs b/src/Handler/Sheet/Edit.hs index bf6e031c8..7e370a960 100644 --- a/src/Handler/Sheet/Edit.hs +++ b/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 - 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 diff --git a/src/Handler/Sheet/Form.hs b/src/Handler/Sheet/Form.hs index 9d827f9a9..4a1bcd754 100644 --- a/src/Handler/Sheet/Form.hs +++ b/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 - 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 diff --git a/src/Handler/Sheet/New.hs b/src/Handler/Sheet/New.hs index 3b2dc8ea1..e2fe398e0 100644 --- a/src/Handler/Sheet/New.hs +++ b/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 - 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 diff --git a/src/Handler/Sheet/Show.hs b/src/Handler/Sheet/Show.hs index 772649a4e..1fdaaab21 100644 --- a/src/Handler/Sheet/Show.hs +++ b/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 - 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 diff --git a/templates/sheetShow.hamlet b/templates/sheetShow.hamlet index fd378a60a..ec8c6e259 100644 --- a/templates/sheetShow.hamlet +++ b/templates/sheetShow.hamlet @@ -70,11 +70,11 @@ $maybe descr <- sheetDescription sheet _{MsgTableSheetType}
    ^{sTypeDesc tr} - $if mayEdit || maySubmit -
    - _{MsgSheetAuthorshipStatementSection} -
    - _{maybe MsgSheetAuthorshipStatementIsRequiredFalse (const MsgSheetAuthorshipStatementIsRequiredTrue) (sheetAuthorshipStatement sheet)} +$# $if mayEdit || maySubmit +$#
    +$# _{MsgSheetAuthorshipStatementSection} +$#
    +$# _{maybe MsgSheetAuthorshipStatementIsRequiredFalse (const MsgSheetAuthorshipStatementIsRequiredTrue) (sheetAuthorshipStatement sheet)} $maybe marktxt <- markingText
    From 7b11ed46dec57c84e467184b9e542b612e4ab661 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Wed, 9 Jun 2021 14:10:12 +0200 Subject: [PATCH 050/120] refactor(exams): prepare for exam-wide statements --- models/exams.model | 1 + src/Handler/Exam/Edit.hs | 1 + src/Handler/Exam/New.hs | 1 + 3 files changed, 3 insertions(+) diff --git a/models/exams.model b/models/exams.model index 1c79e1f7f..ded7124b6 100644 --- a/models/exams.model +++ b/models/exams.model @@ -20,6 +20,7 @@ Exam examMode ExamMode staff Text Maybe partsFrom UTCTime Maybe +-- authorshipStatement AuthorshipStatementDefinitionId Maybe UniqueExam course name deriving Generic ExamPart diff --git a/src/Handler/Exam/Edit.hs b/src/Handler/Exam/Edit.hs index 5ecffe1f0..875e99025 100644 --- a/src/Handler/Exam/Edit.hs +++ b/src/Handler/Exam/Edit.hs @@ -60,6 +60,7 @@ postEEditR tid ssh csh examn = do , examGradingMode = efGradingMode , examDescription = efDescription , examExamMode = efExamMode + -- , examAuthorshipStatement = Nothing -- TODO , examStaff = efStaff , examPartsFrom = efPartsFrom } diff --git a/src/Handler/Exam/New.hs b/src/Handler/Exam/New.hs index 4c20fe692..09b8a6dbe 100644 --- a/src/Handler/Exam/New.hs +++ b/src/Handler/Exam/New.hs @@ -49,6 +49,7 @@ postCExamNewR tid ssh csh = do , examPublicStatistics = efPublicStatistics , examDescription = efDescription , examExamMode = efExamMode + -- , examAuthorshipStatement = Nothing -- TODO , examStaff = efStaff , examPartsFrom = efPartsFrom } From a1111b498fb8e96f67a3d1b7e382ca3b85df0a72 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Wed, 9 Jun 2021 14:10:37 +0200 Subject: [PATCH 051/120] refactor: update db fill --- test/Database/Fill.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 2539f2c4b..818fbd85f 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -657,7 +657,7 @@ fillDb = do , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True - , sheetAuthorshipStatement = Nothing + -- , sheetAuthorshipStatement = Nothing } insert_ $ SheetEdit gkleen now adhoc feste <- insert Sheet @@ -677,7 +677,7 @@ fillDb = do , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True - , sheetAuthorshipStatement = Nothing + -- , sheetAuthorshipStatement = Nothing } insert_ $ SheetEdit gkleen now feste keine <- insert Sheet @@ -697,7 +697,7 @@ fillDb = do , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True - , sheetAuthorshipStatement = Nothing + -- , sheetAuthorshipStatement = Nothing } insert_ $ SheetEdit gkleen now keine void . insertMany $ map (\u -> CourseParticipant ffp u now Nothing CourseParticipantActive) @@ -732,6 +732,7 @@ fillDb = do , examSynchronicity = Just $ ExamSynchronicityPreset ExamSynchronous , examRequiredEquipment = Just $ ExamRequiredEquipmentPreset ExamRequiredEquipmentNone } + -- , examAuthorshipStatement = Nothing , examStaff = Just "Hofmann" } _ <- insert' Material @@ -942,7 +943,7 @@ fillDb = do , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True - , sheetAuthorshipStatement = Nothing + -- , sheetAuthorshipStatement = Nothing } void . insert $ SheetEdit jost now shId when (submissionModeCorrector sheetSubmissionMode) $ @@ -1186,7 +1187,7 @@ fillDb = do , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True - , sheetAuthorshipStatement = if shNr == 14 then Just ifiAuthorshipStatement else Nothing + -- , sheetAuthorshipStatement = if shNr == 14 then Just ifiAuthorshipStatement else Nothing } manyUsers' <- shuffleM $ take 1024 manyUsers groupSizes <- getRandomRs (1, 3) From 5cc41aeef94993a24538b2f88af1fb75625036a8 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Wed, 9 Jun 2021 15:35:34 +0200 Subject: [PATCH 052/120] feat(exams): basic required optional action for authorship statements --- .../courses/exam/exam/de-de-formal.msg | 7 ++-- .../categories/courses/exam/exam/en-eu.msg | 5 ++- models/exams.model | 2 +- src/Handler/Exam/Form.hs | 35 +++++++++++++++++++ 4 files changed, 45 insertions(+), 4 deletions(-) diff --git a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg index 9e8168802..7f14504b1 100644 --- a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg +++ b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg @@ -314,7 +314,10 @@ ExamGradingMixed: Gemischt ExamFinished: Ergebnisse sichtbar ab ExamAuthorshipStatementSection: Eigenständigkeitserklärung -ExamAuthorshipStatementRequired: Eigenständigkeitserklärung für zugehörige Übungsblattabgaben einfordern? +ExamAuthorshipStatementRequired: Eigenständigkeitserklärung für prüfungszugehörige Übungsblattabgaben einfordern? ExamAuthorshipStatementRequiredTip: Sollen für alle zu dieser Prüfung zugehörige Übungsblätter die Abgebenden (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren? -ExamAuthorshipStatementUseSchoolDefinition: Eigenständigkeitserklärung des Instituts verwenden +ExamAuthorshipStatementRequiredDisabledOffTip: Für dieses Institut sind Eigenständigkeitserklärungen für prüfungsrelevante Blätter deaktiviert. +ExamAuthorshipStatementRequiredDisabledOnTip: Für dieses Institut sind Eigenständigkeitserklärungen für prüfungsrelevante Blätter vorgeschrieben. +ExamAuthorshipStatementUseSchoolDefinition: Eigenständigkeitserklärung des Instituts verwenden? +ExamAuthorshipStatementUseSchoolDefinitionTip: Soll die institutsweit eingestellte Eigenständigkeitserklärung genutzt werden? (Hinweis: Um konsistente Erklärungen für alle Abgaben einer Prüfung zu gewährleisten, dient die institutsweite Erklärung hier nur als Vorlage und wird ab dann getrennt (als Kopie) gespeichert. Ändert sich die institutsweite Erklärung, so muss die Änderung für diese Prüfung manuell übernommen werden, falls erwünscht.) ExamAuthorshipStatementCustom: Benutzerdefinierte Eigenständigkeitserklärung \ No newline at end of file diff --git a/messages/uniworx/categories/courses/exam/exam/en-eu.msg b/messages/uniworx/categories/courses/exam/exam/en-eu.msg index 4a33f8383..fa0525d38 100644 --- a/messages/uniworx/categories/courses/exam/exam/en-eu.msg +++ b/messages/uniworx/categories/courses/exam/exam/en-eu.msg @@ -314,5 +314,8 @@ ExamFinished: Results visible from ExamAuthorshipStatementSection: Statement of Authorship ExamAuthorshipStatementRequired: Require Statement of Authorship for exam-related exercise sheet submissions? ExamAuthorshipStatementRequiredTip: Should submittors (in case of submission groups each group member) be required to accept a Statement of Authorship for all exercise sheets related to this exam? -ExamAuthorshipStatementUseSchoolDefinition: Use school-wide Statement of Authorship +ExamAuthorshipStatementRequiredDisabledOffTip: This school permits Statements of Authorship for exam-related sheets. +ExamAuthorshipStatementRequiredDisabledOnTip: This school requires Statements of Authorship for exam-related sheets. +ExamAuthorshipStatementUseSchoolDefinition: Use school-wide Statement of Authorship? +ExamAuthorshipStatementUseSchoolDefinitionTip: Should the school-wide Statement of Authorship be used? (Hint: To ensure consistent statements for all submissions related to this exam, the school-wide statement will be used as a template here and will then be stored separately (as a copy). If the school-wide statement changes, this change must be applied manually for this exam if desired.) ExamAuthorshipStatementCustom: Custom Statement of Authorship \ No newline at end of file diff --git a/models/exams.model b/models/exams.model index ded7124b6..e756e1df2 100644 --- a/models/exams.model +++ b/models/exams.model @@ -20,7 +20,7 @@ Exam examMode ExamMode staff Text Maybe partsFrom UTCTime Maybe --- authorshipStatement AuthorshipStatementDefinitionId Maybe +-- authorshipStatement AuthorshipStatementDefinitionId Maybe UniqueExam course name deriving Generic ExamPart diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index 9801ab658..19b15df64 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -143,6 +143,41 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do <*> examCorrectorsForm (efCorrectors <$> template) <* aformSection MsgExamFormParts <*> examPartsForm (efExamParts <$> template) + -- TODO: refactor messages to be used across scopes, then define this form section separately (to be used for exams and sheets) + <* aformSection MsgExamAuthorshipStatementSection + <* optionalActionA + ( optionalActionA + ( apreq htmlField + (fslI MsgExamAuthorshipStatementCustom) + ( + -- TODO: load custom statement from template + -- (loading school definition as default is not necessary if it is displayed in form) + Nothing + ) + ) + ( fslI MsgExamAuthorshipStatementUseSchoolDefinition + & setTooltip MsgExamAuthorshipStatementUseSchoolDefinitionTip + -- TODO: disable field if school settings prevent custom statements + -- & addAttr "disabled" "disabled" & setTooltip MsgExamAuthorshipStatementUseSchoolDefinitionDisabledTip + ) + ( + -- TODO: set value to False if school settings prevent custom statements + Nothing + ) + -- apreq htmlField + -- (fslI MsgExamAuthorshipStatementCustom) + -- (Nothing) + ) + ( case schoolSheetExamAuthorshipStatementMode of + SchoolAuthorshipStatementModeNone -> fslI MsgExamAuthorshipStatementRequired & addAttr "disabled" "disabled" & setTooltip MsgExamAuthorshipStatementRequiredDisabledOffTip + SchoolAuthorshipStatementModeOptional -> fslI MsgExamAuthorshipStatementRequired & setTooltip MsgExamAuthorshipStatementRequiredTip + SchoolAuthorshipStatementModeRequired -> fslI MsgExamAuthorshipStatementRequired & addAttr "disabled" "disabled" & setTooltip MsgExamAuthorshipStatementRequiredDisabledOnTip + ) + ( case schoolSheetExamAuthorshipStatementMode of + SchoolAuthorshipStatementModeNone -> Just False + SchoolAuthorshipStatementModeOptional -> Nothing -- TODO: set value according to template + SchoolAuthorshipStatementModeRequired -> Just True + ) officeSchoolsForm :: Maybe (Set SchoolId) -> AForm Handler (Set SchoolId) officeSchoolsForm mPrev = wFormToAForm $ do From 22dfd33aca9b8ad797c2617bbc656cf8276edf38 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Wed, 9 Jun 2021 16:23:21 +0200 Subject: [PATCH 053/120] feat(exams): disable and set use-custom field according to school setting --- .../courses/exam/exam/de-de-formal.msg | 7 ++++--- .../categories/courses/exam/exam/en-eu.msg | 7 ++++--- src/Handler/Exam/Form.hs | 19 +++++++++---------- 3 files changed, 17 insertions(+), 16 deletions(-) diff --git a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg index 7f14504b1..199795e57 100644 --- a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg +++ b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg @@ -318,6 +318,7 @@ ExamAuthorshipStatementRequired: Eigenständigkeitserklärung für prüfungszuge ExamAuthorshipStatementRequiredTip: Sollen für alle zu dieser Prüfung zugehörige Übungsblätter die Abgebenden (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren? ExamAuthorshipStatementRequiredDisabledOffTip: Für dieses Institut sind Eigenständigkeitserklärungen für prüfungsrelevante Blätter deaktiviert. ExamAuthorshipStatementRequiredDisabledOnTip: Für dieses Institut sind Eigenständigkeitserklärungen für prüfungsrelevante Blätter vorgeschrieben. -ExamAuthorshipStatementUseSchoolDefinition: Eigenständigkeitserklärung des Instituts verwenden? -ExamAuthorshipStatementUseSchoolDefinitionTip: Soll die institutsweit eingestellte Eigenständigkeitserklärung genutzt werden? (Hinweis: Um konsistente Erklärungen für alle Abgaben einer Prüfung zu gewährleisten, dient die institutsweite Erklärung hier nur als Vorlage und wird ab dann getrennt (als Kopie) gespeichert. Ändert sich die institutsweite Erklärung, so muss die Änderung für diese Prüfung manuell übernommen werden, falls erwünscht.) -ExamAuthorshipStatementCustom: Benutzerdefinierte Eigenständigkeitserklärung \ No newline at end of file +ExamAuthorshipStatementUseCustomDefinition: Benutzerdefinierte Eigenständigkeitserklärung verwenden? +ExamAuthorshipStatementUseCustomDefinitionTip: Soll anstatt der institutsweit vorgegebenen Eigenständigkeitserklärung eine benuzterdefinierte Erklärung für diese Prüfung genutzt werden? (Hinweis: Um konsistente Erklärungen für alle Abgaben der Prüfung zu gewährleisten, dient die institutsweite Erklärung hier nur als Vorlage und wird ab dann getrennt (als Kopie) gespeichert. Ändert sich die institutsweite Erklärung, so muss die Änderung für diese Prüfung manuell übernommen werden, falls erwünscht.) +ExamAuthorshipStatementUseCustomDefinitionDisabledTip: Für dieses Institut ist die institutsweite Vorgabe als Erklärung zu verwenden. Benutzerdefinierte Erklärungen sind nicht gestattet. +ExamAuthorshipStatementCustom: Eigenständigkeitserklärung \ No newline at end of file diff --git a/messages/uniworx/categories/courses/exam/exam/en-eu.msg b/messages/uniworx/categories/courses/exam/exam/en-eu.msg index fa0525d38..d784d00de 100644 --- a/messages/uniworx/categories/courses/exam/exam/en-eu.msg +++ b/messages/uniworx/categories/courses/exam/exam/en-eu.msg @@ -316,6 +316,7 @@ ExamAuthorshipStatementRequired: Require Statement of Authorship for exam-relate ExamAuthorshipStatementRequiredTip: Should submittors (in case of submission groups each group member) be required to accept a Statement of Authorship for all exercise sheets related to this exam? ExamAuthorshipStatementRequiredDisabledOffTip: This school permits Statements of Authorship for exam-related sheets. ExamAuthorshipStatementRequiredDisabledOnTip: This school requires Statements of Authorship for exam-related sheets. -ExamAuthorshipStatementUseSchoolDefinition: Use school-wide Statement of Authorship? -ExamAuthorshipStatementUseSchoolDefinitionTip: Should the school-wide Statement of Authorship be used? (Hint: To ensure consistent statements for all submissions related to this exam, the school-wide statement will be used as a template here and will then be stored separately (as a copy). If the school-wide statement changes, this change must be applied manually for this exam if desired.) -ExamAuthorshipStatementCustom: Custom Statement of Authorship \ No newline at end of file +ExamAuthorshipStatementUseCustomDefinition: Use custom Statement of Authorship? +ExamAuthorshipStatementUseCustomDefinitionTip: Should a custom Statement of Authorship be used for this exam instead of the school-wide statement? (Hint: To ensure consistent statements for all submissions related to this exam, the school-wide statement will be used as a template here and will then be stored separately (as a copy). If the school-wide statement changes, this change must be applied manually for this exam if desired.) +ExamAuthorshipStatementUseCustomDefinitionDisabledTip: This school dictates that the school-wide Statement of Authorship must be used. Custom statements are prohibited. +ExamAuthorshipStatementCustom: Statement of Authorship \ No newline at end of file diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index 19b15df64..985d841fa 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -155,18 +155,17 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do Nothing ) ) - ( fslI MsgExamAuthorshipStatementUseSchoolDefinition - & setTooltip MsgExamAuthorshipStatementUseSchoolDefinitionTip - -- TODO: disable field if school settings prevent custom statements - -- & addAttr "disabled" "disabled" & setTooltip MsgExamAuthorshipStatementUseSchoolDefinitionDisabledTip + ( if schoolSheetExamAuthorshipStatementAllowOther + then fslI MsgExamAuthorshipStatementUseCustomDefinition + & setTooltip MsgExamAuthorshipStatementUseCustomDefinitionTip + else fslI MsgExamAuthorshipStatementUseCustomDefinition + & addAttr "disabled" "disabled" + & setTooltip MsgExamAuthorshipStatementUseCustomDefinitionDisabledTip ) - ( - -- TODO: set value to False if school settings prevent custom statements - Nothing + ( bool (Just True) + (Just True) -- TODO: set according to template, if template is empty `Just True` + schoolSheetExamAuthorshipStatementAllowOther ) - -- apreq htmlField - -- (fslI MsgExamAuthorshipStatementCustom) - -- (Nothing) ) ( case schoolSheetExamAuthorshipStatementMode of SchoolAuthorshipStatementModeNone -> fslI MsgExamAuthorshipStatementRequired & addAttr "disabled" "disabled" & setTooltip MsgExamAuthorshipStatementRequiredDisabledOffTip From abd68ac0322a34afb62c416b60965e87ee6f10c2 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Wed, 9 Jun 2021 16:52:50 +0200 Subject: [PATCH 054/120] feat(exams): display school default in form --- .../categories/courses/exam/exam/de-de-formal.msg | 3 ++- .../uniworx/categories/courses/exam/exam/en-eu.msg | 5 +++-- src/Handler/Exam/Form.hs | 12 ++++++++++-- 3 files changed, 15 insertions(+), 5 deletions(-) diff --git a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg index 199795e57..1205a5cd2 100644 --- a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg +++ b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg @@ -318,7 +318,8 @@ ExamAuthorshipStatementRequired: Eigenständigkeitserklärung für prüfungszuge ExamAuthorshipStatementRequiredTip: Sollen für alle zu dieser Prüfung zugehörige Übungsblätter die Abgebenden (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren? ExamAuthorshipStatementRequiredDisabledOffTip: Für dieses Institut sind Eigenständigkeitserklärungen für prüfungsrelevante Blätter deaktiviert. ExamAuthorshipStatementRequiredDisabledOnTip: Für dieses Institut sind Eigenständigkeitserklärungen für prüfungsrelevante Blätter vorgeschrieben. +ExamAuthorshipStatementSchoolDefinition: Institutsweit vorgegebene Eigenständigkeitserklärung ExamAuthorshipStatementUseCustomDefinition: Benutzerdefinierte Eigenständigkeitserklärung verwenden? ExamAuthorshipStatementUseCustomDefinitionTip: Soll anstatt der institutsweit vorgegebenen Eigenständigkeitserklärung eine benuzterdefinierte Erklärung für diese Prüfung genutzt werden? (Hinweis: Um konsistente Erklärungen für alle Abgaben der Prüfung zu gewährleisten, dient die institutsweite Erklärung hier nur als Vorlage und wird ab dann getrennt (als Kopie) gespeichert. Ändert sich die institutsweite Erklärung, so muss die Änderung für diese Prüfung manuell übernommen werden, falls erwünscht.) ExamAuthorshipStatementUseCustomDefinitionDisabledTip: Für dieses Institut ist die institutsweite Vorgabe als Erklärung zu verwenden. Benutzerdefinierte Erklärungen sind nicht gestattet. -ExamAuthorshipStatementCustom: Eigenständigkeitserklärung \ No newline at end of file +ExamAuthorshipStatementCustom: Benutzerdefinierte Eigenständigkeitserklärung \ No newline at end of file diff --git a/messages/uniworx/categories/courses/exam/exam/en-eu.msg b/messages/uniworx/categories/courses/exam/exam/en-eu.msg index d784d00de..0f80e4dc5 100644 --- a/messages/uniworx/categories/courses/exam/exam/en-eu.msg +++ b/messages/uniworx/categories/courses/exam/exam/en-eu.msg @@ -316,7 +316,8 @@ ExamAuthorshipStatementRequired: Require Statement of Authorship for exam-relate ExamAuthorshipStatementRequiredTip: Should submittors (in case of submission groups each group member) be required to accept a Statement of Authorship for all exercise sheets related to this exam? ExamAuthorshipStatementRequiredDisabledOffTip: This school permits Statements of Authorship for exam-related sheets. ExamAuthorshipStatementRequiredDisabledOnTip: This school requires Statements of Authorship for exam-related sheets. +ExamAuthorshipStatementSchoolDefinition: School-wide default Statement of Authorship ExamAuthorshipStatementUseCustomDefinition: Use custom Statement of Authorship? -ExamAuthorshipStatementUseCustomDefinitionTip: Should a custom Statement of Authorship be used for this exam instead of the school-wide statement? (Hint: To ensure consistent statements for all submissions related to this exam, the school-wide statement will be used as a template here and will then be stored separately (as a copy). If the school-wide statement changes, this change must be applied manually for this exam if desired.) +ExamAuthorshipStatementUseCustomDefinitionTip: Should a custom Statement of Authorship be used for this exam instead of the school-wide default statement? (Hint: To ensure consistent statements for all submissions related to this exam, the school-wide default statement will be used as a template here and will then be stored separately (as a copy). If the school-wide default statement changes, this change must be applied manually for this exam if desired.) ExamAuthorshipStatementUseCustomDefinitionDisabledTip: This school dictates that the school-wide Statement of Authorship must be used. Custom statements are prohibited. -ExamAuthorshipStatementCustom: Statement of Authorship \ No newline at end of file +ExamAuthorshipStatementCustom: Custom Statement of Authorship \ No newline at end of file diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index 985d841fa..af22fca30 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -111,7 +111,10 @@ examForm :: ( MonadHandler m => Entity Course -> Maybe ExamForm -> (Html -> MForm m (FormResult ExamForm, Widget)) examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do MsgRenderer mr <- getMsgRenderer - School{..} <- liftHandler . runDBRead $ getJust courseSchool + (School{..}, mSchoolAuthorshipStatement) <- liftHandler . runDBRead $ do + school@School{..} <- getJust courseSchool + mSchoolAuthorshipStatement <- maybe (pure Nothing) getEntity schoolSheetExamAuthorshipStatementDefinition + return (school, mSchoolAuthorshipStatement) flip (renderAForm FormStandard) csrf $ ExamForm <$> areq ciField (fslpI MsgTableExamName (mr MsgTableExamName) & setTooltip MsgExamNameTip) (efName <$> template) @@ -146,7 +149,12 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do -- TODO: refactor messages to be used across scopes, then define this form section separately (to be used for exams and sheets) <* aformSection MsgExamAuthorshipStatementSection <* optionalActionA - ( optionalActionA + ( aopt htmlField + ( fslI MsgExamAuthorshipStatementSchoolDefinition + & addAttr "disabled" "disabled" + ) + ((Just . authorshipStatementDefinitionContent . entityVal) <$> mSchoolAuthorshipStatement) + <* optionalActionA ( apreq htmlField (fslI MsgExamAuthorshipStatementCustom) ( From 8bb61401a77f20fcb35aa05401bf16285aad1d93 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Wed, 9 Jun 2021 16:56:25 +0200 Subject: [PATCH 055/120] fix(exams): set use-custom correctly if forced --- src/Handler/Exam/Form.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index af22fca30..ee42effa5 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -150,9 +150,7 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do <* aformSection MsgExamAuthorshipStatementSection <* optionalActionA ( aopt htmlField - ( fslI MsgExamAuthorshipStatementSchoolDefinition - & addAttr "disabled" "disabled" - ) + (fslI MsgExamAuthorshipStatementSchoolDefinition & addAttr "disabled" "disabled") ((Just . authorshipStatementDefinitionContent . entityVal) <$> mSchoolAuthorshipStatement) <* optionalActionA ( apreq htmlField @@ -170,7 +168,7 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do & addAttr "disabled" "disabled" & setTooltip MsgExamAuthorshipStatementUseCustomDefinitionDisabledTip ) - ( bool (Just True) + ( bool (Just False) (Just True) -- TODO: set according to template, if template is empty `Just True` schoolSheetExamAuthorshipStatementAllowOther ) From 0392297ddbfccbb9a08e678696a9cedd1098121a Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 10 Jun 2021 13:46:27 +0200 Subject: [PATCH 056/120] feat(exams): first do-nothing stub for exam-wide authorship statements --- .../courses/exam/exam/de-de-formal.msg | 5 +- .../categories/courses/exam/exam/en-eu.msg | 5 +- src/Handler/Exam/Form.hs | 73 ++++++++++++++----- 3 files changed, 61 insertions(+), 22 deletions(-) diff --git a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg index 1205a5cd2..3c08b0f05 100644 --- a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg +++ b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg @@ -322,4 +322,7 @@ ExamAuthorshipStatementSchoolDefinition: Institutsweit vorgegebene Eigenständig ExamAuthorshipStatementUseCustomDefinition: Benutzerdefinierte Eigenständigkeitserklärung verwenden? ExamAuthorshipStatementUseCustomDefinitionTip: Soll anstatt der institutsweit vorgegebenen Eigenständigkeitserklärung eine benuzterdefinierte Erklärung für diese Prüfung genutzt werden? (Hinweis: Um konsistente Erklärungen für alle Abgaben der Prüfung zu gewährleisten, dient die institutsweite Erklärung hier nur als Vorlage und wird ab dann getrennt (als Kopie) gespeichert. Ändert sich die institutsweite Erklärung, so muss die Änderung für diese Prüfung manuell übernommen werden, falls erwünscht.) ExamAuthorshipStatementUseCustomDefinitionDisabledTip: Für dieses Institut ist die institutsweite Vorgabe als Erklärung zu verwenden. Benutzerdefinierte Erklärungen sind nicht gestattet. -ExamAuthorshipStatementCustom: Benutzerdefinierte Eigenständigkeitserklärung \ No newline at end of file +ExamAuthorshipStatementCustom: Benutzerdefinierte Eigenständigkeitserklärung + +ExamAuthorshipStatementContent: Eigenständigkeitserklärung +ExamAuthorshipStatementAllowOtherFalseTip: Für dieses Institut muss die institutsweit vorgegebene Eigenständigkeitserklärung verwendet werden. Benutzerdefinierte Erklärungen sind nicht gestattet. \ No newline at end of file diff --git a/messages/uniworx/categories/courses/exam/exam/en-eu.msg b/messages/uniworx/categories/courses/exam/exam/en-eu.msg index 0f80e4dc5..83cb8cad8 100644 --- a/messages/uniworx/categories/courses/exam/exam/en-eu.msg +++ b/messages/uniworx/categories/courses/exam/exam/en-eu.msg @@ -320,4 +320,7 @@ ExamAuthorshipStatementSchoolDefinition: School-wide default Statement of Author ExamAuthorshipStatementUseCustomDefinition: Use custom Statement of Authorship? ExamAuthorshipStatementUseCustomDefinitionTip: Should a custom Statement of Authorship be used for this exam instead of the school-wide default statement? (Hint: To ensure consistent statements for all submissions related to this exam, the school-wide default statement will be used as a template here and will then be stored separately (as a copy). If the school-wide default statement changes, this change must be applied manually for this exam if desired.) ExamAuthorshipStatementUseCustomDefinitionDisabledTip: This school dictates that the school-wide Statement of Authorship must be used. Custom statements are prohibited. -ExamAuthorshipStatementCustom: Custom Statement of Authorship \ No newline at end of file +ExamAuthorshipStatementCustom: Custom Statement of Authorship + +ExamAuthorshipStatementContent: Statement of Authorship +ExamAuthorshipStatementAllowOtherFalseTip: The settings of this school dictate that the school-wide Statement of Authorship must be used. Custom statements are prohibited. \ No newline at end of file diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index ee42effa5..640f8799f 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -52,6 +52,7 @@ data ExamForm = ExamForm , efStaff :: Maybe Text , efCorrectors :: Set (Either UserEmail UserId) , efExamParts :: Set ExamPartForm + , efAuthorshipStatement :: Maybe StoredMarkup } data ExamOccurrenceForm = ExamOccurrenceForm @@ -148,29 +149,16 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do <*> examPartsForm (efExamParts <$> template) -- TODO: refactor messages to be used across scopes, then define this form section separately (to be used for exams and sheets) <* aformSection MsgExamAuthorshipStatementSection - <* optionalActionA - ( aopt htmlField - (fslI MsgExamAuthorshipStatementSchoolDefinition & addAttr "disabled" "disabled") - ((Just . authorshipStatementDefinitionContent . entityVal) <$> mSchoolAuthorshipStatement) - <* optionalActionA - ( apreq htmlField - (fslI MsgExamAuthorshipStatementCustom) - ( - -- TODO: load custom statement from template - -- (loading school definition as default is not necessary if it is displayed in form) - Nothing - ) - ) + <*> optionalActionA + ( areq htmlField ( if schoolSheetExamAuthorshipStatementAllowOther - then fslI MsgExamAuthorshipStatementUseCustomDefinition - & setTooltip MsgExamAuthorshipStatementUseCustomDefinitionTip - else fslI MsgExamAuthorshipStatementUseCustomDefinition + then fslI MsgExamAuthorshipStatementContent + else fslI MsgExamAuthorshipStatementContent & addAttr "disabled" "disabled" - & setTooltip MsgExamAuthorshipStatementUseCustomDefinitionDisabledTip + & setTooltip MsgExamAuthorshipStatementAllowOtherFalseTip ) - ( bool (Just False) - (Just True) -- TODO: set according to template, if template is empty `Just True` - schoolSheetExamAuthorshipStatementAllowOther + ( Nothing -- TODO: take value from template + <|> (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement) ) ) ( case schoolSheetExamAuthorshipStatementMode of @@ -183,6 +171,44 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do SchoolAuthorshipStatementModeOptional -> Nothing -- TODO: set value according to template SchoolAuthorshipStatementModeRequired -> Just True ) + -- <*> optionalActionA + -- ( ( optionalActionA + -- ( areq htmlField + -- (fslI MsgExamAuthorshipStatementCustom) + -- ( + -- -- TODO: load custom statement from template + -- -- (loading school definition as default is not necessary if it is displayed in form) + -- mempty + -- ) + -- ) + -- ( if schoolSheetExamAuthorshipStatementAllowOther + -- then fslI MsgExamAuthorshipStatementUseCustomDefinition + -- & setTooltip MsgExamAuthorshipStatementUseCustomDefinitionTip + -- else fslI MsgExamAuthorshipStatementUseCustomDefinition + -- & addAttr "disabled" "disabled" + -- & setTooltip MsgExamAuthorshipStatementUseCustomDefinitionDisabledTip + -- ) + -- ( bool (Just False) + -- (Just True) -- TODO: set according to template, if template is empty `Just True` + -- schoolSheetExamAuthorshipStatementAllowOther + -- ) + -- ) + -- <*> ( aopt htmlField + -- (fslI MsgExamAuthorshipStatementSchoolDefinition & addAttr "disabled" "disabled") + -- ((Just . authorshipStatementDefinitionContent . entityVal) <$> mSchoolAuthorshipStatement) + -- ) + -- ) + -- ( case schoolSheetExamAuthorshipStatementMode of + -- SchoolAuthorshipStatementModeNone -> fslI MsgExamAuthorshipStatementRequired & addAttr "disabled" "disabled" & setTooltip MsgExamAuthorshipStatementRequiredDisabledOffTip + -- SchoolAuthorshipStatementModeOptional -> fslI MsgExamAuthorshipStatementRequired & setTooltip MsgExamAuthorshipStatementRequiredTip + -- SchoolAuthorshipStatementModeRequired -> fslI MsgExamAuthorshipStatementRequired & addAttr "disabled" "disabled" & setTooltip MsgExamAuthorshipStatementRequiredDisabledOnTip + -- ) + -- ( case schoolSheetExamAuthorshipStatementMode of + -- SchoolAuthorshipStatementModeNone -> Just False + -- SchoolAuthorshipStatementModeOptional -> Nothing -- TODO: set value according to template + -- SchoolAuthorshipStatementModeRequired -> Just True + -- ) + -- ) officeSchoolsForm :: Maybe (Set SchoolId) -> AForm Handler (Set SchoolId) officeSchoolsForm mPrev = wFormToAForm $ do @@ -403,6 +429,7 @@ examFormTemplate (Entity eId Exam{..}) = do , efExamMode = examExamMode , efOfficeSchools = Set.fromList $ examOfficeSchoolSchool . entityVal <$> extraSchools , efStaff = examStaff + , efAuthorshipStatement = Nothing -- TODO } examTemplate :: MonadHandler m @@ -455,6 +482,7 @@ examTemplate cid = runMaybeT $ do , efExamMode = examExamMode oldExam , efStaff = examStaff oldExam , efOfficeSchools = Set.fromList $ examOfficeSchoolSchool . entityVal <$> extraSchools + , efAuthorshipStatement = Nothing -- TODO } @@ -565,5 +593,10 @@ validateExam cId oldExam = do warnValidation MsgExamModeSchoolDiscouraged . not $ evalExamModeDNF schoolExamDiscouragedModes efExamMode + -- TODO: form validation of examAuthorshipStatement wrt school settings + -- - if mode is none, the statement must be `Nothing` + -- - if mode is required, the statement must be `Just x` + -- - if the school has a definition and disallows other, the statement must match the school definition + unless (has (_Just . _entityVal . _examStaff . _Nothing) oldExam) $ guardValidation MsgExamStaffRequired $ isn't _Nothing efStaff From f8a3c13428d68aa8df4a08633ec63a366281ad7e Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 10 Jun 2021 13:58:32 +0200 Subject: [PATCH 057/120] chore(exams): enhance authorship statement messages --- .../categories/courses/exam/exam/de-de-formal.msg | 9 ++++----- messages/uniworx/categories/courses/exam/exam/en-eu.msg | 5 ++--- 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg index 3c08b0f05..4ea047217 100644 --- a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg +++ b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg @@ -313,16 +313,15 @@ ExamGradingGrades: Numerische Noten ExamGradingMixed: Gemischt ExamFinished: Ergebnisse sichtbar ab -ExamAuthorshipStatementSection: Eigenständigkeitserklärung +ExamAuthorshipStatementSection: Eigenständigkeitserklärungen ExamAuthorshipStatementRequired: Eigenständigkeitserklärung für prüfungszugehörige Übungsblattabgaben einfordern? ExamAuthorshipStatementRequiredTip: Sollen für alle zu dieser Prüfung zugehörige Übungsblätter die Abgebenden (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren? -ExamAuthorshipStatementRequiredDisabledOffTip: Für dieses Institut sind Eigenständigkeitserklärungen für prüfungsrelevante Blätter deaktiviert. -ExamAuthorshipStatementRequiredDisabledOnTip: Für dieses Institut sind Eigenständigkeitserklärungen für prüfungsrelevante Blätter vorgeschrieben. +ExamAuthorshipStatementRequiredDisabledOffTip: Für dieses Institut sind Eigenständigkeitserklärungen für prüfungsrelevante Übungsblätter deaktiviert. +ExamAuthorshipStatementRequiredDisabledOnTip: Für dieses Institut sind Eigenständigkeitserklärungen für prüfungsrelevante Übungsblätter vorgeschrieben. ExamAuthorshipStatementSchoolDefinition: Institutsweit vorgegebene Eigenständigkeitserklärung ExamAuthorshipStatementUseCustomDefinition: Benutzerdefinierte Eigenständigkeitserklärung verwenden? ExamAuthorshipStatementUseCustomDefinitionTip: Soll anstatt der institutsweit vorgegebenen Eigenständigkeitserklärung eine benuzterdefinierte Erklärung für diese Prüfung genutzt werden? (Hinweis: Um konsistente Erklärungen für alle Abgaben der Prüfung zu gewährleisten, dient die institutsweite Erklärung hier nur als Vorlage und wird ab dann getrennt (als Kopie) gespeichert. Ändert sich die institutsweite Erklärung, so muss die Änderung für diese Prüfung manuell übernommen werden, falls erwünscht.) ExamAuthorshipStatementUseCustomDefinitionDisabledTip: Für dieses Institut ist die institutsweite Vorgabe als Erklärung zu verwenden. Benutzerdefinierte Erklärungen sind nicht gestattet. ExamAuthorshipStatementCustom: Benutzerdefinierte Eigenständigkeitserklärung - ExamAuthorshipStatementContent: Eigenständigkeitserklärung -ExamAuthorshipStatementAllowOtherFalseTip: Für dieses Institut muss die institutsweit vorgegebene Eigenständigkeitserklärung verwendet werden. Benutzerdefinierte Erklärungen sind nicht gestattet. \ No newline at end of file +ExamAuthorshipStatementAllowOtherFalseTip: Für dieses Institut ist die institutsweit vorgegebene Eigenständigkeitserklärung für prüfungsrelevante Übungsblätter zu verwenden. Benutzerdefinierte Erklärungen sind nicht gestattet. \ No newline at end of file diff --git a/messages/uniworx/categories/courses/exam/exam/en-eu.msg b/messages/uniworx/categories/courses/exam/exam/en-eu.msg index 83cb8cad8..385a1e44e 100644 --- a/messages/uniworx/categories/courses/exam/exam/en-eu.msg +++ b/messages/uniworx/categories/courses/exam/exam/en-eu.msg @@ -311,7 +311,7 @@ ExamGradingGrades: Numeric grades ExamGradingMixed: Mixed ExamFinished: Results visible from -ExamAuthorshipStatementSection: Statement of Authorship +ExamAuthorshipStatementSection: Statements of Authorship ExamAuthorshipStatementRequired: Require Statement of Authorship for exam-related exercise sheet submissions? ExamAuthorshipStatementRequiredTip: Should submittors (in case of submission groups each group member) be required to accept a Statement of Authorship for all exercise sheets related to this exam? ExamAuthorshipStatementRequiredDisabledOffTip: This school permits Statements of Authorship for exam-related sheets. @@ -321,6 +321,5 @@ ExamAuthorshipStatementUseCustomDefinition: Use custom Statement of Authorship? ExamAuthorshipStatementUseCustomDefinitionTip: Should a custom Statement of Authorship be used for this exam instead of the school-wide default statement? (Hint: To ensure consistent statements for all submissions related to this exam, the school-wide default statement will be used as a template here and will then be stored separately (as a copy). If the school-wide default statement changes, this change must be applied manually for this exam if desired.) ExamAuthorshipStatementUseCustomDefinitionDisabledTip: This school dictates that the school-wide Statement of Authorship must be used. Custom statements are prohibited. ExamAuthorshipStatementCustom: Custom Statement of Authorship - ExamAuthorshipStatementContent: Statement of Authorship -ExamAuthorshipStatementAllowOtherFalseTip: The settings of this school dictate that the school-wide Statement of Authorship must be used. Custom statements are prohibited. \ No newline at end of file +ExamAuthorshipStatementAllowOtherFalseTip: The settings of this school dictate that the school-wide Statement of Authorship for exam-related sheets must be used. Custom statements are prohibited. \ No newline at end of file From 57a259d8a2822ac1c593663e99f6e41163909c91 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 10 Jun 2021 14:16:24 +0200 Subject: [PATCH 058/120] feat(exams): use template authorship statement settings if applicable --- src/Handler/Exam/Form.hs | 42 ++-------------------------------------- 1 file changed, 2 insertions(+), 40 deletions(-) diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index 640f8799f..530bc47b2 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -157,7 +157,7 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do & addAttr "disabled" "disabled" & setTooltip MsgExamAuthorshipStatementAllowOtherFalseTip ) - ( Nothing -- TODO: take value from template + ( (bool Nothing (join $ efAuthorshipStatement <$> template) schoolSheetExamAuthorshipStatementAllowOther) -- TODO: allow reverting from template to school definition (e.g. show school definition somewhere else, implement some kind of reset button, at least explain workaround (create new exam -> copy from there)...) <|> (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement) ) ) @@ -168,47 +168,9 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do ) ( case schoolSheetExamAuthorshipStatementMode of SchoolAuthorshipStatementModeNone -> Just False - SchoolAuthorshipStatementModeOptional -> Nothing -- TODO: set value according to template + SchoolAuthorshipStatementModeOptional -> is _Just . efAuthorshipStatement <$> template SchoolAuthorshipStatementModeRequired -> Just True ) - -- <*> optionalActionA - -- ( ( optionalActionA - -- ( areq htmlField - -- (fslI MsgExamAuthorshipStatementCustom) - -- ( - -- -- TODO: load custom statement from template - -- -- (loading school definition as default is not necessary if it is displayed in form) - -- mempty - -- ) - -- ) - -- ( if schoolSheetExamAuthorshipStatementAllowOther - -- then fslI MsgExamAuthorshipStatementUseCustomDefinition - -- & setTooltip MsgExamAuthorshipStatementUseCustomDefinitionTip - -- else fslI MsgExamAuthorshipStatementUseCustomDefinition - -- & addAttr "disabled" "disabled" - -- & setTooltip MsgExamAuthorshipStatementUseCustomDefinitionDisabledTip - -- ) - -- ( bool (Just False) - -- (Just True) -- TODO: set according to template, if template is empty `Just True` - -- schoolSheetExamAuthorshipStatementAllowOther - -- ) - -- ) - -- <*> ( aopt htmlField - -- (fslI MsgExamAuthorshipStatementSchoolDefinition & addAttr "disabled" "disabled") - -- ((Just . authorshipStatementDefinitionContent . entityVal) <$> mSchoolAuthorshipStatement) - -- ) - -- ) - -- ( case schoolSheetExamAuthorshipStatementMode of - -- SchoolAuthorshipStatementModeNone -> fslI MsgExamAuthorshipStatementRequired & addAttr "disabled" "disabled" & setTooltip MsgExamAuthorshipStatementRequiredDisabledOffTip - -- SchoolAuthorshipStatementModeOptional -> fslI MsgExamAuthorshipStatementRequired & setTooltip MsgExamAuthorshipStatementRequiredTip - -- SchoolAuthorshipStatementModeRequired -> fslI MsgExamAuthorshipStatementRequired & addAttr "disabled" "disabled" & setTooltip MsgExamAuthorshipStatementRequiredDisabledOnTip - -- ) - -- ( case schoolSheetExamAuthorshipStatementMode of - -- SchoolAuthorshipStatementModeNone -> Just False - -- SchoolAuthorshipStatementModeOptional -> Nothing -- TODO: set value according to template - -- SchoolAuthorshipStatementModeRequired -> Just True - -- ) - -- ) officeSchoolsForm :: Maybe (Set SchoolId) -> AForm Handler (Set SchoolId) officeSchoolsForm mPrev = wFormToAForm $ do From b6a72d9a454860fd22d43cbf3108a4848a246eeb Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 10 Jun 2021 15:13:55 +0200 Subject: [PATCH 059/120] chore(exams): connect exam authorship statement form part to model --- models/exams.model | 2 +- src/Handler/Exam/Edit.hs | 15 ++++++++++++++- src/Handler/Exam/New.hs | 4 +++- test/Database/Fill.hs | 1 + 4 files changed, 19 insertions(+), 3 deletions(-) diff --git a/models/exams.model b/models/exams.model index e756e1df2..e75996be3 100644 --- a/models/exams.model +++ b/models/exams.model @@ -20,7 +20,7 @@ Exam examMode ExamMode staff Text Maybe partsFrom UTCTime Maybe --- authorshipStatement AuthorshipStatementDefinitionId Maybe + authorshipStatement AuthorshipStatementDefinitionId Maybe UniqueExam course name deriving Generic ExamPart diff --git a/src/Handler/Exam/Edit.hs b/src/Handler/Exam/Edit.hs index 875e99025..cc00bbc35 100644 --- a/src/Handler/Exam/Edit.hs +++ b/src/Handler/Exam/Edit.hs @@ -40,6 +40,19 @@ postEEditR tid ssh csh examn = do editExamAct <- formResultMaybe editExamResult $ \ExamForm{..} -> do res <- trySql @ExamEditException $ do + mAuthorshipStatementId <- case efAuthorshipStatement of + Nothing -> return Nothing + Just newStatementContent -> do + mPreviousStatement <- maybe (pure Nothing) getEntity (oldExam ^. _examAuthorshipStatement) + if + | Just (Entity previousStatementId AuthorshipStatementDefinition{authorshipStatementDefinitionContent=previousStatementContent}) <- mPreviousStatement + , newStatementContent == previousStatementContent + -> return $ Just previousStatementId + | Just (Entity previousStatementId _) <- mPreviousStatement + -> update previousStatementId [ AuthorshipStatementDefinitionContent =. newStatementContent ] >> return (Just previousStatementId) + | otherwise + -> fmap Just $ insert AuthorshipStatementDefinition { authorshipStatementDefinitionContent = newStatementContent } + insertRes <- myReplaceUnique eId Exam { examCourse = cid , examName = efName @@ -60,9 +73,9 @@ postEEditR tid ssh csh examn = do , examGradingMode = efGradingMode , examDescription = efDescription , examExamMode = efExamMode - -- , examAuthorshipStatement = Nothing -- TODO , examStaff = efStaff , examPartsFrom = efPartsFrom + , examAuthorshipStatement = mAuthorshipStatementId } when (is _Just insertRes) $ diff --git a/src/Handler/Exam/New.hs b/src/Handler/Exam/New.hs index 09b8a6dbe..cda9f41c2 100644 --- a/src/Handler/Exam/New.hs +++ b/src/Handler/Exam/New.hs @@ -29,6 +29,8 @@ postCExamNewR tid ssh csh = do newExamAct <- formResultMaybe newExamResult $ \ExamForm{..} -> do now <- liftIO getCurrentTime + mAuthorshipStatementId <- maybe (return Nothing) (fmap Just . insert . AuthorshipStatementDefinition) efAuthorshipStatement + insertRes <- insertUnique Exam { examName = efName , examCourse = cid @@ -49,9 +51,9 @@ postCExamNewR tid ssh csh = do , examPublicStatistics = efPublicStatistics , examDescription = efDescription , examExamMode = efExamMode - -- , examAuthorshipStatement = Nothing -- TODO , examStaff = efStaff , examPartsFrom = efPartsFrom + , examAuthorshipStatement = mAuthorshipStatementId } whenIsJust insertRes $ \examid -> do insertMany_ diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 818fbd85f..3ae3e5c12 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -734,6 +734,7 @@ fillDb = do } -- , examAuthorshipStatement = Nothing , examStaff = Just "Hofmann" + , examAuthorshipStatement = Nothing } _ <- insert' Material { materialCourse = ffp From 53a8f1ba122466312947cdbdb49749a61acab37c Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 10 Jun 2021 17:22:14 +0200 Subject: [PATCH 060/120] fix(schools): fix schools form wrt. discouraged modes --- src/Handler/School.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Handler/School.hs b/src/Handler/School.hs index 423f0f4a4..be69e883a 100644 --- a/src/Handler/School.hs +++ b/src/Handler/School.hs @@ -85,7 +85,7 @@ mkSchoolForm mSsh template = renderAForm FormStandard $ SchoolForm <*> aopt daysField (fslI MsgSchoolExamMinimumRegisterBeforeStart & setTooltip MsgSchoolExamMinimumRegisterBeforeStartTip) (sfExamMinimumRegisterBeforeStart <$> template) <*> aopt daysField (fslI MsgSchoolExamMinimumRegisterDuration & setTooltip MsgSchoolExamMinimumRegisterDurationTip) (sfExamMinimumRegisterDuration <$> template) <*> apopt checkBoxField (fslI MsgSchoolExamRequireModeForRegistration & setTooltip MsgSchoolExamRequireModeForRegistration) (sfExamRequireModeForRegistration <$> template) - <*> areq pathPieceField (fslI MsgSchoolExamDiscouragedModes) (sfExamDiscouragedModes <$> template <|> pure (ExamModeDNF predDNFFalse)) + <*> (fromMaybe (ExamModeDNF predDNFFalse) <$> aopt pathPieceField (fslI MsgSchoolExamDiscouragedModes) (Just $ sfExamDiscouragedModes <$> template <|> pure (ExamModeDNF predDNFFalse))) <*> apopt (selectField optionsFinite) (fslI MsgExamCloseMode) (sfExamCloseMode <$> template <|> pure ExamCloseSeparate) <* aformSection MsgSchoolAuthorshipStatementSection <*> apopt (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetMode) (sfSheetAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) From fe5111c25f8dac42b9fd45b298394331dd2a35b8 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 10 Jun 2021 17:24:32 +0200 Subject: [PATCH 061/120] chore(exams): get authorship statement content from template --- src/Handler/Exam/Form.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index 530bc47b2..1f8ed214e 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -344,6 +344,8 @@ examFormTemplate (Entity eId Exam{..}) = do examParts' <- forM examParts $ \(Entity pid part) -> (,) <$> encrypt pid <*> pure part occurrences' <- forM occurrences $ \(Entity oid occ) -> (,) <$> encrypt oid <*> pure occ + mAuthorshipStatement <- maybe (pure Nothing) getEntity examAuthorshipStatement + return ExamForm { efName = examName , efGradingRule = examGradingRule @@ -391,7 +393,7 @@ examFormTemplate (Entity eId Exam{..}) = do , efExamMode = examExamMode , efOfficeSchools = Set.fromList $ examOfficeSchoolSchool . entityVal <$> extraSchools , efStaff = examStaff - , efAuthorshipStatement = Nothing -- TODO + , efAuthorshipStatement = authorshipStatementDefinitionContent . entityVal <$> mAuthorshipStatement } examTemplate :: MonadHandler m @@ -399,8 +401,9 @@ examTemplate :: MonadHandler m examTemplate cid = runMaybeT $ do newCourse <- MaybeT $ get cid - [(Entity _ oldCourse, Entity oldExamId oldExam)] <- lift . E.select . E.from $ \(course `E.InnerJoin` exam) -> do + [(Entity _ oldCourse, Entity oldExamId oldExam, mOldExamAuthorshipStatement)] <- lift . E.select . E.from $ \(course `E.InnerJoin` (exam `E.LeftOuterJoin` authorshipStatementDefinition)) -> do E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse + E.on $ exam E.^. ExamAuthorshipStatement E.==. authorshipStatementDefinition E.?. AuthorshipStatementDefinitionId E.where_ $ ( course E.^. CourseShorthand E.==. E.val (courseShorthand newCourse) E.||. course E.^. CourseName E.==. E.val (courseName newCourse) ) @@ -411,7 +414,7 @@ examTemplate cid = runMaybeT $ do E.where_ . E.not_ . E.isNothing $ exam E.^. ExamVisibleFrom E.limit 1 E.orderBy [ E.desc $ course E.^. CourseTerm, E.asc $ exam E.^. ExamVisibleFrom ] - return (course, exam) + return (course, exam, authorshipStatementDefinition) extraSchools <- lift $ selectList [ ExamOfficeSchoolExam ==. oldExamId ] [] @@ -444,7 +447,7 @@ examTemplate cid = runMaybeT $ do , efExamMode = examExamMode oldExam , efStaff = examStaff oldExam , efOfficeSchools = Set.fromList $ examOfficeSchoolSchool . entityVal <$> extraSchools - , efAuthorshipStatement = Nothing -- TODO + , efAuthorshipStatement = authorshipStatementDefinitionContent . entityVal <$> mOldExamAuthorshipStatement } From bf7b25ca9e9d11df94b91f7483ee339cefd3e0c9 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Fri, 11 Jun 2021 11:59:02 +0200 Subject: [PATCH 062/120] feat(exams): do form validation --- .../categories/courses/exam/exam/de-de-formal.msg | 6 +++++- .../uniworx/categories/courses/exam/exam/en-eu.msg | 6 +++++- src/Handler/Exam/Form.hs | 12 ++++++++---- 3 files changed, 18 insertions(+), 6 deletions(-) diff --git a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg index 4ea047217..baac78f3f 100644 --- a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg +++ b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg @@ -324,4 +324,8 @@ ExamAuthorshipStatementUseCustomDefinitionTip: Soll anstatt der institutsweit vo ExamAuthorshipStatementUseCustomDefinitionDisabledTip: Für dieses Institut ist die institutsweite Vorgabe als Erklärung zu verwenden. Benutzerdefinierte Erklärungen sind nicht gestattet. ExamAuthorshipStatementCustom: Benutzerdefinierte Eigenständigkeitserklärung ExamAuthorshipStatementContent: Eigenständigkeitserklärung -ExamAuthorshipStatementAllowOtherFalseTip: Für dieses Institut ist die institutsweit vorgegebene Eigenständigkeitserklärung für prüfungsrelevante Übungsblätter zu verwenden. Benutzerdefinierte Erklärungen sind nicht gestattet. \ No newline at end of file +ExamAuthorshipStatementAllowOtherFalseTip: Für dieses Institut ist die institutsweit vorgegebene Eigenständigkeitserklärung für prüfungsrelevante Übungsblätter zu verwenden. Benutzerdefinierte Erklärungen sind nicht gestattet. + +ExamAuthorshipStatementMustBeEmpty: Es darf keine Eigenständigkeitserklärung für prüfungsrelevante Übungsblätter angegeben werden. +ExamAuthorshipStatementMustBeNonEmpty: Es muss eine nicht-leere Eigenständigkeitserklärung für prüfungsrelevante Übungsblätter angegeben werden. +ExamAuthorshipStatementMustMatchSchoolDefinition: Die angegebene Eigenständigkeitserklärung für prüfungsrelevante Übungsblätter muss der Vorgabe des Instituts entsprechen. \ No newline at end of file diff --git a/messages/uniworx/categories/courses/exam/exam/en-eu.msg b/messages/uniworx/categories/courses/exam/exam/en-eu.msg index 385a1e44e..ab41c986a 100644 --- a/messages/uniworx/categories/courses/exam/exam/en-eu.msg +++ b/messages/uniworx/categories/courses/exam/exam/en-eu.msg @@ -322,4 +322,8 @@ ExamAuthorshipStatementUseCustomDefinitionTip: Should a custom Statement of Auth ExamAuthorshipStatementUseCustomDefinitionDisabledTip: This school dictates that the school-wide Statement of Authorship must be used. Custom statements are prohibited. ExamAuthorshipStatementCustom: Custom Statement of Authorship ExamAuthorshipStatementContent: Statement of Authorship -ExamAuthorshipStatementAllowOtherFalseTip: The settings of this school dictate that the school-wide Statement of Authorship for exam-related sheets must be used. Custom statements are prohibited. \ No newline at end of file +ExamAuthorshipStatementAllowOtherFalseTip: The settings of this school dictate that the school-wide Statement of Authorship for exam-related sheets must be used. Custom statements are prohibited. + +ExamAuthorshipStatementMustBeEmpty: No Statement of Authorship for exam-related sheets may be given. +ExamAuthorshipStatementMustBeNonEmpty: A non-empty Statement of Authorship for exam-related sheets must be given. +ExamAuthorshipStatementMustMatchSchoolDefinition: The given Statement of Authorship for exam-related sheets must match the school-wide Statement of Authorship. \ No newline at end of file diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index 1f8ed214e..4391a7ed6 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -558,10 +558,14 @@ validateExam cId oldExam = do warnValidation MsgExamModeSchoolDiscouraged . not $ evalExamModeDNF schoolExamDiscouragedModes efExamMode - -- TODO: form validation of examAuthorshipStatement wrt school settings - -- - if mode is none, the statement must be `Nothing` - -- - if mode is required, the statement must be `Just x` - -- - if the school has a definition and disallows other, the statement must match the school definition + case schoolSheetExamAuthorshipStatementMode of + SchoolAuthorshipStatementModeNone -> guardValidation MsgExamAuthorshipStatementMustBeEmpty $ is _Nothing efAuthorshipStatement + SchoolAuthorshipStatementModeRequired -> guardValidation MsgExamAuthorshipStatementMustBeNonEmpty $ is _Just efAuthorshipStatement + _otherwise -> return () + whenIsJust efAuthorshipStatement $ \statementContent -> do + mSchoolAuthorshipStatement <- lift $ maybe (pure Nothing) getEntity schoolSheetExamAuthorshipStatementDefinition + guardValidation MsgExamAuthorshipStatementMustBeNonEmpty $ schoolSheetExamAuthorshipStatementMode == SchoolAuthorshipStatementModeRequired && statementContent /= mempty + guardValidation MsgExamAuthorshipStatementMustMatchSchoolDefinition $ not schoolSheetExamAuthorshipStatementAllowOther && Just statementContent == (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement) unless (has (_Just . _entityVal . _examStaff . _Nothing) oldExam) $ guardValidation MsgExamStaffRequired $ isn't _Nothing efStaff From 0082135c56b7fc0e5db3af6910f8365e12920c46 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Fri, 11 Jun 2021 12:20:43 +0200 Subject: [PATCH 063/120] fix(exams): fix form validation wrt non-empty statements --- src/Handler/Exam/Form.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index 4391a7ed6..41c003cab 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -564,7 +564,7 @@ validateExam cId oldExam = do _otherwise -> return () whenIsJust efAuthorshipStatement $ \statementContent -> do mSchoolAuthorshipStatement <- lift $ maybe (pure Nothing) getEntity schoolSheetExamAuthorshipStatementDefinition - guardValidation MsgExamAuthorshipStatementMustBeNonEmpty $ schoolSheetExamAuthorshipStatementMode == SchoolAuthorshipStatementModeRequired && statementContent /= mempty + guardValidation MsgExamAuthorshipStatementMustBeNonEmpty $ schoolSheetExamAuthorshipStatementMode /= SchoolAuthorshipStatementModeRequired || statementContent /= mempty guardValidation MsgExamAuthorshipStatementMustMatchSchoolDefinition $ not schoolSheetExamAuthorshipStatementAllowOther && Just statementContent == (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement) unless (has (_Just . _entityVal . _examStaff . _Nothing) oldExam) $ From fe78377fae8af7766f9720628aebef599656ed2f Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Fri, 11 Jun 2021 12:28:23 +0200 Subject: [PATCH 064/120] fix(exams): better behaviour for optional statements wrt school default --- src/Handler/Exam/Form.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index 41c003cab..9deb02102 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -168,7 +168,7 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do ) ( case schoolSheetExamAuthorshipStatementMode of SchoolAuthorshipStatementModeNone -> Just False - SchoolAuthorshipStatementModeOptional -> is _Just . efAuthorshipStatement <$> template + SchoolAuthorshipStatementModeOptional -> (is _Just . efAuthorshipStatement <$> template) <|> (pure $ is _Just schoolSheetExamAuthorshipStatementDefinition) SchoolAuthorshipStatementModeRequired -> Just True ) From 1e87aa2dfe7119c7b7075782128cee020e9261e4 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Fri, 11 Jun 2021 13:08:14 +0200 Subject: [PATCH 065/120] refactor(exams): add FIXME markers (exam form still broken) --- src/Handler/Exam/Form.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index 9deb02102..7ea49ca6c 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -169,7 +169,7 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do ( case schoolSheetExamAuthorshipStatementMode of SchoolAuthorshipStatementModeNone -> Just False SchoolAuthorshipStatementModeOptional -> (is _Just . efAuthorshipStatement <$> template) <|> (pure $ is _Just schoolSheetExamAuthorshipStatementDefinition) - SchoolAuthorshipStatementModeRequired -> Just True + SchoolAuthorshipStatementModeRequired -> Just True -- FIXME: checkbox is unticked after form submit with school defaults (e.g. required, school definition given and unchanged) ) officeSchoolsForm :: Maybe (Set SchoolId) -> AForm Handler (Set SchoolId) @@ -564,7 +564,7 @@ validateExam cId oldExam = do _otherwise -> return () whenIsJust efAuthorshipStatement $ \statementContent -> do mSchoolAuthorshipStatement <- lift $ maybe (pure Nothing) getEntity schoolSheetExamAuthorshipStatementDefinition - guardValidation MsgExamAuthorshipStatementMustBeNonEmpty $ schoolSheetExamAuthorshipStatementMode /= SchoolAuthorshipStatementModeRequired || statementContent /= mempty + guardValidation MsgExamAuthorshipStatementMustBeNonEmpty $ schoolSheetExamAuthorshipStatementMode /= SchoolAuthorshipStatementModeRequired || statementContent /= mempty -- FIXME: form validation fails in required mode with non-empty school default guardValidation MsgExamAuthorshipStatementMustMatchSchoolDefinition $ not schoolSheetExamAuthorshipStatementAllowOther && Just statementContent == (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement) unless (has (_Just . _entityVal . _examStaff . _Nothing) oldExam) $ From 3f87f20eb14e5db8a63c61885c4570689169ebed Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Fri, 11 Jun 2021 14:03:09 +0200 Subject: [PATCH 066/120] feat(sheets): introduce sheet-specific statements for exam-unrelated sheets and as exam-statement overrides --- .../categories/courses/sheet/de-de-formal.msg | 5 +- .../categories/courses/sheet/en-eu.msg | 5 +- models/sheets.model | 2 +- src/Handler/Sheet/Edit.hs | 11 ++-- src/Handler/Sheet/Form.hs | 56 ++++++++----------- src/Handler/Sheet/New.hs | 2 +- test/Database/Fill.hs | 10 ++-- 7 files changed, 43 insertions(+), 48 deletions(-) diff --git a/messages/uniworx/categories/courses/sheet/de-de-formal.msg b/messages/uniworx/categories/courses/sheet/de-de-formal.msg index f830472ee..b24c3cc85 100644 --- a/messages/uniworx/categories/courses/sheet/de-de-formal.msg +++ b/messages/uniworx/categories/courses/sheet/de-de-formal.msg @@ -153,8 +153,8 @@ SheetGradingPassBinary: Bestanden/Nicht Bestanden SheetGradingPassAlways: Automatisch bestanden, sobald korrigiert SheetAuthorshipStatementSection: Eigenständigkeitserklärung -SheetAuthorshipStatementRequired: Falls nicht-prüfungsrelevant: Eigenständigkeitserklärung einfordern? -SheetAuthorshipStatementRequiredTip: Soll jeder Abgebende (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren? +SheetAuthorshipStatementRequired: Eigenständigkeitserklärung einfordern? +SheetAuthorshipStatementRequiredTip: Soll jeder Abgebende (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren? (Hinweis: Gehört dieses Übungsblatt zu einer Prüfung und sind für die Prüfung Eigenständigkeitserklärungen aktiviert, so überschreibt diese Erklärung die prüfungsweite Eigenständigkeitserklärung für dieses Übungsblatt.) SheetAuthorshipStatementRequiredDisabled: Eigenständigkeitserklärungen für nicht-prüfungsrelevante Übungsblattabgaben sind institutsweit deaktiviert. SheetAuthorshipStatementRequiredForced: Es ist institutsweit vorgeschrieben, dass bei Übungsblattabgaben jeder Abgebende (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden muss, eine Eigenständigkeitserklärung zu akzeptieren. SheetAuthorshipStatementIsRequiredTrue: Erforderlich @@ -163,3 +163,4 @@ SheetAuthorshipStatementUseSchoolDefault: Vorgabe des Instituts verwenden? SheetAuthorshipStatementUseSchoolDefaultTip: Soll die aktuelle Vorgabe des Instituts (siehe unten) verwendet werden? (Hinweis: Um über alle Abgaben eines Blattes hinweg konsistente Eigenständigkeitserklärungen zu gewährleisten, werden Änderungen an der Vorgabe des Instituts nur für neue Blätter angewandt.) SheetAuthorshipStatementCustom: Benutzerdefinierte Erklärung SheetAuthorshipStatementSchoolDefault: Vorgabe des Instituts +SheetAuthorshipStatementContent: Eigenständigkeitserklärung diff --git a/messages/uniworx/categories/courses/sheet/en-eu.msg b/messages/uniworx/categories/courses/sheet/en-eu.msg index 0ce9116f1..b7e46a205 100644 --- a/messages/uniworx/categories/courses/sheet/en-eu.msg +++ b/messages/uniworx/categories/courses/sheet/en-eu.msg @@ -152,8 +152,8 @@ SheetGradingPassBinary: Pass/Fail SheetGradingPassAlways: Automatically passed when corrected SheetAuthorshipStatementSection: Statement of Authorship -SheetAuthorshipStatementRequired: For exam-unrelated sheets: Require Statement of Authorship for submissions? -SheetAuthorshipStatementRequiredTip: Should each submittor (in case of submission groups each group member) be required to accept a Statement of Authorship? +SheetAuthorshipStatementRequired: Require Statement of Authorship for submissions? +SheetAuthorshipStatementRequiredTip: Should each submittor (in case of submission groups each group member) be required to accept a Statement of Authorship? (Hint: If this sheet is related to an exam and a Statement of Authorship is activated for this exam, this statement will override the exam-wide Statement of Authorship for this specific sheet.) SheetAuthorshipStatementRequiredDisabled: The school settings prohibit Statements of Authorship for exam-unrelated exercise sheet submissions. SheetAuthorshipStatementRequiredForced: The school settings enforce that each submittor (in case of submission groups each group member) is required to accept a Statement of Authorship. SheetAuthorshipStatementIsRequiredTrue: Required @@ -162,3 +162,4 @@ SheetAuthorshipStatementUseSchoolDefault: Use school preset? SheetAuthorshipStatementUseSchoolDefaultTip: Should the school-wide preset be used? (Hint: To ensure consistent statements across all submissions for a sheet, changes of the school-wide preset will only apply to new exercise sheets.) SheetAuthorshipStatementCustom: Custom statement SheetAuthorshipStatementSchoolDefault: School preset +SheetAuthorshipStatementContent: Statement of Authorship diff --git a/models/sheets.model b/models/sheets.model index 796ebbe76..1fde7ec1b 100644 --- a/models/sheets.model +++ b/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 -- TODO: sheet-specific authorship statement; for exam-unrelated sheets and for exam setting overrides + authorshipStatement AuthorshipStatementDefinitionId Maybe -- sheet-specific authorship statement; for exam-unrelated sheets and as exam setting overrides 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 7e370a960..76dfd4448 100644 --- a/src/Handler/Sheet/Edit.hs +++ b/src/Handler/Sheet/Edit.hs @@ -22,8 +22,8 @@ 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 oldSheet) <- 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 ] []) @@ -34,8 +34,8 @@ postSEditR tid ssh csh shn = do -- Entity _ School{..} <- MaybeT . getEntity $ ssh -- definitionId <- MaybeT . return $ schoolSheetAuthorshipStatementDefinition -- MaybeT . getEntity $ definitionId - -- mAuthorshipStatement <- maybe (pure Nothing) getEntity sheetAuthorshipStatement - return (ent, fti, cLoads, hasPersonalisedFiles) + mAuthorshipStatement <- maybe (pure Nothing) getEntity (oldSheet ^. _sheetAuthorshipStatement) + return (ent, fti, cLoads, hasPersonalisedFiles, mAuthorshipStatement) let template = Just $ SheetForm { sfName = sheetName , sfDescription = sheetDescription @@ -61,6 +61,7 @@ postSEditR tid ssh csh shn = do , spffAllowNonPersonalisedSubmission = sheetAllowNonPersonalisedSubmission , spffFiles = Nothing } + , sfAuthorshipStatement = authorshipStatementDefinitionContent . entityVal <$> mAuthorshipStatement } let action = uniqueReplace sid -- More specific error message for edit old sheet could go here by using myReplaceUnique instead @@ -118,7 +119,7 @@ handleSheetEdit tid ssh csh msId template dbAction = do , sheetAnonymousCorrection = sfAnonymousCorrection , sheetRequireExamRegistration = sfRequireExamRegistration , sheetAllowNonPersonalisedSubmission = maybe True spffAllowNonPersonalisedSubmission sfPersonalF - -- , sheetAuthorshipStatement = Nothing -- TODO: implement sheet-specific statements + , sheetAuthorshipStatement = Nothing -- TODO: implement sheet-specific statements } mbsid <- dbAction newSheet case mbsid of diff --git a/src/Handler/Sheet/Form.hs b/src/Handler/Sheet/Form.hs index 4a1bcd754..32c886c06 100644 --- a/src/Handler/Sheet/Form.hs +++ b/src/Handler/Sheet/Form.hs @@ -42,7 +42,7 @@ data SheetForm = SheetForm , sfMarkingText :: Maybe StoredMarkup , sfAnonymousCorrection :: Bool , sfCorrectors :: Loads - -- , sfAuthorshipStatement :: Maybe (Either AuthorshipStatementDefinitionId StoredMarkup) -- TODO: exam-unrelated statement, override for exam setting + , sfAuthorshipStatement :: Maybe StoredMarkup } data SheetPersonalisedFilesForm = SheetPersonalisedFilesForm @@ -66,7 +66,6 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS (Just sId) -> liftHandler $ runDB $ getFtIdMap sId MsgRenderer mr <- getMsgRenderer ctime <- ceilingQuarterHour <$> liftIO getCurrentTime - -- TODO: use ((_school, _mSchoolAuthorshipStatement), _course) <- liftHandler . runDB $ do course@Course{courseSchool} <- get404 cId school@School{..} <- get404 courseSchool @@ -106,37 +105,30 @@ 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 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 + <* aformSection MsgSheetAuthorshipStatementSection + -- TODO: add info: applies to exam-unrelated sheets and overrides exam definition 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) - -- ) + <*> optionalActionA + ( areq htmlField + (fslI MsgSheetAuthorshipStatementContent) + ( + -- TODO: select correct school settings wrt. exam-related/exam-unrelated + -- TODO: if school enforces school-wide statement, take school-wide statement + -- TODO: otherwise, take value from template, or take exam-wide statement if there is any, or take the school default if there is any + Nothing + ) + ) + ( fslI MsgSheetAuthorshipStatementRequired + & setTooltip MsgSheetAuthorshipStatementRequiredTip + -- TODO: set disabled attr if school mode disables or enforces statements + -- TODO: select school mode wrt. exam-related/exam-unrelated: Is this sheet related to an exam? If yes, take school exam sheet mode, otherwise take school sheet mode + ) + ( + -- TODO: if school disables/enforces statements for this sheet (exam-related/exam-unrelated?), set value accordingly + -- TODO: if this sheet is related to an exam and this exam enforces statements, set value accordingly + -- TODO: otherwise, take value from template, or `Just True` if the school has a non-empty school-wide default + Nothing + ) where makeSheetPersonalisedFilesForm :: Maybe SheetPersonalisedFilesForm -> MForm Handler (AForm Handler SheetPersonalisedFilesForm) makeSheetPersonalisedFilesForm template' = do diff --git a/src/Handler/Sheet/New.hs b/src/Handler/Sheet/New.hs index e2fe398e0..f235e9363 100644 --- a/src/Handler/Sheet/New.hs +++ b/src/Handler/Sheet/New.hs @@ -70,7 +70,7 @@ postSheetNewR tid ssh csh = do , sfAnonymousCorrection = sheetAnonymousCorrection , sfRequireExamRegistration = Nothing , sfPersonalF = Nothing - -- , sfAuthorshipStatement = mAuthorshipStatement + , sfAuthorshipStatement = Nothing -- TODO: implement sheet-specific statements } _other -> Nothing let action = -- More specific error message for new sheet could go here, if insertUnique returns Nothing diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 3ae3e5c12..68e33f41a 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -657,7 +657,7 @@ fillDb = do , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True - -- , sheetAuthorshipStatement = Nothing + , sheetAuthorshipStatement = Nothing } insert_ $ SheetEdit gkleen now adhoc feste <- insert Sheet @@ -677,7 +677,7 @@ fillDb = do , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True - -- , sheetAuthorshipStatement = Nothing + , sheetAuthorshipStatement = Nothing } insert_ $ SheetEdit gkleen now feste keine <- insert Sheet @@ -697,7 +697,7 @@ fillDb = do , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True - -- , sheetAuthorshipStatement = Nothing + , sheetAuthorshipStatement = Nothing } insert_ $ SheetEdit gkleen now keine void . insertMany $ map (\u -> CourseParticipant ffp u now Nothing CourseParticipantActive) @@ -944,7 +944,7 @@ fillDb = do , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True - -- , sheetAuthorshipStatement = Nothing + , sheetAuthorshipStatement = Nothing } void . insert $ SheetEdit jost now shId when (submissionModeCorrector sheetSubmissionMode) $ @@ -1188,7 +1188,7 @@ fillDb = do , sheetAnonymousCorrection = True , sheetRequireExamRegistration = Nothing , sheetAllowNonPersonalisedSubmission = True - -- , sheetAuthorshipStatement = if shNr == 14 then Just ifiAuthorshipStatement else Nothing + , sheetAuthorshipStatement = Nothing } manyUsers' <- shuffleM $ take 1024 manyUsers groupSizes <- getRandomRs (1, 3) From 8fb49dd602f4eb854b300b5b399206aa2fbca87b Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Tue, 15 Jun 2021 13:01:04 +0200 Subject: [PATCH 067/120] fix(schools): switch authorship modes to required in form --- src/Handler/School.hs | 4 ++-- test/Database/Fill.hs | 1 - 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/src/Handler/School.hs b/src/Handler/School.hs index be69e883a..2cdaf0c33 100644 --- a/src/Handler/School.hs +++ b/src/Handler/School.hs @@ -88,10 +88,10 @@ mkSchoolForm mSsh template = renderAForm FormStandard $ SchoolForm <*> (fromMaybe (ExamModeDNF predDNFFalse) <$> aopt pathPieceField (fslI MsgSchoolExamDiscouragedModes) (Just $ sfExamDiscouragedModes <$> template <|> pure (ExamModeDNF predDNFFalse))) <*> apopt (selectField optionsFinite) (fslI MsgExamCloseMode) (sfExamCloseMode <$> template <|> pure ExamCloseSeparate) <* aformSection MsgSchoolAuthorshipStatementSection - <*> apopt (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetMode) (sfSheetAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) + <*> areq (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetMode) (sfSheetAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) <*> aopt htmlField (fslI MsgSchoolAuthorshipStatementSheetDefinition & setTooltip MsgSchoolAuthorshipStatementSheetDefinitionTip) (sfSheetAuthorshipStatementDefinition <$> template) <*> apopt checkBoxField (fslI MsgSchoolAuthorshipStatementSheetAllowOther) (sfSheetAuthorshipStatementAllowOther <$> template <|> pure True) - <*> apopt (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetExamMode) (sfSheetExamAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) + <*> areq (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetExamMode) (sfSheetExamAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) <*> aopt htmlField (fslI MsgSchoolAuthorshipStatementSheetExamDefinition & setTooltip MsgSchoolAuthorshipStatementSheetExamDefinitionTip) (sfSheetExamAuthorshipStatementDefinition <$> template) <*> apopt checkBoxField (fslI MsgSchoolAuthorshipStatementSheetExamAllowOther) (sfSheetExamAuthorshipStatementAllowOther <$> template <|> pure True) where diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 68e33f41a..8ee7d4675 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -732,7 +732,6 @@ fillDb = do , examSynchronicity = Just $ ExamSynchronicityPreset ExamSynchronous , examRequiredEquipment = Just $ ExamRequiredEquipmentPreset ExamRequiredEquipmentNone } - -- , examAuthorshipStatement = Nothing , examStaff = Just "Hofmann" , examAuthorshipStatement = Nothing } From 227264743e0e8d0acf76839300a034b4bb1bf2a6 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Tue, 15 Jun 2021 13:04:53 +0200 Subject: [PATCH 068/120] fix(schools): insert correct authorship statement definition for exam-unrelated sheets --- src/Handler/School.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Handler/School.hs b/src/Handler/School.hs index 2cdaf0c33..e83a978cf 100644 --- a/src/Handler/School.hs +++ b/src/Handler/School.hs @@ -140,7 +140,7 @@ postSchoolEditR ssh = do formResult sfResult $ \SchoolForm{..} -> do runDB $ do let insertAuthorshipStatement = maybe (pure Nothing) $ fmap Just . insert . AuthorshipStatementDefinition - mSheetAuthorshipStatementId <- insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition + mSheetAuthorshipStatementId <- insertAuthorshipStatement sfSheetAuthorshipStatementDefinition mSheetExamAuthorshipStatementId <- insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition update ssh [ SchoolName =. sfName From c5b3ac65c8ee2f51711e3ef2130ee19896e580aa Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Tue, 15 Jun 2021 16:40:40 +0200 Subject: [PATCH 069/120] chore(schools): document form failure with authship mode none as FIXME --- src/Handler/School.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Handler/School.hs b/src/Handler/School.hs index e83a978cf..0d31aa0bb 100644 --- a/src/Handler/School.hs +++ b/src/Handler/School.hs @@ -88,10 +88,10 @@ mkSchoolForm mSsh template = renderAForm FormStandard $ SchoolForm <*> (fromMaybe (ExamModeDNF predDNFFalse) <$> aopt pathPieceField (fslI MsgSchoolExamDiscouragedModes) (Just $ sfExamDiscouragedModes <$> template <|> pure (ExamModeDNF predDNFFalse))) <*> apopt (selectField optionsFinite) (fslI MsgExamCloseMode) (sfExamCloseMode <$> template <|> pure ExamCloseSeparate) <* aformSection MsgSchoolAuthorshipStatementSection - <*> areq (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetMode) (sfSheetAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) + <*> areq (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetMode) (sfSheetAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) -- FIXME: SchoolAuthorshipStatementModeNone leads to FormFailure <*> aopt htmlField (fslI MsgSchoolAuthorshipStatementSheetDefinition & setTooltip MsgSchoolAuthorshipStatementSheetDefinitionTip) (sfSheetAuthorshipStatementDefinition <$> template) <*> apopt checkBoxField (fslI MsgSchoolAuthorshipStatementSheetAllowOther) (sfSheetAuthorshipStatementAllowOther <$> template <|> pure True) - <*> areq (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetExamMode) (sfSheetExamAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) + <*> areq (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetExamMode) (sfSheetExamAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional) -- FIXME: SchoolAuthorshipStatementModeNone leads to FormFailure <*> aopt htmlField (fslI MsgSchoolAuthorshipStatementSheetExamDefinition & setTooltip MsgSchoolAuthorshipStatementSheetExamDefinitionTip) (sfSheetExamAuthorshipStatementDefinition <$> template) <*> apopt checkBoxField (fslI MsgSchoolAuthorshipStatementSheetExamAllowOther) (sfSheetExamAuthorshipStatementAllowOther <$> template <|> pure True) where From 4109db6f815fbb49c861177b3caecb98c2a963d8 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Sat, 19 Jun 2021 09:56:33 +0200 Subject: [PATCH 070/120] fix(exams): fixhance exam authship form section --- src/Handler/Exam/Form.hs | 43 +++++++++++++++++++--------------------- 1 file changed, 20 insertions(+), 23 deletions(-) diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index 7ea49ca6c..25cf5740d 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -148,29 +148,26 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do <* aformSection MsgExamFormParts <*> examPartsForm (efExamParts <$> template) -- TODO: refactor messages to be used across scopes, then define this form section separately (to be used for exams and sheets) - <* aformSection MsgExamAuthorshipStatementSection - <*> optionalActionA - ( areq htmlField - ( if schoolSheetExamAuthorshipStatementAllowOther - then fslI MsgExamAuthorshipStatementContent - else fslI MsgExamAuthorshipStatementContent - & addAttr "disabled" "disabled" - & setTooltip MsgExamAuthorshipStatementAllowOtherFalseTip - ) - ( (bool Nothing (join $ efAuthorshipStatement <$> template) schoolSheetExamAuthorshipStatementAllowOther) -- TODO: allow reverting from template to school definition (e.g. show school definition somewhere else, implement some kind of reset button, at least explain workaround (create new exam -> copy from there)...) - <|> (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement) - ) - ) - ( case schoolSheetExamAuthorshipStatementMode of - SchoolAuthorshipStatementModeNone -> fslI MsgExamAuthorshipStatementRequired & addAttr "disabled" "disabled" & setTooltip MsgExamAuthorshipStatementRequiredDisabledOffTip - SchoolAuthorshipStatementModeOptional -> fslI MsgExamAuthorshipStatementRequired & setTooltip MsgExamAuthorshipStatementRequiredTip - SchoolAuthorshipStatementModeRequired -> fslI MsgExamAuthorshipStatementRequired & addAttr "disabled" "disabled" & setTooltip MsgExamAuthorshipStatementRequiredDisabledOnTip - ) - ( case schoolSheetExamAuthorshipStatementMode of - SchoolAuthorshipStatementModeNone -> Just False - SchoolAuthorshipStatementModeOptional -> (is _Just . efAuthorshipStatement <$> template) <|> (pure $ is _Just schoolSheetExamAuthorshipStatementDefinition) - SchoolAuthorshipStatementModeRequired -> Just True -- FIXME: checkbox is unticked after form submit with school defaults (e.g. required, school definition given and unchanged) - ) + <*> let + reqContentField :: (FieldSettings UniWorX -> FieldSettings UniWorX) -> AForm Handler StoredMarkup + reqContentField ttip = areq htmlField + (fslI MsgExamAuthorshipStatementContent & ttip) + ( join $ (efAuthorshipStatement <$> template) + <|> (pure . authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement) + ) + forcedContentField = aforced htmlField + (fslI MsgExamAuthorshipStatementContent & setTooltip MsgExamAuthorshipStatementAllowOtherFalseTip) + (maybe mempty (authorshipStatementDefinitionContent . entityVal) mSchoolAuthorshipStatement) + contentField ttipReq = bool forcedContentField (reqContentField ttipReq) schoolSheetExamAuthorshipStatementAllowOther + in case schoolSheetExamAuthorshipStatementMode of + SchoolAuthorshipStatementModeNone -> pure Nothing + SchoolAuthorshipStatementModeOptional -> aformSection MsgExamAuthorshipStatementSection + *> optionalActionA + (contentField id) + (fslI MsgExamAuthorshipStatementRequired & setTooltip MsgExamAuthorshipStatementRequiredTip) + ((is _Just . efAuthorshipStatement <$> template) <|> (pure $ is _Just schoolSheetExamAuthorshipStatementDefinition)) + SchoolAuthorshipStatementModeRequired -> aformSection MsgExamAuthorshipStatementSection + *> (fmap Just $ contentField (setTooltip MsgExamAuthorshipStatementRequiredDisabledOnTip)) officeSchoolsForm :: Maybe (Set SchoolId) -> AForm Handler (Set SchoolId) officeSchoolsForm mPrev = wFormToAForm $ do From 5c813ed02b0e4782090bafa0b71b60260f9b576c Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Sat, 19 Jun 2021 10:05:03 +0200 Subject: [PATCH 071/120] refactor(exams): restruct case wrt. aformSection --- src/Handler/Exam/Form.hs | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index 25cf5740d..ec8136171 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -160,14 +160,15 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do (maybe mempty (authorshipStatementDefinitionContent . entityVal) mSchoolAuthorshipStatement) contentField ttipReq = bool forcedContentField (reqContentField ttipReq) schoolSheetExamAuthorshipStatementAllowOther in case schoolSheetExamAuthorshipStatementMode of - SchoolAuthorshipStatementModeNone -> pure Nothing - SchoolAuthorshipStatementModeOptional -> aformSection MsgExamAuthorshipStatementSection - *> optionalActionA - (contentField id) - (fslI MsgExamAuthorshipStatementRequired & setTooltip MsgExamAuthorshipStatementRequiredTip) - ((is _Just . efAuthorshipStatement <$> template) <|> (pure $ is _Just schoolSheetExamAuthorshipStatementDefinition)) - SchoolAuthorshipStatementModeRequired -> aformSection MsgExamAuthorshipStatementSection - *> (fmap Just $ contentField (setTooltip MsgExamAuthorshipStatementRequiredDisabledOnTip)) + SchoolAuthorshipStatementModeNone -> pure Nothing -- suppress display of whole section incl. header + otherMode -> aformSection MsgExamAuthorshipStatementSection + *> case otherMode of + SchoolAuthorshipStatementModeOptional -> optionalActionA + (contentField id) + (fslI MsgExamAuthorshipStatementRequired & setTooltip MsgExamAuthorshipStatementRequiredTip) + ((is _Just . efAuthorshipStatement <$> template) <|> (pure $ is _Just schoolSheetExamAuthorshipStatementDefinition)) + SchoolAuthorshipStatementModeRequired -> fmap Just . contentField $ setTooltip MsgExamAuthorshipStatementRequiredDisabledOnTip + _none -> pure Nothing officeSchoolsForm :: Maybe (Set SchoolId) -> AForm Handler (Set SchoolId) officeSchoolsForm mPrev = wFormToAForm $ do From ac86832b34a605e5d64d56ef08a871bf307347a8 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Sat, 19 Jun 2021 10:17:42 +0200 Subject: [PATCH 072/120] fix(exams): correctly treat school-mode optional as off by default --- src/Handler/Exam/Form.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index ec8136171..ee463f11a 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -163,10 +163,9 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do SchoolAuthorshipStatementModeNone -> pure Nothing -- suppress display of whole section incl. header otherMode -> aformSection MsgExamAuthorshipStatementSection *> case otherMode of - SchoolAuthorshipStatementModeOptional -> optionalActionA - (contentField id) + SchoolAuthorshipStatementModeOptional -> optionalActionA (contentField id) (fslI MsgExamAuthorshipStatementRequired & setTooltip MsgExamAuthorshipStatementRequiredTip) - ((is _Just . efAuthorshipStatement <$> template) <|> (pure $ is _Just schoolSheetExamAuthorshipStatementDefinition)) + (is _Just . efAuthorshipStatement <$> template) SchoolAuthorshipStatementModeRequired -> fmap Just . contentField $ setTooltip MsgExamAuthorshipStatementRequiredDisabledOnTip _none -> pure Nothing From bf059a132094e53c3ef956582b5e13517e9c133d Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Sat, 19 Jun 2021 10:20:50 +0200 Subject: [PATCH 073/120] fix(exams): remove deprecated/unnecessary form validation wrt. authship statements --- src/Handler/Exam/Form.hs | 9 --------- 1 file changed, 9 deletions(-) diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index ee463f11a..a8d88a206 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -555,14 +555,5 @@ validateExam cId oldExam = do warnValidation MsgExamModeSchoolDiscouraged . not $ evalExamModeDNF schoolExamDiscouragedModes efExamMode - case schoolSheetExamAuthorshipStatementMode of - SchoolAuthorshipStatementModeNone -> guardValidation MsgExamAuthorshipStatementMustBeEmpty $ is _Nothing efAuthorshipStatement - SchoolAuthorshipStatementModeRequired -> guardValidation MsgExamAuthorshipStatementMustBeNonEmpty $ is _Just efAuthorshipStatement - _otherwise -> return () - whenIsJust efAuthorshipStatement $ \statementContent -> do - mSchoolAuthorshipStatement <- lift $ maybe (pure Nothing) getEntity schoolSheetExamAuthorshipStatementDefinition - guardValidation MsgExamAuthorshipStatementMustBeNonEmpty $ schoolSheetExamAuthorshipStatementMode /= SchoolAuthorshipStatementModeRequired || statementContent /= mempty -- FIXME: form validation fails in required mode with non-empty school default - guardValidation MsgExamAuthorshipStatementMustMatchSchoolDefinition $ not schoolSheetExamAuthorshipStatementAllowOther && Just statementContent == (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement) - unless (has (_Just . _entityVal . _examStaff . _Nothing) oldExam) $ guardValidation MsgExamStaffRequired $ isn't _Nothing efStaff From 0cd8f4c02f383f43b5e3ea059cd3acd38595ab56 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Sat, 19 Jun 2021 10:26:35 +0200 Subject: [PATCH 074/120] fix(exams): prefill with school authship statement in optional mode --- src/Handler/Exam/Form.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index a8d88a206..1e9138afa 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -151,13 +151,13 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do <*> let reqContentField :: (FieldSettings UniWorX -> FieldSettings UniWorX) -> AForm Handler StoredMarkup reqContentField ttip = areq htmlField - (fslI MsgExamAuthorshipStatementContent & ttip) - ( join $ (efAuthorshipStatement <$> template) - <|> (pure . authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement) - ) - forcedContentField = aforced htmlField - (fslI MsgExamAuthorshipStatementContent & setTooltip MsgExamAuthorshipStatementAllowOtherFalseTip) - (maybe mempty (authorshipStatementDefinitionContent . entityVal) mSchoolAuthorshipStatement) + (fslI MsgExamAuthorshipStatementContent & ttip) + ( (join $ efAuthorshipStatement <$> template) + <|> (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement) + ) + forcedContentField = aforced htmlField + (fslI MsgExamAuthorshipStatementContent & setTooltip MsgExamAuthorshipStatementAllowOtherFalseTip) + (maybe mempty (authorshipStatementDefinitionContent . entityVal) mSchoolAuthorshipStatement) contentField ttipReq = bool forcedContentField (reqContentField ttipReq) schoolSheetExamAuthorshipStatementAllowOther in case schoolSheetExamAuthorshipStatementMode of SchoolAuthorshipStatementModeNone -> pure Nothing -- suppress display of whole section incl. header From 491f7d35826f696ba93a0e2d7981b79b98e9199b Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Sat, 19 Jun 2021 12:10:50 +0200 Subject: [PATCH 075/120] chore: refactor authship statement messages --- .../courses/exam/exam/de-de-formal.msg | 16 ++----- .../categories/courses/exam/exam/en-eu.msg | 18 ++------ .../categories/courses/sheet/de-de-formal.msg | 14 ++---- .../categories/courses/sheet/en-eu.msg | 12 ++---- .../categories/school/de-de-formal.msg | 18 ++++---- messages/uniworx/categories/school/en-eu.msg | 12 +++--- src/Handler/Exam/Form.hs | 5 +-- src/Handler/Sheet/Form.hs | 43 ++++++++++--------- 8 files changed, 53 insertions(+), 85 deletions(-) diff --git a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg index baac78f3f..bbcf9f472 100644 --- a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg +++ b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg @@ -313,19 +313,9 @@ ExamGradingGrades: Numerische Noten ExamGradingMixed: Gemischt ExamFinished: Ergebnisse sichtbar ab -ExamAuthorshipStatementSection: Eigenständigkeitserklärungen +ExamAuthorshipStatementSection: Eigenständigkeitserklärung ExamAuthorshipStatementRequired: Eigenständigkeitserklärung für prüfungszugehörige Übungsblattabgaben einfordern? ExamAuthorshipStatementRequiredTip: Sollen für alle zu dieser Prüfung zugehörige Übungsblätter die Abgebenden (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren? -ExamAuthorshipStatementRequiredDisabledOffTip: Für dieses Institut sind Eigenständigkeitserklärungen für prüfungsrelevante Übungsblätter deaktiviert. -ExamAuthorshipStatementRequiredDisabledOnTip: Für dieses Institut sind Eigenständigkeitserklärungen für prüfungsrelevante Übungsblätter vorgeschrieben. -ExamAuthorshipStatementSchoolDefinition: Institutsweit vorgegebene Eigenständigkeitserklärung -ExamAuthorshipStatementUseCustomDefinition: Benutzerdefinierte Eigenständigkeitserklärung verwenden? -ExamAuthorshipStatementUseCustomDefinitionTip: Soll anstatt der institutsweit vorgegebenen Eigenständigkeitserklärung eine benuzterdefinierte Erklärung für diese Prüfung genutzt werden? (Hinweis: Um konsistente Erklärungen für alle Abgaben der Prüfung zu gewährleisten, dient die institutsweite Erklärung hier nur als Vorlage und wird ab dann getrennt (als Kopie) gespeichert. Ändert sich die institutsweite Erklärung, so muss die Änderung für diese Prüfung manuell übernommen werden, falls erwünscht.) -ExamAuthorshipStatementUseCustomDefinitionDisabledTip: Für dieses Institut ist die institutsweite Vorgabe als Erklärung zu verwenden. Benutzerdefinierte Erklärungen sind nicht gestattet. -ExamAuthorshipStatementCustom: Benutzerdefinierte Eigenständigkeitserklärung +ExamAuthorshipStatementRequiredForcedTip: Für dieses Institut sind Eigenständigkeitserklärungen für prüfungszugehörige Übungsblätter vorgeschrieben. ExamAuthorshipStatementContent: Eigenständigkeitserklärung -ExamAuthorshipStatementAllowOtherFalseTip: Für dieses Institut ist die institutsweit vorgegebene Eigenständigkeitserklärung für prüfungsrelevante Übungsblätter zu verwenden. Benutzerdefinierte Erklärungen sind nicht gestattet. - -ExamAuthorshipStatementMustBeEmpty: Es darf keine Eigenständigkeitserklärung für prüfungsrelevante Übungsblätter angegeben werden. -ExamAuthorshipStatementMustBeNonEmpty: Es muss eine nicht-leere Eigenständigkeitserklärung für prüfungsrelevante Übungsblätter angegeben werden. -ExamAuthorshipStatementMustMatchSchoolDefinition: Die angegebene Eigenständigkeitserklärung für prüfungsrelevante Übungsblätter muss der Vorgabe des Instituts entsprechen. \ No newline at end of file +ExamAuthorshipStatementContentForcedTip: Für dieses Institut ist die institutsweit vorgegebene Eigenständigkeitserklärung für prüfungsrelevante Übungsblätter zu verwenden. Benutzerdefinierte Erklärungen sind nicht gestattet. \ No newline at end of file diff --git a/messages/uniworx/categories/courses/exam/exam/en-eu.msg b/messages/uniworx/categories/courses/exam/exam/en-eu.msg index ab41c986a..756491717 100644 --- a/messages/uniworx/categories/courses/exam/exam/en-eu.msg +++ b/messages/uniworx/categories/courses/exam/exam/en-eu.msg @@ -311,19 +311,9 @@ ExamGradingGrades: Numeric grades ExamGradingMixed: Mixed ExamFinished: Results visible from -ExamAuthorshipStatementSection: Statements of Authorship +ExamAuthorshipStatementSection: Statement of Authorship ExamAuthorshipStatementRequired: Require Statement of Authorship for exam-related exercise sheet submissions? -ExamAuthorshipStatementRequiredTip: Should submittors (in case of submission groups each group member) be required to accept a Statement of Authorship for all exercise sheets related to this exam? -ExamAuthorshipStatementRequiredDisabledOffTip: This school permits Statements of Authorship for exam-related sheets. -ExamAuthorshipStatementRequiredDisabledOnTip: This school requires Statements of Authorship for exam-related sheets. -ExamAuthorshipStatementSchoolDefinition: School-wide default Statement of Authorship -ExamAuthorshipStatementUseCustomDefinition: Use custom Statement of Authorship? -ExamAuthorshipStatementUseCustomDefinitionTip: Should a custom Statement of Authorship be used for this exam instead of the school-wide default statement? (Hint: To ensure consistent statements for all submissions related to this exam, the school-wide default statement will be used as a template here and will then be stored separately (as a copy). If the school-wide default statement changes, this change must be applied manually for this exam if desired.) -ExamAuthorshipStatementUseCustomDefinitionDisabledTip: This school dictates that the school-wide Statement of Authorship must be used. Custom statements are prohibited. -ExamAuthorshipStatementCustom: Custom Statement of Authorship +ExamAuthorshipStatementRequiredTip: Should submittors (each group member in case of submission groups) be required to accept a Statement of Authorship for all exercise sheets related to this exam? +ExamAuthorshipStatementRequiredForcedTip: This school enforces Statements of Authorship for all exam-related exercise sheets. ExamAuthorshipStatementContent: Statement of Authorship -ExamAuthorshipStatementAllowOtherFalseTip: The settings of this school dictate that the school-wide Statement of Authorship for exam-related sheets must be used. Custom statements are prohibited. - -ExamAuthorshipStatementMustBeEmpty: No Statement of Authorship for exam-related sheets may be given. -ExamAuthorshipStatementMustBeNonEmpty: A non-empty Statement of Authorship for exam-related sheets must be given. -ExamAuthorshipStatementMustMatchSchoolDefinition: The given Statement of Authorship for exam-related sheets must match the school-wide Statement of Authorship. \ No newline at end of file +ExamAuthorshipStatementContentForcedTip: The settings of this school dictate that the school-wide Statement of Authorship for exam-related sheets must be used. Custom statements are prohibited. \ No newline at end of file diff --git a/messages/uniworx/categories/courses/sheet/de-de-formal.msg b/messages/uniworx/categories/courses/sheet/de-de-formal.msg index b24c3cc85..e7a8b11a6 100644 --- a/messages/uniworx/categories/courses/sheet/de-de-formal.msg +++ b/messages/uniworx/categories/courses/sheet/de-de-formal.msg @@ -153,14 +153,8 @@ SheetGradingPassBinary: Bestanden/Nicht Bestanden SheetGradingPassAlways: Automatisch bestanden, sobald korrigiert SheetAuthorshipStatementSection: Eigenständigkeitserklärung -SheetAuthorshipStatementRequired: Eigenständigkeitserklärung einfordern? -SheetAuthorshipStatementRequiredTip: Soll jeder Abgebende (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren? (Hinweis: Gehört dieses Übungsblatt zu einer Prüfung und sind für die Prüfung Eigenständigkeitserklärungen aktiviert, so überschreibt diese Erklärung die prüfungsweite Eigenständigkeitserklärung für dieses Übungsblatt.) -SheetAuthorshipStatementRequiredDisabled: Eigenständigkeitserklärungen für nicht-prüfungsrelevante Übungsblattabgaben sind institutsweit deaktiviert. -SheetAuthorshipStatementRequiredForced: Es ist institutsweit vorgeschrieben, dass bei Übungsblattabgaben jeder Abgebende (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden muss, eine Eigenständigkeitserklärung zu akzeptieren. -SheetAuthorshipStatementIsRequiredTrue: Erforderlich -SheetAuthorshipStatementIsRequiredFalse: Keine -SheetAuthorshipStatementUseSchoolDefault: Vorgabe des Instituts verwenden? -SheetAuthorshipStatementUseSchoolDefaultTip: Soll die aktuelle Vorgabe des Instituts (siehe unten) verwendet werden? (Hinweis: Um über alle Abgaben eines Blattes hinweg konsistente Eigenständigkeitserklärungen zu gewährleisten, werden Änderungen an der Vorgabe des Instituts nur für neue Blätter angewandt.) -SheetAuthorshipStatementCustom: Benutzerdefinierte Erklärung -SheetAuthorshipStatementSchoolDefault: Vorgabe des Instituts +SheetAuthorshipStatementRequired: Eigenständigkeitserklärung für Übungsblattabgaben einfordern? +SheetAuthorshipStatementRequiredTip: Sollen die Abgebenden (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren? +SheetAuthorshipStatementRequiredForcedTip: Für dieses Institut sind Eigenständigkeitserklärungen für nicht-prüfungszugehörige Übungsblätter vorgeschrieben. SheetAuthorshipStatementContent: Eigenständigkeitserklärung +SheetAuthorshipStatementContentOverridesExamTip: Gehört dieses Übungsblatt zu einer Prüfung mit einer prüfungsweit eingestellten Eigenständigkeitserklärung, so können Sie hier eine für dieses Übungsblatt abweichende Eigenständigkeitserklärung angeben. diff --git a/messages/uniworx/categories/courses/sheet/en-eu.msg b/messages/uniworx/categories/courses/sheet/en-eu.msg index b7e46a205..d72478c60 100644 --- a/messages/uniworx/categories/courses/sheet/en-eu.msg +++ b/messages/uniworx/categories/courses/sheet/en-eu.msg @@ -153,13 +153,7 @@ SheetGradingPassAlways: Automatically passed when corrected SheetAuthorshipStatementSection: Statement of Authorship SheetAuthorshipStatementRequired: Require Statement of Authorship for submissions? -SheetAuthorshipStatementRequiredTip: Should each submittor (in case of submission groups each group member) be required to accept a Statement of Authorship? (Hint: If this sheet is related to an exam and a Statement of Authorship is activated for this exam, this statement will override the exam-wide Statement of Authorship for this specific sheet.) -SheetAuthorshipStatementRequiredDisabled: The school settings prohibit Statements of Authorship for exam-unrelated exercise sheet submissions. -SheetAuthorshipStatementRequiredForced: The school settings enforce that each submittor (in case of submission groups each group member) is required to accept a Statement of Authorship. -SheetAuthorshipStatementIsRequiredTrue: Required -SheetAuthorshipStatementIsRequiredFalse: None -SheetAuthorshipStatementUseSchoolDefault: Use school preset? -SheetAuthorshipStatementUseSchoolDefaultTip: Should the school-wide preset be used? (Hint: To ensure consistent statements across all submissions for a sheet, changes of the school-wide preset will only apply to new exercise sheets.) -SheetAuthorshipStatementCustom: Custom statement -SheetAuthorshipStatementSchoolDefault: School preset +SheetAuthorshipStatementRequiredTip: Should submittors (each group member in case of submission groups) be required to accept a Statement of Authorship? +SheetAuthorshipStatementRequiredForcedTip: This school enforces Statements of Authorship for all exam-unrelated exercise sheets. SheetAuthorshipStatementContent: Statement of Authorship +SheetAuthorshipStatementContentOverridesExamTip: If this exercise sheet is related to an exam with an exam-wide Statement of Authorship set, a sheet-specific adaptation can be given here. diff --git a/messages/uniworx/categories/school/de-de-formal.msg b/messages/uniworx/categories/school/de-de-formal.msg index 8a0c21c8e..66e657534 100644 --- a/messages/uniworx/categories/school/de-de-formal.msg +++ b/messages/uniworx/categories/school/de-de-formal.msg @@ -26,15 +26,15 @@ SchoolExamOffice: Prüfungsverwaltung SchoolAllocation: Zentralanmeldungs-Administration SchoolAdmin !ident-ok: Admin -SchoolAuthorshipStatementSection: Eigenständigkeitserklärung +SchoolAuthorshipStatementSection: Eigenständigkeitserklärungen +SchoolAuthorshipStatementSheetMode: Modus für nicht-prüfungszugehörige Übungsblattabgaben +SchoolAuthorshipStatementSheetExamMode: Modus für prüfungszugehörige Übungsblattabgaben SchoolAuthorshipStatementModeNone: Keine Eigenständigkeitserklärung erlauben SchoolAuthorshipStatementModeOptional: Eigenständigkeitserklärung optional einforderbar SchoolAuthorshipStatementModeRequired: Eigenständigkeitserklärung immer erforderlich -SchoolAuthorshipStatementSheetMode: Modus für nicht-prüfungsrelevante Übungsblattabgaben -SchoolAuthorshipStatementSheetDefinition: Eigenständigkeitserklärung für nicht-prüfungsrelevante Übungsblattabgaben -SchoolAuthorshipStatementSheetDefinitionTip: Deutsch und Englisch -SchoolAuthorshipStatementSheetAllowOther: Abweichende Erklärungen für nicht-prüfungsrelevante Übungsblätter erlauben? -SchoolAuthorshipStatementSheetExamMode: Modus für prüfungsrelevante Übungsblattabgaben -SchoolAuthorshipStatementSheetExamDefinition: Eigenständigkeitserklärung für prüfungsrelevante Übungsblattabgaben -SchoolAuthorshipStatementSheetExamDefinitionTip: Deutsch und Englisch -SchoolAuthorshipStatementSheetExamAllowOther: Abweichende Erklärungen für prüfungsrelevante Übungsblätter erlauben? \ No newline at end of file +SchoolAuthorshipStatementSheetDefinition: Eigenständigkeitserklärung für nicht-prüfungszugehörige Übungsblattabgaben +SchoolAuthorshipStatementSheetDefinitionTip: Bitte in sowohl deutscher als auch englischer Sprache angeben. +SchoolAuthorshipStatementSheetExamDefinition: Eigenständigkeitserklärung für prüfungszugehörige Übungsblattabgaben +SchoolAuthorshipStatementSheetExamDefinitionTip: Bitte in sowohl deutscher als auch englischer Sprache angeben. +SchoolAuthorshipStatementSheetAllowOther: Abweichende Eigenständigkeitserklärungen für nicht-prüfungszugehörige Übungsblätter erlauben? +SchoolAuthorshipStatementSheetExamAllowOther: Abweichende Eigenständigkeitserklärungen für prüfungszugehörige Übungsblätter erlauben? \ No newline at end of file diff --git a/messages/uniworx/categories/school/en-eu.msg b/messages/uniworx/categories/school/en-eu.msg index 008b44ed2..31d499c65 100644 --- a/messages/uniworx/categories/school/en-eu.msg +++ b/messages/uniworx/categories/school/en-eu.msg @@ -26,15 +26,15 @@ SchoolEvaluation: Course evaluation SchoolExamOffice: Exam office SchoolAllocation: Administration of central allocations -SchoolAuthorshipStatementSection: Statement of Authorship +SchoolAuthorshipStatementSection: Statements of Authorship +SchoolAuthorshipStatementSheetMode: Mode for exam-unrelated exercise sheet submissions +SchoolAuthorshipStatementSheetExamMode: Mode for exam-related exercise sheet submissions SchoolAuthorshipStatementModeNone: No Statement of Authorship allowed SchoolAuthorshipStatementModeOptional: Statement of Authorship optionally activatable SchoolAuthorshipStatementModeRequired: Statement of Authorship always required -SchoolAuthorshipStatementSheetMode: Mode for exam-unrelated exercise sheets SchoolAuthorshipStatementSheetDefinition: Statement of Authorship for exam-unrelated exercise sheets -SchoolAuthorshipStatementSheetDefinitionTip: German and English -SchoolAuthorshipStatementSheetAllowOther: Allow adaptations for exam-unrelated exercise sheets? -SchoolAuthorshipStatementSheetExamMode: Mode for exam-related exercise sheets +SchoolAuthorshipStatementSheetDefinitionTip: Please enter both german and english statements. SchoolAuthorshipStatementSheetExamDefinition: Statement of Authorship for exam-related exercise sheets -SchoolAuthorshipStatementSheetExamDefinitionTip: German and English +SchoolAuthorshipStatementSheetExamDefinitionTip: Please enter both german and english statements. +SchoolAuthorshipStatementSheetAllowOther: Allow adaptations for exam-unrelated exercise sheets? SchoolAuthorshipStatementSheetExamAllowOther: Allow adaptations for exam-related exercise sheets? \ No newline at end of file diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index 1e9138afa..fc1b3f020 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -147,7 +147,6 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do <*> examCorrectorsForm (efCorrectors <$> template) <* aformSection MsgExamFormParts <*> examPartsForm (efExamParts <$> template) - -- TODO: refactor messages to be used across scopes, then define this form section separately (to be used for exams and sheets) <*> let reqContentField :: (FieldSettings UniWorX -> FieldSettings UniWorX) -> AForm Handler StoredMarkup reqContentField ttip = areq htmlField @@ -156,7 +155,7 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do <|> (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement) ) forcedContentField = aforced htmlField - (fslI MsgExamAuthorshipStatementContent & setTooltip MsgExamAuthorshipStatementAllowOtherFalseTip) + (fslI MsgExamAuthorshipStatementContent & setTooltip MsgExamAuthorshipStatementContentForcedTip) (maybe mempty (authorshipStatementDefinitionContent . entityVal) mSchoolAuthorshipStatement) contentField ttipReq = bool forcedContentField (reqContentField ttipReq) schoolSheetExamAuthorshipStatementAllowOther in case schoolSheetExamAuthorshipStatementMode of @@ -166,7 +165,7 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do SchoolAuthorshipStatementModeOptional -> optionalActionA (contentField id) (fslI MsgExamAuthorshipStatementRequired & setTooltip MsgExamAuthorshipStatementRequiredTip) (is _Just . efAuthorshipStatement <$> template) - SchoolAuthorshipStatementModeRequired -> fmap Just . contentField $ setTooltip MsgExamAuthorshipStatementRequiredDisabledOnTip + SchoolAuthorshipStatementModeRequired -> fmap Just . contentField $ setTooltip MsgExamAuthorshipStatementRequiredForcedTip _none -> pure Nothing officeSchoolsForm :: Maybe (Set SchoolId) -> AForm Handler (Set SchoolId) diff --git a/src/Handler/Sheet/Form.hs b/src/Handler/Sheet/Form.hs index 32c886c06..f5b94480e 100644 --- a/src/Handler/Sheet/Form.hs +++ b/src/Handler/Sheet/Form.hs @@ -108,27 +108,28 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS <* aformSection MsgSheetAuthorshipStatementSection -- TODO: add info: applies to exam-unrelated sheets and overrides exam definition 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 - ( areq htmlField - (fslI MsgSheetAuthorshipStatementContent) - ( - -- TODO: select correct school settings wrt. exam-related/exam-unrelated - -- TODO: if school enforces school-wide statement, take school-wide statement - -- TODO: otherwise, take value from template, or take exam-wide statement if there is any, or take the school default if there is any - Nothing - ) - ) - ( fslI MsgSheetAuthorshipStatementRequired - & setTooltip MsgSheetAuthorshipStatementRequiredTip - -- TODO: set disabled attr if school mode disables or enforces statements - -- TODO: select school mode wrt. exam-related/exam-unrelated: Is this sheet related to an exam? If yes, take school exam sheet mode, otherwise take school sheet mode - ) - ( - -- TODO: if school disables/enforces statements for this sheet (exam-related/exam-unrelated?), set value accordingly - -- TODO: if this sheet is related to an exam and this exam enforces statements, set value accordingly - -- TODO: otherwise, take value from template, or `Just True` if the school has a non-empty school-wide default - Nothing - ) + <*> pure Nothing -- TODO + -- <*> optionalActionA + -- ( areq htmlField + -- (fslI MsgSheetAuthorshipStatementContent) + -- ( + -- -- TODO: select correct school settings wrt. exam-related/exam-unrelated + -- -- TODO: if school enforces school-wide statement, take school-wide statement + -- -- TODO: otherwise, take value from template, or take exam-wide statement if there is any, or take the school default if there is any + -- (fromMaybe mempty $ sfAuthorshipStatement <$> template <|> (Just . authorshipStatementDefinitionContent . entityVal) <$> mSchoolAuthorshipStatement) + -- ) + -- ) + -- ( fslI MsgSheetAuthorshipStatementRequired + -- & setTooltip MsgSheetAuthorshipStatementRequiredTip + -- -- TODO: set disabled attr if school mode disables or enforces statements + -- -- TODO: select school mode wrt. exam-related/exam-unrelated: Is this sheet related to an exam? If yes, take school exam sheet mode, otherwise take school sheet mode + -- ) + -- ( + -- -- TODO: if school disables/enforces statements for this sheet (exam-related/exam-unrelated?), set value accordingly + -- -- TODO: if this sheet is related to an exam and this exam enforces statements, set value accordingly + -- -- TODO: otherwise, take value from template, or `Just True` if the school has a non-empty school-wide default + -- (is _Just . sfAuthorshipStatement <$> template) + -- ) where makeSheetPersonalisedFilesForm :: Maybe SheetPersonalisedFilesForm -> MForm Handler (AForm Handler SheetPersonalisedFilesForm) makeSheetPersonalisedFilesForm template' = do From 7192cb527c7f66c320308a80de9906a6edc6e9ec Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Sat, 19 Jun 2021 12:31:14 +0200 Subject: [PATCH 076/120] fix(sheets): fixhance sheet authship form section --- .../categories/courses/sheet/de-de-formal.msg | 1 + .../categories/courses/sheet/en-eu.msg | 1 + src/Handler/Sheet/Form.hs | 49 +++++++++---------- 3 files changed, 25 insertions(+), 26 deletions(-) diff --git a/messages/uniworx/categories/courses/sheet/de-de-formal.msg b/messages/uniworx/categories/courses/sheet/de-de-formal.msg index e7a8b11a6..ff8357d8f 100644 --- a/messages/uniworx/categories/courses/sheet/de-de-formal.msg +++ b/messages/uniworx/categories/courses/sheet/de-de-formal.msg @@ -157,4 +157,5 @@ SheetAuthorshipStatementRequired: Eigenständigkeitserklärung für Übungsblatt SheetAuthorshipStatementRequiredTip: Sollen die Abgebenden (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren? SheetAuthorshipStatementRequiredForcedTip: Für dieses Institut sind Eigenständigkeitserklärungen für nicht-prüfungszugehörige Übungsblätter vorgeschrieben. SheetAuthorshipStatementContent: Eigenständigkeitserklärung +SheetAuthorshipStatementContentForcedTip: Für dieses Institut ist die institutsweit vorgegebene Eigenständigkeitserklärung für nicht-prüfungszugehörige Übungsblätter zu verwenden. Benutzerdefinierte Erklärungen sind nicht gestattet. SheetAuthorshipStatementContentOverridesExamTip: Gehört dieses Übungsblatt zu einer Prüfung mit einer prüfungsweit eingestellten Eigenständigkeitserklärung, so können Sie hier eine für dieses Übungsblatt abweichende Eigenständigkeitserklärung angeben. diff --git a/messages/uniworx/categories/courses/sheet/en-eu.msg b/messages/uniworx/categories/courses/sheet/en-eu.msg index d72478c60..aec230fd4 100644 --- a/messages/uniworx/categories/courses/sheet/en-eu.msg +++ b/messages/uniworx/categories/courses/sheet/en-eu.msg @@ -156,4 +156,5 @@ SheetAuthorshipStatementRequired: Require Statement of Authorship for submission SheetAuthorshipStatementRequiredTip: Should submittors (each group member in case of submission groups) be required to accept a Statement of Authorship? SheetAuthorshipStatementRequiredForcedTip: This school enforces Statements of Authorship for all exam-unrelated exercise sheets. SheetAuthorshipStatementContent: Statement of Authorship +SheetAuthorshipStatementContentForcedTip: The settings of this school dictate that the school-wide Statement of Authorship for exam-unrelated sheets must be used. Custom statements are prohibited. SheetAuthorshipStatementContentOverridesExamTip: If this exercise sheet is related to an exam with an exam-wide Statement of Authorship set, a sheet-specific adaptation can be given here. diff --git a/src/Handler/Sheet/Form.hs b/src/Handler/Sheet/Form.hs index f5b94480e..28fac1d1f 100644 --- a/src/Handler/Sheet/Form.hs +++ b/src/Handler/Sheet/Form.hs @@ -66,7 +66,7 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS (Just sId) -> liftHandler $ runDB $ getFtIdMap sId MsgRenderer mr <- getMsgRenderer ctime <- ceilingQuarterHour <$> liftIO getCurrentTime - ((_school, _mSchoolAuthorshipStatement), _course) <- liftHandler . runDB $ do + ((School{..}, mSchoolAuthorshipStatement), _course) <- liftHandler . runDB $ do course@Course{courseSchool} <- get404 cId school@School{..} <- get404 courseSchool mSchoolAuthorshipStatement <- runMaybeT $ do @@ -105,31 +105,28 @@ 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 MsgSheetAuthorshipStatementSection - -- TODO: add info: applies to exam-unrelated sheets and overrides exam definition 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) - <*> pure Nothing -- TODO - -- <*> optionalActionA - -- ( areq htmlField - -- (fslI MsgSheetAuthorshipStatementContent) - -- ( - -- -- TODO: select correct school settings wrt. exam-related/exam-unrelated - -- -- TODO: if school enforces school-wide statement, take school-wide statement - -- -- TODO: otherwise, take value from template, or take exam-wide statement if there is any, or take the school default if there is any - -- (fromMaybe mempty $ sfAuthorshipStatement <$> template <|> (Just . authorshipStatementDefinitionContent . entityVal) <$> mSchoolAuthorshipStatement) - -- ) - -- ) - -- ( fslI MsgSheetAuthorshipStatementRequired - -- & setTooltip MsgSheetAuthorshipStatementRequiredTip - -- -- TODO: set disabled attr if school mode disables or enforces statements - -- -- TODO: select school mode wrt. exam-related/exam-unrelated: Is this sheet related to an exam? If yes, take school exam sheet mode, otherwise take school sheet mode - -- ) - -- ( - -- -- TODO: if school disables/enforces statements for this sheet (exam-related/exam-unrelated?), set value accordingly - -- -- TODO: if this sheet is related to an exam and this exam enforces statements, set value accordingly - -- -- TODO: otherwise, take value from template, or `Just True` if the school has a non-empty school-wide default - -- (is _Just . sfAuthorshipStatement <$> template) - -- ) + -- TODO: add info: define exam-unrelated/related, if exam-unrelated: applies to sheet, if exam-related: overrides exam-wide authship statement settings + -- TODO: compare versions of current school statement and template statement: school > template if school statement is newer than template statement, template > school otherwise (TODO: add lastEdited to models?) + <*> let + reqContentField :: (FieldSettings UniWorX -> FieldSettings UniWorX) -> AForm Handler StoredMarkup + reqContentField ttip = areq htmlField + (fslI MsgSheetAuthorshipStatementContent & ttip) + ( (join $ sfAuthorshipStatement <$> template) + <|> (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement) + ) + forcedContentField = aforced htmlField + (fslI MsgSheetAuthorshipStatementContent & setTooltip MsgSheetAuthorshipStatementContentForcedTip) + (maybe mempty (authorshipStatementDefinitionContent . entityVal) mSchoolAuthorshipStatement) + contentField ttipReq = bool forcedContentField (reqContentField ttipReq) schoolSheetAuthorshipStatementAllowOther + in case schoolSheetAuthorshipStatementMode of + SchoolAuthorshipStatementModeNone -> pure Nothing -- suppress display of whole section incl. header + otherMode -> aformSection MsgSheetAuthorshipStatementSection + *> case otherMode of + SchoolAuthorshipStatementModeOptional -> optionalActionA (contentField id) + (fslI MsgSheetAuthorshipStatementRequired & setTooltip MsgSheetAuthorshipStatementRequiredTip) + (is _Just . sfAuthorshipStatement <$> template) + SchoolAuthorshipStatementModeRequired -> fmap Just . contentField $ setTooltip MsgSheetAuthorshipStatementRequiredForcedTip + _none -> pure Nothing where makeSheetPersonalisedFilesForm :: Maybe SheetPersonalisedFilesForm -> MForm Handler (AForm Handler SheetPersonalisedFilesForm) makeSheetPersonalisedFilesForm template' = do From 09a1c829bd9fd6b42b3f7616a903280b08ed01af Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Sat, 19 Jun 2021 12:58:55 +0200 Subject: [PATCH 077/120] refactor(sheets): remove obsolete form validation TODOs --- src/Handler/Sheet/Form.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/Handler/Sheet/Form.hs b/src/Handler/Sheet/Form.hs index 28fac1d1f..7de3e713e 100644 --- a/src/Handler/Sheet/Form.hs +++ b/src/Handler/Sheet/Form.hs @@ -185,10 +185,6 @@ 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?), 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 currentRoute <- fromMaybe (error "correctorForm called from 404-handler") <$> liftHandler getCurrentRoute From a9fe7487a63eb321f1039f39cfb1a7daa028c519 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Wed, 7 Jul 2021 11:33:14 +0200 Subject: [PATCH 078/120] chore: fix tests --- src/Handler/Exam/Edit.hs | 2 +- src/Handler/Exam/Form.hs | 2 +- src/Handler/Sheet/Form.hs | 2 +- src/Model/Types/School.hs | 2 +- test/Model/TypesSpec.hs | 5 +++++ test/ModelSpec.hs | 9 ++++++++- 6 files changed, 17 insertions(+), 5 deletions(-) diff --git a/src/Handler/Exam/Edit.hs b/src/Handler/Exam/Edit.hs index cc00bbc35..774913d5f 100644 --- a/src/Handler/Exam/Edit.hs +++ b/src/Handler/Exam/Edit.hs @@ -51,7 +51,7 @@ postEEditR tid ssh csh examn = do | Just (Entity previousStatementId _) <- mPreviousStatement -> update previousStatementId [ AuthorshipStatementDefinitionContent =. newStatementContent ] >> return (Just previousStatementId) | otherwise - -> fmap Just $ insert AuthorshipStatementDefinition { authorshipStatementDefinitionContent = newStatementContent } + -> Just <$> insert AuthorshipStatementDefinition { authorshipStatementDefinitionContent = newStatementContent } insertRes <- myReplaceUnique eId Exam { examCourse = cid diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index fc1b3f020..40796dad0 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -151,7 +151,7 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do reqContentField :: (FieldSettings UniWorX -> FieldSettings UniWorX) -> AForm Handler StoredMarkup reqContentField ttip = areq htmlField (fslI MsgExamAuthorshipStatementContent & ttip) - ( (join $ efAuthorshipStatement <$> template) + ( (efAuthorshipStatement =<< template) <|> (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement) ) forcedContentField = aforced htmlField diff --git a/src/Handler/Sheet/Form.hs b/src/Handler/Sheet/Form.hs index 7de3e713e..7c7dd5b00 100644 --- a/src/Handler/Sheet/Form.hs +++ b/src/Handler/Sheet/Form.hs @@ -111,7 +111,7 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS reqContentField :: (FieldSettings UniWorX -> FieldSettings UniWorX) -> AForm Handler StoredMarkup reqContentField ttip = areq htmlField (fslI MsgSheetAuthorshipStatementContent & ttip) - ( (join $ sfAuthorshipStatement <$> template) + ( (sfAuthorshipStatement =<< template) <|> (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement) ) forcedContentField = aforced htmlField diff --git a/src/Model/Types/School.hs b/src/Model/Types/School.hs index bb739f563..fe9b43e5b 100644 --- a/src/Model/Types/School.hs +++ b/src/Model/Types/School.hs @@ -25,7 +25,7 @@ data SchoolAuthorshipStatementMode deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable) deriving anyclass (Universe, Finite, NFData) -nullaryPathPiece ''SchoolAuthorshipStatementMode $ camelToPathPiece' 4 +finitePathPiece ''SchoolAuthorshipStatementMode [ "no-statement", "optional", "required" ] pathPieceJSON ''SchoolAuthorshipStatementMode pathPieceJSONKey ''SchoolAuthorshipStatementMode derivePersistFieldPathPiece ''SchoolAuthorshipStatementMode diff --git a/test/Model/TypesSpec.hs b/test/Model/TypesSpec.hs index e7b88713f..251b9adf3 100644 --- a/test/Model/TypesSpec.hs +++ b/test/Model/TypesSpec.hs @@ -340,6 +340,9 @@ instance Arbitrary UploadNonce where arbitrary = pure $ unsafePerformIO newUploadNonce +instance Arbitrary SchoolAuthorshipStatementMode where + arbitrary = genericArbitrary + spec :: Spec spec = do @@ -448,6 +451,8 @@ spec = do [ eqLaws, ordLaws, showLaws, showReadLaws, pathPieceLaws, jsonLaws, persistFieldLaws, binaryLaws ] lawsCheckHspec (Proxy @UploadNonce) [ eqLaws, ordLaws, showLaws, showReadLaws, pathPieceLaws, jsonLaws, jsonKeyLaws, persistFieldLaws ] + lawsCheckHspec (Proxy @SchoolAuthorshipStatementMode) + [ eqLaws, ordLaws, showLaws, showReadLaws, boundedEnumLaws, finiteLaws, pathPieceLaws, jsonLaws, jsonKeyLaws, persistFieldLaws, binaryLaws ] describe "TermIdentifier" $ do it "has compatible encoding/decoding to/from Text" . property $ diff --git a/test/ModelSpec.hs b/test/ModelSpec.hs index b0adbaaec..f99b1298b 100644 --- a/test/ModelSpec.hs +++ b/test/ModelSpec.hs @@ -68,8 +68,9 @@ instance Arbitrary Sheet where <*> arbitrary <*> arbitrary <*> arbitrary - <*> return Nothing + <*> pure Nothing <*> arbitrary + <*> pure Nothing shrink = genericShrink instance Arbitrary Tutorial where @@ -164,6 +165,12 @@ instance Arbitrary School where schoolExamRequireModeForRegistration <- arbitrary schoolExamDiscouragedModes <- arbitrary schoolExamCloseMode <- arbitrary + schoolSheetAuthorshipStatementMode <- arbitrary + let schoolSheetAuthorshipStatementDefinition = Nothing + schoolSheetAuthorshipStatementAllowOther <- arbitrary + schoolSheetExamAuthorshipStatementMode <- arbitrary + let schoolSheetExamAuthorshipStatementDefinition = Nothing + schoolSheetExamAuthorshipStatementAllowOther <- arbitrary return School{..} instance Arbitrary Term where From 2d95f353c1209a4d3528c6aaf53c832bf5429a34 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 8 Jul 2021 15:36:47 +0200 Subject: [PATCH 079/120] feat: i18n form --- frontend/src/app.sass | 22 +++ .../utils/handler_form/de-de-formal.msg | 3 + messages/uniworx/utils/handler_form/en-eu.msg | 3 + src/Foundation/I18n.hs | 8 +- src/Foundation/Navigation.hs | 2 +- src/Handler/Admin/Test.hs | 31 +++- src/Handler/Course/Edit.hs | 7 +- src/Handler/Sheet/Form.hs | 9 +- src/Handler/Submission/Helper.hs | 3 +- src/Handler/Utils/Communication.hs | 4 +- src/Handler/Utils/Form.hs | 158 ++++++++++++++++- src/Handler/Utils/Form/MassInput.hs | 167 +++++++++--------- src/Handler/Utils/Workflow/EdgeForm.hs | 3 +- src/Model/Types/Markup.hs | 3 + src/Utils.hs | 3 + templates/widgets/i18n-form/add.hamlet | 12 ++ templates/widgets/i18n-form/cell.hamlet | 4 + templates/widgets/i18n-form/layout.hamlet | 25 +++ .../widgets/occurrence/form/except-add.hamlet | 2 +- .../occurrence/form/except-layout.hamlet | 2 +- .../occurrence/form/scheduled-add.hamlet | 2 +- .../occurrence/form/scheduled-layout.hamlet | 2 +- 22 files changed, 366 insertions(+), 109 deletions(-) create mode 100644 messages/uniworx/utils/handler_form/de-de-formal.msg create mode 100644 messages/uniworx/utils/handler_form/en-eu.msg create mode 100644 templates/widgets/i18n-form/add.hamlet create mode 100644 templates/widgets/i18n-form/cell.hamlet create mode 100644 templates/widgets/i18n-form/layout.hamlet diff --git a/frontend/src/app.sass b/frontend/src/app.sass index 017d9d98a..f63bea3b0 100644 --- a/frontend/src/app.sass +++ b/frontend/src/app.sass @@ -390,6 +390,12 @@ input[type="button"].btn-info:not(.btn-link):hover, padding-right: 10px max-width: 300px + &.table__td--unlimited + max-width: unset + + &.table__td--wide + max-width: 600px + .table__td--number width: min-content padding-left: 0 @@ -412,6 +418,12 @@ input[type="button"].btn-info:not(.btn-link):hover, line-height: 1.4 vertical-align: top + &.table__td--bottom + vertical-align: bottom + + &.table__td--middle + vertical-align: middle + .table__td--automatic font-style: oblique color: var(--color-fontsec) @@ -465,6 +477,10 @@ input[type="button"].btn-info:not(.btn-link):hover, max-height: 200px overflow-y: auto + .table__td--unlimited &, .table__td--wide & + max-height: unset + overflow-y: unset + .table--vertical th, .table__th background-color: transparent @@ -1675,3 +1691,9 @@ video & > video object-fit: contain flex-grow: 1 + +.hr + height: 1px + width: 90% + margin: 0.5em auto + background-color: var(--color-grey) diff --git a/messages/uniworx/utils/handler_form/de-de-formal.msg b/messages/uniworx/utils/handler_form/de-de-formal.msg new file mode 100644 index 000000000..bd586dfa1 --- /dev/null +++ b/messages/uniworx/utils/handler_form/de-de-formal.msg @@ -0,0 +1,3 @@ +I18nFormNoTranslations: (Noch) keine Übersetzungen +I18nFormLanguageAlreadyExists lang@Lang: Die Sprache „#{lang}“ wurde bereits hinzugefügt. +I18nFormLanguage: Sprache \ No newline at end of file diff --git a/messages/uniworx/utils/handler_form/en-eu.msg b/messages/uniworx/utils/handler_form/en-eu.msg new file mode 100644 index 000000000..bc55d9f2b --- /dev/null +++ b/messages/uniworx/utils/handler_form/en-eu.msg @@ -0,0 +1,3 @@ +I18nFormLanguageAlreadyExists lang: Language “#{lang}” was already added. +I18nFormLanguage: Language +I18nFormNoTranslations: No translations (yet) diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs index 17f4d418b..c13fd25d1 100644 --- a/src/Foundation/I18n.hs +++ b/src/Foundation/I18n.hs @@ -232,17 +232,19 @@ instance RenderMessage UniWorX Load where Load { byTutorial = Just True , byProportion = p } -> MsgCorByProportionIncludingTutorial p Load { byTutorial = Just False, byProportion = p } -> MsgCorByProportionExcludingTutorial p -newtype MsgLanguage = MsgLanguage Lang +data MsgLanguage = MsgLanguage { unMsgLanguage :: Lang } | MsgLanguageEndonym { unMsgLanguage :: Lang } deriving stock (Eq, Ord, Show, Read) instance RenderMessage UniWorX MsgLanguage where - renderMessage foundation ls (MsgLanguage lang@(map mk . Text.splitOn "-" -> lang')) + renderMessage foundation ls msg@(unMsgLanguage -> lang@(map mk . Text.splitOn "-" -> lang')) | ("de" : "DE" : _) <- lang' = mr MsgGermanGermany | ("de" : _) <- lang' = mr MsgGerman | ("en" : "EU" : _) <- lang' = mr MsgEnglishEurope | ("en" : _) <- lang' = mr MsgEnglish | otherwise = lang where - mr = renderMessage foundation $ lang : filter (/= lang) ls + mr = renderMessage foundation $ case msg of + MsgLanguageEndonym _ -> lang : filter (/= lang) ls + MsgLanguage _ -> ls appLanguagesOpts :: ( MonadHandler m , RenderMessage (HandlerSite m) MsgLanguage diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 3f2f77b37..bb4baad68 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -619,7 +619,7 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the activeLang <- selectLanguage appLanguages let navChildren = flip map (toList appLanguages) $ \lang -> NavLink - { navLabel = MsgLanguage lang + { navLabel = MsgLanguageEndonym lang , navRoute = (LangR, [(toPathPiece GetReferer, toPathPiece currentRoute) | currentRoute <- hoistMaybe mCurrentRoute ]) , navAccess' = NavAccessTrue , navType = NavTypeButton diff --git a/src/Handler/Admin/Test.hs b/src/Handler/Admin/Test.hs index 2de4ec9f2..ac62ab491 100644 --- a/src/Handler/Admin/Test.hs +++ b/src/Handler/Admin/Test.hs @@ -149,15 +149,16 @@ postAdminTestR = do -- This /needs/ to replace all occurrences of @mreq@ with @mpreq@ (no fields should be /actually/ required) mkAddForm :: ListPosition -- ^ Approximate position of the add-widget -> Natural -- ^ Dimension Index, outermost dimension ist 0 i.e. if dimension is 3 hyperplane-adders get passed 0, planes get passed 1, lines get 2, and points get 3 + -> ListLength -- ^ Previous shape of massinput -> (Text -> Text) -- ^ Nudge deterministic field ids so they're unique -> FieldView UniWorX -- ^ Submit-Button for this add-widget -> Maybe (Form (Map ListPosition Int -> FormResult (Map ListPosition Int))) -- ^ Nothing iff adding further cells in this position/dimension makes no sense; returns callback to determine index of new cells and data needed to initialize cells - mkAddForm 0 0 nudge submitBtn = Just $ \csrf -> do + mkAddForm 0 0 liveliness nudge submitBtn = guardOn (allowAdd 0 0 liveliness) $ \csrf -> do (addRes, addView) <- mpreq textField ("" & addName (nudge "text")) Nothing -- Any old field; for demonstration let addRes' = fromMaybe 0 . readMay . Text.filter isDigit <$> addRes -- Do something semi-interesting on the result of the @textField@ to demonstrate that further processing can be done addRes'' = addRes' <&> \dat prev -> FormSuccess (Map.singleton (maybe 0 (succ . fst) $ Map.lookupMax prev) dat) -- Construct the callback to determine new cell positions and data within @FormResult@ as required, nested @FormResult@ allows aborting the add depending on previous data return (addRes'', toWidget csrf >> fvWidget addView >> fvWidget submitBtn) - mkAddForm _pos _dim _ _ = error "Dimension and Position is always 0 for our 1-dimensional form" + mkAddForm _pos _dim _ _ _ = error "Dimension and Position is always 0 for our 1-dimensional form" -- | Make a single massInput-Cell -- @@ -184,8 +185,9 @@ postAdminTestR = do -- The actual call to @massInput@ is comparatively simple: - ((miResult, fvWidget -> miForm), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell allowAdd (\_ _ _ -> Set.empty) buttonAction defaultMiLayout ("massinput" :: Text)) "" True Nothing + ((miResult, fvWidget -> miForm), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell (\_ _ _ -> Set.empty) buttonAction defaultMiLayout ("massinput" :: Text)) "" True Nothing + ((i18nResult, fvWidget -> i18nWidget), i18nEnc) <- runFormPost . identifyForm ("i18n-stored-markup" :: Text) $ i18nField htmlField True (\_ -> Nothing) ("i18n-stored-markup" :: Text) "" True Nothing testDownloadWidget <- testDownload @@ -228,6 +230,29 @@ postAdminTestR = do

    #{tshow res} |] + + i18nIdent <- newIdent + let i18nForm' = wrapForm i18nWidget FormSettings + { formMethod = POST + , formAction = Just . SomeRoute $ AdminTestR :#: i18nIdent + , formEncoding = i18nEnc + , formAttrs = [] + , formSubmit = FormSubmit + , formAnchor = Just i18nIdent + } + [whamlet| +

    I18n-Form + ^{i18nForm'} + $case i18nResult + $of FormMissing + $of FormFailure errs +