refactor(firm): clean firm interface

- multiactions working
- several code redundancies removed

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

@@ -9,18 +9,23 @@ FirmEmail: Allgemeine Email
 FirmAddress: Postanschrift
 FirmDefaultPreferenceInfo: Diese Voreinstellungen gelten nur für neue Firmenangehörige
 FirmAction: Firmenweite Aktion
+FirmActionInfo: Betrifft alle Firmenangehörigen.
 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
-FirmActAddSupervisors: Ansprechpartner hinzufügen
+FirmActAddSupersvisors: Ansprechpartner hinzufügen
-FirmAllActNotify: Mitteilung versenden
+FirmActAddSupersEmpty: Es konnten keine Ansprechpartner hinzugefügt werden
-FirmAllActResetSupervision: Ansprechpartner für alle Firmenangehörigen zurücksetzen
+FirmActAddSupersSet n@Int64 postal@(Maybe Bool): #{n} Standardansprechpartner eingetragen #{maybeBoolMessage postal "" "und auf Briefversand geschaltet" "und Benachrichtigungen per Email gesetzt"}, aber nicht nicht aktiviert.
-FirmAllActResetSuperKeep: Bisherige Ansprechpartner der Firmenangehörigen zusätzlich beibehalten?
+RemoveSupervisors ndef@Int64 nact@Int64: #{ndef} Standard Ansprechpartner entfernt#{bool ", aber noch nicht deaktiviert" (", " <> tshow nact <> " aktive Ansprechpartnerbeziehungen gelöscht") (nact > 0)}
-FirmAllActResetMutualSupervision: Ansprechpartner beaufsichtigen sich gegenseitig
+FirmActChangeContactUser: Kontaktinformationen von Firmenangehörigen ändern
+FirmActChangeContactFirm: Kontaktinformationen der Firma ändern
+FirmActChangeContactFirmInfo: Firmenkontaktinformationen werden nur für neue Firmenangehörige verwendet, für die sonst keine Kontaktinformationen vorliegen.
+FirmActChangeContactFirmResult: Firmenkontaktinformationen geändert. Betrifft nur neue Firmenangehörige ohne eigene Kontaktinformationen
 FirmUserActNotify: Mitteilung versenden
 FirmUserActResetSupervision: Ansprechpartner auf Firmenstandard zurücksetzen
 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
 FirmSuperActRMSuperDef: Standard Firmenansprechpartner entfernen
@@ -37,12 +42,9 @@ FilterFirmExtern: Externe Firma
 FirmSupervisorOf fsh@CompanyShorthand: Ansprechpartner #{fsh} angehörig
 FirmSupervisorIndependent: Ansprechpartner ohne jegliche Firmenzugehörigkeit
 FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh}
-NoCompanySelected: Bitte wählen Sie mindestens eine Firm aus.
+NoCompanySelected: Bitte wählen Sie mindestens eine Firma aus.
 TableIsDefaultSupervisor: Standardansprechpartner
 TableIsDefaultReroute: Standardumleitung
-FormReqPostal: Benachrichtigungseinstellung
+FormFieldPostal: Benachrichtigungseinstellung
-FormReqPostalTip: Gilt für alle Benachrichtigungen an diese Person, nicht nur für Umleitungen an diesen Ansprechpartner
+FormFieldPostalTip: Gilt für alle Benachrichtigungen an diese Person, nicht nur für Umleitungen an diesen Ansprechpartner
-ASReqEmpty: Es konnten keine Ansprechpartner hinzugefügt werden
-ASReqSetSupers n@Int64 postal@(Maybe Bool): #{n} Standardansprechpartner eingetragen #{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)}
 FirmUserChanges n@Int64: Benachrichtigungseinstellung für #{n} Firmenangehörige wurden geändert

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

@@ -9,18 +9,23 @@ FirmEmail: General company email
 FirmAddress: Postal address
 FirmDefaultPreferenceInfo: Default setting for new company associates only
 FirmAction: Companywide action
+FirmActionInfo: Affects alle company associates.
 FirmActNotify: Send message
 FirmActResetSupervision: Reset supervisors for all company associates
 FirmActResetSuperKeep: Additionally keep existing supervisors of company associates?
 FirmActResetMutualSupervision: Supervisors supervise each other
