Merge branch 'fradrive/newletter'

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

@@ -16,7 +16,7 @@ FirmActNotify: Mitteilung versenden
 FirmActResetSupervision: Ansprechpartner für alle Firmenangehörigen zurücksetzen
 FirmActResetSuperKeep: Bisherige Ansprechpartner der Firmenangehörigen zusätzlich beibehalten?
 FirmActResetMutualSupervision: Ansprechpartner beaufsichtigen sich gegenseitig
-FirmActAddSupersvisors: Ansprechpartner hinzufügen
+FirmActAddSupervisors: Ansprechpartner hinzufügen
 FirmActAddSupersEmpty: Es konnten keine Ansprechpartner hinzugefügt werden
 FirmActAddSupersSet n@Int64 postal@(Maybe Bool): #{n} Standardansprechpartner geändert #{maybeBoolMessage postal "" "und auf Briefversand geschaltet" "und Benachrichtigungen per Email gesetzt"}, aber nicht nicht aktiviert.
 RemoveSupervisors ndef@Int64 nact@Int64: #{ndef} Standard Ansprechpartner entfernt#{bool ", aber noch nicht deaktiviert" (", " <> tshow nact <> " aktive Ansprechpartnerbeziehungen gelöscht") (nact > 0)}
@@ -27,11 +27,16 @@ FirmActChangeContactFirmResult: Firmenkontaktinformationen geändert. Betrifft n
 FirmUserActNotify: Mitteilung versenden
 FirmUserActResetSupervision: Ansprechpartner auf Firmenstandard zurücksetzen
 FirmUserActSetSupervisor: Ansprechpartner ändern
+FirmUserActChangeContact: Kontaktinformationen für ausgewählte Firmenangehörige ändern
+FirmUserActChangeDetails: Firmenassoziation bearbeiten
+FirmUserActRemove: Firmenassoziation entfernen
+FirmUserActMkSuper: Zum Firmenansprechpartner ernennen
+FirmUserActChangeDetailsResult n@Int64 t@Int64: Firmenassoziation von #{n}/#{t} #{pluralDE n "Firmenangehörigen" "Firmenangehörige"} wurden aktualisiert
+FirmUserActChangeResult n@Int64 t@Int64: Benachrichtigungseinstellung für #{n}/#{t} #{pluralDE n "Firmenangehörigen" "Firmenangehörige"} wurden geändert
+FirmuserActRemoveResult uc@Int64 sup@Int64 sub@Int64: #{uc} #{pluralDE uc "Firmenassoziation" "Firmenassoziationen"} entfernt. #{noneMoreDE sup "" (tshow sup <> "Ansprechpartnerbeziehungen wegen entferntem Ansprechpartner gelöschtt. ")} #{noneMoreDE sub "" (tshow sup <> "Ansprechpartnerbeziehungen wegen entfernten Angesprochenen gelöscht.")}
 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)}
 FirmSuperActNotify: Mitteilung versenden
 FirmSuperActSwitchSuper: Standard Firmenansprechpartner abändern
@@ -57,5 +62,9 @@ TableIsDefaultSupervisor: Standardansprechpartner
 TableIsDefaultReroute: Standardumleitung
 FormFieldPostal: Benachrichtigungseinstellung
 FormFieldPostalTip: Gilt für alle Benachrichtigungen an diese Person, nicht nur für Umleitungen an diesen Ansprechpartner
-FirmUserChanges n@Int64: Benachrichtigungseinstellung für #{n} Firmenangehörige wurden geändert
 FirmSupervisionKeyData: Kennzahlen Ansprechpartner
+CompanyUserPriority: Firmenpriorität
+CompanyUserPriorityTip: Firmenpriorität ist lediglich relativ zu anderen Firmenassoziation der Person
+CompanyUserUseCompanyAddress: Verwendet Firmenkontaktaddresse
+CompanyUserUseCompanyAddressTip: sofern im Benutzer keine Postanschrift hinterlegt ist
+CompanyUserUseCompanyPostalError: Postalische Adresse muss leer bleiben, damit die Firmenanschrift genutzt wird!

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

@@ -16,7 +16,7 @@ FirmActNotify: Send message
 FirmActResetSupervision: Reset supervisors for all company associates
 FirmActResetSuperKeep: Additionally keep existing supervisors of company associates?
 FirmActResetMutualSupervision: Supervisors supervise each other
-FirmActAddSupersvisors: Add supervisors
+FirmActAddSupervisors: Add supervisors
 FirmActAddSupersEmpty: No supervisors added
 FirmActAddSupersSet n postal: #{n} default company supervisors changed #{maybeBoolMessage postal "" "and switched to postal notifications" "and switched to email notifications"}, but not yet activated.
 RemoveSupervisors ndef nact: #{ndef} default supervisors removed#{bool ", but not yet deactivated" (" and " <> tshow nact <> " active supervisions terminated") (nact > 0)}
@@ -27,15 +27,20 @@ FirmActChangeContactFirmResult: Company contact data changed, affecting future c
 FirmUserActNotify: Send message
 FirmUserActResetSupervision: Reset supervisors to company default
 FirmUserActSetSupervisor: Change supervision
+FirmUserActChangeContact: Change contact data for selected company associates
+FirmUserActChangeDetails: Edit company association
+FirmUserActRemove: Delete company association
+FirmUserActMkSuper: Mark as company supervisor
+FirmUserActChangeDetailsResult n t: #{n}/#{t} #{pluralENs n "company association"} updated
+FirmUserActChangeResult n t: Notification settings changed for #{n}/#{t} company #{pluralENs n "associate"}
+FirmuserActRemoveResult uc sup sub: #{pluralENsN uc "Company association"} deleted. #{noneMoreEN sup "" ((pluralENsN sup "supervision") <> " removed due to eliminated supervisors.")} #{noneMoreEN sub "" ((pluralENsN sub "supervision") <> " removed due to eliminated supervisees.")}
 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)}
+FirmSetSupersReport nusr nspr nrem: #{nspr} individual 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
 FirmSuperActNotify: Send message
 FirmSuperActSwitchSuper: Change default company supervisor
-FirmSuperActSwitchSuperInfo: Does not affect company-external supervisors and does not change any active individal supervisions. Additionally use reset action, if desired.
+FirmSuperActSwitchSuperInfo: Does not affect company-external supervisors and does not change any active individual supervisions. Additionally use reset action, if desired.
 FirmSuperActRMSuperDef: Remove default supervisor
 FirmSuperActRMSuperActive: Also remove active supervisions within this company
 FirmsNotification: Send company notification e-mail
@@ -57,5 +62,9 @@ TableIsDefaultSupervisor: Default supervisor
 TableIsDefaultReroute: Default reroute
 FormFieldPostal: Notification type
 FormFieldPostalTip: Affects all notifications to this person, not just reroutes to this supervisor
-FirmUserChanges n: Notification settings changed for #{n} company associates
 FirmSupervisionKeyData: Supervision key data
+CompanyUserPriority: Company priority
+CompanyUserPriorityTip: Company priority is relative to other company associations for a user
+CompanyUserUseCompanyAddress: Use company postal address
+CompanyUserUseCompanyAddressTip: if and only if the postal address of the user is empty
+CompanyUserUseCompanyPostalError: Individual postal address must left empty for the company address to be used!

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

@@ -12,7 +12,7 @@ QualificationAuditDurationTooltip n@Int: Optionaler Zeitraum zur Löschung von E
 QualificationAuditDurationReuseError: Diese Qualifikation nutzt das E‑Learning einer anderen Qualifikation, für die derzeit keinen Löschzeitraum konfiguriert wurde.
 QualificationRefreshWithin: Erneurerungszeitraum
 QualificationRefreshWithinTooltip: Optionaler Zeitraum vor Ablauf für automatischen Start des E‑Learnings und Versand einer Benachrichtigung per Brief oder Email.
-QualificationRefreshReminder: 2. Erinnerung
+QualificationRefreshReminder: Zweite Erinnerung
 QualificationRefreshReminderTooltip: Optionaler Zeitraum vor Ablauf zur Versendung einer zweiten Erinnerung per Brief oder Email mit identischen Zugangsdaten, sofern in diesem Zeitraum vor Ablauf noch keine Ablaufbenachrichtigung versendet wurde.
 QualificationElearningStart: Wird das E‑Learning automatisch gestartet?
 QualificationElearningRenew: Verlängert ein erfolgreiches E‑Learning die Qualifikation automatisch um die reguläre Gültigkeitsdauer?
@@ -123,7 +123,7 @@ QualificationStatusBlock   l@QualificationShorthand n@Int m@Int: #{n}/#{m} #{l}
 QualificationStatusUnblock l@QualificationShorthand n@Int m@Int: #{n}/#{m} #{l} reaktiviert
 LmsInactive: Aktuell kein E‑Learning aktiv
 LmsRenewalInstructions: Weitere Anweisungen zur Verlängerung finden Sie im angehängten PDF. Um Missbrauch zu verhindern wurde das PDF mit dem im FRADrive hinterlegten PDF-Passwort des Prüflings verschlüsselt. Falls kein PDF-Passwort manuell hinterlegt wurde, ist das PDF-Passwort die Flughafen Ausweisnummer, inklusive Punkt und der Ziffer danach.
-LmsNoRenewal: Leider kann diese Qualifikation nicht alleine durch E‑Learning verlängert werden.
+LmsNoRenewal: Leider kann diese Qualifikation nicht alleine durch E‑Learning verlängert werden. Bitte setzen Sie sich mit uns in Verbindung, wenn Sie die Qualifikation verlängern möchten und noch nicht wissen, wie Sie das tun können. Ignorieren Sie diese automatisch generierte Erinnerung, falls Sie sich bereits um die Verlängerung gekümmert haben
 LmsRenewalReminder: Erinnerung
 LmsActNotify: Benachrichtigung E‑Learning erneut per Post oder E-Mail versenden
 LmsActRenewPin: Neues zufällige E‑Learning Passwort zuweisen

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

@@ -12,7 +12,7 @@ QualificationAuditDurationTooltip n@Int: Optional period for deletion of e‑lea
 QualificationAuditDurationReuseError: This qualification reuses the e‑learning from another qualification, which has no audit duration configured.
 QualificationRefreshWithin: Refresh within
 QualificationRefreshWithinTooltip: Optional period before expiry to start e‑learning and send a notification by post or email.
-QualificationRefreshReminder: 2. Reminder
+QualificationRefreshReminder: Second reminder
 QualificationRefreshReminderTooltip: Optional period before expiry to send a second notification by post or email once more, provided that no renewal notification was sent in this period before expiry.
 QualificationElearningStart: Is e‑learning automatically started?
 QualificationElearningRenew: Does successful e‑learning automatically extend a qualification by the default validity period?
@@ -123,7 +123,7 @@ QualificationStatusBlock   l n m: #{n}/#{m} #{l} revoked
 QualificationStatusUnblock l n m: #{n}/#{m} #{l} reactivated
 LmsInactive: Currently no active e‑learning
 LmsRenewalInstructions: Instruction on how to accomplish the renewal are enclosed in the attached PDF. In order to avoid misuse, the PDF is encrypted with the FRADrive PDF-password of the examinee. If no PDF-password had been chosen yet, then the password is the Fraport id card number of the examinee, including the punctuation mark and the digit thereafter.
-LmsNoRenewal: Unfortunately, this particular qualification cannot be renewed through e‑learning only.
+LmsNoRenewal: Unfortunately, this particular qualification cannot be renewed through e‑learning only. Please contact us, if you do not yet know how to renew this qualification. Ignore this automatically generated reminder email, if you have made arrangements for the renewal of this qualification already.
 LmsRenewalReminder: Reminder
 LmsActNotify: Resend e‑learning notification by post or email
 LmsActRenewPin: Randomly replace e‑learning password

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

@@ -111,4 +111,7 @@ UsersChangeSupervisorsSuccess usr@Int spr@Int: #{tshow spr} Ansprechpartner für
 UsersChangeSupervisorsWarning usr@Int spr@Int bad@Int: Nur _{MsgUsersChangeSupervisorsSuccess usr spr} #{tshow bad} Ansprechpartner #{pluralDE bad "wurde" "wurden"} nicht gefunden!
 UsersRemoveSupervisors usr@Int: Alle Ansprechpartner für #{tshow usr} Benutzer gelöscht.
 UsersRemoveSubordinates usr@Int: Alle Ansprechpartnerbeziehungen für #{tshow usr} #{pluralDE usr "ehemaligen" "ehemalige"} Ansprechpartner gelöscht.
