fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

fix(labels): implement label deletion on ProfileR

Browse Source
This commit is contained in:
Sarah Vaupel 2022-01-26 00:43:57 +01:00
parent 7764265dee
commit da39b05627
1 changed files with 14 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
src/Handler/Profile.hs
View File

@ -460,7 +460,7 @@ postProfileR = do
E.&&. userSchool E.^. UserSchoolUser E.==. E.val uid
E.&&. userSchool E.^. UserSchoolSchool E.==. school E.^. SchoolId
return $ school E.^. SchoolId
userExamOfficeLabels <- fmap (foldMap $ \(Entity eolid ExamOfficeLabel{..}) -> Map.singleton (Right eolid) (examOfficeLabelName,examOfficeLabelStatus,examOfficeLabelPriority)) (selectList [ ExamOfficeLabelUser ==. uid ] [])
userExamOfficeLabels <- selectList [ ExamOfficeLabelUser ==. uid ] []
return (userSchools, userExamOfficeLabels)
allocs <- runDB $ getAllocationNotifications uid
let settingsTemplate = Just SettingsForm
@ -480,7 +480,7 @@ postProfileR = do
, stgExamOfficeSettings = ExamOfficeSettings
{ eosettingsGetSynced = userExamOfficeGetSynced
, eosettingsGetLabels = userExamOfficeGetLabels
, eosettingsLabels = userExamOfficeLabels
, eosettingsLabels = flip foldMap userExamOfficeLabels $ \(Entity eolid ExamOfficeLabel{..}) -> Map.singleton (Right eolid) (examOfficeLabelName,examOfficeLabelStatus,examOfficeLabelPriority)
}
, stgAllocationNotificationSettings = allocs
}
@ -527,8 +527,14 @@ postProfileR = do
}
[ UserSchoolIsOptOut =. True
]
-- TODO: delete labels
forM_ (Map.toList $ stgExamOfficeSettings & eosettingsLabels) $ \(eoLabelIdent, (examOfficeLabelName, examOfficeLabelStatus, examOfficeLabelPriority)) -> case eoLabelIdent of
let
oldExamLabels = userExamOfficeLabels
newExamLabels = stgExamOfficeSettings & eosettingsLabels
forM_ oldExamLabels $ \(Entity eolid ExamOfficeLabel{..}) -> unless ((Right eolid) `Map.member` newExamLabels || (Left examOfficeLabelName) `Map.member` newExamLabels) $ do
E.delete . E.from $ \examOfficeExternalExamLabel -> E.where_ $ examOfficeExternalExamLabel E.^. ExamOfficeExternalExamLabelLabel E.==. E.val eolid
E.delete . E.from $ \examOfficeExamLabel -> E.where_ $ examOfficeExamLabel E.^. ExamOfficeExamLabelLabel E.==. E.val eolid
delete eolid
forM_ (Map.toList newExamLabels) $ \(eoLabelIdent, (examOfficeLabelName, examOfficeLabelStatus, examOfficeLabelPriority)) -> case eoLabelIdent of
Left _ -> void $ upsert ExamOfficeLabel{ examOfficeLabelUser=uid, .. }
[ ExamOfficeLabelName =. examOfficeLabelName
, ExamOfficeLabelStatus =. examOfficeLabelStatus
@ -587,7 +593,6 @@ getProfileDataR = do
makeProfileData :: Entity User -> DB Widget
makeProfileData (Entity uid User{..}) = do
-- MsgRenderer mr <- getMsgRenderer
functions <- Map.fromListWith Set.union . map (\(Entity _ UserFunction{..}) -> (userFunctionFunction, Set.singleton userFunctionSchool)) <$> selectList [UserFunctionUser ==. uid] []
lecture_corrector <- E.select $ E.distinct $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
@ -619,8 +624,8 @@ makeProfileData (Entity uid User{..}) = do
-- | Table listing all courses that the given user is a lecturer for
mkOwnedCoursesTable :: UserId -> DB (Bool, Widget)
-- Table listing all courses that the given user is a lecturer for
mkOwnedCoursesTable =
let dbtIdent = "courseOwnership" :: Text
dbtStyle = def
@ -670,9 +675,8 @@ mkOwnedCoursesTable =
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid in (_1 %~ getAny) <$> dbTableWidget validator DBTable{..}
-- | Table listing all courses that the given user is enrolled in
mkEnrolledCoursesTable :: UserId -> DB Widget
-- Table listing all courses that the given user is enrolled in
mkEnrolledCoursesTable =
let withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
@ -723,9 +727,8 @@ mkEnrolledCoursesTable =
}
-- | Table listing all submissions for the given user
mkSubmissionTable :: UserId -> DB Widget
-- Table listing all submissions for the given user
mkSubmissionTable =
let dbtIdent = "submissions" :: Text
dbtStyle = def
@ -809,9 +812,8 @@ mkSubmissionTable =
-- return $ dbTableWidget' validator $ DBTable {..}
-- | Table listing all submissions for the given user
mkSubmissionGroupTable :: UserId -> DB Widget
-- Table listing all submissions for the given user
mkSubmissionGroupTable =
let dbtIdent = "subGroups" :: Text
dbtStyle = def
@ -866,13 +868,10 @@ mkSubmissionGroupTable =
in dbTableWidget' validator DBTable{..}
mkCorrectionsTable :: UserId -> DB Widget
-- Table listing sum of corrections made by the given user per sheet
mkCorrectionsTable =
let dbtIdent = "corrections" :: Text
dbtStyle = def
-- TODO Continue here
withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity SheetCorrector))->a)
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity SheetCorrector))->a)
withType = id