Merge branch 'master' into fradrive/tutorial-overhaul

messages/uniworx/categories/qualification/de-de-formal.msg

@@ -32,6 +32,7 @@ QualificationUserNoRenewal: Läuft ohne Benachrichtigung aus
 QualificationUserNone: Für diese Person sind keine Qualifikationen registriert.
 QualificationBlockReason: Entzugsbegründung
 QualificationBlockNotify: Benachrichtigung verschicken
+QualificationBlockRemoveSupervisor: Alle Ansprechpartner löschen
 QualificationExpired: Ungültig seit
 LmsUser: Inhaber
 LmsURL: Link E‑Learning
@@ -47,7 +48,7 @@ TableLmsStarted: Begonnen
 TableLmsReceived: Letzte Rückmeldung
 TableLmsNotified: Versand Benachrichtigung
 TableLmsNotifiedTooltip: Benachrichtigungen werden erst versendet wenn das LMS bestätigt die Eröffnung des E‑Learning für den Benutzer bestätigt hat, was ein paar Stunden dauern kann!
-TableLmsEnded: Beended
+TableLmsEnded: Beendet
 TableLmsStatus: Status E‑Learning
 TableLmsStatusTooltip mbMonth@(Maybe Int): Zeigt #{maybeToMessage "bis zu " (fmap (flip pluralDEeN "Monat") mbMonth) " nach Abschluss"} den letzten Zustand eines E‑Learnings an:
 TableLmsStatusDay: Datum letzte Statusänderung E‑Learning

messages/uniworx/categories/qualification/en-eu.msg

@@ -32,6 +32,7 @@ QualificationUserNoRenewal: Expires without further notification
 QualificationUserNone: No registered qualifications for this person.
 QualificationBlockReason: Reason for revoking
 QualificationBlockNotify: Send notification
+QualificationBlockRemoveSupervisor: Remove all supervisors
 QualificationExpired: Expired on
 LmsUser: Licensee
 LmsURL: Link E-learning

src/Handler/Qualification.hs

@@ -269,7 +269,7 @@ data QualificationTableActionData
   = QualificationActExpireData 
   | QualificationActUnexpireData  
   | QualificationActBlockSupervisorData
-  | QualificationActBlockData           { qualTableActBlockReason :: Text, qualTableActNotify :: Bool }
+  | QualificationActBlockData           { qualTableActBlockReason :: Text, qualTableActNotify :: Bool, qualTableActRemoveSupervisors :: Bool }
   | QualificationActUnblockData
   | QualificationActRenewData
   | QualificationActGrantData           { qualTableActGrantUntil  :: Day }   
@@ -286,6 +286,11 @@ isBlockAct QualificationActBlockData{}          = True
 isBlockAct QualificationActUnblockData          = True
 isBlockAct _ = False
 
+blockActRemoveSupervisors :: QualificationTableActionData -> Bool
+blockActRemoveSupervisors QualificationActBlockSupervisorData  = True
+blockActRemoveSupervisors QualificationActBlockData{qualTableActRemoveSupervisors=res} = res
+blockActRemoveSupervisors _ = False
+
 qualificationTableQuery :: QualificationId -> (_ -> E.SqlExpr (E.Value Bool)) -> QualificationTableExpr
   -> E.SqlQuery ( E.SqlExpr (Entity QualificationUser)
                 , E.SqlExpr (Entity User)
@@ -491,7 +496,8 @@ postQualificationR sid qsh = do
           [ singletonMap QualificationActUnblock         $ pure QualificationActUnblockData           -- Admin-only actions
           , singletonMap QualificationActBlock           $      QualificationActBlockData 
               <$> apreq textField (fslI MsgQualificationBlockReason) Nothing
-              <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgQualificationBlockNotify) (Just False)
+              <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgQualificationBlockNotify)            (Just False)
+              <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgQualificationBlockRemoveSupervisor)  (Just False)
           , singletonMap QualificationActRenew           $ pure QualificationActRenewData
           , singletonMap QualificationActGrant           $      QualificationActGrantData 
                 <$> apopt dayField (fslI MsgLmsQualificationValidUntil) dayExpiry
@@ -562,8 +568,7 @@ postQualificationR sid qsh = do
               _ -> False
           
       oks <- runDB $ do 
-        deleteWhere [UserSupervisorUser <-. selUserIds]
-        deleteWhere [UserCompanyUser    <-. selUserIds]
+        when (blockActRemoveSupervisors action) $ deleteWhere [UserSupervisorUser <-. selUserIds]
         qualificationUserBlocking qid selUserIds notify qubr
       let nrq = length selectedUsers
           warnLevel = if