diff --git a/messages/uniworx/categories/firm/de-de-formal.msg b/messages/uniworx/categories/firm/de-de-formal.msg index 89399a379..459750323 100644 --- a/messages/uniworx/categories/firm/de-de-formal.msg +++ b/messages/uniworx/categories/firm/de-de-formal.msg @@ -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} \ No newline at end of file +FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh} +NoCompanySelected: Bitte wählen Sie mindestens eine Firm aus. \ No newline at end of file diff --git a/messages/uniworx/categories/firm/en-eu.msg b/messages/uniworx/categories/firm/en-eu.msg index 044bebd48..6d497c91e 100644 --- a/messages/uniworx/categories/firm/en-eu.msg +++ b/messages/uniworx/categories/firm/en-eu.msg @@ -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 \ No newline at end of file +FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users +NoCompanySelected: Select at least one company, please. \ No newline at end of file diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index 3cba53920..2e97195e8 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -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) diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index dc46d5f9a..e7020fab4 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -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