chore(firm): add action to change individual supervisors

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

@@ -24,6 +24,10 @@ FirmActChangeContactFirmInfo: Firmenkontaktinformationen werden nur für neue Fi
 FirmActChangeContactFirmResult: Firmenkontaktinformationen geändert. Betrifft nur neue Firmenangehörige ohne eigene Kontaktinformationen
 FirmUserActNotify: Mitteilung versenden
 FirmUserActResetSupervision: Ansprechpartner auf Firmenstandard zurücksetzen
+FirmUserActSetSupervisor: Ansprechpartner ändern
+FirmNewSupervisor: Neue individuelle Ansprechpartner hinzufügen
+FirmSetSupervisor: Existierende Ansprechpartner hinzufügen
+FirmSetSupersReport nusr@Int64 nspr@Int64 nrem@Int64: Für #{nusr} Firmenangehörige wurden #{nspr} individuelle Ansprechpartner eingetragen#{bool "." (" und " <> tshow nrem <> " individuelle Ansprechpartnerbeziehungen gelöscht.") (nrem >0)}
 FirmUserActMkSuper: Zum Firmenansprechpartner ernennen
 FirmUserActChangeContact: Kontaktinformationen für ausgewählte Firmenangehörige ändern
 FirmResetSupervision rem@Int64 set@Int64: #{tshow set} Ansprechpartner gesetzt#{bool mempty (", " <> tshow rem <> " zuvor gelöscht") (rem > 0)}

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

@@ -24,6 +24,10 @@ FirmActChangeContactFirmInfo: The company contact data is only used for new comp
 FirmActChangeContactFirmResult: Company contact data changed, affecting future company associates without contact information only
 FirmUserActNotify: Send message
 FirmUserActResetSupervision: Reset supervisors to company default
+FirmUserActSetSupervisor: Change supervision
+FirmNewSupervisor: Appoint new individual supervisors
+FirmSetSupervisor: Add existing supervisors
+FirmSetSupersReport nusr@Int64 nspr@Int64 nrem@Int64: #{nspr} individal supervisors set for #{nusr} company associates#{bool "." (" and " <> tshow nrem <> " other individual supervisions terminated.") (nrem >0)}
 FirmResetSupervision rem set: #{tshow set} supervisors set#{bool mempty (", " <> tshow rem <> " deleted before") (rem > 0)}
 FirmUserActChangeContact: Change contact data for selected company associates
 FirmUserActMkSuper: Mark as company supervisor

messages/uniworx/categories/send/send_notifications/de-de-formal.msg

@@ -103,4 +103,4 @@ MailSupervisorNoCopy: Warnung: Diese Nachricht wurde nicht an den eigentlichen E
 MailSupervisedNote: Hinweis
 MailSupervisedBody: Eine Kopie dieser Nachricht wurde auch an folgende in FRADrive eingetragene Ansprechpartner gesendet:
 MailSupervisorReroute: Benachrichtigungsumleitung
-MailSupervisorRerouteTooltip: Alle Benachrichtigungen werden stattdessen an alle Ansprechpartner mit Benachrichtigungsumleitung gesandt
+MailSupervisorRerouteTooltip: Alle Benachrichtigungen werden stattdessen an diese Ansprechpartner mit Benachrichtigungsumleitung gesandt

messages/uniworx/categories/send/send_notifications/en-eu.msg

@@ -103,4 +103,4 @@ MailSupervisorNoCopy: Warning: This message was not sent to the original recipie
 MailSupervisedNote: Please note
 MailSupervisedBody: A copy of this message has been sent to all supervisors registered for you in FRADrive, namely:
 MailSupervisorReroute: Reroute notifications
-MailSupervisorRerouteTooltip: All notification will be sent to all supervisors with notification rerouting instead
+MailSupervisorRerouteTooltip: All notification will be rerouted to these supervisors instead

src/Handler/Firm.hs

@@ -664,6 +664,7 @@ postFirmAllR = do
 
 data FirmUserAction = FirmUserActNotify
                     | FirmUserActResetSupervision
+                    | FirmUserActSetSupervisor
                     | FirmUserActMkSuper
                     | FirmUserActChangeContact
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
@@ -672,11 +673,17 @@ data FirmUserAction = FirmUserActNotify
 nullaryPathPiece ''FirmUserAction $ camelToPathPiece' 3
 embedRenderMessage ''UniWorX ''FirmUserAction id
 
-data FirmUserActionData = FirmUserActNotifyData
+data FirmUserActionData = FirmUserActNotifyData                        
                         | FirmUserActResetSupervisionData
                             { firmUserActResetKeepOldSupers     :: Maybe Bool
                             -- , firmUserActResetMutualSupervision :: Maybe Bool
                             }
