refactor(firm): fix #157 refactor duplicated code
also ensures that supervisor default reaons filters are obeyed.
This commit is contained in:
parent
0bbb679a43
commit
fee14edf36
@ -149,11 +149,13 @@ 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
|
||||
usr <- E.from $ E.table @UserCompany
|
||||
E.where_ $ usr E.^. UserCompanyCompany `E.in_` E.vals fids
|
||||
E.&&. usr E.^. UserCompanyUser E.==. spr E.^. UserSupervisorUser
|
||||
)
|
||||
E.where_ $ suprFltr spr
|
||||
E.&&. spr E.^. UserSupervisorReason E.~=. E.val (tshow SupervisorReasonCompanyDefault)
|
||||
E.&&. 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 <- addDefaultSupervisorsFor (Just $ tshow SupervisorReasonCompanyDefault) madId (firmActResetMutualSupervision /= Just False) fids
|
||||
addMessageI Success $ MsgFirmResetSupervision delSupers newSupers
|
||||
@ -252,25 +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]
|
||||
let superReasonComDef = Just $ tshow SupervisorReasonCompanyDefault
|
||||
nr_add <- addDefaultSupervisors superReasonComDef cid employees
|
||||
return $ max nr_del nr_add
|
||||
|
||||
|
||||
|
||||
------------------------------
|
||||
-- repeatedly useful queries
|
||||
|
||||
usrPrimaryCompanies :: E.SqlExpr (Entity Company) -> E.SqlExpr (Entity UserCompany) -> E.SqlQuery ()
|
||||
@ -1072,7 +1055,7 @@ 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 Nothing cid uids
|
||||
addMessageI Info $ MsgFirmResetSupervision delSupers newSupers
|
||||
@ -1093,7 +1076,7 @@ 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) firmUserActSetSuperReason | u <- toList uids, s <- newSupers]
|
||||
addMessageI Success $ MsgFirmSetSupersReport nrUsers nrSupers delSupers
|
||||
reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
|
||||
|
||||
@ -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
|
||||
-- addDefaultSupervisors 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
|
||||
@ -553,7 +553,7 @@ createAvsUserById muid api = do
|
||||
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
|
||||
void $ addDefaultSupervisors Nothing cid $ singleton 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
|
||||
|
||||
@ -59,6 +59,11 @@ 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!
|
||||
|
||||
type AnySuperReason = Either SupervisorReason (Maybe Text)
|
||||
|
||||
|
||||
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"
|
||||
@ -211,13 +216,24 @@ switchAvsUserCompany usrPostEmailUpds keepOldCompanySupervs uid newCompanyId = d
|
||||
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):reasonFilter)
|
||||
<*> deleteWhereCount ((UserSupervisorCompany ==. Just cid):(UserSupervisorUser <-. uids):reasonFilter)
|
||||
where
|
||||
reasonFilter = [UserSupervisorReason ==. Nothing]
|
||||
||. [UserSupervisorReason <-. [Just $ tshow r | r <- [SupervisorReasonCompanyDefault, SupervisorReasonAvsSuperior]]]
|
||||
<*> deleteWhereCount ((UserSupervisorCompany ==. Just cid):(UserSupervisorSupervisor <-. uids) : defaultSupervisorReasonFilter)
|
||||
<*> deleteWhereCount ((UserSupervisorCompany ==. Just cid):(UserSupervisorUser <-. uids) : defaultSupervisorReasonFilter)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user