From 9fa12dc758042e82b6f5129420da67f8910a233a Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 14 Jul 2022 17:57:40 +0200 Subject: [PATCH] chore(print-center): work on dbtable --- src/Handler/PrintCenter.hs | 30 +++++++++++++++++------------- src/Handler/Utils/Table/Columns.hs | 5 +++++ src/Utils/Lens.hs | 2 ++ 3 files changed, 24 insertions(+), 13 deletions(-) diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index d384cba73..abf6f785b 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -181,11 +181,11 @@ mkPJTable = do dbtRowKey = queryPrintJob >>> (E.^. PrintJobId) dbtProj = dbtProjFilteredPostId dbtColonnade = mconcat - [ dbSelectIf (applying _1) id (return . view (resultPrintJob . _entityKey)) (\r -> isNothing $ r ^? resultPrintJob . _printJobAcknowleged) + [ dbSelectIf (applying _2) id (return . view (resultPrintJob . _entityKey)) (\r -> isNothing $ r ^? resultPrintJob . _entityVal . _printJobAcknowledged) , sortable (Just "pj-name") (i18nCell MsgPrintJobName) $ \( view $ resultPrintJob . _entityVal . _printJobName -> n) -> textCell n , sortable (Just "pj-id") (i18nCell MsgPrintJobId) $ \( view $ resultPrintJob . _entityKey -> k) -> numCell k , sortable (Just "pj-created") (i18nCell MsgPrintJobCreated) $ \( view $ resultPrintJob . _entityVal . _printJobCreated -> t) -> dateTimeCell t - , sortable (Just "pj-acknowledged") (i18nCell MsgPrintJobAcknowledged) $ \(preview $ resultPrintJob . _entityVal . _printJobAcknowledged -> t) -> maybeDateTimeCell t + , sortable (Just "pj-acknowledged") (i18nCell MsgPrintJobAcknowledged) $ \( view $ resultPrintJob . _entityVal . _printJobAcknowledged -> t) -> maybeDateTimeCell t , sortable (Just "pj-recipient") (i18nCell MsgPrintRecipient) $ \(preview $ resultRecipient . _entityVal -> u) -> maybeCell u $ cellHasUserLink AdminUserR , sortable (Just "pj-sender") (i18nCell MsgPrintSender) $ \(preview $ resultSender . _entityVal -> u) -> maybeCell u $ cellHasUserLink AdminUserR , sortable (Just "pj-course") (i18nCell MsgPrintCourse) $ \(preview $ resultCourse . _entityVal -> c) -> maybeCell c courseCell @@ -196,10 +196,10 @@ mkPJTable = do , single ("pj-id" , SortColumn $ queryPrintJob >>> (E.^. PrintJobId)) , single ("pj-created" , SortColumn $ queryPrintJob >>> (E.^. PrintJobCreated)) , single ("pj-acknowledged" , SortColumn $ queryPrintJob >>> (E.^. PrintJobAcknowledged)) - , single ("pj-recipient" , sortUserNameBare queryRecipient) - , single ("pj-sender" , sortUserNameBare querySender ) - , single ("pj-course" , SortColumn $ queryCourse >>> (E.^. CourseName)) - , single ("pj-qualification", SortColumn $ queryQualification >>> (E.^. QualificationName)) + , single ("pj-recipient" , sortUserNameBareM queryRecipient) + , single ("pj-sender" , sortUserNameBareM querySender ) + , single ("pj-course" , SortColumn $ queryCourse >>> (E.?. CourseName)) + , single ("pj-qualification", SortColumn $ queryQualification >>> (E.?. QualificationName)) ] dbtFilter = mconcat [ @@ -222,20 +222,24 @@ mkPJTable = do , dbParamsFormAttrs = [] , dbParamsFormSubmit = FormSubmit , dbParamsFormAdditional - = renderAForm FormStandard + = let acts :: Map PJTableAction (AForm Handler PJTableActionData) + acts = mconcat + [ singletonMap PJActAcknowledge $ pure PJActAcknowledgeData + ] + in renderAForm FormStandard $ (, mempty) . First . Just <$> multiActionA acts (fslI MsgTableAction) Nothing , dbParamsFormEvaluate = liftHandler . runFormPost , dbParamsFormResult = id , dbParamsFormIdent = def } - postprocess :: FormResult (First act', DBFormResult UserId Bool PJTableData) - -> FormResult ( act', Set UserId) + postprocess :: FormResult (First PJTableAction, DBFormResult PrintJobId Bool PJTableData) + -> FormResult ( PJTableAction, Set PrintJobId) postprocess inp = do - (First (Just act), usrMap) <- inp - let usrSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) usrMap - return (act, usrSet) - over _1 postprocess <$> dbTable psValidator DBTable{..} + (First (Just act), jobMap) <- inp + let jobSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) jobMap + return (act, jobSet) + over _1 postprocess <$> dbTable def DBTable{..} getPrintCenterR, postPrintCenterR :: Handler Html getPrintCenterR = postPrintCenterR diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs index 0bd752ea5..4d584aed4 100644 --- a/src/Handler/Utils/Table/Columns.hs +++ b/src/Handler/Utils/Table/Columns.hs @@ -497,6 +497,11 @@ sortUserNameBare queryUser = SortColumns $ queryUser >>> \user -> [ SomeExprValue $ user E.^. UserSurname , SomeExprValue $ user E.^. UserDisplayName ] +sortUserNameBareM :: (t -> E.SqlExpr (Maybe (Entity User))) -> SortColumn t r' +sortUserNameBareM queryUser = SortColumns $ queryUser >>> \user -> + [ SomeExprValue $ user E.?. UserSurname + , SomeExprValue $ user E.?. UserDisplayName + ] -- | Alias for sortUserName for consistency, since column comes in two variants sortUserNameLink :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t r') diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index 397fc4378..ebe41eea4 100644 --- a/src/Utils/Lens.hs +++ b/src/Utils/Lens.hs @@ -282,6 +282,8 @@ makePrisms ''SheetAuthorshipStatementMode makeLenses_ ''AuthorshipStatementSubmission makeLenses_ ''AuthorshipStatementDefinition +makeLenses_ ''PrintJob + -------------------------- -- Fields for `UniWorX` -- --------------------------