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

chore(tutorial): add separate exam occurrence edit page (WIP)

Browse Source
This commit is contained in:
Steffen Jost 2025-01-14 18:28:31 +01:00 committed by Sarah Vaupel
parent 50c7d18b53
commit 5e41c2073f
9 changed files with 70 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
messages/uniworx/utils/navigation/menu/de-de-formal.msg
View File

@ -33,6 +33,7 @@ MenuCourseIcon: Kurse
MenuCourseMembers: Kursartteilnehmer:innen
MenuCourseAddMembers: Kursartteilnehmer:innen hinzufügen
MenuTutorialAddMembers: Kursteilnehmer:innen hinzufügen
MenuTutorialExam exn@ExamName: Kursprüfung #{exn} bearbeiten
MenuCourseCommunication: Kursartmitteilung (E‑Mail)
MenuCourseExamOffice: Prüfungsbeauftragte
MenuTermShow: Jahr

1
messages/uniworx/utils/navigation/menu/en-eu.msg
View File

@ -33,6 +33,7 @@ MenuCourseIcon: Courses
MenuCourseMembers: Participants
MenuCourseAddMembers: Add course type participants
MenuTutorialAddMembers: Add course participants
MenuTutorialExam exn@ExamName: Edit course exam #{exn}
MenuCourseCommunication: Course type message (email)
MenuCourseExamOffice: Exam offices
MenuTermShow: Semesters

1
routes
View File

@ -228,6 +228,7 @@
/delete TDeleteR GET POST
/participants TUsersR GET POST !tutor
/participants/add TAddUserR GET POST !tutor
/participants/exam/#ExamName TExamR GET POST !tutor
/register TRegisterR POST !timeANDcapacityANDcourse-registeredANDregister-group !timeANDtutorial-registered
/communication TCommR GET POST !tutor
/tutor-invite TInviteR GET POST !tutorANDtutor-control

1
src/Foundation/Navigation.hs
View File

@ -306,6 +306,7 @@ breadcrumb (CourseR tid ssh csh (TutorialR tutn sRoute)) = case sRoute of
guardM . lift . hasReadAccessTo $ CTutorialR tid ssh csh tutn TUsersR
return (CI.original tutn, Just $ CourseR tid ssh csh CTutorialListR)
TAddUserR -> i18nCrumb MsgMenuTutorialAddMembers . Just $ CTutorialR tid ssh csh tutn TUsersR
TExamR exn -> i18nCrumb (MsgMenuTutorialExam exn) . Just $ CTutorialR tid ssh csh tutn TUsersR
TEditR -> i18nCrumb MsgMenuTutorialEdit . Just $ CTutorialR tid ssh csh tutn TUsersR
TDeleteR -> i18nCrumb MsgMenuTutorialDelete . Just $ CTutorialR tid ssh csh tutn TUsersR
TCommR -> i18nCrumb MsgMenuTutorialComm . Just $ CTutorialR tid ssh csh tutn TUsersR

2
src/Handler/Exam/Edit.hs
View File

@ -75,7 +75,7 @@ postEEditR tid ssh csh examn = do
occIds <- fmap catMaybes . forM (Set.toList efOccurrences) $ traverse decrypt . eofId
deleteWhere [ ExamOccurrenceExam ==. eId, ExamOccurrenceId /<-. occIds ]
upsertExamOccurrences eId $ Set.toList efOccurrences
void $ upsertExamOccurrences eId $ Set.toList efOccurrences
pIds <- fmap catMaybes . forM (Set.toList efExamParts) $ traverse decrypt . epfId

18
src/Handler/Exam/Form.hs
View File

