From 6f1ad811f73aaf5f02a11ac92889e1f03f964df2 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Mon, 4 Nov 2024 18:20:43 +0100 Subject: [PATCH] chore(firm): add action to add non-avs firm associates --- .../uniworx/categories/firm/de-de-formal.msg | 5 +- messages/uniworx/categories/firm/en-eu.msg | 5 +- src/Handler/Firm.hs | 83 +++++++++++++++---- src/Utils/DB.hs | 12 +++ 4 files changed, 86 insertions(+), 19 deletions(-) diff --git a/messages/uniworx/categories/firm/de-de-formal.msg b/messages/uniworx/categories/firm/de-de-formal.msg index 8f27c24c4..d526dc8c4 100644 --- a/messages/uniworx/categories/firm/de-de-formal.msg +++ b/messages/uniworx/categories/firm/de-de-formal.msg @@ -21,8 +21,11 @@ FirmActResetSupersKeepAll: Alle behalten FirmActResetSupersRemoveAps: Nur Standardansprechpartner entfernen FirmActResetSupersRemoveAll: Alle entfernen FirmActAddSupervisors: Ansprechpartner hinzufügen -FirmActAddSupersEmpty: Es konnten keine Ansprechpartner hinzugefügt werden +FirmActAddAssociates: Firmenangehörige hinzufügen +FirmActAddSupersEmpty: Es konnten keine neuen 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. +FirmActAddAssocsEmpty: Es konnten keine neuen Firmenangehörige hinzugefügt werden! +FirmActAddAssocs n@Int64: #{n} Firmenangehörige hinzugefügt. RemoveSupervisors ndef@Int64: #{ndef} Standardansprechpartner entfernt. FirmActChangeContactUser: Kontaktinformationen von allen Firmenangehörigen ändern FirmActChangeContactFirm: Kontaktinformationen der Firma ändern diff --git a/messages/uniworx/categories/firm/en-eu.msg b/messages/uniworx/categories/firm/en-eu.msg index fe4dbc045..991164701 100644 --- a/messages/uniworx/categories/firm/en-eu.msg +++ b/messages/uniworx/categories/firm/en-eu.msg @@ -21,8 +21,11 @@ FirmActResetSupersKeepAll: Keep all FirmActResetSupersRemoveAps: Remove default supervisors only FirmActResetSupersRemoveAll: Remove all FirmActAddSupervisors: Add supervisors -FirmActAddSupersEmpty: No supervisors added +FirmActAddAssociates: Associate users with company +FirmActAddSupersEmpty: No new 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. +FirmActAddAssocsEmpty: No new company associated users added! +FirmActAddAssocs n@Int64: #{pluralENsN n "company associated user"} added. RemoveSupervisors ndef: #{ndef} default supervisors removed. FirmActChangeContactUser: Change contact data for all company associates FirmActChangeContactFirm: Change company contact data diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index fa5e52d8f..ad44d1257 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -54,6 +54,7 @@ postalEmailField = boolFieldCustom (SomeMessage MsgUtilPostal) (SomeMessage MsgU data FirmAction = FirmActNotify | FirmActResetSupervision | FirmActAddSupervisors + | FirmActAddAssociates | FirmActChangeContactFirm | FirmActChangeContactUser deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) @@ -64,24 +65,31 @@ embedRenderMessage ''UniWorX ''FirmAction id data FirmActionData = FirmActNotifyData | FirmActResetSupervisionData - { firmActResetKeepOldSupers :: Maybe Bool - , firmActResetMutualSupervision :: Maybe Bool + { firmActResetKeepOldSupers :: Maybe Bool + , firmActResetMutualSupervision :: Maybe Bool } | FirmActAddSupervisorsData - { firmActAddSupervisorIds :: Set Text - , firmActAddSupervisorReroute :: Bool - , firmActAddSupervisorPostal :: Maybe Bool - , firmActAddSupervisorReason :: Maybe Text + { firmActAddUserIds :: Set Text + , firmActAddSupervisorReroute :: Bool + , firmActAddSupervisorPostal :: Maybe Bool + , firmActAddUserUseCompanyAddress :: Bool + , firmActAddSupervisorReason :: Maybe Text + } + | FirmActAddAssociatesData + { firmActAddUserIds :: Set Text + , firmActAddAssociatePriority :: Int + , firmActAddUserUseCompanyAddress :: Bool + , firmActAddAssociateReason :: Maybe Text } | FirmActChangeContactFirmData - { firmActCCFPostalAddr :: Maybe StoredMarkup - , firmActCCFEmail :: Maybe UserEmail - , firmActCCFPostalPref :: Maybe Bool + { firmActCCFPostalAddr :: Maybe StoredMarkup + , firmActCCFEmail :: Maybe UserEmail + , firmActCCFPostalPref :: Maybe Bool } | FirmActChangeContactUserData - { firmActCCUPostalAddr :: Maybe StoredMarkup - , firmActCCUUseCompanyPostal :: Maybe Bool - , firmActCCUPostalPref :: Maybe Bool + { firmActCCUPostalAddr :: Maybe StoredMarkup + , firmActCCUUseCompanyPostal :: Maybe Bool + , firmActCCUPostalPref :: Maybe Bool } deriving (Eq, Ord, Read, Show, Generic) @@ -93,11 +101,18 @@ firmActionMap mr isAdmin acts = mconcat (mkAct isAdmin <$> acts) <$> aopt boolField' (fslI MsgFirmActResetSuperKeep) (Just $ Just False) <*> aopt checkBoxField (fslI MsgFirmActResetMutualSupervision) (Just $ Just True ) mkAct _ FirmActAddSupervisors = singletonMap FirmActAddSupervisors $ FirmActAddSupervisorsData - <$> areq (textField & cfAnySeparatedSet) (fslI MsgFirmSuperDefault & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing + <$> areq (textField & cfAnySeparatedSet) (fslI MsgFirmSuperDefault & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing <*> areq checkBoxField (fslI MsgTableIsDefaultReroute) (Just True) <*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing + <*> areq checkBoxField (fslI MsgCompanyUserUseCompanyAddress & setTooltip MsgCompanyUserUseCompanyAddressTip) (Just True) <*> aopt (textField & cfStrip & addDatalist ucdefSuperReasons) (fslI MsgUserCompanyReason & setTooltip MsgUserCompanyReasonTooltip) Nothing + mkAct _ FirmActAddAssociates = singletonMap FirmActAddAssociates $ FirmActAddAssociatesData + <$> areq (textField & cfAnySeparatedSet) (fslI MsgFirmAssociates & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing + <*> areq intField (fslI MsgCompanyUserPriority & setTooltip MsgCompanyUserPriorityTip) (Just 0) + <*> areq checkBoxField (fslI MsgCompanyUserUseCompanyAddress & setTooltip MsgCompanyUserUseCompanyAddressTip) (Just True) + <*> aopt (textField & cfStrip & addDatalist ucdefAssocReasons) + (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 @@ -112,7 +127,15 @@ firmActionMap mr isAdmin acts = mconcat (mkAct isAdmin <$> acts) 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 + E.where_ $ E.isJust (usrc E.^. UserCompanyReason) + E.&&. usrc E.^. UserCompanySupervisor + return $ usrc E.^. UserCompanyReason + ucdefAssocReasons :: HandlerFor UniWorX (OptionList Text) + ucdefAssocReasons = 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.&&. E.not__ (usrc E.^. UserCompanySupervisor) return $ usrc E.^. UserCompanyReason @@ -158,7 +181,7 @@ firmActionHandler route isAdmin = flip formResult faHandler reloadKeepGetParams route -- reload to reflect changes faHandler (FirmActAddSupervisorsData{..}, Set.toList -> [cid]) = do - avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet guessAvsUser firmActAddSupervisorIds + avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet guessAvsUser firmActAddUserIds let (usersFound', usersNotFound) = partition (is _Just . view _2) $ Map.toList avsUsers usersFound = mapMaybe snd usersFound' unless (null usersNotFound) $ @@ -175,12 +198,38 @@ 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 firmActAddSupervisorReason| uid <- usersFound] [] [UserCompanySupervisor =. True, UserCompanySupervisorReroute =. firmActAddSupervisorReroute, UserCompanyReason =. firmActAddSupervisorReason] [] -- identical to previous line, but perhaps more clear? + upsertManyWhere + [UserCompany uid cid True firmActAddSupervisorReroute 0 firmActAddUserUseCompanyAddress 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 redirect route + faHandler (FirmActAddAssociatesData{..}, Set.toList -> [cid]) = do + avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet guessAvsUser firmActAddUserIds + let (usersFound', usersNotFound) = partition (is _Just . view _2) $ Map.toList avsUsers + usersFound = mapMaybe snd usersFound' + unless (null usersNotFound) $ + let msgContent = [whamlet| + $newline never +