+                        | FirmUserActSetSupervisorData
+                            {  firmUserActSetSuperNames   :: Set Text
+                            ,  firmUserActSetSuperIds     :: [UserId]
+                            ,  firmUserActSetSuperReroute :: Bool
+                            ,  firmUserActSetSuperKeep    :: Bool
+                            }
                         | FirmUserActMkSuperData
                             { firmUserActMkSuperReroute   :: Maybe Bool }
                         | FirmUserActChangeContactData
@@ -831,6 +838,11 @@ mkFirmUserTable isAdmin cid = do
           , singletonMap FirmUserActResetSupervision $ FirmUserActResetSupervisionData
               <$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep)         (Just $ Just False)
               -- <*> aopt checkBoxField                                      (fslI MsgFirmActResetMutualSupervision) (Just $ Just True )
+          , singletonMap FirmUserActSetSupervisor $ FirmUserActSetSupervisorData
+              <$> apopt (textField & cfAnySeparatedSet) (fslI MsgFirmNewSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
+              <*> apopt supervisorsField (fslI MsgFirmSetSupervisor) Nothing
+              <*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just False)
+              <*> areq  (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep) (Just False)
           , singletonMap FirmUserActMkSuper $ FirmUserActMkSuperData
               <$> aopt checkBoxField (fslI MsgTableIsDefaultReroute) (Just $ Just True)
           , singletonMap FirmUserActChangeContact $ FirmUserActChangeContactData
@@ -904,10 +916,6 @@ postFirmUsersR fsh = do
 
   formResult fusrRes $ \case
     (_, uids) | null uids -> addMessageI Error MsgUtilEmptyChoice
-    (FirmUserActMkSuperData{..}, Set.toList -> uids) -> do
-      nrMkSuper <- runDB $ updateWhereCount [UserCompanyUser <-. uids, UserCompanyCompany ==. cid] [UserCompanySupervisor =. True, UserCompanySupervisorReroute =. (firmUserActMkSuperReroute == Just True)]
-      addMessageI Info $ MsgFirmActAddSupersSet nrMkSuper Nothing
-      reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
     (FirmUserActNotifyData , uids) -> do
       cuids <- traverse encrypt $ Set.toList uids :: Handler [CryptoUUIDUser]
       redirect (FirmCommR fsh, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])
@@ -919,6 +927,31 @@ postFirmUsersR fsh = do
         newSupers <- addDefaultSupervisors cid uids
         addMessageI Info $ MsgFirmResetSupervision delSupers newSupers
       reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
+    (FirmUserActSetSupervisorData{..}, set2NonEmpty (error "Unexpected empty user list in getFirmUserR action handler.") -> uids) -> do
+      avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet guessAvsUser firmUserActSetSuperNames
+      let (usersFound', usersNotFound) = partition (is _Just . view _2) $ Map.toList avsUsers
+          usersFound = mapMaybe snd usersFound'
+          newSupers = Set.toList $ Set.fromList firmUserActSetSuperIds <> Set.fromList usersFound
+          nrSupers = fromIntegral $ length newSupers
+          nrUsers  = fromIntegral $ length uids
+      unless (null usersNotFound) $
+        let msgContent = [whamlet|
+              $newline never
+              <ul>
+                $forall (usr,_) <- usersNotFound
+                  <li>#{usr}
+              |]
+        in addMessageModal Error (i18n . MsgCourseParticipantsRegisterNotFoundInAvs $ length usersNotFound) (Right msgContent)
+      delSupers <- runDB 
+         $ bool (deleteSupervisors uids) (return 0) firmUserActSetSuperKeep 
+        <* putMany [UserSupervisor s u firmUserActSetSuperReroute | u <- toList uids, s <- newSupers]
+      addMessageI Success $ MsgFirmSetSupersReport nrUsers nrSupers delSupers
+      reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
+      
+    (FirmUserActMkSuperData{..}, Set.toList -> uids) -> do
+      nrMkSuper <- runDB $ updateWhereCount [UserCompanyUser <-. uids, UserCompanyCompany ==. cid] [UserCompanySupervisor =. True, UserCompanySupervisorReroute =. (firmUserActMkSuperReroute == Just True)]
+      addMessageI Info $ MsgFirmActAddSupersSet nrMkSuper Nothing
+      reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
     (FirmUserActChangeContactData{..}, Set.toList -> uids) ->
       let changes = catMaybes
             [ (UserPostAddress   =.) . Just <$> canonical firmUserActPostalAddr  -- note that Nothing means no change and not delete address!