-SupervisorReason: Begründung
+UserCompanyReason: Begründung der Firmenassoziation
+UserCompanyReasonTooltip: Optionale Notiz für besondere Fälle. Kann ggf. autmatische Entfernung bei AVS Firmenwechsel verhindern.
+UserSupervisorReason: Begründung Ansprechpartner
+UserSupervisorReasonTooltip: Optionale Notiz für besondere Fälle. Kann ggf. autmatische Entfernung bei AVS Firmenwechsel verhindern.

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

@@ -111,4 +111,7 @@ UsersChangeSupervisorsSuccess usr spr: #{pluralENsN spr "supervisor"} for #{plur
 UsersChangeSupervisorsWarning usr spr bad: Only _{MsgUsersChangeSupervisorsSuccess usr spr} #{pluralENsN bad "supervisors"} could not be identified!
 UsersRemoveSupervisors usr: Removed all supervisors for #{pluralENsN usr "user"}.
 UsersRemoveSubordinates usr: Removed all subordinates for #{pluralENsN usr "previous supervisor"}.
-SupervisorReason: Reason
+UserCompanyReason: Reason for company association
+UserCompanyReasonTooltip: Optional note for special cases. In some case this may prevent automatic removel upon AVS user company changes.
+UserSupervisorReason: Reason for supervision
+UserSupervisorReasonTooltip: Optional note for special cases. In some case this may prevent automatic removel upon AVS user company changes.

messages/uniworx/misc/de-de-formal.msg

@@ -16,6 +16,7 @@ LdapIdentificationOrEmail: Fraport AG-Kennung / E-Mail-Adresse
 Months num@Int64: #{num} #{pluralDE num "Monat" "Monate"}
 Days num@Int64: #{num} #{pluralDE num "Tag" "Tage"}
 NoAutomaticUpdateTip: Dieser Wert wurde manuell editiert und wird daher nicht mehr automatisch durch as AVS aktualisiert.
+AddressIsLinkedTip: Verlinkte Postaddresse: Für diesen Benutzer ist keine individuelle Postadresse gespeichert, die Adresse wurde stattdessen aus der Firmenzugehörigkeit abgeleitet.
 
 ClusterVolatileQuickActionsEnabled: Schnellzugriffsmenü aktiv
 
