diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index 2990ca28f..f5afda286 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -14,6 +14,7 @@ module Database.Esqueleto.Utils , mkExactFilter, mkExactFilterWith , mkExactFilterLast, mkExactFilterLastWith , mkContainsFilter, mkContainsFilterWith + , mkDayFilter , mkExistsFilter , anyFilter, allFilter , orderByList @@ -222,7 +223,7 @@ mkExactFilterWith cast lenslike row criterias mkExactFilterLast :: (PersistField a) => (t -> E.SqlExpr (E.Value a)) -- ^ getter from query to searched element -> t -- ^ query row - -> Last a -- ^ needle collection + -> Last a -- ^ needle -> E.SqlExpr (E.Value Bool) mkExactFilterLast = mkExactFilterLastWith id @@ -231,7 +232,7 @@ mkExactFilterLastWith :: (PersistField b) => (a -> b) -- ^ type conversion -> (t -> E.SqlExpr (E.Value b)) -- ^ getter from query to searched element -> t -- ^ query row - -> Last a -- ^ needle collection + -> Last a -- ^ needle -> E.SqlExpr (E.Value Bool) mkExactFilterLastWith cast lenslike row criterias | Last (Just crit) <- criterias = lenslike row E.==. E.val (cast crit) @@ -258,6 +259,16 @@ mkContainsFilterWith cast lenslike row criterias | Set.null criterias = true | 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 => (t -> a -> E.SqlQuery ()) -> t diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index c8656153c..a05d70ab3 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -193,8 +193,6 @@ mkPJTable = do , sortable (Just "pj-filename") (i18nCell MsgPrintPDF) $ \r -> let k = r ^. resultPrintJob . _entityKey t = r ^. resultPrintJob . _entityVal . _printJobFilename 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-recipient") (i18nCell MsgPrintRecipient) $ \(preview resultRecipient -> 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 [ single ("pj-name" , SortColumn $ queryPrintJob >>> (E.^. PrintJobName)) - , single ("pj-filename" , SortColumn $ queryPrintJob >>> (E.^. PrintJobFilename)) - -- , single ("pj-id" , SortColumn $ queryPrintJob >>> (E.^. PrintJobId)) + , single ("pj-filename" , SortColumn $ queryPrintJob >>> (E.^. PrintJobFilename)) , single ("pj-created" , SortColumn $ queryPrintJob >>> (E.^. PrintJobCreated)) , single ("pj-acknowledged" , SortColumn $ queryPrintJob >>> (E.^. PrintJobAcknowledged)) , single ("pj-recipient" , sortUserNameBareM queryRecipient) @@ -215,15 +212,17 @@ mkPJTable = do dbtFilter = mconcat [ single ("pj-name" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobName)) , 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-sender" , FilterColumn . E.mkContainsFilterWith Just $ views (to querySender) (E.?. UserDisplayName)) , 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 ("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 - [ 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-sender" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintSender) , prismAForm (singletonFilter "pj-course" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintCourse) diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index b9811208e..04b088fb6 100644 --- a/src/Utils/Print.hs +++ b/src/Utils/Print.hs @@ -280,10 +280,6 @@ sendLetter printJobName pdf (printJobRecipient, printJobSender) printJobCourse p printJobFile = LBS.toStrict pdf lprPDF jobFullName pdf >>= \case Left err -> do - -- for testing - printJobCreated <- liftIO getCurrentTime - insert_ PrintJob {..} - -- for testing return $ Left err Right ok -> do printJobCreated <- liftIO getCurrentTime diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 8056ccd87..61f80af29 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -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 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 examLabels = Map.fromList [ ( sbarth