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

feat(lpr): print center allows filtering by day now

Browse Source
This commit is contained in:
Steffen Jost 2022-09-09 15:46:18 +02:00
parent fc926c23cb
commit cac4870c95
4 changed files with 28 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/Database/Esqueleto/Utils.hs
View File

@ -14,6 +14,7 @@ module Database.Esqueleto.Utils
, mkExactFilter, mkExactFilterWith , mkExactFilter, mkExactFilterWith
, mkExactFilterLast, mkExactFilterLastWith , mkExactFilterLast, mkExactFilterLastWith
, mkContainsFilter, mkContainsFilterWith , mkContainsFilter, mkContainsFilterWith
, mkDayFilter
, mkExistsFilter , mkExistsFilter
, anyFilter, allFilter , anyFilter, allFilter
, orderByList , orderByList
@ -222,7 +223,7 @@ mkExactFilterWith cast lenslike row criterias
mkExactFilterLast :: (PersistField a) mkExactFilterLast :: (PersistField a)
=> (t -> E.SqlExpr (E.Value a)) -- ^ getter from query to searched element => (t -> E.SqlExpr (E.Value a)) -- ^ getter from query to searched element
-> t -- ^ query row -> t -- ^ query row
-> Last a -- ^ needle collection -> Last a -- ^ needle
-> E.SqlExpr (E.Value Bool) -> E.SqlExpr (E.Value Bool)
mkExactFilterLast = mkExactFilterLastWith id mkExactFilterLast = mkExactFilterLastWith id
@ -231,7 +232,7 @@ mkExactFilterLastWith :: (PersistField b)
=> (a -> b) -- ^ type conversion => (a -> b) -- ^ type conversion
-> (t -> E.SqlExpr (E.Value b)) -- ^ getter from query to searched element -> (t -> E.SqlExpr (E.Value b)) -- ^ getter from query to searched element
-> t -- ^ query row -> t -- ^ query row
-> Last a -- ^ needle collection -> Last a -- ^ needle
-> E.SqlExpr (E.Value Bool) -> E.SqlExpr (E.Value Bool)
mkExactFilterLastWith cast lenslike row criterias mkExactFilterLastWith cast lenslike row criterias
| Last (Just crit) <- criterias = lenslike row E.==. E.val (cast crit) | Last (Just crit) <- criterias = lenslike row E.==. E.val (cast crit)
@ -258,6 +259,16 @@ mkContainsFilterWith cast lenslike row criterias
| Set.null criterias = true | Set.null criterias = true
| otherwise = any (hasInfix $ lenslike row) (E.val . cast <$> Set.toList criterias) | otherwise = any (hasInfix $ lenslike row) (E.val . cast <$> Set.toList criterias)
mkDayFilter :: (t -> E.SqlExpr (E.Value UTCTime)) -- ^ getter from query to searched element
-> t -- ^ query row
-> Last Day -- ^ a day to filter for
-> E.SqlExpr (E.Value Bool)
mkDayFilter lenslike row criterias
| Last (Just crit) <- criterias = day (lenslike row) E.==. E.val crit
| otherwise = true
mkExistsFilter :: PathPiece a mkExistsFilter :: PathPiece a
=> (t -> a -> E.SqlQuery ()) => (t -> a -> E.SqlQuery ())
-> t -> t

13
src/Handler/PrintCenter.hs
View File

