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

chore(print-center): work on dbtable

Browse Source
This commit is contained in:
Sarah Vaupel 2022-07-14 17:57:40 +02:00
parent ac78edd99c
commit 9fa12dc758
3 changed files with 24 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/Handler/PrintCenter.hs
View File

@ -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

5
src/Handler/Utils/Table/Columns.hs
View File

@ -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')

2
src/Utils/Lens.hs
View File

@ -282,6 +282,8 @@ makePrisms ''SheetAuthorshipStatementMode
makeLenses_ ''AuthorshipStatementSubmission
makeLenses_ ''AuthorshipStatementDefinition
makeLenses_ ''PrintJob
--------------------------
-- Fields for `UniWorX` --
--------------------------