-FirmActAddSupervisors: Add supervisors
+FirmActAddSupersvisors: Add supervisors
-FirmAllActNotify: Send message
+FirmActAddSupersEmpty: No supervisors added
-FirmAllActResetSupervision: Reset supervisors for all company associates
+FirmActAddSupersSet n postal: #{n} default company supervisors set #{maybeBoolMessage postal "" "and switched to postal notifications" "and switched to email notifications"}, but not yet activated.
-FirmAllActResetSuperKeep: Additionally keep existing supervisors of company associates?
+RemoveSupervisors ndef nact: #{ndef} default supervisors removed#{bool ", but not yet deactivated" (" and " <> tshow nact <> " active supervisons terminated") (nact > 0)}
-FirmAllActResetMutualSupervision: Supervisors supervise each other
+FirmActChangeContactUser: Change contact data for company associates
+FirmActChangeContactFirm: Change company contact data
+FirmActChangeContactFirmInfo: The company contact data is only used for new company associates that would habe no contact information of their own otherwise.
+FirmActChangeContactFirmResult: Company contact data changed, affecting future company associates without contact information only
 FirmUserActNotify: Send message
 FirmUserActResetSupervision: Reset supervisors to company default
 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
 FirmSuperActRMSuperDef: Remove as default supervisor
@@ -40,9 +45,6 @@ FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users
 NoCompanySelected: Select at least one company, please.
 TableIsDefaultSupervisor: Default supervisor
 TableIsDefaultReroute: Default reroute
-FormReqPostal: Notification type
+FormFieldPostal: Notification type
-FormReqPostalTip: Affects all notifications to this person, not just reroutes to this supervisor
+FormFieldPostalTip: Affects all notifications to this person, not just reroutes to this supervisor
-ASReqEmpty: No supervisors added
-ASReqSetSupers n postal: #{n} default company supervisors set #{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 supervisons terminated") (nact > 0)}
 FirmUserChanges n: Notification settings changed for #{n} company associates

src/Handler/Firm.hs