@ -193,8 +193,6 @@ mkPJTable = do
, sortable (Just "pj-filename") (i18nCell MsgPrintPDF) $ \r -> let k = r ^. resultPrintJob . _entityKey , sortable (Just "pj-filename") (i18nCell MsgPrintPDF) $ \r -> let k = r ^. resultPrintJob . _entityKey
t = r ^. resultPrintJob . _entityVal . _printJobFilename t = r ^. resultPrintJob . _entityVal . _printJobFilename
in anchorCellM (PrintDownloadR <$> encrypt k) (toWgt t) in anchorCellM (PrintDownloadR <$> encrypt k) (toWgt t)
-- , sortable (Just "pj-id") (i18nCell MsgPrintJobId) $ \( view $ resultPrintJob . _entityKey -> k) -> textCell (tshow . E.unSqlBackendKey $ unPrintJobKey k)
-- , sortable (Just "pj-id") (i18nCell MsgPrintJobId) $ \( view $ resultPrintJob . _entityKey -> k) -> cell (showId k)
, sortable (Just "pj-name") (i18nCell MsgPrintJobName) $ \( view $ resultPrintJob . _entityVal . _printJobName -> n) -> textCell n , sortable (Just "pj-name") (i18nCell MsgPrintJobName) $ \( view $ resultPrintJob . _entityVal . _printJobName -> n) -> textCell n
, sortable (Just "pj-recipient") (i18nCell MsgPrintRecipient) $ \(preview resultRecipient -> u) -> maybeCell u $ cellHasUserLink AdminUserR , sortable (Just "pj-recipient") (i18nCell MsgPrintRecipient) $ \(preview resultRecipient -> u) -> maybeCell u $ cellHasUserLink AdminUserR
, sortable (Just "pj-sender") (i18nCell MsgPrintSender) $ \(preview resultSender -> u) -> maybeCell u $ cellHasUserLink AdminUserR , sortable (Just "pj-sender") (i18nCell MsgPrintSender) $ \(preview resultSender -> u) -> maybeCell u $ cellHasUserLink AdminUserR
@ -203,8 +201,7 @@ mkPJTable = do
] ]
dbtSorting = mconcat dbtSorting = mconcat
[ single ("pj-name" , SortColumn $ queryPrintJob >>> (E.^. PrintJobName)) [ single ("pj-name" , SortColumn $ queryPrintJob >>> (E.^. PrintJobName))
, single ("pj-filename" , SortColumn $ queryPrintJob >>> (E.^. PrintJobFilename)) , single ("pj-filename" , SortColumn $ queryPrintJob >>> (E.^. PrintJobFilename))
-- , single ("pj-id" , SortColumn $ queryPrintJob >>> (E.^. PrintJobId))
, single ("pj-created" , SortColumn $ queryPrintJob >>> (E.^. PrintJobCreated)) , single ("pj-created" , SortColumn $ queryPrintJob >>> (E.^. PrintJobCreated))
, single ("pj-acknowledged" , SortColumn $ queryPrintJob >>> (E.^. PrintJobAcknowledged)) , single ("pj-acknowledged" , SortColumn $ queryPrintJob >>> (E.^. PrintJobAcknowledged))
, single ("pj-recipient" , sortUserNameBareM queryRecipient) , single ("pj-recipient" , sortUserNameBareM queryRecipient)
@ -215,15 +212,17 @@ mkPJTable = do
dbtFilter = mconcat dbtFilter = mconcat
[ single ("pj-name" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobName)) [ single ("pj-name" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobName))
, single ("pj-filename" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobFilename)) , single ("pj-filename" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobFilename))
, single ("pj-created" , FilterColumn . E.mkDayFilter $ views (to queryPrintJob) (E.^. PrintJobCreated))
, single ("pj-recipient" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryRecipient) (E.?. UserDisplayName)) , single ("pj-recipient" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryRecipient) (E.?. UserDisplayName))
, single ("pj-sender" , FilterColumn . E.mkContainsFilterWith Just $ views (to querySender) (E.?. UserDisplayName)) , single ("pj-sender" , FilterColumn . E.mkContainsFilterWith Just $ views (to querySender) (E.?. UserDisplayName))
, single ("pj-course" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryCourse) (E.?. CourseName)) , single ("pj-course" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryCourse) (E.?. CourseName))
, single ("pj-qualification", FilterColumn . E.mkContainsFilterWith Just $ views (to queryQualification) (E.?. QualificationName)) , single ("pj-qualification", FilterColumn . E.mkContainsFilterWith Just $ views (to queryQualification) (E.?. QualificationName))
, single ("acknowledged" , FilterColumn . E.mkExactFilterLast $ views (to queryPrintJob) (E.isJust . (E.^. PrintJobAcknowledged))) , single ("acknowledged" , FilterColumn . E.mkExactFilterLast $ views (to queryPrintJob) (E.isJust . (E.^. PrintJobAcknowledged)))
] ]
dbtFilterUI mPrev = mconcat dbtFilterUI mPrev = mconcat
[ prismAForm (singletonFilter "pj-filename" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintJobFilename) [ prismAForm (singletonFilter "pj-name" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintJobName)
, prismAForm (singletonFilter "pj-name" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintJobName) , prismAForm (singletonFilter "pj-filename" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintJobFilename)
, prismAForm (singletonFilter "pj-created" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift dayField) (fslI MsgPrintJobCreated)
, prismAForm (singletonFilter "pj-recipient" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintRecipient) , prismAForm (singletonFilter "pj-recipient" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintRecipient)
, prismAForm (singletonFilter "pj-sender" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintSender) , prismAForm (singletonFilter "pj-sender" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintSender)
, prismAForm (singletonFilter "pj-course" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintCourse) , prismAForm (singletonFilter "pj-course" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintCourse)

4
src/Utils/Print.hs
View File

@ -280,10 +280,6 @@ sendLetter printJobName pdf (printJobRecipient, printJobSender) printJobCourse p
printJobFile = LBS.toStrict pdf printJobFile = LBS.toStrict pdf
lprPDF jobFullName pdf >>= \case lprPDF jobFullName pdf >>= \case
Left err -> do Left err -> do
-- for testing
printJobCreated <- liftIO getCurrentTime
insert_ PrintJob {..}
-- for testing
return $ Left err return $ Left err
Right ok -> do Right ok -> do
printJobCreated <- liftIO getCurrentTime printJobCreated <- liftIO getCurrentTime

9
test/Database/Fill.hs
View File

@ -528,6 +528,15 @@ fillDb = do
void . insert' $ LmsUser qid_f tinaTester (LmsIdent "qwvu") "45678" True now (Just $ LmsSuccess $ n_day (-2)) now Nothing Nothing void . insert' $ LmsUser qid_f tinaTester (LmsIdent "qwvu") "45678" True now (Just $ LmsSuccess $ n_day (-2)) now Nothing Nothing
void . insert' $ LmsUser qid_f maxMuster (LmsIdent "xyz") "a1b2c3" False now (Just $ LmsBlocked $ n_day (-1)) now (Just $ n_day' (-2)) (Just $ n_day' (-1)) void . insert' $ LmsUser qid_f maxMuster (LmsIdent "xyz") "a1b2c3" False now (Just $ LmsBlocked $ n_day (-1)) now (Just $ n_day' (-2)) (Just $ n_day' (-1))
void . insert $ PrintJob "TestJob1" "job1" "No Text herein." (n_day' (-1)) Nothing Nothing (Just svaupel) Nothing (Just qid_f)
void . insert $ PrintJob "TestJob2" "job2" "No Text herein." (n_day' (-1)) Nothing (Just jost) (Just svaupel) Nothing (Just qid_f)
void . insert $ PrintJob "TestJob3" "job3" "No Text herein." (n_day' (-2)) Nothing Nothing Nothing Nothing Nothing
void . insert $ PrintJob "TestJob4" "job4" "No Text herein." (n_day' (-2)) Nothing (Just jost) Nothing Nothing Nothing
void . insert $ PrintJob "TestJob5" "job5" "No Text herein." (n_day' (-4)) Nothing (Just jost) (Just svaupel) Nothing (Just qid_r)
void . insert $ PrintJob "TestJob6" "job6" "No Text herein." (n_day' (-4)) Nothing (Just svaupel) Nothing Nothing (Just qid_r)
void . insert $ PrintJob "TestJob7" "job7" "No Text herein." (n_day' (-4)) Nothing (Just svaupel) Nothing Nothing Nothing
let let
examLabels = Map.fromList examLabels = Map.fromList
[ ( sbarth [ ( sbarth