@@ -27,3 +28,5 @@ AvsNoLicenceGuest: Keine Fahrberechtigung (Gast, Fahrberechtigungserwerb nicht m
 PaginationSize: Einträge pro Seite
 PaginationPage: Angzeigte Seite
 PaginationError: Paginierung Parameter dürfen nicht negativ sein
+
+NullDeletes: Zum Löschen NULL eingeben.

messages/uniworx/misc/en-eu.msg

@@ -16,6 +16,7 @@ LdapIdentificationOrEmail: Fraport AG-Kennung / email address
 Months num: #{num} #{pluralEN num "Month" "Months"}
 Days num: #{num} #{pluralEN num "Day" "Days"}
 NoAutomaticUpdateTip: This particular value receives no automatic AVS updates, since it has been edited manually.
+AddressIsLinkedTip: Linked postal address: No individual postal address is stored for this user, instead a postal address was inferred from the user's company association.
 
 ClusterVolatileQuickActionsEnabled: Quick actions enabled
 
@@ -27,3 +28,5 @@ AvsNoLicenceGuest: No driving licence (Guest account, cannot acquire a diriving
 PaginationSize: Rows per Page
 PaginationPage: Page to show
 PaginationError: Pagination parameter must not be negative
+
+NullDeletes:  Enter NULL to delete.

messages/uniworx/utils/table_column/de-de-formal.msg

@@ -84,6 +84,7 @@ TableCompanyNos: Firmennummern
 TableCompanyUser: Firmenangehöriger
 TableCompanyNrUsers: Firmenangehörige
 TableCompanyNrSecondaryUsers: Sekundäre Firmenangehörige
+TableCompanyReason: Notiz
 TableCompanyNrSupers: Ansprechpartner
 TableCompanyNrEmpSupervised: Firmenangehörige mit Ansprechpartner
 TableCompanyNrEmpRerouted: Firmenangehörige mit Umleitung
@@ -97,6 +98,7 @@ TableRerouteActive: Umleitung
 TableCompanyPostalPreference: Benachrichtigungspräferenz neue Firmenangehörige
 TableSupervisor: Ansprechpartner
 TableSupervisee: Ansprechpartner für
+TableReason: Begründung
 TableCreationTime: Erstellungszeit
 TableJob !ident-ok: Job
 TableJobContent !ident-ok: Parameter

messages/uniworx/utils/table_column/en-eu.msg

@@ -84,6 +84,7 @@ TableCompanyNos: Company numbers
 TableCompanyUser: Associate
 TableCompanyNrUsers: Associates
 TableCompanyNrSecondaryUsers: Secondary Associates
+TableCompanyReason: Note
 TableCompanyNrSupers: Supervisors
 TableCompanyNrEmpSupervised: Supervised employees 
 TableCompanyNrEmpRerouted: Employees having reroute
@@ -97,6 +98,7 @@ TableRerouteActive: Reroute
 TableCompanyPostalPreference: Default notification preference
 TableSupervisor: Supervisor
 TableSupervisee: Supervisor for
+TableReason: Reason
 TableCreationTime: Creation
 TableJob !ident-ok: Job
 TableJobContent !ident-ok: Parameters

models/users.model

@@ -93,6 +93,7 @@ UserCompany
     supervisorReroute     Bool       default=false -- if supervisor is true, should this supervisor receive email for _new_ company users?
     priority              Int        default=0     -- higher number, higher priority; default=1 for Haskell-Code
     useCompanyAddress     Bool       default=true  -- if true, CompanyPostalAddress and CompanyEmail are used if UserPostalAddress/UserDisplayEmail are Nothing, respects priority
+    reason                Text Maybe -- miscellaneous note, e.g. Superior
     UniqueUserCompany user company   -- a user may belong to multiple companies, but to each one only once
     deriving Generic Show
 UserSupervisor

src/Handler/Firm.hs

@@ -19,6 +19,7 @@ import Import
 
 -- import Jobs
 import Handler.Utils
+import Handler.Utils.Company
 import Handler.Utils.Communication
 import Handler.Utils.Avs (guessAvsUser)
 
@@ -32,8 +33,8 @@ import qualified Data.CaseInsensitive as CI
 import Database.Persist.Postgresql
 import           Database.Esqueleto.Experimental ((:&)(..))
 import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
-import qualified Database.Esqueleto.Legacy as EL (on)
+import qualified Database.Esqueleto.Legacy as EL (on) -- needed for legacy join expected by dbTable
-import qualified Database.Esqueleto.PostgreSQL as E
+-- import qualified Database.Esqueleto.PostgreSQL as E
 import qualified Database.Esqueleto.Utils as E
 import Database.Esqueleto.Utils.TH
 
@@ -56,7 +57,7 @@ postalEmailField = boolFieldCustom (SomeMessage MsgUtilPostal) (SomeMessage MsgU
 
 data FirmAction = FirmActNotify
                 | FirmActResetSupervision
-                | FirmActAddSupersvisors
+                | FirmActAddSupervisors
                 | FirmActChangeContactFirm
                 | FirmActChangeContactUser
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
@@ -70,10 +71,11 @@ data FirmActionData = FirmActNotifyData
                         { firmActResetKeepOldSupers       :: Maybe Bool
                         , firmActResetMutualSupervision   :: Maybe Bool
                         }
-                    | FirmActAddSupersvisorsData
+                    | FirmActAddSupervisorsData
                         { firmActAddSupervisorIds         :: Set Text
                         , firmActAddSupervisorReroute     :: Bool
                         , firmActAddSupervisorPostal      :: Maybe Bool
+                        , firmActAddSupervisorReason      :: Maybe Text
                         }
                     | FirmActChangeContactFirmData
                         { firmActCCFPostalAddr            :: Maybe StoredMarkup
@@ -82,6 +84,7 @@ data FirmActionData = FirmActNotifyData
                         }
                     | FirmActChangeContactUserData
                         { firmActCCUPostalAddr            :: Maybe StoredMarkup
+                        , firmActCCUUseCompanyPostal      :: Maybe Bool
                         , firmActCCUPostalPref            :: Maybe Bool
                         }
   deriving (Eq, Ord, Read, Show, Generic)
@@ -91,21 +94,31 @@ firmActionMap mr isAdmin acts = mconcat (mkAct isAdmin <$> acts)
   where
     mkAct True  FirmActNotify           = singletonMap FirmActNotify           $ pure FirmActNotifyData
     mkAct _     FirmActResetSupervision = singletonMap FirmActResetSupervision $      FirmActResetSupervisionData
-                  <$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep)                     (Just $ Just False)
+                  <$> aopt boolField'                       (fslI MsgFirmActResetSuperKeep)                     (Just $ Just False)
-                  <*> aopt checkBoxField                                      (fslI MsgFirmActResetMutualSupervision)             (Just $ Just True )
+                  <*> aopt checkBoxField                    (fslI MsgFirmActResetMutualSupervision)             (Just $ Just True )
-    mkAct _     FirmActAddSupersvisors   = singletonMap FirmActAddSupersvisors   $ FirmActAddSupersvisorsData
+    mkAct _     FirmActAddSupervisors   = singletonMap FirmActAddSupervisors   $ FirmActAddSupervisorsData
                   <$> areq (textField & cfAnySeparatedSet)  (fslI MsgTableIsDefaultSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip)  Nothing
                   <*> areq checkBoxField                    (fslI MsgTableIsDefaultReroute)                                                             (Just True)
                   <*> aopt postalEmailField                 (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip)                                Nothing
+                  <*> aopt (textField & cfStrip & addDatalist ucdefSuperReasons)
+                                                            (fslI MsgUserCompanyReason & setTooltip MsgUserCompanyReasonTooltip)                        Nothing
     mkAct _     FirmActChangeContactFirm = singletonMap FirmActChangeContactFirm $ FirmActChangeContactFirmData
                   <$> aopt htmlField                        (fslI MsgPostAddress      & setTooltip (SomeMessages [SomeMessage MsgPostAddressTip, SomeMessage MsgUtilEmptyNoChangeTip])) Nothing
                   <*> aopt (emailField & cfStrip & cfCI)    (fslI MsgUserDisplayEmail & setTooltip MsgUtilEmptyNoChangeTip) Nothing
-                  <*> aopt postalEmailField                 (fslI MsgFormFieldPostal  & setTooltip MsgFormFieldPostalTip)   Nothing
+                  <*> aopt postalEmailField                 (fslI MsgFormFieldPostal  & setTooltip MsgFirmDefaultPreferenceInfo)   Nothing
                   <*  aformMessage (Message Info (toHtml $ mr MsgFirmActChangeContactFirmInfo) (Just IconNotificationNonactive))
     mkAct _     FirmActChangeContactUser = singletonMap FirmActChangeContactUser $ FirmActChangeContactUserData
                   <$> aopt htmlField                        (fslI MsgPostAddress      & setTooltip (SomeMessages [SomeMessage MsgPostAddressTip, SomeMessage MsgUtilEmptyNoChangeTip])) Nothing
+                  <*> aopt boolField'                       (fslI MsgCompanyUserUseCompanyAddress & setTooltip MsgCompanyUserUseCompanyAddressTip) Nothing
                   <*> aopt postalEmailField                 (fslI MsgFormFieldPostal  & setTooltip MsgFormFieldPostalTip) Nothing
     mkAct _  _ = mempty
+    ucdefSuperReasons :: HandlerFor UniWorX (OptionList Text)
+    ucdefSuperReasons = fmap (mkOptionList . map (\t -> Option t t t) . Set.toAscList) . runDB $
+      fmap (setOf $ folded . _Value . _Just) . E.select . E.distinct $ do
+        usrc <- E.from $ E.table @UserCompany
+        E.where_ $ E.isJust $ usrc E.^. UserCompanyReason
+        return $ usrc E.^. UserCompanyReason
+
 
 firmActionForm :: _ -> Bool -> [FirmAction] -> AForm Handler FirmActionData
 firmActionForm mr isAdmin acts = multiActionA (firmActionMap mr isAdmin acts) (fslI MsgTableAction) Nothing
@@ -136,17 +149,19 @@ firmActionHandler route isAdmin = flip formResult faHandler
         delSupers <- if firmActResetKeepOldSupers == Just False
           then E.deleteCount $ do
                 spr <- E.from $ E.table @UserSupervisor
-                E.where_ $ suprFltr spr E.&&. E.exists (do
+                E.where_ $ suprFltr spr
-                    usr <- E.from $ E.table @UserCompany
+                    E.&&. spr E.^. UserSupervisorReason E.~=. E.val (tshow SupervisorReasonCompanyDefault)
-                    E.where_ $ usr E.^. UserCompanyCompany `E.in_` E.vals fids
+                    E.&&. E.exists (do
-                        E.&&.  usr E.^. UserCompanyUser E.==. spr E.^. UserSupervisorUser
+                      usr <- E.from $ E.table @UserCompany
-                  )
+                      E.where_ $ usr E.^. UserCompanyCompany `E.in_` E.vals fids
+                          E.&&.  usr E.^. UserCompanyUser E.==. spr E.^. UserSupervisorUser
+                    )
           else return 0
-        newSupers <- addDefaultSupervisorsFor madId (firmActResetMutualSupervision /= Just False) fids
+        newSupers <- addDefaultSupervisorsFor (Just $ tshow SupervisorReasonCompanyDefault) madId (firmActResetMutualSupervision /= Just False) fids
         addMessageI Success $ MsgFirmResetSupervision delSupers newSupers
       reloadKeepGetParams route -- reload to reflect changes
 
-    faHandler (FirmActAddSupersvisorsData{..}, Set.toList -> [cid]) = do
+    faHandler (FirmActAddSupervisorsData{..}, Set.toList -> [cid]) = do
       avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet guessAvsUser firmActAddSupervisorIds
       let (usersFound', usersNotFound) = partition (is _Just . view _2) $ Map.toList avsUsers
           usersFound = mapMaybe snd usersFound'
@@ -164,7 +179,7 @@ firmActionHandler route isAdmin = flip formResult faHandler
       runDB $ do
         -- putMany [UserCompany uid cid True firmActAddSupervisorReroute 0 False | uid <- usersFound] -- putMany always overwrites existing records, which would destroy priority and useCompanyAddress here
         -- upsertManyWhere [UserCompany uid cid True firmActAddSupervisorReroute 0 False | uid <- usersFound] [copyField UserCompanySupervisor, copyField UserCompanySupervisorReroute] [] [] -- overwrite Supervisor and SupervisorReroute, keep priority and useCompanyAddress
-        upsertManyWhere [UserCompany uid cid True firmActAddSupervisorReroute 0 False | uid <- usersFound] [] [UserCompanySupervisor =. True, UserCompanySupervisorReroute =. firmActAddSupervisorReroute] [] -- identical to previous line, but perhaps more clear?
+        upsertManyWhere [UserCompany uid cid True firmActAddSupervisorReroute 0 False firmActAddSupervisorReason| uid <- usersFound] [] [UserCompanySupervisor =. True, UserCompanySupervisorReroute =. firmActAddSupervisorReroute, UserCompanyReason =. firmActAddSupervisorReason] [] -- identical to previous line, but perhaps more clear?
         whenIsJust firmActAddSupervisorPostal $ \prefPostal ->
           updateWhere [UserId <-. usersFound] [UserPrefersPostal =. prefPostal]
         addMessageI Success $ MsgFirmActAddSupersSet (fromIntegral $ length usersFound) firmActAddSupervisorPostal
@@ -181,21 +196,30 @@ firmActionHandler route isAdmin = flip formResult faHandler
         addMessageI Success MsgFirmActChangeContactFirmResult
         reloadKeepGetParams route
 
-    faHandler (FirmActChangeContactUserData{..}, Set.toList -> [cid]) =
+    faHandler (FirmActChangeContactUserData{..}, Set.toList -> [cid])
-      let changes = catMaybes
+      | firmActCCUUseCompanyPostal == Just True, isJust firmActCCUPostalAddr =
-            [ (UserPostAddress   E.=.) . E.justVal <$> canonical firmActCCUPostalAddr  -- note that Nothing means no change and not delete address!
+          addMessageI Error MsgCompanyUserUseCompanyPostalError
-            , (UserPrefersPostal E.=.) . E.val     <$>           firmActCCUPostalPref
+      | otherwise = do
-            ]
+          let changes = catMaybes
-      in unless (null changes) $ do
+                [ toMaybe (firmActCCUUseCompanyPostal == Just True) (UserPostAddress   E.=. E.nothing)      -- precondition ensures that only one update applies for UserPostAddress
-        nrChanged <- runDB $ E.updateCount $ \usr -> do
+                , (UserPostAddress   E.=.) . E.justVal <$> canonical firmActCCUPostalAddr  -- note that Nothing means no change and not delete address!
-          E.set usr changes
+                , (UserPrefersPostal E.=.) . E.val     <$>           firmActCCUPostalPref
-          E.where_ $ E.exists $ do
+                ]
-            usrCmpy <- E.from $ E.table @UserCompany
+          (total, nrChanged) <- runDB $ do
-            E.where_ $ usrCmpy E.^. UserCompanyCompany E.==. E.val cid
+            nrUsrChange <- E.updateCount $ \usr -> do
-                E.&&.  usrCmpy E.^. UserCompanyUser    E.==. usr E.^. UserId
+              E.set usr changes
-        addMessageI Success $ MsgFirmUserChanges nrChanged
+              E.where_ $ E.exists $ do
-        reloadKeepGetParams route  -- reload to reflect changes
+                usrCmpy <- E.from $ E.table @UserCompany
-
+                E.where_ $ usrCmpy E.^. UserCompanyCompany E.==. E.val cid
+                    E.&&.  usrCmpy E.^. UserCompanyUser    E.==. usr E.^. UserId
+            nrUseComp <- case firmActCCUUseCompanyPostal of
+              Just x  -> updateWhereCount [UserCompanyCompany ==. cid] [UserCompanyUseCompanyAddress =. x]
+              Nothing -> return 0
+            nrCid <- count [UserCompanyCompany ==. cid]
+            return (fromIntegral nrCid, max nrUsrChange nrUseComp)
+          let allok = bool Warning Success $ nrChanged == total
+          addMessageI allok $ MsgFirmUserActChangeResult nrChanged total
+          reloadKeepGetParams route  -- reload to reflect changes
     faHandler _ = addMessageI Error MsgErrorUnknownFormAction
 
 
@@ -230,99 +254,6 @@ runFirmActionFormPost cid route isAdmin acts = do
 -- Firm specific utilities
 -- for filters and counts also see before FirmAllR Handlers
 
-
-
--- | remove supervisors for given users; maybe restricted to those linked to a given companies
-deleteSupervisors :: NonEmpty UserId -> [CompanyId] -> DB Int64
-deleteSupervisors usrs cids = deleteWhereCount $ (UserSupervisorUser <-. toList usrs) : restrictByCompany
-  where
-    restrictByCompany = guardMonoid (notNull cids) [UserSupervisorCompany <-. (Just <$> cids)]
-
--- reset supervisors given employees of a company to default company supervision, deleting all previous company-related supervisors
-resetSupervisors :: CompanyId -> NonEmpty UserId -> DB Int64
-resetSupervisors cid employees = do
-  nr_del <- deleteSupervisors employees [cid]
-  nr_add <- addDefaultSupervisors cid employees
-  return $ max nr_del nr_add
-
--- adds the default company supervisors as supervisor to a given set of users, which themselves may belong to any company
-addDefaultSupervisors :: CompanyId -> NonEmpty UserId -> DB Int64
-addDefaultSupervisors cid employees = do
-  E.insertSelectWithConflictCount UniqueUserSupervisor
-    (do
-      (spr :& usr) <- E.from $ E.table @UserCompany `E.crossJoin` E.toValues employees
-      E.where_ $ spr E.^. UserCompanyCompany E.==. E.val cid
-          E.&&.  spr E.^. UserCompanySupervisor
-      E.distinct $ return $ UserSupervisor
-        E.<#  (spr E.^. UserCompanyUser)
-        E.<&>  usr
-        E.<&> (spr E.^. UserCompanySupervisorReroute)
-        E.<&> E.justVal cid
-        E.<&> E.nothing
-    )
-    (\_old new ->
-      [ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications
-      , UserSupervisorCompany E.=. E.justVal cid
-      -- , UserSupervisorReason  E.=. new E.^. UserSupervisorReason -- keep any existing reason
-      ])
-
--- like `addDefaultSupervisors`, but selects all employees of given companies from database, optionally filtered by being under supervision of a given individual
-addDefaultSupervisorsFor ::  (CompanyId ~ Element mono, MonoFoldable mono) => Maybe UserId -> Bool -> mono -> DB Int64
-addDefaultSupervisorsFor mbSuperId mutualSupervision cids = do
-  E.insertSelectWithConflictCount UniqueUserSupervisor
-    (do
-      (spr :& usr) <- E.from $ E.table @UserCompany `E.innerJoin` E.table @UserCompany `E.on` (\(spr :& usr) -> spr E.^. UserCompanyCompany E.==. usr E.^. UserCompanyCompany)
-      E.where_ $ E.and $ guardMonoid (not mutualSupervision)
-                            [ E.not_ $ usr E.^. UserCompanySupervisor ]
-                        <>  maybeEmpty mbSuperId (\sprId -> [E.exists $ do
-                              superv <- E.from $ E.table @UserSupervisor
-                              E.where_ $ superv E.^. UserSupervisorSupervisor E.==. E.val sprId
-                                  E.&&.  superv E.^. UserSupervisorUser       E.==. usr E.^. UserCompanyUser
-                            ])
-                        <>  [          spr E.^. UserCompanySupervisor
-                            , spr E.^. UserCompanyCompany `E.in_` E.vals cids
-                            , usr E.^. UserCompanyCompany `E.in_` E.vals cids
-                            ]
-      E.distinct $ return $ UserSupervisor
-        E.<#  (spr E.^. UserCompanyUser)
-        E.<&> (usr E.^. UserCompanyUser)
-        E.<&> (spr E.^. UserCompanySupervisorReroute)
-        E.<&> E.just (spr E.^. UserCompanyCompany)
-        E.<&> E.nothing
-    )
-    (\_old new ->
-        [ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications
-        , UserSupervisorCompany E.=. new E.^. UserSupervisorCompany
-        -- , UserSupervisorReason  E.=. new E.^. UserSupervisorReason   -- keep any existing reaon
-        ] )
-
--- like `addDefaultSupervisors`, but selects all employees of given companies from database
-addDefaultSupervisorsAll ::  (CompanyId ~ Element mono, MonoFoldable mono) => Bool -> mono -> DB Int64
-addDefaultSupervisorsAll mutualSupervision cids = do
-  E.insertSelectWithConflictCount UniqueUserSupervisor
-    (do
-      (spr :& usr) <- E.from $ E.table @UserCompany `E.innerJoin` E.table @UserCompany `E.on` (\(spr :& usr) -> spr E.^. UserCompanyCompany E.==. usr E.^. UserCompanyCompany)
-      E.where_ $ E.and $ guardMonoid (not mutualSupervision)
-                            [ E.not_ $ usr E.^. UserCompanySupervisor ]
-                        <>  [          spr E.^. UserCompanySupervisor
-                            , spr E.^. UserCompanyCompany `E.in_` E.vals cids
-                            , usr E.^. UserCompanyCompany `E.in_` E.vals cids
-                            ]
-      E.distinct $ return $ UserSupervisor
-        E.<#  (spr E.^. UserCompanyUser)
-        E.<&> (usr E.^. UserCompanyUser)
-        E.<&> (spr E.^. UserCompanySupervisorReroute)
-        E.<&> E.just (spr E.^. UserCompanyCompany)
-        E.<&> E.nothing
-    )
-    (\_old new ->
-        [ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications
-        , UserSupervisorCompany E.=. new E.^. UserSupervisorCompany
-        -- , UserSupervisorReason  E.=. new E.^. UserSupervisorReason   -- keep any existing reaon
-        ] )
-
-
-------------------------------
 -- repeatedly useful queries
 
 usrPrimaryCompanies :: E.SqlExpr (Entity Company) -> E.SqlExpr (Entity UserCompany) -> E.SqlQuery ()
@@ -797,7 +728,9 @@ data FirmUserAction = FirmUserActNotify
                     | FirmUserActResetSupervision
                     | FirmUserActSetSupervisor
                     | FirmUserActMkSuper
+                    | FirmUserActChangeDetails
                     | FirmUserActChangeContact
+                    | FirmUserActRemove
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
   deriving anyclass (Universe, Finite)
 
@@ -812,14 +745,23 @@ data FirmUserActionData = FirmUserActNotifyData
                         | FirmUserActSetSupervisorData
                             {  firmUserActSetSuperNames   :: Maybe (Set Text)
                             ,  firmUserActSetSuperIds     :: Maybe [UserId]
+                            ,  firmUserActSetSuperReason  :: Maybe Text
                             ,  firmUserActSetSuperReroute :: Bool
                             ,  firmUserActSetSuperKeep    :: Bool
                             }
                         | FirmUserActMkSuperData
                             { firmUserActMkSuperReroute   :: Maybe Bool }
+                        | FirmUserActChangeDetailsData
+                            { firmUserActDetailPriority     :: Maybe Int
+                            , firmUserActDetailReason       :: Maybe Text
+                            }
                         | FirmUserActChangeContactData
-                            { firmUserActPostalAddr :: Maybe StoredMarkup
+                            { firmUserActPostalAddr         :: Maybe StoredMarkup
-                            , firmUserActPostalPref :: Maybe Bool
+                            , firmUserActUseCompanyPostal   :: Maybe Bool
+                            , firmUserActPostalPref         :: Maybe Bool
+                            }
+                        | FirmUserActRemoveData
+                            { firmUserActRemoveKeepSuper :: Bool
                             }
   deriving (Eq, Ord, Show, Generic)
 
@@ -831,7 +773,7 @@ queryUserUser = $(sqlIJproj 2 1)
 queryUserUserCompany :: UserCompanyTableExpr -> E.SqlExpr (Entity UserCompany)
 queryUserUserCompany = $(sqlIJproj 2 2)
 
-type UserCompanyTableData = DBRow (Entity User, Entity UserCompany, E.Value Word64, E.Value Word64) -- , E.Value Bool)
+type UserCompanyTableData = DBRow (Entity User, Entity UserCompany, E.Value Word64, E.Value Word64, E.Value Bool)
 
 resultUserUser :: Lens' UserCompanyTableData (Entity User)
 resultUserUser = _dbrOutput . _1
@@ -845,8 +787,8 @@ resultUserCompanySupervisors = _dbrOutput . _3 . _unValue
 resultUserCompanyReroutes :: Lens' UserCompanyTableData Word64
 resultUserCompanyReroutes = _dbrOutput . _4 . _unValue
 
--- resultUserCompanyPrimary :: Lens' UserCompanyTableData Bool
+resultUserCompanyPrimary :: Lens' UserCompanyTableData Bool
--- resultUserCompanyPrimary = _dbrOutput . _5 . _unValue
+resultUserCompanyPrimary = _dbrOutput . _5 . _unValue
 
 instance HasEntity UserCompanyTableData User where
   hasEntity = resultUserUser
@@ -888,12 +830,12 @@ mkFirmUserTable isAdmin cid = do
         dbtSQLQuery = \(usr `E.InnerJoin` usrCmp) -> do
           EL.on $ usr E.^. UserId E.==. usrCmp E.^. UserCompanyUser
           E.where_ $ usrCmp E.^. UserCompanyCompany E.==. E.val cid
-          -- let isPrimary = E.notExists (do
+          let isPrimary = E.notExists (do
-          --         other <- E.from $ E.table @UserCompany
+                  other <- E.from $ E.table @UserCompany
-          --         E.where_ $ other E.^. UserCompanyUser     E.==. usrCmp E.^. UserCompanyUser
+                  E.where_ $ other E.^. UserCompanyUser     E.==. usrCmp E.^. UserCompanyUser
-          --             E.&&.  other E.^. UserCompanyPriority E.>.  usrCmp E.^. UserCompanyPriority
+                      E.&&.  other E.^. UserCompanyPriority E.>.  usrCmp E.^. UserCompanyPriority
-          --         )
+                  )
-          return (usr, usrCmp, firmCountUserSupervisors usrCmp, firmCountUserSupervisorsReroute usrCmp)
+          return (usr, usrCmp, firmCountUserSupervisors usrCmp, firmCountUserSupervisorsReroute usrCmp, isPrimary)
         dbtRowKey = queryUserUser >>> (E.^. UserId)
         dbtProj = dbtProjId
         dbtColonnade = formColonnade $ mconcat
@@ -904,7 +846,16 @@ mkFirmUserTable isAdmin cid = do
           , sortable (Just "supervisors")     (i18nCell MsgTableCompanyNrSupers       )  $ \(view resultUserCompanySupervisors  -> nr) -> wgtCell $ word2widget nr
           , sortable (Just "reroutes")        (i18nCell MsgTableCompanyNrRerouteActive)  $ \(view resultUserCompanyReroutes     -> nr) -> wgtCell $ word2widget nr
           , sortable (Just "postal-pref")     (i18nCell MsgPrefersPostal)                $ \(view $ resultUserUser . _userPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b
+          , sortable Nothing                  (i18nCell MsgCompanyUserUseCompanyAddress) $ \row ->
+              let noUsrAddr = isNothing $ row ^. resultUserUser . _userPostAddress
+                  useCompA  = row ^. resultUserUserCompany . _entityVal . _userCompanyUseCompanyAddress
+              in tickmarkCell $ noUsrAddr && useCompA
           , colUserEmail
+          , sortable (Just "usr-reason")      (i18nCell MsgTableCompanyReason)           $ \(view $ resultUserUserCompany . _entityVal . _userCompanyReason -> r) -> cellMaybe textCell r
+          , sortable (Just "priority")        (i18nCell MsgCompanyUserPriority)          $ \row ->
+              let prio :: Int = row ^. resultUserUserCompany . _entityVal . _userCompanyPriority
+                  isPrime     = row ^. resultUserCompanyPrimary
+              in numCell prio <> spacerCell <> ifIconCell isPrime IconTop
           , sortable Nothing (i18nCell MsgTableUserEdit) $ \(view resultUserUser -> entUsr) -> cellEditUserModal entUsr
           ]
         dbtSorting = mconcat
@@ -915,6 +866,8 @@ mkFirmUserTable isAdmin cid = do
           , singletonMap "personal-number"  $ SortColumn $ queryUserUser        >>> (E.^. UserCompanyPersonalNumber)
           , singletonMap "supervisors"      $ SortColumn $ queryUserUserCompany >>> firmCountUserSupervisors
           , singletonMap "reroutes"         $ SortColumn $ queryUserUserCompany >>> firmCountUserSupervisorsReroute
+          , singletonMap "usr-reason"       $ SortColumn $ queryUserUserCompany >>> (E.^. UserCompanyReason)
+          , singletonMap "priority"         $ SortColumn $ queryUserUserCompany >>> (E.^. UserCompanyPriority)
           ]
         dbtFilter = mconcat
           [ single $ fltrUserNameEmail queryUserUser
@@ -991,6 +944,20 @@ mkFirmUserTable isAdmin cid = do
           , prismAForm (singletonFilter "is-primary-company"     . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI   MsgFilterFirmPrimary)
           ]
         dbtStyle =  def { dbsFilterLayout = defaultDBSFilterLayout }
+        userReasons :: HandlerFor UniWorX (OptionList Text)
+        userReasons = fmap (mkOptionList . map (\t -> Option t t t) . Set.toAscList) . runDB $
+          fmap (setOf $ folded . _Value . _Just) . E.select . E.distinct $ do
+            usrc <- E.from $ E.table @UserCompany
+            E.where_ $ E.isJust (usrc E.^. UserCompanyReason)
+                  E.&&. usrc E.^. UserCompanyCompany E.==. E.val cid
+            return $ usrc E.^. UserCompanyReason
+        superReasons :: HandlerFor UniWorX (OptionList Text)
+        superReasons = fmap (mkOptionList . map (\t -> Option t t t) . Set.toAscList) . runDB $
+          fmap (setOf $ folded . _Value . _Just) . E.select . E.distinct $ do
+            usrc <- E.from $ E.table @UserSupervisor
+            E.where_ $ E.isJust (usrc E.^. UserSupervisorReason)
+                  E.&&. usrc E.^. UserSupervisorCompany E.~=. E.val cid
+            return $ usrc E.^. UserSupervisorReason
         acts :: Map FirmUserAction (AForm Handler FirmUserActionData)
         acts = mconcat
           [ guardMonoid isAdmin $ singletonMap FirmUserActNotify $ pure FirmUserActNotifyData
@@ -1000,13 +967,20 @@ mkFirmUserTable isAdmin cid = do
           , singletonMap FirmUserActSetSupervisor $ FirmUserActSetSupervisorData
               <$> aopt (textField & cfAnySeparatedSet)                    (fslI MsgFirmNewSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
               <*> aopt supervisorsField                                   (fslI MsgFirmSetSupervisor & setTooltip MsgMultiSelectTip)                          Nothing
+              <*> aopt (textField & cfStrip & addDatalist superReasons)   (fslI MsgUserSupervisorReason  & setTooltip MsgUserSupervisorReasonTooltip)          Nothing
               <*> areq (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 FirmUserActChangeDetails $ FirmUserActChangeDetailsData
+              <$> aopt intField                                           (fslI MsgCompanyUserPriority & setTooltip MsgCompanyUserPriorityTip) Nothing
+              <*> aopt (textField & cfStrip & addDatalist userReasons)    (fslI MsgUserCompanyReason & setTooltip (SomeMessages [SomeMessage MsgUserCompanyReasonTooltip, SomeMessage MsgNullDeletes])) Nothing
           , singletonMap FirmUserActChangeContact $ FirmUserActChangeContactData
-              <$> aopt htmlField                        (fslI MsgPostAddress      & setTooltip (SomeMessages [SomeMessage MsgPostAddressTip, SomeMessage MsgUtilEmptyNoChangeTip])) Nothing
+              <$> aopt htmlField        (fslI MsgPostAddress      & setTooltip (SomeMessages [SomeMessage MsgPostAddressTip, SomeMessage MsgUtilEmptyNoChangeTip])) Nothing
-              <*> aopt postalEmailField                 (fslI MsgFormFieldPostal  & setTooltip MsgFormFieldPostalTip) Nothing
+              <*> aopt boolField'       (fslI MsgCompanyUserUseCompanyAddress & setTooltip MsgCompanyUserUseCompanyAddressTip) Nothing
+              <*> aopt postalEmailField (fslI MsgFormFieldPostal  & setTooltip MsgFormFieldPostalTip) Nothing
+          , singletonMap FirmUserActRemove $ FirmUserActRemoveData
+              <$> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep)                                                     (Just False)
           ]
         dbtParams = DBParamsForm
           { dbParamsFormMethod = POST
@@ -1081,9 +1055,9 @@ postFirmUsersR fsh = do
     (FirmUserActResetSupervisionData{..}, set2NonEmpty (error "Unexpected empty user list in getFirmUserR action handler.") -> uids) -> do  -- set guaranteed to be non-empty due to first case clause
       runDB $ do
         delSupers <- if firmUserActResetKeepOldSupers == Just False
-          then deleteSupervisors uids []
+          then deleteDefaultSupervisorsForUsers [] [] uids
           else return 0
-        newSupers <- addDefaultSupervisors cid uids
+        newSupers <- addDefaultSupervisors Nothing 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
@@ -1102,26 +1076,51 @@ postFirmUsersR fsh = do
               |]
         in addMessageModal Error (i18n . MsgCourseParticipantsRegisterNotFoundInAvs $ length usersNotFound) (Right msgContent)
       delSupers <- runDB
-         $ bool (deleteSupervisors uids [cid]) (return 0) firmUserActSetSuperKeep
+         $ bool (deleteDefaultSupervisorsForUsers [cid] [] uids) (return 0) firmUserActSetSuperKeep
-        <* putMany [UserSupervisor s u firmUserActSetSuperReroute (Just cid) Nothing | u <- toList uids, s <- newSupers]
+        <* putMany [UserSupervisor s u firmUserActSetSuperReroute (Just cid) firmUserActSetSuperReason | 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)]
+      nrUpd <- runDB $ updateWhereCount [UserCompanyCompany ==. cid, UserCompanyUser <-. uids] [UserCompanySupervisor =. True, UserCompanySupervisorReroute =. (firmUserActMkSuperReroute == Just True)]
-      addMessageI Info $ MsgFirmActAddSupersSet nrMkSuper Nothing
+      addMessageI Success $ MsgFirmActAddSupersSet nrUpd Nothing
       reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
-    (FirmUserActChangeContactData{..}, Set.toList -> uids) ->
+    (FirmUserActChangeDetailsData{..}, Set.toList -> uids) -> do
-      let changes = catMaybes
+      let upReason = case canonical firmUserActDetailReason of
-            [ (UserPostAddress   =.) . Just <$> canonical firmUserActPostalAddr  -- note that Nothing means no change and not delete address!
+                      Nothing     -> Nothing
-            , (UserPrefersPostal =.)        <$>           firmUserActPostalPref
+                      Just "NULL" -> Just $ UserCompanyReason =. Nothing
-            ]
+                      other       -> Just $ UserCompanyReason =. other
-      in unless (null changes) $ do
+      nrUpd <- runDB $ updateWhereCount [UserCompanyCompany ==. cid, UserCompanyUser <-. uids] $ catMaybes [upReason, (UserCompanyPriority =.) <$> firmUserActDetailPriority]
-        nrChanged <- runDB $ updateWhereCount [UserId <-. uids] changes
+      let total = fromIntegral $ length uids
-        addMessageI Success $ MsgFirmUserChanges nrChanged
+          allok = bool Warning Success $ nrUpd == total
+      addMessageI allok $ MsgFirmUserActChangeDetailsResult nrUpd total
+      reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
+    (FirmUserActChangeContactData{..}, Set.toList -> uids)
+      | firmUserActUseCompanyPostal == Just True, isJust firmUserActPostalAddr ->
+          addMessageI Error MsgCompanyUserUseCompanyPostalError
+      | otherwise -> do
+        let changes = catMaybes
+              [ toMaybe (firmUserActUseCompanyPostal == Just True) (UserPostAddress =. Nothing) -- precondition ensures that only one update applies for UserPostAddress
+              , (UserPostAddress   =.) . Just <$> canonical firmUserActPostalAddr               -- note that Nothing means no change and not delete address!
+              , (UserPrefersPostal =.)        <$>           firmUserActPostalPref
+              ]
+        nrChanged <- runDB $ do
+          nrUsrChange <- updateWhereCount [UserId <-. uids] changes
+          nrUseComp   <- case firmUserActUseCompanyPostal of
+            Just x  -> updateWhereCount [UserCompanyCompany ==. cid, UserCompanyUser <-. uids] [UserCompanyUseCompanyAddress =. x]
+            Nothing -> return 0
+          return $ max nrUsrChange nrUseComp
+        let total = fromIntegral $ length uids
+            allok = bool Warning Success $ nrChanged == total
+        addMessageI allok $ MsgFirmUserActChangeResult nrChanged total
         reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
+    (FirmUserActRemoveData{}, Set.toList -> uids) -> do
+      (nrUc, nrSuper, nrSubs) <- runDB $ deleteCompanyUser cid uids
+      let total = fromIntegral $ length uids
+          allok = bool Warning Success $ nrUc == total
+      addMessageI allok $ MsgFirmuserActRemoveResult nrUc nrSuper nrSubs
+      reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
 
-  formFirmAction <- runFirmActionFormPost cid (FirmUsersR fsh) isAdmin [FirmActNotify, FirmActResetSupervision, FirmActAddSupersvisors, FirmActChangeContactFirm, FirmActChangeContactUser]
+  formFirmAction <- runFirmActionFormPost cid (FirmUsersR fsh) isAdmin [FirmActNotify, FirmActResetSupervision, FirmActAddSupervisors, FirmActChangeContactFirm, FirmActChangeContactUser]
 
   siteLayout (citext2widget companyName) $ do
     setTitle $ toHtml $ CI.original companyShorthand <> "-" <> tshow companyAvsId
@@ -1351,7 +1350,7 @@ postFirmSupersR fsh = do
       cuids <- traverse encrypt $ Set.toList uids :: Handler [CryptoUUIDUser]
       redirect (FirmCommR fsh, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])
 
-  formFirmAction <- runFirmActionFormPost cid (FirmSupersR fsh) isAdmin [FirmActAddSupersvisors, FirmActResetSupervision, FirmActChangeContactFirm]
+  formFirmAction <- runFirmActionFormPost cid (FirmSupersR fsh) isAdmin [FirmActAddSupervisors, FirmActResetSupervision, FirmActChangeContactFirm]
 
   siteLayout (citext2widget fsh) $ do
     setTitle $ citext2Html $ fsh <> " Supers"

src/Handler/Profile.hs

@@ -630,7 +630,7 @@ makeProfileData usrEnt@(Entity uid usrVal@User{..}) = do
   avsId <- entityVal <<$>> getBy (UniqueUserAvsUser uid)
   let usrAutomatic :: CU_UserAvs_User -> Widget
       usrAutomatic = updateAutomatic . mayUpdate usrVal avsId . mkCheckUpdate
-
+  addressLinkdIcon <- messageTooltip <$> messageIconI Info IconLink MsgAddressIsLinkedTip
   (actualPrefersPostal, (actualPostAddress, postalAutomatic), (actualDisplayEmail, emailAutomatic)) <- getPostalPreferenceAndAddress' usrEnt
   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
@@ -1096,8 +1096,8 @@ mkSupervisorsTable uid = dbTableWidget validator DBTable{..}
                 if isReroute
                   then iconCell IconReroute <> spacerCell <> iconFixedCell (iconLetterOrEmail isLetter)
                   else mempty
-        , sortable (Just "cshort")      (i18nCell MsgTableCompany)        $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorCompany -> mc) -> maybeCell mc (\(unCompanyKey -> c) -> anchorCell (FirmUsersR c) $ citext2widget c)
+        , sortable (Just "cshort")      (i18nCell MsgTableCompany) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorCompany -> mc) -> maybeCell mc (\(unCompanyKey -> c) -> anchorCell (FirmUsersR c) $ citext2widget c)
-        , sortable (Just "reason")      (i18nCell MsgSupervisorReason)    $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorReason  -> mr) -> maybeCell mr textCell
+        , sortable (Just "reason")      (i18nCell MsgTableReason)  $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorReason  -> mr) -> maybeCell mr textCell
         ]
     validator = def & defaultSorting [ SortAscBy "cshort", SortAscBy "user-name" ]
     dbtSorting = mconcat
