chore(firm): reset supervisors for FirmAllR working
This commit is contained in:
parent
ecde6b0fac
commit
612d975384
@ -8,8 +8,11 @@ FirmAddress: Postanschrift
|
||||
FirmDefaultPreferenceInfo: Diese Voreinstellungen gelten nur für neue Firmenangehörige
|
||||
FirmAllActNotify: Mitteilung versenden
|
||||
FirmAllActResetSupervision: Ansprechpartner für alle Firmenangehörigen zurücksetzen
|
||||
FirmAllActResetSuperKeep: Bisherige Ansprechpartner der Firmenangehörigen zusätzlich beibehalten?
|
||||
FirmAllActResetMutualSupervision: Ansprechpartner beaufsichtigen sich gegenseitig
|
||||
FirmUserActNotify: Mitteilung versenden
|
||||
FirmUserActMkSuper: Zum Firmenansprechpartner ernennen
|
||||
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
|
||||
FirmSuperActRMSuperAll: Als aktiven Ansprechpartner komplett entfernen
|
||||
@ -24,4 +27,5 @@ FilterForeignSupervisor: Hat firmenfremde Ansprechpartner
|
||||
FilterFirmExtern: Externe Firma
|
||||
FirmSupervisorOf fsh@CompanyShorthand: Ansprechpartner #{fsh} angehörig
|
||||
FirmSupervisorIndependent: Ansprechpartner ohne jegliche Firmenzugehörigkeit
|
||||
FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh}
|
||||
FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh}
|
||||
NoCompanySelected: Bitte wählen Sie mindestens eine Firm aus.
|
||||
@ -9,6 +9,9 @@ FirmDefaultPreferenceInfo: Default setting for new company associates only
|
||||
FirmAllActNotify: Send message
|
||||
FirmAllActResetSupervision: Reset supervisors for all company associates
|
||||
FirmUserActNotify: Send message
|
||||
FirmAllActResetSuperKeep: Additionally keep existing supervisors of company associates?
|
||||
FirmAllActResetMutualSupervision: Supervisors supervise each other
|
||||
FirmResetSupervision rem set: #{tshow set} supervisors set#{bool mempty (", " <> tshow rem <> " deleted before") (rem > 0)}
|
||||
FirmUserActMkSuper: Mark as company supervisor
|
||||
FirmSuperActNotify: Send message
|
||||
FirmSuperActRMSuperDef: Remove as default supervisor
|
||||
@ -24,4 +27,5 @@ FilterForeignSupervisor: Has company-external supervisors
|
||||
FilterFirmExtern: External company
|
||||
FirmSupervisorOf fsh@CompanyShorthand: Supervisors belonging to #{fsh}
|
||||
FirmSupervisorIndependent: Independent supervisors
|
||||
FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users
|
||||
FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users
|
||||
NoCompanySelected: Select at least one company, please.
|
||||
@ -227,8 +227,8 @@ explicitUnsafeCoerceSqlExprValue typ (E.ERaw _m1 f1) = E.ERaw E.noMeta $ \_nPare
|
||||
)
|
||||
|
||||
and, or :: Foldable f => f (E.SqlExpr (E.Value Bool)) -> E.SqlExpr (E.Value Bool)
|
||||
and = F.foldr (E.&&.) true
|
||||
or = F.foldr (E.||.) false
|
||||
and = F.foldl' (E.&&.) true -- we can use foldl' since Postgresql reorders conditions anyway
|
||||
or = F.foldl' (E.||.) false
|
||||
|
||||
-- | Given a test and a set of values, check whether anyone succeeds the test
|
||||
-- WARNING: SQL leaves it explicitely unspecified whether `||` is short curcuited (i.e. lazily evaluated)
|
||||
|
||||
@ -70,16 +70,18 @@ addDefaultSupervisors cid employees = do
|
||||
E.<&> usr
|
||||
E.<&> (spr E.^. UserCompanySupervisorReroute)
|
||||
)
|
||||
(\_old new -> [UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications] )
|
||||
(\_old new -> [UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications])
|
||||
|
||||
-- like `addDefaultSupervisors`, but selects all employees from database
|
||||
addDefaultSupervisorsAll :: CompanyId -> DB Int64
|
||||
addDefaultSupervisorsAll cid = do
|
||||
addDefaultSupervisorsAll :: (MonoFoldable mono, CompanyId ~ Element 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_ $ spr E.^. UserCompanyCompany E.==. E.val cid
|
||||
E.&&. spr E.^. UserCompanySupervisor
|
||||
E.where_ $ E.and $ guardMonoid (not mutualSupervision) [ E.not_ $ usr E.^. UserCompanySupervisor ]
|
||||
<> [ spr E.^. UserCompanyCompany `E.in_` E.vals cids
|
||||
, spr E.^. UserCompanySupervisor
|
||||
]
|
||||
return $ UserSupervisor
|
||||
E.<# (spr E.^. UserCompanyUser)
|
||||
E.<&> (usr E.^. UserCompanyUser)
|
||||
@ -160,8 +162,11 @@ nullaryPathPiece ''FirmAllAction $ camelToPathPiece' 3
|
||||
embedRenderMessage ''UniWorX ''FirmAllAction id
|
||||
|
||||
data FirmAllActionData = FirmAllActNotifyData
|
||||
| FirmAllActResetSupervisionData
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
||||
| 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)
|
||||
@ -389,7 +394,9 @@ mkFirmAllTable isAdmin uid = do
|
||||
acts :: Map FirmAllAction (AForm Handler FirmAllActionData)
|
||||
acts = mconcat
|
||||
[ singletonMap FirmAllActNotify $ pure FirmAllActNotifyData
|
||||
, singletonMap FirmAllActResetSupervision $ pure FirmAllActResetSupervisionData
|
||||
, singletonMap FirmAllActResetSupervision $ FirmAllActResetSupervisionData
|
||||
<$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmAllActResetSuperKeep) (Just $ Just False)
|
||||
<*> aopt checkBoxField (fslI MsgFirmAllActResetMutualSupervision) (Just $ Just True )
|
||||
]
|
||||
dbtParams = DBParamsForm
|
||||
{ dbParamsFormMethod = POST
|
||||
@ -429,7 +436,21 @@ postFirmAllR = do
|
||||
isAdmin <- hasReadAccessTo AdminR
|
||||
(firmRes, firmTable) <- runDB $ mkFirmAllTable isAdmin uid -- filters to associated companies for non-admins
|
||||
formResult firmRes $ \case
|
||||
(FirmAllActResetSupervisionData, fids) -> addMessage Info $ text2Html $ "Reset " <> tshow (length fids) <> " companies. TODO"
|
||||
(_, fids) | null fids -> addMessageI Error MsgNoCompanySelected
|
||||
|
||||
(FirmAllActResetSupervisionData{..}, fids) -> runDB $ do
|
||||
delSupers <- if firmAllActResetKeepOldSupers == Just False
|
||||
then E.deleteCount $ do
|
||||
spr <- E.from $ E.table @UserSupervisor
|
||||
E.where_ $ E.exists $ do
|
||||
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 <- addDefaultSupervisorsAll (firmAllActResetMutualSupervision /= Just False) fids
|
||||
addMessageI Info $ MsgFirmResetSupervision newSupers delSupers
|
||||
reloadKeepGetParams FirmAllR -- reload to reflect changes
|
||||
|
||||
(FirmAllActNotifyData , Set.toList -> fids) -> do
|
||||
usrs <- runDB $ E.select $ E.distinct $ do
|
||||
(usr :& uc) <- E.from $ E.table @User `E.innerJoin` E.table @UserCompany `E.on` (\(emp :& uc) -> emp E.^. UserId E.==. uc E.^. UserCompanyUser)
|
||||
@ -437,6 +458,7 @@ postFirmAllR = do
|
||||
return $ usr E.^. UserId
|
||||
cuids <- traverse (encrypt . E.unValue) usrs :: Handler [CryptoUUIDUser]
|
||||
redirect (FirmsCommR $ fmap unCompanyKey fids, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])
|
||||
|
||||
siteLayoutMsg MsgMenuFirms $ do
|
||||
setTitleI MsgMenuFirms
|
||||
$(i18nWidgetFile "firm-all")
|
||||
@ -887,7 +909,7 @@ handleFirmCommR ultDest cs = do
|
||||
sprCmp <- E.from $ E.table @UserCompany
|
||||
E.where_ $ sprCmp E.^. UserCompanyUser E.==. spr E.^. UserId
|
||||
)
|
||||
return $ spr
|
||||
return spr
|
||||
|
||||
queryCmpy :: Bool -> CompanyId -> E.SqlQuery (E.SqlExpr (Entity User))
|
||||
queryCmpy sORe acid = do
|
||||
|
||||
Loading…
Reference in New Issue
Block a user