From 19eea7abe8ddd317c8dc14cb1264bd07402414e2 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 24 Oct 2023 09:08:04 +0000 Subject: [PATCH] chore(firm): change dbTable to form with selection box (WIP) --- src/Handler/Firm.hs | 58 ++++++++++++++++++++++++++++++++++----------- 1 file changed, 44 insertions(+), 14 deletions(-) diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index 653561d27..45b47f9da 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -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")