fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor(firm): FirmAllR messaging working old way

Browse Source
This commit is contained in:
Steffen Jost 2023-11-23 18:22:00 +01:00
parent 8973ea5849
commit b10cbc39cc
1 changed files with 42 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
src/Handler/Firm.hs
View File

@ -437,7 +437,7 @@ resultAllCompanyDefaultReroutes :: Lens' AllCompanyTableData Bool
resultAllCompanyDefaultReroutes = _dbrOutput . _4 . _unValue
mkFirmAllTable :: Bool -> UserId -> DB (FormResult (FirmActionData, Set CompanyId), Widget)
mkFirmAllTable :: Bool -> UserId -> DB (FormResult (FirmAllActionData, Set CompanyId), Widget)
mkFirmAllTable isAdmin uid = do
-- now <- liftIO getCurrentTime
let
@ -554,14 +554,25 @@ mkFirmAllTable isAdmin uid = do
, prismAForm (singletonFilter "company-postal" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterFirmExtern)
]
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
acts :: Map FirmAllAction (AForm Handler FirmAllActionData)
acts = mconcat
[ singletonMap FirmAllActNotify $ pure FirmAllActNotifyData
, singletonMap FirmAllActResetSupervision $ FirmAllActResetSupervisionData
<$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmAllActResetSuperKeep) (Just $ Just False)
<*> aopt checkBoxField (fslI MsgFirmAllActResetMutualSupervision) (Just $ Just True )
]
dbtParams = DBParamsForm
{ dbParamsFormMethod = POST
, dbParamsFormAction = Nothing
, dbParamsFormAttrs = []
, dbParamsFormSubmit = FormSubmit
-- , dbParamsFormAdditional = renderAForm FormStandard $ (, mempty) . First . Just <$> firmActionForm [FirmActNotify, FirmActResetSupervision]
, dbParamsFormAdditional = renderAForm FormStandard $ (, mempty) . First . Just
<$> multiActionA (firmActionMap [FirmActNotify, FirmActResetSupervision]) (fslI MsgTableAction) Nothing
-- , dbParamsFormAdditional = renderAForm FormStandard $ (, mempty) . First . Just
-- <$> multiActionA (firmActionMap [FirmActNotify, FirmActResetSupervision]) (fslI MsgTableAction) Nothing
, dbParamsFormAdditional
= renderAForm FormStandard $ (, mempty) . First . Just
<$> multiActionA acts (fslI MsgTableAction) Nothing
, dbParamsFormEvaluate = liftHandler . runFormPost
, dbParamsFormResult = id
, dbParamsFormIdent = def
@ -572,8 +583,8 @@ mkFirmAllTable isAdmin uid = do
dbtCsvDecode = Nothing
dbtExtraReps = []
postprocess :: FormResult (First FirmActionData, DBFormResult CompanyId Bool AllCompanyTableData)
-> FormResult ( FirmActionData, Set CompanyId)
postprocess :: FormResult (First FirmAllActionData, DBFormResult CompanyId Bool AllCompanyTableData)
-> FormResult ( FirmAllActionData, Set CompanyId)
postprocess inp = do
(First (Just act), cmpMap) <- inp
let cmpSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) cmpMap
@ -590,8 +601,33 @@ getFirmAllR = postFirmAllR
postFirmAllR = do
uid <- requireAuthId
isAdmin <- hasReadAccessTo AdminR
(_firmRes, firmTable) <- runDB $ mkFirmAllTable isAdmin uid -- filters to associated companies for non-admins
(firmRes, firmTable) <- runDB $ mkFirmAllTable isAdmin uid -- filters to associated companies for non-admins
-- firmActionHandler FirmAllR firmRes
formResult firmRes $ \case
(_, fids) | null fids -> addMessageI Error MsgNoCompanySelected
(FirmAllActResetSupervisionData{..}, fids) -> do
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 delSupers newSupers
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)
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])
siteLayoutMsg MsgMenuFirms $ do
setTitleI MsgMenuFirms
$(i18nWidgetFile "firm-all")