@@ -1146,8 +1146,8 @@ mkSuperviseesTable userPrefersPostal uid = dbTableWidget validator DBTable{..}
         , sortable (Just "reroute") (i18nCell MsgTableRerouteActive) $ \row ->
             let isReroute = row ^. resultUserSupervisor . _entityVal ._userSupervisorRerouteNotifications
             in  tellCell (Sum 1, Sum $ fromEnum isReroute) $ boolCell isReroute $ iconCell IconReroute <> iconCellLetterOrEmail
-        , sortable (Just "cshort")      (i18nCell MsgTableCompany)        $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorCompany -> mc) -> maybeCell mc (\(unCompanyKey -> c) -> anchorCell (FirmUsersR c) $ citext2widget c)
+        , sortable (Just "cshort")      (i18nCell MsgTableCompany)  $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorCompany -> mc) -> maybeCell mc (\(unCompanyKey -> c) -> anchorCell (FirmUsersR c) $ citext2widget c)
-        , sortable (Just "reason")      (i18nCell MsgSupervisorReason)    $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorReason  -> mr) -> maybeCell mr textCell
+        , sortable (Just "reason")      (i18nCell MsgTableReason)   $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorReason  -> mr) -> maybeCell mr textCell
         ]
     validator = def & defaultSorting [ SortAscBy "cshort", SortAscBy "user-name" ]
     dbtSorting = mconcat

