From da39b05627058a1472929b46ae1c2adb0b1fe2c9 Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
Date: Wed, 26 Jan 2022 00:43:57 +0100
Subject: [PATCH] fix(labels): implement label deletion on ProfileR

---
 src/Handler/Profile.hs | 29 ++++++++++++++---------------
 1 file changed, 14 insertions(+), 15 deletions(-)

diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs
index 06c297d38..99b06a835 100644
--- a/src/Handler/Profile.hs
+++ b/src/Handler/Profile.hs
@@ -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