chore(firm): add action to add non-avs firm associates
This commit is contained in:
parent
d2f69dc023
commit
6f1ad811f7
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
<ul>
|
||||
$forall (usr,_) <- usersNotFound
|
||||
<li>#{usr}
|
||||
|]
|
||||
in addMessageModal Error (i18n . MsgCourseParticipantsRegisterNotFoundInAvs $ length usersNotFound) (Right msgContent)
|
||||
when (null usersFound) $ do
|
||||
addMessageI Warning MsgFirmActAddAssocsEmpty
|
||||
reloadKeepGetParams route
|
||||
runDB $ do
|
||||
oks0 <- mapM insertUnique_ [UserCompany uid cid False False firmActAddAssociatePriority firmActAddUserUseCompanyAddress firmActAddAssociateReason | uid <- usersFound]
|
||||
let oks = length $ catMaybes oks0
|
||||
allok = bool Warning Success $ oks == length usersFound
|
||||
addMessageI allok $ MsgFirmActAddAssocs (fromIntegral oks)
|
||||
redirect route
|
||||
|
||||
faHandler (FirmActChangeContactFirmData{..}, Set.toList -> [cid]) =
|
||||
let changes = catMaybes
|
||||
[ (CompanyPostAddress =.) . Just <$> canonical firmActCCFPostalAddr
|
||||
@ -1139,7 +1188,7 @@ postFirmUsersR fsh = do
|
||||
addMessageI allok $ someMessages [MsgFirmUserActRemoveResult nrUc, MsgFirmRemoveSupervision nrSuper nrSubs]
|
||||
reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
|
||||
|
||||
formFirmAction <- runFirmActionFormPost cid (FirmUsersR fsh) isAdmin [FirmActNotify, FirmActResetSupervision, FirmActAddSupervisors, FirmActChangeContactFirm, FirmActChangeContactUser]
|
||||
formFirmAction <- runFirmActionFormPost cid (FirmUsersR fsh) isAdmin [FirmActNotify, FirmActResetSupervision, FirmActAddAssociates, FirmActChangeContactFirm, FirmActChangeContactUser]
|
||||
|
||||
siteLayout (citext2widget companyName) $ do
|
||||
setTitle $ toHtml $ CI.original companyShorthand <> "-" <> tshow companyAvsId
|
||||
|
||||
@ -222,6 +222,18 @@ checkUniqueKeys (x:xs) = do
|
||||
Nothing -> checkUniqueKeys xs
|
||||
Just _ -> return (Just x)
|
||||
|
||||
-- Backport from version persistent-2.14.6.3
|
||||
insertUnique_ :: ( MonadIO m
|
||||
, PersistEntity record
|
||||
, PersistUniqueWrite backend
|
||||
, PersistEntityBackend record ~ BaseBackend backend
|
||||
)
|
||||
=> record -> ReaderT backend m (Maybe ())
|
||||
insertUnique_ datum = do
|
||||
conflict <- checkUnique datum
|
||||
case conflict of
|
||||
Nothing -> Just <$> insert_ datum
|
||||
Just _ -> return Nothing
|
||||
|
||||
put :: ( MonadIO m
|
||||
, PersistUniqueWrite backend
|
||||
|
||||
Loading…
Reference in New Issue
Block a user