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

chore(firm): change dbTable to form with selection box (WIP)

Browse Source
This commit is contained in:
Steffen Jost 2023-10-24 09:08:04 +00:00
parent ebecbf5c7f
commit 19eea7abe8
1 changed files with 44 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
src/Handler/Firm.hs
View File

@ -102,14 +102,17 @@ data FirmAllAction = FirmAllActNotify
nullaryPathPiece ''FirmAllAction $ camelToPathPiece' 3 nullaryPathPiece ''FirmAllAction $ camelToPathPiece' 3
embedRenderMessage ''UniWorX ''FirmAllAction id embedRenderMessage ''UniWorX ''FirmAllAction id
data FirmAllActionData = FirmAllActNotifyData { } data FirmAllActionData = FirmAllActNotifyData
| FirmAllActResetSupervisionData | FirmAllActResetSupervisionData
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
type AllCompanyTableData = DBRow (Entity Company, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64) type AllCompanyTableData = DBRow (Entity Company, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64)
resultAllCompanyEntity :: Lens' AllCompanyTableData (Entity Company)
resultAllCompanyEntity = _dbrOutput . _1
resultAllCompany :: Lens' AllCompanyTableData Company resultAllCompany :: Lens' AllCompanyTableData Company
resultAllCompany = _dbrOutput . _1 . _entityVal resultAllCompany = resultAllCompanyEntity . _entityVal
resultAllCompanyUsers :: Lens' AllCompanyTableData Word64 resultAllCompanyUsers :: Lens' AllCompanyTableData Word64
resultAllCompanyUsers = _dbrOutput . _2 . _unValue resultAllCompanyUsers = _dbrOutput . _2 . _unValue
@ -181,7 +184,14 @@ firmCountActiveReroutes' cmpy = E.subSelectCount $ do
E.&&. usrSuper E.^. UserSupervisorRerouteNotifications E.&&. usrSuper E.^. UserSupervisorRerouteNotifications
mkFirmAllTable :: Bool -> UserId -> DB (FormResult (FirmAllActionData, Set CompanyId), Widget) mkFirmAllTable ::
-- ( Functor h, ToSortable h
-- , AsCornice h p FirmAllActionData
-- (DBCell (MForm Handler)
-- (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
-- ) cols
-- ) =>
Bool -> UserId -> DB (FormResult (FirmAllActionData, Set CompanyId), Widget)
mkFirmAllTable isAdmin uid = do mkFirmAllTable isAdmin uid = do
-- now <- liftIO getCurrentTime -- now <- liftIO getCurrentTime
let let
@ -202,9 +212,11 @@ mkFirmAllTable isAdmin uid = do
) )
dbtRowKey = (E.^. CompanyId) dbtRowKey = (E.^. CompanyId)
dbtProj = dbtProjId dbtProj = dbtProjId
dbtColonnade = dbColonnade $ mconcat dbtColonnade = -- formColonnade $
mconcat
[ -- if not isAdmin then mempty else -- guardOnM idAdmin $ [ -- if not isAdmin then mempty else -- guardOnM idAdmin $
dbSelect (applying _2) id (return . view (_dbrOutput . _1 . _entityKey)) -- hole :: (x -> f x) -> r -> f r
dbSelect (applying _2) id (return . view (resultAllCompanyEntity . _entityKey))
, sortable (Just "name") (i18nCell MsgTableCompany) $ \(view resultAllCompany -> firm) -> , sortable (Just "name") (i18nCell MsgTableCompany) $ \(view resultAllCompany -> firm) ->
anchorCell (FirmR $ companyShorthand firm) . toWgt $ companyName firm anchorCell (FirmR $ companyShorthand firm) . toWgt $ companyName firm
, sortable (Just "short") (i18nCell MsgTableCompanyShort) $ \(view resultAllCompany -> firm) -> , sortable (Just "short") (i18nCell MsgTableCompanyShort) $ \(view resultAllCompany -> firm) ->
@ -237,22 +249,40 @@ mkFirmAllTable isAdmin uid = do
[ [
] ]
dbtStyle = def -- { dbsFilterLayout = defaultDBSFilterLayout } dbtStyle = def -- { dbsFilterLayout = defaultDBSFilterLayout }
dbtParams = def acts :: Map FirmAllAction (AForm Handler FirmAllActionData)
acts = mconcat
[ singletonMap FirmAllActNotify $ pure FirmAllActNotifyData
, singletonMap FirmAllActResetSupervision $ pure FirmAllActResetSupervisionData
]
dbtParams = DBParamsForm
{ dbParamsFormMethod = POST
, dbParamsFormAction = Nothing
, dbParamsFormAttrs = []
, dbParamsFormSubmit = FormSubmit
, dbParamsFormAdditional
= renderAForm FormStandard
$ (, mempty) . First . Just
<$> multiActionA acts (fslI MsgTableAction) Nothing
, dbParamsFormEvaluate = liftHandler . runFormPost
, dbParamsFormResult = id
, dbParamsFormIdent = def
}
dbtIdent :: Text dbtIdent :: Text
dbtIdent = "firm" dbtIdent = "firm"
dbtCsvEncode = noCsvEncode dbtCsvEncode = noCsvEncode
dbtCsvDecode = Nothing dbtCsvDecode = Nothing
dbtExtraReps = [] dbtExtraReps = []
postprocess :: FormResult (First act', DBFormResult CompanyId Bool FirmAllActionData) postprocess :: FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData)
-> FormResult ( act', Set CompanyId) -> FormResult ( FirmAllActionData, 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
return (act, cmpSet) return (act, cmpSet)
-- resultDBTableValidator :: PSValidator (MForm Handler) (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData)) -- This type signature is not optional!
resultDBTableValidator = def resultDBTableValidator = def
-- & defaultSorting [SortAscBy "school", SortAscBy "qshort"] & defaultSorting [SortAscBy "short"]
over _1 postprocess <$> dbTable resultDBTableValidator resultDBTable over _1 postprocess <$> dbTable resultDBTableValidator resultDBTable
@ -263,8 +293,8 @@ postFirmAllR = do
isAdmin <- hasReadAccessTo AdminR 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
formResult firmRes $ \case formResult firmRes $ \case
(FirmAllActNotifyData, fids) -> addMessageI Info $ SomeMessage $ "Notify " <> length fids <> " companies. TODO" (FirmAllActNotifyData , fids) -> addMessage Info $ text2Html $ "Notify " <> tshow (length fids) <> " companies. TODO"
(FirmAllActResetSupervisionData, fids) -> addMessageI Info $ SomeMessage $ "Reset " <> length fids <> " companies. TODO" (FirmAllActResetSupervisionData, fids) -> addMessage Info $ text2Html $ "Reset " <> tshow (length fids) <> " companies. TODO"
siteLayoutMsg MsgMenuFirms $ do siteLayoutMsg MsgMenuFirms $ do
setTitleI MsgMenuFirms setTitleI MsgMenuFirms
-- $(widgetFile "firm-all") -- $(widgetFile "firm-all")