fraport/fradrive
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

58
src/Handler/Firm.hs
View File

@ -102,14 +102,17 @@ data FirmAllAction = FirmAllActNotify
nullaryPathPiece ''FirmAllAction $ camelToPathPiece' 3
embedRenderMessage ''UniWorX ''FirmAllAction id
data FirmAllActionData = FirmAllActNotifyData { }
data FirmAllActionData = FirmAllActNotifyData
| FirmAllActResetSupervisionData
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)
resultAllCompanyEntity :: Lens' AllCompanyTableData (Entity Company)
resultAllCompanyEntity = _dbrOutput . _1
resultAllCompany :: Lens' AllCompanyTableData Company
resultAllCompany = _dbrOutput . _1 . _entityVal
resultAllCompany = resultAllCompanyEntity . _entityVal
resultAllCompanyUsers :: Lens' AllCompanyTableData Word64
resultAllCompanyUsers = _dbrOutput . _2 . _unValue
@ -181,12 +184,19 @@ firmCountActiveReroutes' cmpy = E.subSelectCount $ do
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
-- now <- liftIO getCurrentTime
let
let
resultDBTable = DBTable{..}
where
where
dbtSQLQuery cmpy = do
unless isAdmin $ E.where_ $ E.exists $ do -- only show associated companies
usrCmpy <- E.from $ E.table @UserCompany
@ -202,9 +212,11 @@ mkFirmAllTable isAdmin uid = do
)
dbtRowKey = (E.^. CompanyId)
dbtProj = dbtProjId
dbtColonnade = dbColonnade $ mconcat
dbtColonnade = -- formColonnade $
mconcat
[ -- 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) ->
anchorCell (FirmR $ companyShorthand firm) . toWgt $ companyName firm
, sortable (Just "short") (i18nCell MsgTableCompanyShort) $ \(view resultAllCompany -> firm) ->
@ -237,22 +249,40 @@ mkFirmAllTable isAdmin uid = do
[
]
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 = "firm"
dbtCsvEncode = noCsvEncode
dbtCsvDecode = Nothing
dbtExtraReps = []
postprocess :: FormResult (First act', DBFormResult CompanyId Bool FirmAllActionData)
-> FormResult ( act', Set CompanyId)
postprocess :: FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData)
-> FormResult ( FirmAllActionData, Set CompanyId)
postprocess inp = do
(First (Just act), cmpMap) <- inp
let cmpSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) cmpMap
return (act, cmpSet)
-- resultDBTableValidator :: PSValidator (MForm Handler) (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData)) -- This type signature is not optional!
resultDBTableValidator = def
-- & defaultSorting [SortAscBy "school", SortAscBy "qshort"]
& defaultSorting [SortAscBy "short"]
over _1 postprocess <$> dbTable resultDBTableValidator resultDBTable
@ -263,8 +293,8 @@ postFirmAllR = do
isAdmin <- hasReadAccessTo AdminR
(firmRes, firmTable) <- runDB $ mkFirmAllTable isAdmin uid -- filters to associated companies for non-admins
formResult firmRes $ \case
(FirmAllActNotifyData, fids) -> addMessageI Info $ SomeMessage $ "Notify " <> length fids <> " companies. TODO"
(FirmAllActResetSupervisionData, fids) -> addMessageI Info $ SomeMessage $ "Reset " <> length fids <> " companies. TODO"
(FirmAllActNotifyData , fids) -> addMessage Info $ text2Html $ "Notify " <> tshow (length fids) <> " companies. TODO"
(FirmAllActResetSupervisionData, fids) -> addMessage Info $ text2Html $ "Reset " <> tshow (length fids) <> " companies. TODO"
siteLayoutMsg MsgMenuFirms $ do
setTitleI MsgMenuFirms
-- $(widgetFile "firm-all")