@ -350,6 +350,7 @@ copyExamOccurrences eId dfrom dto = do
_examOccurrenceEnd . _Just . _utctDay %~ shiftDay $ eo
newName <- maybeM (guessExamOccurrenceName eId $ examOccurrenceTemplate eo') return $ return (fmap CI.mk $ textReplaceFirst drepl $ CI.original oldName)
insertUnique_ (eo'{examOccurrenceName=newName})
memcachedInvalidateClass MemcachedKeyClassExamOccurrences
return $ length $ catMaybes res
-- | generate an exam-unique occurrence name from data
@ -402,15 +403,15 @@ guessExamOccurrenceName eId ExamOccurrenceForm{..} = do
-- upsertExamOccurrences :: (MonoFoldable mono, Element mono ~ ExamOccurrenceForm) => ExamId -> mono -> DB () -- too specific
upsertExamOccurrences :: ( MonoFoldable mono, Element mono ~ ExamOccurrenceForm, HandlerSite m ~ UniWorX, MonadHandler m, MonadThrow m
, PersistQueryRead backend, PersistUniqueRead backend, PersistStoreWrite backend
upsertExamOccurrences :: ( HandlerSite m ~ UniWorX, MonadHandler m, MonadThrow m
, PersistQueryRead backend, PersistUniqueWrite backend
, BaseBackend backend ~ SqlBackend, BackendCompatible SqlBackend backend)
=> Key Exam -> mono -> ReaderT backend m ()
upsertExamOccurrences eId = mapM_ $ \case
=> Key Exam -> [ExamOccurrenceForm] -> ReaderT backend m Int
upsertExamOccurrences eId = fmap (length . catMaybes) . mapM (\case
eof@ExamOccurrenceForm{ eofId = Nothing, eofName = eofNameMb, .. } -> do
eofName <- fromMaybeM (guessExamOccurrenceName eId eof) (pure eofNameMb)
$logInfoS "ExamOccurrenceForm" [st|New Exam Occurrence: #{eofName}|]
insert_ ExamOccurrence
insertUnique_ ExamOccurrence
{ examOccurrenceExam = eId
, examOccurrenceName = eofName
, examOccurrenceExaminer = eofExaminer
@ -421,14 +422,14 @@ upsertExamOccurrences eId = mapM_ $ \case
, examOccurrenceEnd = eofEnd
, examOccurrenceDescription = eofDescription
}
eof@ExamOccurrenceForm{eofName = eofNameMb, .. } -> void . runMaybeT $ do
eof@ExamOccurrenceForm{eofName = eofNameMb, .. } -> fmap join $ runMaybeT $ do
cID <- hoistMaybe eofId
eofId' <- decrypt cID
oldOcc <- MaybeT $ get eofId'
guard $ examOccurrenceExam oldOcc == eId
lift $ do
eofName <- fromMaybeM (guessExamOccurrenceName eId eof) (pure eofNameMb)
replace eofId' ExamOccurrence
res <- replaceUnique eofId' ExamOccurrence
{ examOccurrenceExam = eId
, examOccurrenceName = eofName
, examOccurrenceExaminer = eofExaminer
@ -439,6 +440,9 @@ upsertExamOccurrences eId = mapM_ $ \case
, examOccurrenceEnd = eofEnd
, examOccurrenceDescription = eofDescription
}
memcachedInvalidateClass MemcachedKeyClassExamOccurrences
return $ flipMaybe () res
)
examPartsForm :: Maybe (Set ExamPartForm) -> AForm Handler (Set ExamPartForm)
examPartsForm prev = wFormToAForm $ do

2
src/Handler/Exam/New.hs
View File

@ -70,7 +70,7 @@ postCExamNewR tid ssh csh = do
examPartWeight = epfWeight
]
upsertExamOccurrences examid efOccurrences
void $ upsertExamOccurrences examid $ Set.toList efOccurrences
insertMany_ [ ExamOfficeSchool ssh' examid | ssh' <- Set.toList efOfficeSchools ]

54
src/Handler/Tutorial/Users.hs
View File

@ -4,8 +4,11 @@
{-# LANGUAGE TypeApplications, BlockArguments #-}
{-# OPTIONS_GHC -Wno-error=unused-local-binds -Wno-error=unused-matches #-}
module Handler.Tutorial.Users
( getTUsersR, postTUsersR
, getTExamR, postTExamR
) where
import Import
@ -238,7 +241,7 @@ postTUsersR tid ssh csh tutn = do
then return $(i18nWidgetFile "exam-missing")
else do
openExamsUUIDs <- forM openExams $ \ent@Entity{entityKey=k, entityVal=Exam{examName}} -> (ent,,) <$> encrypt k <*> pure (mkExamEditBtn examName)
((gtaRes, gtaWgt), gtaEnctype) <- runFormPost . identifyForm FIDGeneralTutorialAction $ mkExamOccurrenceForm openExamsUUIDs exOccs -- TODO also TODO: occurrence name auto generation
((gtaRes, gtaWgt), gtaEnctype) <- runFormPost . identifyForm ("FIDGeneralTutorialAction"::Text) $ mkExamOccurrenceForm openExamsUUIDs exOccs -- TODO also TODO: occurrence name auto generation
let gtaAnchor = "general-tutorial-action-form" :: Text
gtaRoute = croute :#: gtaAnchor
gtaForm = wrapForm gtaWgt FormSettings
@ -257,10 +260,57 @@ postTUsersR tid ssh csh tutn = do
$logInfoS "ExamOccurrenceEdit" [st|Exam-Edit: #{length cEOIds} old occurrences, #{length eoIdsDelete} to delete, #{length $ Set.filter (isNothing . eofId) occs} to insert, #{length $ Set.filter (isJust . eofId) occs} to edit|]
runDB do
deleteWhere [ExamOccurrenceExam ==. eId, ExamOccurrenceId <-. eoIdsDelete]
upsertExamOccurrences eId $ Set.toList occs
void $ upsertExamOccurrences eId $ Set.toList occs
return gtaForm
let heading = prependCourseTitle tid ssh csh $ CI.original tutorialName
html <- siteLayoutMsg heading do
setTitleI heading
$(widgetFile "tutorial-participants")
return $ toTypedContent html
getTExamR, postTExamR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> ExamName -> Handler Html
getTExamR = postTExamR
postTExamR tid ssh csh tutn exmName = do
let baseroute = CTutorialR tid ssh csh tutn
(cid,tutEnt,Entity{entityKey=eId,entityVal=exm},exOccs) <- runDB do
trm <- get404 tid
(cid, tutEnt) <- fetchCourseIdTutorial tid ssh csh tutn
exm <- getBy404 $ UniqueExam cid exmName
let lessons = occurringLessons trm $ tutEnt ^. _entityVal . _tutorialTime . _Wrapped'
timespan = lessonTimesSpan lessons
-- (fmap (toMidnight . succ) -> tbegin, fmap toMidnight -> tend) = munzip timespan
-- exms <- selectList ([ExamCourse ==. cid, ExamStart <=. tend] ++ ([ExamEnd >=. tbegin] ||. [ExamEnd ==. Nothing])) [Asc ExamName]
exOccs <- flip foldMapM timespan $ getDayExamOccurrences False ssh $ Just cid
return (cid,tutEnt,exm,exOccs)
cueId :: CryptoUUIDExam <- encrypt eId
let eid2eos = convertExamOccurrenceMap exOccs
(cuEoIds, eos) = munzip $ Map.lookup eId eid2eos
exOcForm = (,,)
<$> areq hiddenField "" (Just cueId)
<*> areq (mkSetField hiddenField) "" cuEoIds
<*> examOccurrenceMultiForm eos
((eofRes, eofWgt), eofEnctype) <- runFormPost $ identifyForm FIDTutorialExamOccurrences $ renderAForm FormStandard exOcForm
let eofForm = wrapForm eofWgt def{formEncoding = eofEnctype}
formResult eofRes $ \(edCEId, edCEOIds, edOccs) -> do
let ceoidsDelete = edCEOIds `Set.difference` setMapMaybe eofId edOccs
$logInfoS "ExamOccurrenceEdit" [st|Exam-Edit: #{length edCEOIds} old occurrences, #{length ceoidsDelete} to delete, #{length $ Set.filter (isNothing . eofId) edOccs} to insert, #{length $ Set.filter (isJust . eofId) edOccs} to edit|]
reId <- decrypt edCEId
eoIdsDelete <- mapM decrypt $ Set.toList ceoidsDelete
when (reId == eId) $ runDB do
nrDel <- deleteWhereCount [ExamOccurrenceExam ==. reId, ExamOccurrenceId <-. eoIdsDelete]
nrUps <- upsertExamOccurrences eId $ Set.toList edOccs
--TODO status message
reload $ baseroute $ TExamR exmName
let heading = prependCourseTitle tid ssh csh $ CI.original $ tutorialName $ entityVal tutEnt
-- let heading = prependCourseTitle tid ssh csh $ tutEnt ^. _entityVal . _tutorialName . _CI
siteLayoutMsg (MsgMenuTutorialExam exmName) do
setTitle $ citext2Html exmName
[whamlet|
<section>
<h2>#{CI.original exmName}
<p>#{examDescription exm}
<section>
^{eofForm}
|]

2
src/Utils/Form.hs
View File

@ -328,7 +328,7 @@ data FormIdentifier
| FIDAddSupervisor
| FIDFirmUserChangeRequest
| FIDFirmAction
| FIDGeneralTutorialAction
| FIDTutorialExamOccurrences
| FIDUnreachableUsersAction
deriving (Eq, Ord, Read, Show)