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

fix(course): WIP course cloning should propose same associated qualifications, towards #149

Browse Source
This commit is contained in:
Steffen Jost 2024-07-31 19:03:30 +02:00
parent 0fde59c19a
commit bc47387c91
1 changed files with 16 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/Handler/Course/Edit.hs
View File

@ -46,12 +46,13 @@ data CourseForm = CourseForm
, cfRegTo :: Maybe UTCTime
, cfDeRegUntil :: Maybe UTCTime
, cfLecturers :: [Either (UserEmail, Maybe LecturerType) (UserId, LecturerType)]
, cfQualis :: [(QualificationId, Int)]
}
makeLenses_ ''CourseForm
courseToForm :: Entity Course -> [Lecturer] -> Map UserEmail (InvitationDBData Lecturer) -> CourseForm
courseToForm (Entity cid Course{..}) lecs lecInvites = CourseForm
courseToForm :: Entity Course -> [Lecturer] -> Map UserEmail (InvitationDBData Lecturer) -> [CourseQualification] -> CourseForm
courseToForm (Entity cid Course{..}) lecs lecInvites qualis = CourseForm
{ cfCourseId = Just cid
, cfName = courseName
, cfDesc = courseDescription
@ -69,6 +70,9 @@ courseToForm (Entity cid Course{..}) lecs lecInvites = CourseForm
, cfDeRegUntil = courseDeregisterUntil
, cfLecturers = [Right (lecturerUser, lecturerType) | Lecturer{..} <- lecs]
++ [Left (email, mType) | (email, InvDBDataLecturer mType) <- Map.toList lecInvites ]
-- TODO: Filterung nach aktueller Schule, da ansonsten ein Sicherheitleck droht! Siehe #150
, cfQualis = [ (courseQualificationQualification, courseQualificationSortOrder)
| CourseQualification{..} <- qualis, courseQualificationCourse == cid ]
}
@ -91,7 +95,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
(termsField, userTerms) <- liftHandler $ case template of
-- Change of term is only allowed if user may delete the course (i.e. no participants) or admin
(Just cform) | (Just cid) <- cfCourseId cform -> do -- edit existing course
(Just cform) | (Just cid) <- cfCourseId cform -> do -- edit existing course& \c
_courseOld@Course{..} <- runDB $ get404 cid
mayEditTerm <- isAuthorized TermEditR True
mayDelete <- isAuthorized (CourseR courseTerm courseSchool courseShorthand CDeleteR) True
@ -208,6 +212,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
& setTooltip MsgCourseDeregisterUntilTip) (deepAlt (cfDeRegUntil <$> template) newDeRegUntil)
<* aformSection MsgCourseFormSectionAdministration
<*> lecturerForm
<*> pure mempty -- TODO: continue here !!! -- TODO: Filterung nach aktueller Schule, da ansonsten ein Sicherheitleck droht! Siehe #150
return (result, widget)
@ -280,8 +285,11 @@ getCourseNewR = do
E.limit 1
return course
template <- case oldCourses of
(oldTemplate:_) ->
let newTemplate = courseToForm oldTemplate mempty mempty in
(oldTemplate:_) -> runDB $ do
mbLecs <- oldTemplate & \course -> map entityVal <$> selectList [LecturerCourse ==. entityKey course] [Asc LecturerType]
mbLecInvites <- oldTemplate & sourceInvitationsF . entityKey
mbQualis <- oldTemplate & \course -> map entityVal <$> selectList [CourseQualificationCourse ==. entityKey course] [Asc CourseQualificationSortOrder]
let newTemplate = courseToForm oldTemplate mbLecs mbLecInvites mbQualis
return $ Just $ newTemplate
{ cfCourseId = Nothing
, cfTerm = TermKey $ termFromRational 0 -- invalid, will be ignored; undefined won't work due to strictness
@ -314,10 +322,11 @@ pgCEditR tid ssh csh = do
mbCourse <- getBy (TermSchoolCourseShort tid ssh csh)
mbLecs <- for mbCourse $ \course -> map entityVal <$> selectList [LecturerCourse ==. entityKey course] [Asc LecturerType]
mbLecInvites <- for mbCourse $ sourceInvitationsF . entityKey
return $ (,,) <$> mbCourse <*> mbLecs <*> mbLecInvites
mbQualis <- for mbCourse $ \course -> map entityVal <$> selectList [CourseQualificationCourse ==. entityKey course] [Asc CourseQualificationSortOrder]
return $ (,,,) <$> mbCourse <*> mbLecs <*> mbLecInvites <*> mbQualis
-- IMPORTANT: both GET and POST Handler must use the same template,
-- since an Edit is identified via CourseID, which is not embedded in the received form data for security reasons.
courseEditHandler (\p -> Just . SomeRoute $ CourseR tid ssh csh CEditR :#: p) $ $(uncurryN 3) courseToForm <$> courseData
courseEditHandler (\p -> Just . SomeRoute $ CourseR tid ssh csh CEditR :#: p) $ $(uncurryN 4) courseToForm <$> courseData
-- | Course Creation and Editing