@@ -2,7 +2,7 @@
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
-{-# OPTIONS -Wno-unused-top-binds -Wno-unused-imports -Wno-unused-binds #-}      -- TODO: remove me, for debugging only
+{-# OPTIONS -Wno-unused-top-binds #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}      -- needed for HasEntity instances
 {-# LANGUAGE TypeApplications #-}
 
@@ -32,7 +32,7 @@ import qualified Data.CaseInsensitive as CI
 import Database.Persist.Sql (deleteWhereCount, updateWhereCount)
 import           Database.Esqueleto.Experimental ((:&)(..))
 import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
-import qualified Database.Esqueleto.Legacy as EL (from, on)
+import qualified Database.Esqueleto.Legacy as EL (on)
 import qualified Database.Esqueleto.PostgreSQL as E
 import qualified Database.Esqueleto.Utils as E
 import Database.Esqueleto.Utils.TH
@@ -42,8 +42,8 @@ import Database.Esqueleto.Utils.TH
 single :: (k,a) -> Map k a
 single = uncurry Map.singleton
 
-decryptUser :: (MonadHandler m, HandlerSite m ~ UniWorX) => CryptoUUIDUser -> m UserId
+-- decryptUser :: (MonadHandler m, HandlerSite m ~ UniWorX) => CryptoUUIDUser -> m UserId
-decryptUser = decrypt 
+-- decryptUser = decrypt
 
 encryptUser :: (MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> m CryptoUUIDUser
 encryptUser = encrypt
@@ -56,7 +56,9 @@ postalEmailField = boolFieldCustom (SomeMessage MsgUtilPostal) (SomeMessage MsgU
 
 data FirmAction = FirmActNotify
                 | FirmActResetSupervision
-                | FirmActAddSupervisors
+                | FirmActAddSupersvisors
+                | FirmActChangeContactFirm
+                | FirmActChangeContactUser
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
   deriving anyclass (Universe, Finite)
 
@@ -65,37 +67,50 @@ embedRenderMessage ''UniWorX ''FirmAction id
 
 data FirmActionData = FirmActNotifyData
                     | FirmActResetSupervisionData
-                        { firmActResetKeepOldSupers      :: Maybe Bool 
+                        { firmActResetKeepOldSupers       :: Maybe Bool
-                        , firmActResetMutualSupervision  :: Maybe Bool
+                        , firmActResetMutualSupervision   :: Maybe Bool
                         }
-                    | FirmActAddSupervisorsData
+                    | FirmActAddSupersvisorsData
-                        { firmActAddSupervisorIds     :: Set Text
+                        { firmActAddSupervisorIds         :: Set Text
-                        , firmActAddSupervisorReroute :: Bool
+                        , firmActAddSupervisorReroute     :: Bool
-                        , firmActAddSupervisorPostal  :: Maybe Bool
+                        , firmActAddSupervisorPostal      :: Maybe Bool
+                        }
+                    | FirmActChangeContactFirmData
+                        { firmActCCFPostalAddr            :: Maybe StoredMarkup
+                        , firmActCCFEmail                 :: Maybe UserEmail
+                        , firmActCCFPostalPref            :: Maybe Bool
+                        }
+                    | FirmActChangeContactUserData
+                        { firmActCCUPostalAddr            :: Maybe StoredMarkup
+                        , firmActCCUPostalPref            :: Maybe Bool
                         }
   deriving (Eq, Ord, Read, Show, Generic)
 
-firmActionMap :: [FirmAction] -> Map FirmAction (AForm Handler FirmActionData)
+firmActionMap :: _ -> [FirmAction] -> Map FirmAction (AForm Handler FirmActionData)
-firmActionMap acts = mconcat (mkAct <$> acts)
+firmActionMap mr acts = mconcat (mkAct <$> acts)
   where
     mkAct FirmActNotify           = singletonMap FirmActNotify           $ pure FirmActNotifyData
     mkAct FirmActResetSupervision = singletonMap FirmActResetSupervision $      FirmActResetSupervisionData
-            <$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep)         (Just $ Just False)
+            <$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep)                     (Just $ Just False)
-            <*> aopt checkBoxField                                      (fslI MsgFirmActResetMutualSupervision) (Just $ Just True )
+            <*> aopt checkBoxField                                      (fslI MsgFirmActResetMutualSupervision)             (Just $ Just True )
-    mkAct FirmActAddSupervisors   = singletonMap FirmActAddSupervisors   $      FirmActAddSupervisorsData
+    mkAct FirmActAddSupersvisors   = singletonMap FirmActAddSupersvisors   $ FirmActAddSupersvisorsData
-            <$> areq (textField & cfAnySeparatedSet)                    (fslI MsgTableIsDefaultSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
+            <$> areq (textField & cfAnySeparatedSet)  (fslI MsgTableIsDefaultSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip)  Nothing
-            <*> areq checkBoxField                                      (fslI MsgTableIsDefaultReroute )                          (Just True)
+            <*> areq checkBoxField                    (fslI MsgTableIsDefaultReroute )                                                            (Just True)
-            <*> aopt postalEmailField                                   (fslI MsgFormReqPostal & setTooltip MsgFormReqPostalTip)  Nothing
+            <*> aopt postalEmailField                 (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip)                                Nothing
+    mkAct FirmActChangeContactFirm = singletonMap FirmActChangeContactFirm $ FirmActChangeContactFirmData
+            <$> aopt htmlField                        (fslI MsgPostAddress   & setTooltip MsgPostAddressTip)                Nothing
+            <*> aopt (emailField & cfStrip & cfCI)    (fslI MsgUserDisplayEmail)                                            Nothing
+            <*> aopt postalEmailField                 (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip)          Nothing
+            <*  aformMessage (Message Info (toHtml $ mr MsgFirmActChangeContactFirmInfo) (Just IconNotificationNonactive))
+    mkAct FirmActChangeContactUser = singletonMap FirmActChangeContactUser $ FirmActChangeContactUserData
+            <$> aopt htmlField                        (fslI MsgPostAddress    & setTooltip MsgPostAddressTip)               Nothing
+            <*> aopt postalEmailField                 (fslI MsgFormFieldPostal  & setTooltip MsgFormFieldPostalTip)         Nothing
 
-firmActionForm :: [FirmAction] -> AForm Handler FirmActionData
+firmActionForm :: _ -> [FirmAction] -> AForm Handler FirmActionData
-firmActionForm acts = multiActionA (firmActionMap acts) (fslI MsgTableAction) Nothing
+firmActionForm mr acts = multiActionA (firmActionMap mr acts) (fslI MsgTableAction) Nothing
 
-
+makeFirmActionForm :: CompanyId -> _ -> [FirmAction] -> Form (FirmActionData, Set CompanyId)
-makeFirmActionForm :: CompanyId -> [FirmAction] -> Form (FirmActionData, Set CompanyId)
+makeFirmActionForm cid mr acts html = flip (renderAForm FormStandard) html $ (,Set.singleton cid) <$> firmActionForm mr acts
-makeFirmActionForm cid acts html = flip (renderAForm FormStandard) html $ (,Set.singleton cid) <$> firmActionForm acts
-
--- makeFirmActionTableForm :: Monoid t => [FirmAction] -> Text.Blaze.Internal.Markup -> Control.Monad.Trans.RWS.Lazy.RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints Handler (FormResult (First FirmActionData, t), WidgetFor UniWorX ())
--- makeFirmActionTableForm acts = renderAForm FormStandard $ (, mempty) . First . Just <$> firmActionForm acts
 
 firmActionHandler :: Route UniWorX -> FormResult (FirmActionData, Set CompanyId) -> Handler ()
 firmActionHandler route = flip formResult faHandler
@@ -112,7 +127,7 @@ firmActionHandler route = flip formResult faHandler
                       E.&&.  usr E.^. UserCompanyUser E.==. spr E.^. UserSupervisorUser
           else return 0
         newSupers <- addDefaultSupervisorsAll (firmActResetMutualSupervision /= Just False) fids
-        addMessageI Info $ MsgFirmResetSupervision delSupers newSupers
+        addMessageI Success $ MsgFirmResetSupervision delSupers newSupers
       reloadKeepGetParams route -- reload to reflect changes
 
     faHandler (FirmActNotifyData, Set.toList -> fids) = do
@@ -123,7 +138,7 @@ firmActionHandler route = flip formResult faHandler
       cuids <- traverse (encrypt . E.unValue) usrs :: Handler [CryptoUUIDUser]
       redirect (FirmsCommR $ fmap unCompanyKey fids, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])
 
-    faHandler (FirmActAddSupervisorsData{..}, Set.toList -> [cid]) = do
+    faHandler (FirmActAddSupersvisorsData{..}, 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'
@@ -136,21 +151,48 @@ firmActionHandler route = flip formResult faHandler
               |]
         in addMessageModal Error (i18n . MsgCourseParticipantsRegisterNotFoundInAvs $ length usersNotFound) (Right msgContent)
       when (null usersFound) $ do
-        addMessageI Warning MsgASReqEmpty
+        addMessageI Warning MsgFirmActAddSupersEmpty
         reloadKeepGetParams route
       runDB $ do
         putMany [UserCompany uid cid True firmActAddSupervisorReroute | uid <- usersFound]
         whenIsJust firmActAddSupervisorPostal $ \prefPostal ->
           updateWhere [UserId <-. usersFound] [UserPrefersPostal =. prefPostal]
-        addMessageI Info $ MsgASReqSetSupers (fromIntegral $ length usersFound) firmActAddSupervisorPostal
+        addMessageI Success $ MsgFirmActAddSupersSet (fromIntegral $ length usersFound) firmActAddSupervisorPostal
       redirect route
+
+    faHandler (FirmActChangeContactFirmData{..}, Set.toList -> [cid]) =
+      let changes = catMaybes
+            [ (CompanyPostAddress   =.) . Just <$> canonical firmActCCFPostalAddr
+            , (CompanyEmail         =.) . Just <$> canonical firmActCCFEmail
+            , (CompanyPrefersPostal =.)        <$>           firmActCCFPostalPref
+            ]
+      in unless (null changes) $ do
+        runDB $ updateBy (UniqueCompanyShorthand $ unCompanyKey cid) changes
+        addMessageI Success MsgFirmActChangeContactFirmResult
+        reloadKeepGetParams route
+
+    faHandler (FirmActChangeContactUserData{..}, Set.toList -> [cid]) =
+      let changes = catMaybes
+            [ (UserPostAddress   E.=.) . E.justVal <$> canonical firmActCCUPostalAddr  -- note that Nothing means no change and not delete address!
+            , (UserPrefersPostal E.=.) . E.val     <$>           firmActCCUPostalPref
+            ]
+      in unless (null changes) $ do
+        nrChanged <- runDB $ E.updateCount $ \usr -> do
+          E.set usr changes
+          E.where_ $ E.exists $ do
+            usrCmpy <- E.from $ E.table @UserCompany
+            E.where_ $ usrCmpy E.^. UserCompanyCompany E.==. E.val cid
+                E.&&.  usrCmpy E.^. UserCompanyUser    E.==. usr E.^. UserId
+        addMessageI Success $ MsgFirmUserChanges nrChanged
+        reloadKeepGetParams route  -- reload to reflect changes
+
     faHandler _ = addMessageI Error MsgErrorUnknownFormAction
 
 
 runFirmActionFormPost :: CompanyId -> Route UniWorX -> [FirmAction] -> Handler Widget
 runFirmActionFormPost cid route acts = do
-  -- ((faRes, faWgt), faEnctype) <- runFormPost . identifyForm FIDFirmAction $ makeFirmActionForm cid acts
+  mr <- getMessageRender
-  ((faRes, faWgt), faEnctype) <- runFormPost $ makeFirmActionForm cid acts
+  ((faRes, faWgt), faEnctype) <- runFormPost . identifyForm FIDFirmAction $ makeFirmActionForm cid mr acts
   let faAnchor  = "firm-action-form" :: Text
       faRoute   = route :#: faAnchor
       faForm    = wrapForm faWgt FormSettings
@@ -167,7 +209,10 @@ runFirmActionFormPost cid route acts = do
             <h2 .show-hide__toggle uw-show-hide data-show-hide-collapsed>
               _{MsgFirmAction}
             <div>
-              ^{faForm}
+              <p>
+                _{MsgFirmActionInfo}
+              <P>
+                ^{faForm}
         |]
 
 
@@ -400,21 +445,6 @@ postFirmR fsh = do
 -----------------------
 -- All Firms Table
 
-data FirmAllAction = FirmAllActNotify
-                   | FirmAllActResetSupervision
-  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
-  deriving anyclass (Universe, Finite)
-
-nullaryPathPiece ''FirmAllAction $ camelToPathPiece' 3
-embedRenderMessage ''UniWorX ''FirmAllAction id
-
-data FirmAllActionData = FirmAllActNotifyData
-                       | FirmAllActResetSupervisionData 
-                          { firmAllActResetKeepOldSupers      :: Maybe Bool 
-                          , firmAllActResetMutualSupervision  :: Maybe Bool
-                          }
-  deriving (Eq, Ord, Read, Show, Generic)
-
 -- just in case for future extensions
 type AllCompanyTableExpr = E.SqlExpr (Entity Company)
 queryAllCompany :: AllCompanyTableExpr -> E.SqlExpr (Entity Company)
@@ -440,6 +470,7 @@ resultAllCompanyDefaultReroutes   = _dbrOutput . _4 . _unValue
 mkFirmAllTable :: Bool -> UserId -> DB (FormResult (FirmActionData, Set CompanyId), Widget)
 mkFirmAllTable isAdmin uid = do
   -- now <- liftIO getCurrentTime
+  mr <- getMessageRender
   let
     resultDBTable = DBTable{..}
       where
@@ -559,9 +590,7 @@ mkFirmAllTable isAdmin uid = do
           , dbParamsFormAction = Nothing
           , dbParamsFormAttrs  = []
           , dbParamsFormSubmit = FormSubmit
-          -- , dbParamsFormAdditional = renderAForm FormStandard $ (, mempty) . First . Just <$> firmActionForm [FirmActNotify, FirmActResetSupervision]
+          , dbParamsFormAdditional = renderAForm FormStandard $ (, mempty) . First . Just <$> firmActionForm mr [FirmActNotify, FirmActResetSupervision]
-          , dbParamsFormAdditional = renderAForm FormStandard $ (, mempty) . First . Just 
-              <$> multiActionA (firmActionMap [FirmActNotify, FirmActResetSupervision]) (fslI MsgTableAction) Nothing
           , dbParamsFormEvaluate = liftHandler . runFormPost
           , dbParamsFormResult   = id
           , dbParamsFormIdent    = def
@@ -600,28 +629,11 @@ postFirmAllR = do
 -----------------------
 -- Firm Users Table
 
-data FirmUserChangeRequest = FirmUserChangeRequest
-      { fucrPostalPref :: Maybe Bool 
-      , fucrPostalAddr :: Maybe StoredMarkup
-      }
-  deriving (Eq, Ord, Show, Generic)
-
-instance Default FirmUserChangeRequest where
-  def = FirmUserChangeRequest
-          { fucrPostalPref = Nothing
-          , fucrPostalAddr = Nothing
-          }
-
-makeFirmUserChangeRequestForm :: Maybe FirmUserChangeRequest -> Form FirmUserChangeRequest
-makeFirmUserChangeRequestForm template html = do 
-  flip (renderAForm FormStandard) html $ FirmUserChangeRequest
-    <$> aopt postalEmailField (fslI MsgFormReqPostal & setTooltip MsgFormReqPostalTip)  (fucrPostalPref <$> template)
-    <*> aopt htmlField        (fslI MsgPostAddress   & setTooltip MsgPostAddressTip) (fucrPostalAddr <$> template)
-    
 
 data FirmUserAction = FirmUserActNotify
                     | FirmUserActResetSupervision
                     | FirmUserActMkSuper
+                    | FirmUserActChangeContact
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
   deriving anyclass (Universe, Finite)
 
@@ -635,7 +647,10 @@ data FirmUserActionData = FirmUserActNotifyData
                             }
                         | FirmUserActMkSuperData
                             { firmUserActMkSuperReroute   :: Maybe Bool }
-
+                        | FirmUserActChangeContactData
+                            { firmUserActPostalAddr :: Maybe StoredMarkup
+                            , firmUserActPostalPref :: Maybe Bool
+                            }
   deriving (Eq, Ord, Show, Generic)
 
 type UserCompanyTableExpr = E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity UserCompany)
@@ -771,7 +786,7 @@ mkFirmUserTable isAdmin cid = do
         -- superField = selectField $ ????
         dbtFilterUI mPrev = mconcat
           [ fltrUserNameEmailHdrUI MsgTableCompanyUser mPrev
-          , prismAForm (singletonFilter "supervisor-is"          . maybePrism _PathPiece) mPrev $ aopt (hoistField lift supervisorField)  (fslI MsgFilterSupervisor)
+          , prismAForm (singletonFilter "supervisor-is"          . maybePrism _PathPiece)     mPrev $ aopt (hoistField lift supervisorField)  (fslI MsgFilterSupervisor)
           , prismAForm (multiFilter     "supervisors-are"        . maybePrism monoPathPieces) mPrev $ aopt (hoistField lift supervisorsField) (fslI MsgFilterSupervisor)
           , prismAForm (singletonFilter "has-supervisor"         . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterSupervisor)
           , prismAForm (singletonFilter "has-company-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorCompany fsh)
@@ -782,10 +797,13 @@ mkFirmUserTable isAdmin cid = do
         acts = mconcat
           [ singletonMap FirmUserActNotify      $ pure FirmUserActNotifyData
           , singletonMap FirmUserActResetSupervision $ FirmUserActResetSupervisionData
-              <$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmAllActResetSuperKeep)         (Just $ Just False)
+              <$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep)         (Just $ Just False)
-              -- <*> aopt checkBoxField                                      (fslI MsgFirmAllActResetMutualSupervision) (Just $ Just True )
+              -- <*> aopt checkBoxField                                      (fslI MsgFirmActResetMutualSupervision) (Just $ Just True )
           , singletonMap FirmUserActMkSuper $ FirmUserActMkSuperData
               <$> aopt checkBoxField (fslI MsgTableIsDefaultReroute) (Just $ Just True)
+          , singletonMap FirmUserActChangeContact $ FirmUserActChangeContactData
+              <$> aopt htmlField                        (fslI MsgPostAddress    & setTooltip MsgPostAddressTip)     Nothing
+              <*> aopt postalEmailField                 (fslI MsgFormFieldPostal  & setTooltip MsgFormFieldPostalTip)   Nothing
           ]
         dbtParams = DBParamsForm
           { dbParamsFormMethod = POST
@@ -812,7 +830,7 @@ mkFirmUserTable isAdmin cid = do
         let s = Map.keysSet . Map.filter id $ getDBFormResult (const False) m
         return (act, s)
 
-    -- resultDBTableValidator :: PSValidator (MForm Handler) (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
+    -- resultDBTableValidator :: PSValidator (MForm Handler) (FormResult (First FirmActionData, DBFormResult CompanyId Bool FirmActionData))
     resultDBTableValidator = def
       & defaultSorting  [SortAscBy "user-name"]
   over _1 postprocess <$> dbTable resultDBTableValidator resultDBTable
@@ -856,7 +874,7 @@ postFirmUsersR fsh = do
     (_, uids) | null uids -> addMessageI Error MsgUtilEmptyChoice
     (FirmUserActMkSuperData{..}, Set.toList -> uids) -> do
       nrMkSuper <- runDB $ updateWhereCount [UserCompanyUser <-. uids, UserCompanyCompany ==. cid] [UserCompanySupervisor =. True, UserCompanySupervisorReroute =. (firmUserActMkSuperReroute == Just True)]
-      addMessageI Info $ MsgASReqSetSupers nrMkSuper Nothing
+      addMessageI Info $ MsgFirmActAddSupersSet nrMkSuper Nothing
       reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
     (FirmUserActNotifyData , uids) -> do
       cuids <- traverse encrypt $ Set.toList uids :: Handler [CryptoUUIDUser]
@@ -869,30 +887,17 @@ postFirmUsersR fsh = do
         newSupers <- addDefaultSupervisors cid uids
         addMessageI Info $ MsgFirmResetSupervision delSupers newSupers
       reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
+    (FirmUserActChangeContactData{..}, Set.toList -> uids) ->
+      let changes = catMaybes
+            [ (UserPostAddress   =.) . Just <$> canonical firmUserActPostalAddr  -- note that Nothing means no change and not delete address!
+            , (UserPrefersPostal =.)        <$>           firmUserActPostalPref
+            ]
+      in unless (null changes) $ do
+        nrChanged <- runDB $ updateWhereCount [UserId <-. uids] changes
+        addMessageI Success $ MsgFirmUserChanges nrChanged
+        reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
 
-  ((fucrRes, fucrWgt), fucrEnctype) <- runFormPost . identifyForm FIDFirmUserChangeRequest $ makeFirmUserChangeRequestForm (Just def)
+  formFirmAction <- runFirmActionFormPost cid (FirmUsersR fsh) [FirmActNotify, FirmActResetSupervision, FirmActAddSupersvisors, FirmActChangeContactFirm, FirmActChangeContactUser]
-  let addFormAnchor = "firm-user-change-form" :: Text
-      routeForm = FirmUsersR fsh :#: addFormAnchor
-      fucrForm = wrapForm fucrWgt FormSettings  
-                        { formMethod = POST
-                        , formAction = Just . SomeRoute $ routeForm
-                        , formEncoding = fucrEnctype
-                        , formAttrs = []
-                        , formSubmit = FormSubmit
-                        , formAnchor = Just addFormAnchor
-                        }
-  formResult fucrRes $ \FirmUserChangeRequest{fucrPostalPref=fucrPPref, fucrPostalAddr=(canonical -> fucrPAddr)} -> do    
-    when (isJust fucrPPref || isJust fucrPAddr) $ do
-      let changes = foldMap (\pp -> [UserPrefersPostal E.=. E.val pp])     fucrPPref <>
-                    foldMap (\pa -> [UserPostAddress   E.=. E.justVal pa]) fucrPAddr      -- seems weird, but: Nothing means no change, and not delete address!
-      nrChanged <- runDB $ E.updateCount $ \usr -> do
-          E.set usr changes 
-          E.where_ $ E.exists $ do
-            usrCmpy <- E.from $ E.table @UserCompany
-            E.where_ $ usrCmpy E.^. UserCompanyCompany E.==. E.val cid
-                E.&&.  usrCmpy E.^. UserCompanyUser    E.==. usr E.^. UserId
-      addMessageI Info $ MsgFirmUserChanges nrChanged
-      reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
 
   siteLayout (citext2widget companyName) $ do
     setTitle $ toHtml $ CI.original companyShorthand <> "-" <> tshow companyAvsId
@@ -919,28 +924,6 @@ data FirmSuperActionData = FirmSuperActNotifyData
   deriving (Eq, Ord, Show, Generic)
 
 
-data AddSupervisorRequest = AddSupervisorRequest
-  {  asReqSupers  :: Set Text
-  ,  asReqReroute :: Bool
-  ,  asReqPostal  :: Maybe Bool
-  } deriving (Eq, Ord, Show, Generic)
-
-instance Default AddSupervisorRequest where 
-  def = AddSupervisorRequest 
-          { asReqSupers   = mempty
-          , asReqReroute  = True
-          , asReqPostal   = Nothing
-          }
-
-makeAddSupervisorForm :: Maybe AddSupervisorRequest -> Form AddSupervisorRequest
-makeAddSupervisorForm template html = do   
-  flip (renderAForm FormStandard) html $ AddSupervisorRequest
-    <$> areq (textField & cfAnySeparatedSet) 
-                              (fslI MsgTableIsDefaultSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) (asReqSupers <$> template)
-    <*> areq checkBoxField    (fslI MsgTableIsDefaultReroute )                      (asReqReroute <$> template)
-    <*> aopt postalEmailField (fslI MsgFormReqPostal & setTooltip MsgFormReqPostalTip)  (asReqPostal <$> template)
-
-
 type SuperCompanyTableExpr = E.SqlExpr (Entity User) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity UserCompany))
 
 querySuperUser :: SuperCompanyTableExpr -> E.SqlExpr (Entity User)
@@ -1109,40 +1092,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) [FirmActAddSupervisors, FirmActResetSupervision]
+  formFirmAction <- runFirmActionFormPost cid (FirmSupersR fsh) [FirmActAddSupersvisors, FirmActResetSupervision, FirmActChangeContactFirm]
-
-  ((asReqRes, asReqWgt), asReqEnctype) <- runFormPost . identifyForm FIDAddSupervisor $ makeAddSupervisorForm (Just def)
-  let addSuperAnchor = "add-supervisors-form" :: Text
-      routeAddSuperForm = FirmSupersR fsh :#: addSuperAnchor
-      addSuperForm = wrapForm asReqWgt FormSettings  
-                        { formMethod = POST
-                        , formAction = Just . SomeRoute $ routeAddSuperForm
-                        , formEncoding = asReqEnctype
-                        , formAttrs = []
-                        , formSubmit = FormSubmit
-                        , formAnchor = Just addSuperAnchor
-                        }
-  formResult asReqRes $ \AddSupervisorRequest{..} -> do
-    avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet guessAvsUser asReqSupers
-    let (usersFound', usersNotFound) = partition (is _Just . view _2) $ Map.toList avsUsers
-        usersFound = mapMaybe snd usersFound'
-    unless (null usersNotFound) $
-      let msgContent = [whamlet|
-            $newline never
-            <ul>
-              $forall (usr,_) <- usersNotFound
-                <li>#{usr}
-            |]
-       in addMessageModal Error (i18n . MsgCourseParticipantsRegisterNotFoundInAvs $ length usersNotFound) (Right msgContent)
-    when (null usersFound) $ do
-      addMessageI Warning MsgASReqEmpty
-      redirect routeAddSuperForm
-    runDB $ do
-      putMany [UserCompany uid cid True asReqReroute | uid <- usersFound]
-      whenIsJust asReqPostal $ \prefPostal ->
-        updateWhere [UserId <-. usersFound] [UserPrefersPostal =. prefPostal]
-      addMessageI Info $ MsgASReqSetSupers (fromIntegral $ length usersFound) asReqPostal
-    redirect $ FirmSupersR fsh
 
   siteLayout (citext2widget fsh) $ do
     setTitle $ citext2Html $ fsh <> " Supers"

src/Utils.hs

@@ -1993,3 +1993,10 @@ instance Canonical (Maybe Text) where -- a split into Canonical Text and Canonic
     | Text.null t' -> Nothing
     | t == t'      -> r
     | otherwise    -> Just t'
+
+instance Canonical (Maybe (CI Text)) where -- a split into Canonical Text and Canonical a => Maybe seems nicer, but the latter instance would be troublesome
+  canonical Nothing     = Nothing
+  canonical r@(Just t)  = let t' = CI.map Text.strip  t in if
+    | mempty == t'-> Nothing
+    | t == t'     -> r
+    | otherwise   -> Just t'

templates/firm-contact-info.hamlet

@@ -9,12 +9,16 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
   <dl .deflist.profile-dl>
     $maybe fem <- companyEmail
       <dt .deflist__dt>
-        _{MsgFirmEmail} #{iconLetterOrEmail False} 
+        _{MsgFirmEmail} 
+        $if not companyPrefersPostal 
+          &nbsp; #{iconLetterOrEmail False} 
       <dd .deflist__dd .email>
         #{mailtoHtml fem}
     $maybe addr <- companyPostAddress
       <dt .deflist__dt>
-        _{MsgFirmAddress} #{iconLetterOrEmail True} 
+        _{MsgFirmAddress}
+        $if companyPrefersPostal 
+          &nbsp; #{iconLetterOrEmail True} 
       <dd .deflist__dd>
         #{addr}
     $nothing

templates/firm-users.hamlet

@@ -6,6 +6,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
 
 ^{firmContactInfo}
 
+^{formFirmAction}
+
 <section>        
   <div .scrolltable .scrolltable--bordered>
     <table .table>      
@@ -55,9 +57,3 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
     _{MsgFirmAssociates}
   <p>
     ^{fusrTable}
-
-<section>
-  <h2 .show-hide__toggle uw-show-hide data-show-hide-collapsed>
-    Heading TODO
-  <div> 
-    ^{fucrForm}

templates/i18n/firm-supervisors/de-de-formal.hamlet

@@ -15,7 +15,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
 ^{formFirmAction}
 
 <section>
-  ^{fsprTable}
+  <h2>
-
+    _{MsgTableSupervisor}
-<section>
+  <div>
-  ^{addSuperForm}
+    ^{fsprTable}

templates/i18n/firm-supervisors/en-eu.hamlet

@@ -14,7 +14,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
 ^{formFirmAction}
 
 <section>
-  ^{fsprTable}
+  <h2>
+    _{MsgTableSupervisor}
+  <div>
+    ^{fsprTable}
 
-<section>
-  ^{addSuperForm}