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

refactor(firm): FirmAllR messaging no longer works now

Browse Source 
What did change? Nothing here is essential?!
This commit is contained in:
Steffen Jost 2023-11-23 18:29:12 +01:00
parent b10cbc39cc
commit 577a2fb45d
1 changed files with 15 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/Handler/Firm.hs
View File

@ -437,7 +437,7 @@ resultAllCompanyDefaultReroutes :: Lens' AllCompanyTableData Bool
resultAllCompanyDefaultReroutes = _dbrOutput . _4 . _unValue resultAllCompanyDefaultReroutes = _dbrOutput . _4 . _unValue
mkFirmAllTable :: Bool -> UserId -> DB (FormResult (FirmAllActionData, Set CompanyId), Widget) mkFirmAllTable :: Bool -> UserId -> DB (FormResult (FirmActionData, Set CompanyId), Widget)
mkFirmAllTable isAdmin uid = do mkFirmAllTable isAdmin uid = do
-- now <- liftIO getCurrentTime -- now <- liftIO getCurrentTime
let let
@ -554,12 +554,12 @@ mkFirmAllTable isAdmin uid = do
, prismAForm (singletonFilter "company-postal" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterFirmExtern) , prismAForm (singletonFilter "company-postal" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterFirmExtern)
] ]
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
acts :: Map FirmAllAction (AForm Handler FirmAllActionData) acts :: Map FirmAction (AForm Handler FirmActionData)
acts = mconcat acts = mconcat
[ singletonMap FirmAllActNotify $ pure FirmAllActNotifyData [ singletonMap FirmActNotify $ pure FirmActNotifyData
, singletonMap FirmAllActResetSupervision $ FirmAllActResetSupervisionData , singletonMap FirmActResetSupervision $ FirmActResetSupervisionData
<$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmAllActResetSuperKeep) (Just $ Just False) <$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep) (Just $ Just False)
<*> aopt checkBoxField (fslI MsgFirmAllActResetMutualSupervision) (Just $ Just True ) <*> aopt checkBoxField (fslI MsgFirmActResetMutualSupervision) (Just $ Just True )
] ]
dbtParams = DBParamsForm dbtParams = DBParamsForm
@ -583,8 +583,8 @@ mkFirmAllTable isAdmin uid = do
dbtCsvDecode = Nothing dbtCsvDecode = Nothing
dbtExtraReps = [] dbtExtraReps = []
postprocess :: FormResult (First FirmAllActionData, DBFormResult CompanyId Bool AllCompanyTableData) postprocess :: FormResult (First FirmActionData, DBFormResult CompanyId Bool AllCompanyTableData)
-> FormResult ( FirmAllActionData, Set CompanyId) -> FormResult ( FirmActionData, Set CompanyId)
postprocess inp = do postprocess inp = do
(First (Just act), cmpMap) <- inp (First (Just act), cmpMap) <- inp
let cmpSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) cmpMap let cmpSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) cmpMap
@ -606,9 +606,9 @@ postFirmAllR = do
formResult firmRes $ \case formResult firmRes $ \case
(_, fids) | null fids -> addMessageI Error MsgNoCompanySelected (_, fids) | null fids -> addMessageI Error MsgNoCompanySelected
(FirmAllActResetSupervisionData{..}, fids) -> do (FirmActResetSupervisionData{..}, fids) -> do
runDB $ do runDB $ do
delSupers <- if firmAllActResetKeepOldSupers == Just False delSupers <- if firmActResetKeepOldSupers == Just False
then E.deleteCount $ do then E.deleteCount $ do
spr <- E.from $ E.table @UserSupervisor spr <- E.from $ E.table @UserSupervisor
E.where_ $ E.exists $ do E.where_ $ E.exists $ do
@ -616,11 +616,11 @@ postFirmAllR = do
E.where_ $ usr E.^. UserCompanyCompany `E.in_` E.vals fids E.where_ $ usr E.^. UserCompanyCompany `E.in_` E.vals fids
E.&&. usr E.^. UserCompanyUser E.==. spr E.^. UserSupervisorUser E.&&. usr E.^. UserCompanyUser E.==. spr E.^. UserSupervisorUser
else return 0 else return 0
newSupers <- addDefaultSupervisorsAll (firmAllActResetMutualSupervision /= Just False) fids newSupers <- addDefaultSupervisorsAll (firmActResetMutualSupervision /= Just False) fids
addMessageI Info $ MsgFirmResetSupervision delSupers newSupers addMessageI Info $ MsgFirmResetSupervision delSupers newSupers
reloadKeepGetParams FirmAllR -- reload to reflect changes reloadKeepGetParams FirmAllR -- reload to reflect changes
(FirmAllActNotifyData , Set.toList -> fids) -> do (FirmActNotifyData , Set.toList -> fids) -> do
usrs <- runDB $ E.select $ E.distinct $ 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) (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 E.where_ $ uc E.^. UserCompanyCompany `E.in_` E.valList fids
@ -818,8 +818,8 @@ mkFirmUserTable isAdmin cid = do
acts = mconcat acts = mconcat
[ singletonMap FirmUserActNotify $ pure FirmUserActNotifyData [ singletonMap FirmUserActNotify $ pure FirmUserActNotifyData
, singletonMap FirmUserActResetSupervision $ FirmUserActResetSupervisionData , singletonMap FirmUserActResetSupervision $ FirmUserActResetSupervisionData
<$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmAllActResetSuperKeep) (Just $ Just False) <$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep) (Just $ Just False)
-- <*> aopt checkBoxField (fslI MsgFirmAllActResetMutualSupervision) (Just $ Just True ) -- <*> aopt checkBoxField (fslI MsgFirmActResetMutualSupervision) (Just $ Just True )
, singletonMap FirmUserActMkSuper $ FirmUserActMkSuperData , singletonMap FirmUserActMkSuper $ FirmUserActMkSuperData
<$> aopt checkBoxField (fslI MsgTableIsDefaultReroute) (Just $ Just True) <$> aopt checkBoxField (fslI MsgTableIsDefaultReroute) (Just $ Just True)
] ]
@ -848,7 +848,7 @@ mkFirmUserTable isAdmin cid = do
let s = Map.keysSet . Map.filter id $ getDBFormResult (const False) m let s = Map.keysSet . Map.filter id $ getDBFormResult (const False) m
return (act, s) return (act, s)
-- resultDBTableValidator :: PSValidator (MForm Handler) (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData)) -- resultDBTableValidator :: PSValidator (MForm Handler) (FormResult (First FirmActionData, DBFormResult CompanyId Bool FirmActionData))
resultDBTableValidator = def resultDBTableValidator = def
& defaultSorting [SortAscBy "user-name"] & defaultSorting [SortAscBy "user-name"]
over _1 postprocess <$> dbTable resultDBTableValidator resultDBTable over _1 postprocess <$> dbTable resultDBTableValidator resultDBTable