src/Handler/Tutorial/Form.hs

@@ -91,7 +91,7 @@ tutorialForm cid template html = do
   where
     tutTypeDatalist :: HandlerFor UniWorX (OptionList (CI Text))
     tutTypeDatalist = fmap (mkOptionList . map (\t -> Option (CI.original t) t (toPathPiece $ CI.original t)) . Set.toAscList) . runDB $
-      fmap (setOf $ folded . _Value) . E.select . E.from $ \tutorial -> do
+      fmap (setOf $ folded . _Value) . E.select . E.distinct . E.from $ \tutorial -> do
         E.where_ $ tutorial E.^. TutorialCourse E.==. E.val cid
         return $ tutorial E.^. TutorialType
 

src/Handler/Users.hs

@@ -186,6 +186,12 @@ postUsersR = do
         let usrSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) usrMap
         return (act, usrSet)
 
+      superReasons :: HandlerFor UniWorX (OptionList Text)
+      superReasons = fmap (mkOptionList . map (\t -> Option t t t) . Set.toAscList) . runDB $
+        fmap (setOf $ folded . _Value . _Just) . Ex.select . Ex.distinct $ do
+          usrc <- Ex.from $ Ex.table @UserSupervisor
+          E.where_ $ E.isJust (usrc E.^. UserSupervisorReason)
+          return $ usrc E.^. UserSupervisorReason
       acts :: Map UserAction (AForm Handler UserActionData)
       acts = mconcat
         [ singletonMap UserLdapSync      $ pure UserLdapSyncData
@@ -193,11 +199,11 @@ postUsersR = do
         , singletonMap UserAddSupervisor $ UserAddSupervisorData
             <$> apopt (textField & cfAnySeparatedSet) (fslI MsgTableSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
             <*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just True)
-            <*> aopt   textField (fslI MsgSupervisorReason) Nothing
+            <*> aopt  (textField & cfStrip & addDatalist superReasons) (fslI MsgUserSupervisorReason & setTooltip MsgUserSupervisorReasonTooltip) Nothing
         , singletonMap UserSetSupervisor $ UserSetSupervisorData
             <$> apopt  (textField & cfAnySeparatedSet) (fslI MsgTableSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
             <*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just True)
-            <*> aopt   textField (fslI MsgSupervisorReason) Nothing
+            <*> aopt  (textField & cfStrip & addDatalist superReasons) (fslI MsgUserSupervisorReason & setTooltip MsgUserSupervisorReasonTooltip) Nothing
         , singletonMap UserRemoveSupervisor $ pure UserRemoveSupervisorData
         , singletonMap UserRemoveSubordinates $ pure UserRemoveSubordinatesData
         ]

src/Handler/Utils/Avs.hs

