diff --git a/messages/uniworx/categories/firm/de-de-formal.msg b/messages/uniworx/categories/firm/de-de-formal.msg index 5d81a2b03..d5cda6037 100644 --- a/messages/uniworx/categories/firm/de-de-formal.msg +++ b/messages/uniworx/categories/firm/de-de-formal.msg @@ -8,6 +8,12 @@ FirmNoContact: Keine allgemeinen Kontaktinformationen bekannt. FirmEmail: Allgemeine Email FirmAddress: Postanschrift FirmDefaultPreferenceInfo: Diese Voreinstellungen gelten nur für neue Firmenangehörige +FirmAction: Firmenweite Aktion +FirmActNotify: Mitteilung versenden +FirmActResetSupervision: Ansprechpartner für alle Firmenangehörigen zurücksetzen +FirmActResetSuperKeep: Bisherige Ansprechpartner der Firmenangehörigen zusätzlich beibehalten? +FirmActResetMutualSupervision: Ansprechpartner beaufsichtigen sich gegenseitig +FirmActAddSupervisors: Ansprechpartner hinzufügen FirmAllActNotify: Mitteilung versenden FirmAllActResetSupervision: Ansprechpartner für alle Firmenangehörigen zurücksetzen FirmAllActResetSuperKeep: Bisherige Ansprechpartner der Firmenangehörigen zusätzlich beibehalten? diff --git a/messages/uniworx/categories/firm/en-eu.msg b/messages/uniworx/categories/firm/en-eu.msg index 250b9ca38..953055b25 100644 --- a/messages/uniworx/categories/firm/en-eu.msg +++ b/messages/uniworx/categories/firm/en-eu.msg @@ -8,11 +8,17 @@ FirmNoContact: No general contact information known. FirmEmail: General company email FirmAddress: Postal address FirmDefaultPreferenceInfo: Default setting for new company associates only +FirmAction: Companywide action +FirmActNotify: Send message +FirmActResetSupervision: Reset supervisors for all company associates +FirmActResetSuperKeep: Additionally keep existing supervisors of company associates? +FirmActResetMutualSupervision: Supervisors supervise each other +FirmActAddSupervisors: Add supervisors 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 +FirmUserActNotify: Send message FirmUserActResetSupervision: Reset supervisors to company default FirmResetSupervision rem set: #{tshow set} supervisors set#{bool mempty (", " <> tshow rem <> " deleted before") (rem > 0)} FirmUserActMkSuper: Mark as company supervisor diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index 9442d841a..12efe6594 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -48,12 +48,134 @@ decryptUser = decrypt encryptUser :: (MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> m CryptoUUIDUser encryptUser = encrypt +postalEmailField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Field m Bool +postalEmailField = boolFieldCustom (SomeMessage MsgUtilPostal) (SomeMessage MsgUtilEMail) $ Just $ SomeMessage MsgUtilUnchanged + +--------------------------------- +-- General firm affecting actions + +data FirmAction = FirmActNotify + | FirmActResetSupervision + -- | FirmActAddSupervisors + deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) + deriving anyclass (Universe, Finite) + +nullaryPathPiece ''FirmAction $ camelToPathPiece' 3 +embedRenderMessage ''UniWorX ''FirmAction id + +data FirmActionData = FirmActNotifyData + | FirmActResetSupervisionData + { firmActResetKeepOldSupers :: Maybe Bool + , firmActResetMutualSupervision :: Maybe Bool + } + -- | FirmActAddSupervisorsData + -- { firmActAddSupervisorIds :: Set Text + -- , firmActAddSupervisorReroute :: Bool + -- , firmActAddSupervisorPostal :: Maybe Bool + -- } + deriving (Eq, Ord, Read, Show, Generic) + +firmActionMap :: [FirmAction] -> Map FirmAction (AForm Handler FirmActionData) +firmActionMap acts = mconcat (mkAct <$> acts) + where + mkAct FirmActNotify = singletonMap FirmActNotify $ pure FirmActNotifyData + mkAct FirmActResetSupervision = singletonMap FirmActResetSupervision $ FirmActResetSupervisionData + <$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep) (Just $ Just False) + <*> aopt checkBoxField (fslI MsgFirmActResetMutualSupervision) (Just $ Just True ) + -- mkAct FirmActAddSupervisors = singletonMap FirmActAddSupervisors $ FirmActAddSupervisorsData + -- <$> areq (textField & cfAnySeparatedSet) (fslI MsgTableIsDefaultSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) (Just mempty) + -- <*> areq checkBoxField (fslI MsgTableIsDefaultReroute ) (Just True) + -- <*> aopt postalEmailField (fslI MsgFormReqPostal & setTooltip MsgFormReqPostalTip) (Just Nothing) + +firmActionForm :: [FirmAction] -> AForm Handler FirmActionData +firmActionForm acts = multiActionA (firmActionMap acts) (fslI MsgTableAction) Nothing + + +makeFirmActionForm :: CompanyId -> [FirmAction] -> Form (FirmActionData, Set CompanyId) +makeFirmActionForm cid acts html = flip (renderAForm FormStandard) html $ (,Set.singleton cid) <$> firmActionForm acts + +-- makeFirmActionTableForm :: Monoid t => [FirmAction] -> Text.Blaze.Internal.Markup -> Control.Monad.Trans.RWS.Lazy.RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints Handler (FormResult (First FirmActionData, t), WidgetFor UniWorX ()) +-- makeFirmActionTableForm acts = renderAForm FormStandard $ (, mempty) . First . Just <$> firmActionForm acts + +firmActionHandler :: Route UniWorX -> FormResult (FirmActionData, Set CompanyId) -> Handler () +firmActionHandler route = flip formResult faHandler + where + faHandler (_,fids) | null fids = addMessageI Error MsgNoCompanySelected + faHandler (FirmActResetSupervisionData{..}, fids) = do + runDB $ do + delSupers <- if firmActResetKeepOldSupers == 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 (firmActResetMutualSupervision /= Just False) fids + addMessageI Info $ MsgFirmResetSupervision delSupers newSupers + reloadKeepGetParams route -- reload to reflect changes + + faHandler (FirmActNotifyData, 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) + E.where_ $ uc E.^. UserCompanyCompany `E.in_` E.valList fids + return $ usr E.^. UserId + cuids <- traverse (encrypt . E.unValue) usrs :: Handler [CryptoUUIDUser] + redirect (FirmsCommR $ fmap unCompanyKey fids, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids]) + + -- faHandler (FirmActAddSupervisorsData{..}, Set.toList -> [cid]) = do + -- avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet guessAvsUser firmActAddSupervisorIds + -- let (usersFound', usersNotFound) = partition (is _Just . view _2) $ Map.toList avsUsers + -- usersFound = mapMaybe snd usersFound' + -- unless (null usersNotFound) $ + -- let msgContent = [whamlet| + -- $newline never + --