@@ -394,7 +394,7 @@ updateAvsUserByADC newAvsDataContact@(AvsDataContact apid newAvsPersonInfo newAv
             --           | otherwise
             --             -> Nothing
             superReasonComDef = tshow SupervisorReasonCompanyDefault
-            newUserComp = UserCompany usrId newCompanyId False False 1 True -- default value for new company insertion, if no update can be done
+            newUserComp = UserCompany usrId newCompanyId False False 1 True Nothing -- default value for new company insertion, if no update can be done
 
         usr_up2 <- case oldAvsFirmInfo of
           _ | Just newCompanyId == oldCompanyId                                               -- company unchanged entirely
@@ -439,7 +439,7 @@ updateAvsUserByADC newAvsDataContact@(AvsDataContact apid newAvsPersonInfo newAv
                   -- let oldCompDefSuperFltr = mconcat [UserSupervisorCompany ~~. oldCompanyId, UserSupervisorReason ~=. superReasonComDef]
                   -- deleteWhere $          (UserSupervisorSupervisor ==. usrId) : oldCompDefSuperFltr
                   -- oldAPs <- deleteWhereCount $ (UserSupervisorUser ==. usrId) : oldCompDefSuperFltr
-                  -- addCompanySupervisors newCompanyId usrId
+                  -- addDefaultSupervisors' newCompanyId $ singleton usrId
                   -- newAPs <- count $ (UserSupervisorUser ==. usrId) : (UserSupervisorCompany ==. Just newCompanyId) : (UserSupervisorReason ~=. superReasonComDef)
                   -- when (oldAPs > 0 && newAPs <= 0) $ reportAdminProblem $ AdminProblemNewlyUnsupervised usrId oldCompanyId newCompanyId
                   -- return pst_up
@@ -550,10 +550,10 @@ createAvsUserById muid api = do
                   }
             runDB $ do        -- any failure must rollback all DB write transactions here
               uid <- maybeThrowM (AvsUserCreationFailed api) $ addNewUserDB newUserData
-              let userComp = UserCompany uid cid False False 1 True -- default value for new company insertion, if no update can be done
+              let userComp = UserCompany uid cid False False 1 True Nothing -- default value for new company insertion, if no update can be done
               void $ insertUnique userComp -- Nothing indicates that the user is already linked to the company (which is unlikely here)
               -- Supervision
-              addCompanySupervisors cid uid
+              void $ addDefaultSupervisors' cid $ singleton uid
               -- Save AVS data for future updates
               insert_ $ usrAvs uid (Just cpi) (Just firmInfo) usrCardNo -- unlikely that uid cannot be linked with avsid, but throw if it is not possible
               return uid
@@ -643,71 +643,90 @@ upsertAvsCompany newAvsFirmInfo mbOldAvsFirmInfo = do
 
 -- upsert company supervisor from AvsFirmEMailSuperior
 upsertCompanySuperior :: (Maybe CompanyId, AvsFirmInfo) -> Maybe AvsFirmInfo -> DB (Maybe (CompanyId, UserId))
-upsertCompanySuperior (mbCid, newAfi) mbOldAfi = runMaybeT $ do
+upsertCompanySuperior (mbCid, newAfi) mbOldAfi
-    supemail <- MaybeT . pure $ newAfi ^. _avsFirmEMailSuperior
+    | Just supemail <- newAfi ^. _avsFirmEMailSuperior -- superior given
-    cid <- MaybeT $ altM (pure mbCid) (getAvsCompanyId newAfi)
+      = runMaybeT $ do
-    supid <- MaybeT $ altM (guessUserByEmail $ stripCI supemail)
+        cid <- MaybeT $ altM (pure mbCid) (getAvsCompanyId newAfi)
-                           (catchAVShandler True True False Nothing $ Just . entityKey <$> ldapLookupAndUpsert supemail)
+        supid <- MaybeT $ altM (guessUserByEmail $ stripCI supemail)
-    lift $ do
+                               (catchAVShandler True True False Nothing $ Just . entityKey <$> ldapLookupAndUpsert supemail)
-      let reasonSuperior = Just $ tshow SupervisorReasonAvsSuperior
+        lift $ do
-      oldChanges <- runMaybeT $ do -- remove old superior, if any
+          oldChanges <- runMaybeT $ do -- remove old superior, if any
-        oldAfi <- MaybeT $ pure mbOldAfi
+            oldAfi <- MaybeT $ pure mbOldAfi
-        oldEml <- MaybeT $ pure $ oldAfi ^. _avsFirmEMailSuperior
+            oldEml <- MaybeT $ pure $ oldAfi ^. _avsFirmEMailSuperior
-        oldCid <- MaybeT $ getAvsCompanyId oldAfi
+            oldCid <- MaybeT $ getAvsCompanyId oldAfi
-        oldSup <- MaybeT $ guessUserByEmail $ stripCI oldEml
+            oldSup <- MaybeT $ guessUserByEmail $ stripCI oldEml
-        let supChange = oldSup /= supid
+            let supChange = oldSup /= supid
-        when (supChange && oldCid == cid) $ lift $ do
+            when (supChange && oldCid == cid) $ lift $ do
-          -- deleteWhere [UserCompanyCompany ==. cid, UserCompanyUser ==. oldSup] -- remove old supervisor from company NOTE: we leave this to the oldSuperior's AVS update
+              -- deleteWhere [UserCompanyCompany ==. cid, UserCompanyUser ==. oldSup] -- remove old supervisor from company NOTE: we leave this to the oldSuperior's AVS update
-          -- switch supervison
+              -- switch supervison
-          -- updateWhere [UserSupervisorCompany ==. Just cid, UserSupervisorSupervisor ==. oldSup, UserSupervisorReason ==. reasonSuperior] [UserSupervisor =. supid] -- not safe, could violate uniqueness
+              -- updateWhere [UserSupervisorCompany ==. Just cid, UserSupervisorSupervisor ==. oldSup, UserSupervisorReason ==. reasonSuperior] [UserSupervisor =. supid] -- not safe, could violate uniqueness
-          E.update $ \usuper -> do
+              E.update $ \usuper -> do
-            E.set usuper [ UserSupervisorSupervisor E.=. E.val supid ]
+                E.set usuper [ UserSupervisorSupervisor E.=. E.val supid ]
-            E.where_ $ usuper E.^. UserSupervisorSupervisor E.==. E.val oldSup
+                E.where_ $ usuper E.^. UserSupervisorSupervisor E.==. E.val oldSup
-                E.&&.  usuper E.^. UserSupervisorCompany    E.==. E.justVal cid
+                    E.&&.  usuper E.^. UserSupervisorCompany    E.==. E.justVal cid
-                E.&&.  usuper E.^. UserSupervisorReason     E.==. E.val reasonSuperior
+                    E.&&.  usuper E.^. UserSupervisorReason     E.==. E.val reasonSuperior
-                E.&&. E.notExists (do
+                    E.&&. E.notExists (do
-                    newSuper <- E.from $ E.table @UserSupervisor
+                        newSuper <- E.from $ E.table @UserSupervisor
-                    E.where_ $ newSuper E.^. UserSupervisorSupervisor E.==. E.val supid
+                        E.where_ $ newSuper E.^. UserSupervisorSupervisor E.==. E.val supid
-                        E.&&.  newSuper E.^. UserSupervisorUser       E.==. newSuper E.^. UserSupervisorUser
+                            E.&&.  newSuper E.^. UserSupervisorUser       E.==. newSuper E.^. UserSupervisorUser
-                  )
+                      )
-          deleteWhere [UserSupervisorSupervisor ==. oldSup, UserSupervisorCompany ==. Just cid, UserSupervisorReason ==. reasonSuperior] -- remove un-updateable remainders, if any
+              deleteOldSuperior oldSup cid    -- remove un-updateable remainders, if any
-        return (supChange, oldSup)
+            return (supChange, oldSup)
-      let supChange = fst <$> oldChanges
+          let supChange = fst <$> oldChanges
-          oldSup    = snd <$> oldChanges
+              oldSup    = snd <$> oldChanges
-      unless (supChange == Just False) $ do
+          unless (supChange == Just False) $ do
-        -- upsert new superior company supervisor
+            -- upsert new superior company supervisor
-        mbMaxPrio <- E.selectOne $ do
+            mbMaxPrio <- E.selectOne $ do
-          usrCmp <- E.from $ E.table @UserCompany
+              usrCmp <- E.from $ E.table @UserCompany
-          E.where_ $ usrCmp E.^. UserCompanyUser E.==. E.val supid
+              E.where_ $ usrCmp E.^. UserCompanyUser E.==. E.val supid
-          return . E.max_ $ usrCmp E.^. UserCompanyPriority
+              return . E.max_ $ usrCmp E.^. UserCompanyPriority
-        let maxPrio = maybe 1 (fromMaybe 1 . E.unValue) mbMaxPrio
+            let maxPrio = maybe 1 (fromMaybe 1 . E.unValue) mbMaxPrio
-        suprEnt <- upsertBy (UniqueUserCompany supid cid)
+            suprEnt <- upsertBy (UniqueUserCompany supid cid)
-                              (UserCompany supid cid True False maxPrio True)
+                                  (UserCompany supid cid True False maxPrio True reasonSuperior)
-                              [UserCompanySupervisor =. True, UserCompanyPriority =. maxPrio]
+                                  [UserCompanySupervisor =. True, UserCompanyPriority =. maxPrio, UserCompanyReason =. reasonSuperior]
-        E.insertSelectWithConflict UniqueUserSupervisor
+            E.insertSelectWithConflict UniqueUserSupervisor
-          (do
+              (do
-            usr <- E.from $ E.table @UserCompany
+                usr <- E.from $ E.table @UserCompany
-            E.where_ $ usr E.^. UserCompanyCompany E.==. E.val cid
+                E.where_ $ usr E.^. UserCompanyCompany E.==. E.val cid
-                -- E.&&. E.notExists (do                                                              -- restrict to primary company only
+                    -- E.&&. E.notExists (do                                                              -- restrict to primary company only
-                --     othr <- E.from $ E.table @UserCompany
+                    --     othr <- E.from $ E.table @UserCompany
-                --     E.where_ $ othr E.^. UserCompanyPriority E.>.  usr E.^. UserCompanyPriority
+                    --     E.where_ $ othr E.^. UserCompanyPriority E.>.  usr E.^. UserCompanyPriority
-                --         E.&&.  othr E.^. UserCompanyUser     E.==. usr E.^. UserCompanyUser
+                    --         E.&&.  othr E.^. UserCompanyUser     E.==. usr E.^. UserCompanyUser
-                --         E.&&.  othr E.^. UserCompanyCompany  E.!=. E.val cid                       -- redundant due to > above, but likely performance improving
+                    --         E.&&.  othr E.^. UserCompanyCompany  E.!=. E.val cid                       -- redundant due to > above, but likely performance improving
-                --   )
+                    --   )
-            return $ UserSupervisor
+                return $ UserSupervisor
-              E.<#  E.val supid
+                  E.<#  E.val supid
-              E.<&> (usr E.^. UserCompanyUser)
+                  E.<&> (usr E.^. UserCompanyUser)
-              E.<&> E.val (suprEnt ^. _entityVal . _userCompanySupervisorReroute)
+                  E.<&> E.val (suprEnt ^. _entityVal . _userCompanySupervisorReroute)
-              E.<&> E.justVal cid
+                  E.<&> E.justVal cid
-              E.<&> E.val reasonSuperior
+                  E.<&> E.val reasonSuperior
-          )
+              )
-          (\old new ->
+              (\_old new ->
-            [ UserSupervisorCompany E.=. E.coalesce [old E.^. UserSupervisorCompany, new E.^. UserSupervisorCompany]
+                [ -- UserSupervisorSupervisor E.=. new E.^. UserSupervisorSupervisor  -- this is already given in case of conflict
-            , UserSupervisorReason  E.=. E.coalesce [old E.^. UserSupervisorReason , new E.^. UserSupervisorReason ]
+                  UserSupervisorCompany    E.=. new E.^. UserSupervisorCompany
-            ]
+                , UserSupervisorReason     E.=. new E.^. UserSupervisorReason
-          )
+                ]
-        reportAdminProblem $ AdminProblemCompanySuperiorChange supid cid oldSup
+              )
-      return (cid,supid)
+            reportAdminProblem $ AdminProblemCompanySuperiorChange supid cid oldSup
+          return (cid,supid)
+    | Just oldSupeEmail <- mbOldAfi ^? _Just . _avsFirmEMailSuperior . _Just -- no more superior, delete old one
+      = do
+          void $ runMaybeT $ do
+            oldAfi <- MaybeT $ pure mbOldAfi
+            oldCid <- MaybeT $ getAvsCompanyId oldAfi
+            oldSup <- MaybeT $ guessUserByEmail $ stripCI oldSupeEmail
+            lift $ deleteOldSuperior oldSup oldCid
+          return Nothing
+    | otherwise -- neither new nor old superior
+      = return Nothing
+  where
+    reasonSuperior = Just $ tshow SupervisorReasonAvsSuperior
+
+    deleteOldSuperior oldSup oldCid =
+      deleteWhere [ UserSupervisorSupervisor ==. oldSup
+                  , UserSupervisorCompany ==. Just oldCid
+                  , UserSupervisorReason ==. reasonSuperior
+                  ]
 
 
 queueAvsUpdateByUID :: (MonoFoldable mono, UserId ~ Element mono) => mono -> Maybe Day -> DB Int64

src/Handler/Utils/Company.hs

@@ -21,6 +21,14 @@ import qualified Database.Esqueleto.PostgreSQL   as E
 import Handler.Utils.Users
 import Handler.Utils.Widgets
 
+-- Snippet to restrict to primary company only
+--  E.&&. E.notExists (do
+--      othr <- E.from $ E.table @UserCompany
+--      E.where_ $ othr E.^. UserCompanyPriority E.>.  userCompany E.^. UserCompanyPriority
+--          E.&&.  othr E.^. UserCompanyUser     E.==. userCompany E.^. UserCompanyUser
+--          E.&&.  othr E.^. UserCompanyCompany  E.!=. E.val cid                       -- redundant due to > above, but likely performance improving
+--    )
+
 company2msg :: CompanyId -> SomeMessage UniWorX
 company2msg = text2message . ciOriginal . unCompanyKey
 
@@ -51,37 +59,94 @@ wgtCompanies = \uid -> do
           (accPri,accTop,accRem) = procCmp maxPri cs
       in (max cmpPrio accPri, bool accTop (cmpWgt : accTop) isTop, bool (cmpWgt : accRem) accRem isTop) -- lazy evaluation after repmin example, don't factor out the bool!
 
--- TODO: use this function in company view Handler.Firm #157
+type AnySuperReason = Either SupervisorReason (Maybe Text)
--- | add all company supervisors for a given users
-addCompanySupervisors :: (MonadIO m, BackendCompatible SqlBackend backend, PersistQueryWrite backend, PersistUniqueWrite backend)
-                      => Key Company -> Key User -> ReaderT backend m ()
-addCompanySupervisors cid uid =
-  E.insertSelectWithConflict
-    UniqueUserSupervisor
-    ( do
-        userCompany <- E.from $ E.table @UserCompany
-        E.where_ $ userCompany E.^. UserCompanyCompany E.==. E.val cid
-            E.&&.  userCompany E.^. UserCompanySupervisor
-        --  E.&&. E.notExists (do                                                              -- restrict to primary company only
-        --      othr <- E.from $ E.table @UserCompany
-        --      E.where_ $ othr E.^. UserCompanyPriority E.>.  userCompany E.^. UserCompanyPriority
-        --          E.&&.  othr E.^. UserCompanyUser     E.==. userCompany E.^. UserCompanyUser
-        --          E.&&.  othr E.^. UserCompanyCompany  E.!=. E.val cid                       -- redundant due to > above, but likely performance improving
-        --    )
 
-        return $ UserSupervisor
-          E.<#  (userCompany E.^. UserCompanyUser)
-          E.<&>  E.val uid
-          E.<&> (userCompany E.^. UserCompanySupervisorReroute)
-          E.<&>  E.justVal cid
-          E.<&>  E.justVal (tshow SupervisorReasonCompanyDefault)
-    )
-    (\current excluded -> -- Supervision between chosen individuals exists already; keep old reason and company, if exists
-        [ UserSupervisorCompany E.=. E.coalesce [current  E.^. UserSupervisorCompany, excluded E.^. UserSupervisorCompany] -- do we want this? Ok, since we delete unconditionally first?!
-        , UserSupervisorReason  E.=. E.coalesce [current  E.^. UserSupervisorReason , excluded E.^. UserSupervisorReason ]
-        ]
-    )
 
+addDefaultSupervisors' :: CompanyId -> NonEmpty UserId -> DB Int64
+addDefaultSupervisors' = addDefaultSupervisors $ Just $ tshow SupervisorReasonCompanyDefault
+
+-- adds the default company supervisors as supervisor to a given set of users, which themselves may belong to any company
+-- if no reason is given, SupervisorReasonCompanyDefault is used, except if reason == Just "NULL"
+addDefaultSupervisors :: Maybe Text -> CompanyId -> NonEmpty UserId -> DB Int64
+addDefaultSupervisors reason cid employees = do
+  E.insertSelectWithConflictCount UniqueUserSupervisor
+    (do
+      (spr :& usr) <- E.from $ E.table @UserCompany `E.crossJoin` E.toValues employees
+      E.where_ $ spr E.^. UserCompanyCompany E.==. E.val cid
+          E.&&.  spr E.^. UserCompanySupervisor
+      E.distinct $ return $ UserSupervisor
+        E.<#  (spr E.^. UserCompanyUser)
+        E.<&>  usr
+        E.<&> (spr E.^. UserCompanySupervisorReroute)
+        E.<&> E.justVal cid
+        E.<&> case reason of
+                Nothing     -> E.justVal $ tshow SupervisorReasonCompanyDefault
+                Just "NULL" -> E.nothing
+                other       -> E.val other
+    )
+    (\old new ->
+      [ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications
+      , UserSupervisorCompany E.=. E.justVal cid
+      , UserSupervisorReason  E.=. E.coalesce [new E.^. UserSupervisorReason, old E.^. UserSupervisorReason] -- keep existing reason, if no new one was given
+      ])
+
+
+-- like `Handler.Utils.addDefaultSupervisors`, but selects all employees of given companies from database, optionally filtered by being under supervision of a given individual
+-- TODO: check redundancies
+addDefaultSupervisorsFor ::  (CompanyId ~ Element mono, MonoFoldable mono) => Maybe Text -> Maybe UserId -> Bool -> mono -> DB Int64
+addDefaultSupervisorsFor reason mbSuperId mutualSupervision cids = do
+  E.insertSelectWithConflictCount UniqueUserSupervisor
+    (do
+      (spr :& usr) <- E.from $ E.table @UserCompany `E.innerJoin` E.table @UserCompany `E.on` (\(spr :& usr) -> spr E.^. UserCompanyCompany E.==. usr E.^. UserCompanyCompany)
+      E.where_ $ E.and $ guardMonoid (not mutualSupervision)
+                            [ E.not_ $ usr E.^. UserCompanySupervisor ]
+                        <>  maybeEmpty mbSuperId (\sprId -> [E.exists $ do
+                              superv <- E.from $ E.table @UserSupervisor
+                              E.where_ $ superv E.^. UserSupervisorSupervisor E.==. E.val sprId
+                                  E.&&.  superv E.^. UserSupervisorUser       E.==. usr E.^. UserCompanyUser
+                            ])
+                        <>  [          spr E.^. UserCompanySupervisor
+                            , spr E.^. UserCompanyCompany `E.in_` E.vals cids
+                            , usr E.^. UserCompanyCompany `E.in_` E.vals cids
+                            ]
+      E.distinct $ return $ UserSupervisor
+        E.<#  (spr E.^. UserCompanyUser)
+        E.<&> (usr E.^. UserCompanyUser)
+        E.<&> (spr E.^. UserCompanySupervisorReroute)
+        E.<&> E.just (spr E.^. UserCompanyCompany)
+        E.<&> E.val reason
+    )
+    (\old new ->
+        [ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications
+        , UserSupervisorCompany E.=. new E.^. UserSupervisorCompany
+        , UserSupervisorReason  E.=. E.coalesce [new E.^. UserSupervisorReason, old E.^. UserSupervisorReason] -- keep existing reason, if no new one was given
+        ] )
+
+-- like `addDefaultSupervisors`, but selects all employees of given companies from database
+-- TODO: check redundancies
+addDefaultSupervisorsAll ::  (CompanyId ~ Element mono, MonoFoldable mono) => Maybe Text -> Bool -> mono -> DB Int64
+addDefaultSupervisorsAll reason mutualSupervision cids = do
+  E.insertSelectWithConflictCount UniqueUserSupervisor
+    (do
+      (spr :& usr) <- E.from $ E.table @UserCompany `E.innerJoin` E.table @UserCompany `E.on` (\(spr :& usr) -> spr E.^. UserCompanyCompany E.==. usr E.^. UserCompanyCompany)
+      E.where_ $ E.and $ guardMonoid (not mutualSupervision)
+                            [ E.not_ $ usr E.^. UserCompanySupervisor ]
+                        <>  [          spr E.^. UserCompanySupervisor
+                            , spr E.^. UserCompanyCompany `E.in_` E.vals cids
+                            , usr E.^. UserCompanyCompany `E.in_` E.vals cids
+                            ]
+      E.distinct $ return $ UserSupervisor
+        E.<#  (spr E.^. UserCompanyUser)
+        E.<&> (usr E.^. UserCompanyUser)
+        E.<&> (spr E.^. UserCompanySupervisorReroute)
+        E.<&> E.just (spr E.^. UserCompanyCompany)
+        E.<&> E.val reason
+    )
+    (\old new ->
+        [ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications
+        , UserSupervisorCompany E.=. new E.^. UserSupervisorCompany
+        , UserSupervisorReason  E.=. E.coalesce [old E.^. UserSupervisorReason, new E.^. UserSupervisorReason] -- keep any existing reason
+        ] )
 
 -- | removes user supervisorship on switch. WARNING: problems are not yet written to DB via reportProblem yet
 switchAvsUserCompany :: Bool -> Bool -> UserId -> CompanyId -> DB ([Update User], [AdminProblem])
@@ -108,13 +173,14 @@ switchAvsUserCompany usrPostEmailUpds keepOldCompanySupervs uid newCompanyId = d
     case mbUsrComp of
       Nothing -> do -- create company user
         void $ insertUnique newUserComp
-        addCompanySupervisors newCompanyId uid
+        void $ addDefaultSupervisors Nothing newCompanyId $ singleton uid
         return (usrUpdate, mempty)
-      Just UserCompany{userCompanyCompany=oldCompanyId, userCompanyPriority=oldPrio, userCompanySupervisor=oldSuper, userCompanySupervisorReroute=oldSuperReroute}
+      Just UserCompany{userCompanyCompany=oldCompanyId, userCompanyPriority=oldPrio, userCompanySupervisor=oldSuper, userCompanySupervisorReroute=oldSuperReroute, userCompanyReason=oldAssocReason}
         | newCompanyId == oldCompanyId -> return mempty -- nothing to do
         | otherwise -> do -- switch company
+            when (isNothing oldAssocReason) $ deleteBy $ UniqueUserCompany uid oldCompanyId
             void $ upsertBy (UniqueUserCompany uid newCompanyId) newUserComp
-              [UserCompanyPriority =. succ oldPrio, UserCompanySupervisor =. False, UserCompanySupervisorReroute =. False, UserCompanyUseCompanyAddress =. True]
+              [UserCompanyPriority =. succ oldPrio, UserCompanySupervisor =. False, UserCompanySupervisorReroute =. False, UserCompanyUseCompanyAddress =. True, UserCompanyReason =. Nothing]
             -- supervised by uid
             supervisees :: [(Entity UserSupervisor, E.Value Bool)] <- E.select $ do
               usrSup <- E.from $ E.table @UserSupervisor
@@ -139,7 +205,7 @@ switchAvsUserCompany usrPostEmailUpds keepOldCompanySupervs uid newCompanyId = d
             oldAPs <- if keepOldCompanySupervs
               then updateWhereCount oldSubFltr [UserSupervisorReason =. Nothing]
               else deleteWhereCount oldSubFltr
-            addCompanySupervisors newCompanyId uid
+            void $ addDefaultSupervisors Nothing newCompanyId $ singleton uid
             newAPs <- count $ (UserSupervisorCompany ==. Just newCompanyId) : superDeftFltr
             let isNoLongerSupervised = not keepOldCompanySupervs && oldAPs > 0 && newAPs <= 0
                 problems = bcons oldSuper             (AdminProblemSupervisorNewCompany uid oldCompanyId newCompanyId oldSuperReroute)
@@ -147,5 +213,27 @@ switchAvsUserCompany usrPostEmailUpds keepOldCompanySupervs uid newCompanyId = d
                            newlyUnsupervised
             return (usrUpdate ,problems)
   where
-    newUserComp       = UserCompany uid newCompanyId False False 1 True -- default value for new company insertion, if no update can be done
+    newUserComp       = UserCompany uid newCompanyId False False 1 True Nothing -- default value for new company insertion, if no update can be done
     superReasonComDef = tshow SupervisorReasonCompanyDefault
+
+defaultSupervisorReasonFilter :: [Filter UserSupervisor]
+defaultSupervisorReasonFilter =
+        [UserSupervisorReason  ==. Nothing]
+    ||. [UserSupervisorReason  ==. Just (tshow SupervisorReasonCompanyDefault)]
+--  ||. [UserSupervisorReason <-. [Just $ tshow r | r <- [SupervisorReasonCompanyDefault, SupervisorReasonAvsSuperior]]]
+
+-- | remove supervisors for given users; maybe restricted to those linked to given companies or supervisors
+deleteDefaultSupervisorsForUsers :: [CompanyId] -> [UserId] -> NonEmpty UserId -> DB Int64
+deleteDefaultSupervisorsForUsers cids sprs usrs =
+    deleteWhereCount
+      $ bcons (notNull cids) (UserSupervisorCompany     <-. (cids <&> Just))
+      $ bcons (notNull sprs) (UserSupervisorSupervisor  <-.  sprs)
+      $ (UserSupervisorUser <-. toList usrs) : defaultSupervisorReasonFilter
+
+-- | deletes user company association and all company related supervision
+-- WARNING: does not check for admin problems!
+deleteCompanyUser :: CompanyId -> [UserId] -> DB (Int64, Int64, Int64)
+deleteCompanyUser cid uids = (,,)
+    <$> deleteWhereCount  [UserCompanyCompany    ==.      cid,  UserCompanyUser          <-. uids]
+    <*> deleteWhereCount ((UserSupervisorCompany ==. Just cid):(UserSupervisorSupervisor <-. uids) : defaultSupervisorReasonFilter)
+    <*> deleteWhereCount ((UserSupervisorCompany ==. Just cid):(UserSupervisorUser       <-. uids) : defaultSupervisorReasonFilter)

src/Handler/Utils/Form.hs

@@ -740,8 +740,7 @@ uploadModeForm fs prev = multiActionA actions fs (classifyUploadMode <$> prev)
                 let iStart = maybe 0 (succ . fst) $ Map.lookupMax oldRess
                  in pure $ Map.singleton iStart fileRes
           return (addRes', formWidget')
-        miCell _ initFile _ nudge csrf =
+        miCell _ initFile _ nudge = sFileForm nudge (Just initFile)
-          sFileForm nudge (Just initFile) csrf
         miDelete :: MassInputDelete ListLength
         miDelete = miDeleteList
         miAddEmpty _ _ _ = Set.empty
@@ -1485,6 +1484,13 @@ yamlField = Field{..}
     fieldEnctype = UrlEncoded
 -}
 
+
+boolField' :: ( MonadHandler m
+              , HandlerSite m ~ UniWorX
+              )
+          => Field m Bool
+boolField' = boolField (Just $ SomeMessage MsgBoolIrrelevant)
+
 boolField :: ( MonadHandler m
              , HandlerSite m ~ UniWorX
              )

src/Handler/Utils/Users.hs

@@ -1000,11 +1000,13 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
         E.<&> (userCompany E.^. UserCompanySupervisorReroute)
         E.<&> (userCompany E.^. UserCompanyPriority)
         E.<&> (userCompany E.^. UserCompanyUseCompanyAddress)
+        E.<&> (userCompany E.^. UserCompanyReason)
     )
     (\current excluded ->
       [ UserCompanySupervisor         E.=. E.greatest (current E.^. UserCompanySupervisor)        (excluded E.^. UserCompanySupervisor)       -- t > f
       , UserCompanyPriority           E.=. E.greatest (current E.^. UserCompanyPriority)          (excluded E.^. UserCompanyPriority)
       , UserCompanyUseCompanyAddress  E.=. E.greatest (current E.^. UserCompanyUseCompanyAddress) (excluded E.^. UserCompanyUseCompanyAddress)
+      , UserCompanyReason             E.=. E.coalesce [current E.^. UserCompanyReason             ,excluded E.^. UserCompanyReason]
       ]
     )
   deleteWhere [ UserCompanyUser ==. oldUserId]

src/Model/Types/Misc.hs

@@ -65,6 +65,8 @@ data SupervisorReason
   deriving (Eq, Ord, Enum, Bounded, Generic)
   deriving anyclass (Universe, Finite, NFData)
 
+-- NOTE: it is intentional not to have an embedRenderMessage here; within the DB, we allow arbitrary text, but we do match on these ones to recognise certain functions
+--       so do not change values here without a proper migration
 instance Show SupervisorReason where
   show SupervisorReasonCompanyDefault = "Firmenstandard"
   show SupervisorReasonAvsSuperior    = "Vorgesetzer"

src/Utils/Form.hs

@@ -801,7 +801,7 @@ intMinMaxField :: (Monad m, Integral i, Show i, RenderMessage (HandlerSite m) Fo
 intMinMaxField lower upper = intF{ fieldView=newView }
   where
     intF@Field{ fieldView=oldView } = intField
-    newView theId name attrs val isReq = oldView theId name (newAttrs <> attrs) val isReq
+    newView theId name attrs = oldView theId name (newAttrs <> attrs)
     newAttrs = [ (a,tshow v) | (a,Just v) <- [("min", lower),("max", upper)] ]
 
 daysField :: (Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m NominalDiffTime

src/Utils/Icon.hs

@@ -121,6 +121,7 @@ data Icon
   | IconUserEdit
   --  IconMagic           -- indicates automatic updates
   | IconReroute           -- for notification rerouting
+  | IconTop               -- indicating highest number/quantity/priority for something
 
   deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic)
   deriving anyclass (Universe, Finite, NFData)
@@ -220,6 +221,7 @@ iconText = \case
     IconUserEdit                -> "user-edit"
     -- IconMagic                   -> "wand-magic"
     IconReroute                 -> "directions"
+    IconTop                     -> "arrow-to-top"
 nullaryPathPiece ''Icon $ camelToPathPiece' 1
 deriveLift ''Icon
 

templates/profileData.hamlet

@@ -68,6 +68,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
         <dt .deflist__dt>
           _{MsgAdminUserPostAddress} #
           ^{updateAutomatic postalAutomatic}
+          $if isNothing userPostAddress
+            ^{addressLinkdIcon}
         <dd .deflist__dd>
           #{addr}
         $if (not postalAutomatic)

test/Database/Fill.hs

@@ -655,25 +655,25 @@ fillDb = do
                           , let rcName  = CI.mk $ "Random Corp " <> tshow n <> bool "" " GmbH" (even n)
                           , let rcShort = CI.mk $ "RC" <> tshow n
                           ]
-  void . insert' $ UserCompany jost    fraportAg    True   True  0 False
+  void . insert' $ UserCompany jost    fraportAg    True   True  0 False $ Just "Vorgesetzter"
-  void . insert' $ UserCompany svaupel nice         True   False 2 False
+  void . insert' $ UserCompany svaupel nice         True   False 2 False $ Just "Vorgesetzter"
-  void . insert' $ UserCompany svaupel ffacil       False  False 1 False
+  void . insert' $ UserCompany svaupel ffacil       False  False 1 False $ Just "Irgendwas"
-  void . insert' $ UserCompany svaupel bpol         True   False 2 False
+  void . insert' $ UserCompany svaupel bpol         True   False 2 False $ Just "Irgendwas"
-  void . insert' $ UserCompany svaupel fraGround    True   False 1 False
+  void . insert' $ UserCompany svaupel fraGround    True   False 1 False $ Just "Irgendwas"
-  void . insert' $ UserCompany gkleen  nice         False  False 1 True
+  void . insert' $ UserCompany gkleen  nice         False  False 1 True  $ Just "Winterdienst"
-  void . insert' $ UserCompany gkleen  fraGround    False  True  2 False
+  void . insert' $ UserCompany gkleen  fraGround    False  True  2 False $ Just "Irgendwas"
-  void . insert' $ UserCompany gkleen  bpol         False  True  1 False
+  void . insert' $ UserCompany gkleen  bpol         False  True  1 False $ Just "Irgendwas"
-  void . insert' $ UserCompany fhamann bpol         False  False 1 True
+  void . insert' $ UserCompany fhamann bpol         False  False 1 True  $ Just "Irgendwas"
-  void . insert' $ UserCompany fhamann ffacil       True   True  2 True
+  void . insert' $ UserCompany fhamann ffacil       True   True  2 True  $ Just "Irgendwas"
-  void . insert' $ UserCompany fhamann nice         False  False 3 False
+  void . insert' $ UserCompany fhamann nice         False  False 3 False $ Just "Winterdienst"
-  void . insert' $ UserCompany sbarth  nice         False  False 3 False
+  void . insert' $ UserCompany sbarth  nice         False  False 3 False $ Just "Winterdienst"
-  void . insert' $ UserCompany sbarth  bpol         True   True  1 True
+  void . insert' $ UserCompany sbarth  bpol         True   True  1 True  $ Just "Irgendwas"
   -- need more tests
-  insertMany_ [UserCompany uid fraGround False False 0 True | Entity uid User{userFirstName = "John"} <- matUsers]
+  insertMany_ [UserCompany uid fraGround False False 0 True Nothing | Entity uid User{userFirstName = "John"} <- matUsers]
-  insertMany_ [UserCompany uid bpol False False 0 False     | Entity uid User{userFirstName = "Elizabeth"} <- matUsers]
+  insertMany_ [UserCompany uid bpol False False 0 False     Nothing | Entity uid User{userFirstName = "Elizabeth"} <- matUsers]
-  insertMany_ [UserCompany uid bpol True True 0 True        | Entity uid User{userFirstName = "Clark", userSurname = dn} <- matUsers, dn == "Walker" || dn == "Robinson"]
+  insertMany_ [UserCompany uid bpol True True 0 True        Nothing | Entity uid User{userFirstName = "Clark", userSurname = dn} <- matUsers, dn == "Walker" || dn == "Robinson"]
-  insertMany_ [UserCompany uid ffacil False False 0 False   | Entity uid User{userSurname = "Walker"} <- matUsers]
+  insertMany_ [UserCompany uid ffacil False False 0 False   Nothing | Entity uid User{userSurname = "Walker"} <- matUsers]
-  insertMany_ [UserCompany uid rckey issuper False 0 True
+  insertMany_ [UserCompany uid rckey issuper False 0 True Nothing
               | rckey <- randComps
               , Just n <- [readMay $ drop 2 $ unpack $ CI.original $ unCompanyKey rckey]
               , Entity uid User{userSurname = uSurname} <- take (n `div` 20) $ drop (2*n) matUsers
@@ -699,9 +699,9 @@ fillDb = do
               , UserSupervisor gkleen gkleen          True  (Just fraGround)  (Just "Staff")
               , UserSupervisor tinaTester tinaTester  False Nothing           (Just "Staff")
               ]
-              ++ take 444 [ UserSupervisor fhamann uid True  Nothing (Just $ tshow SupervisorReasonCompanyDefault) | Entity uid _ <-          matUsers, uid /= jost]
+              ++ take 444 [ UserSupervisor fhamann uid True  Nothing (Just $ tshow SupervisorReasonCompanyDefault)        | Entity uid _ <-          matUsers, uid /= jost]
-              ++ take 123 [ UserSupervisor gkleen  uid True  Nothing Nothing                                       | Entity uid _ <- drop 369 matUsers ]
+              ++ take 123 [ UserSupervisor gkleen  uid True  Nothing Nothing                                              | Entity uid _ <- drop 369 matUsers ]
-              ++ take  11 [ UserSupervisor jost    uid False Nothing (Just $ tshow SupervisorReasonAvsSuperior)    | Entity uid _ <- drop 501 matUsers ]
+              ++ take  11 [ UserSupervisor jost    uid False (Just fraportAg) (Just $ tshow SupervisorReasonAvsSuperior)  | Entity uid _ <- drop 501 matUsers ]
   upsertManyWhere supvs [] [] []
   -- insertMany_ supvs              -- NOTE: multiple calls like this throw a runtime error!
   -- upsertManyWhere supvs [] [] [] -- NOTE: multiple calls like this are ok