From 73aecc2df833bdeed93a113b6c756e36b50491b7 Mon Sep 17 00:00:00 2001 From: Steffen Date: Thu, 20 Jun 2024 18:22:35 +0200 Subject: [PATCH] fix(print): fix #167 by sotring affected user in PrintJob --- .../uniworx/categories/print/de-de-formal.msg | 1 + messages/uniworx/categories/print/en-eu.msg | 1 + models/print.model | 1 + src/Handler/PrintCenter.hs | 34 +++++++++++++------ src/Utils/Print.hs | 1 + src/Utils/Print/CourseCertificate.hs | 8 +++-- src/Utils/Print/ExpireQualification.hs | 1 + src/Utils/Print/Letters.hs | 1 + src/Utils/Print/RenewQualification.hs | 1 + test/Database/Fill.hs | 20 +++++------ 10 files changed, 46 insertions(+), 23 deletions(-) diff --git a/messages/uniworx/categories/print/de-de-formal.msg b/messages/uniworx/categories/print/de-de-formal.msg index 32fe30556..d2c275335 100644 --- a/messages/uniworx/categories/print/de-de-formal.msg +++ b/messages/uniworx/categories/print/de-de-formal.msg @@ -18,6 +18,7 @@ PrintJobAcknowledgeFailed: Keine Druckaufträge bestätigt aufgrund zwischenzeit PrintJobAcknowledgeQuestion n@Int d@Text: #{n} #{pluralDE n "Druckauftrag" "Druckaufräge"} vom #{d} als gedruckt und versendet bestätigen? PrintJobAcknowledgements: Versanddatum von Briefen an PrintRecipient: Empfänger +PrintAffected: Betroffener PrintSender !ident-ok: Sender PrintCourse: Kursarten PrintQualification: Qualifikation diff --git a/messages/uniworx/categories/print/en-eu.msg b/messages/uniworx/categories/print/en-eu.msg index 053fd1a7e..dbe776ebe 100644 --- a/messages/uniworx/categories/print/en-eu.msg +++ b/messages/uniworx/categories/print/en-eu.msg @@ -18,6 +18,7 @@ PrintJobAcknowledgeFailed: No print-jobs acknowledged, due to intermediate chang PrintJobAcknowledgeQuestion n d: Mark #{n} #{pluralENs n "print-job"} issued on #{d} as printed and mailed already? PrintJobAcknowledgements: Sent-dates for Letter to PrintRecipient: Recipient +PrintAffected: Affetcted PrintSender: Sender PrintCourse: Course type PrintQualification: Qualification diff --git a/models/print.model b/models/print.model index bdf7b5a56..94d4a3dc8 100644 --- a/models/print.model +++ b/models/print.model @@ -10,6 +10,7 @@ PrintJob created UTCTime acknowledged UTCTime Maybe recipient UserId Maybe OnDeleteSetNull OnUpdateCascade -- optional as some letters may contain just an address + affected UserId Maybe OnDeleteSetNull OnUpdateCascade -- subject of the letter sender UserId Maybe OnDeleteSetNull OnUpdateCascade -- senders and associations are optional course CourseId Maybe OnDeleteCascade OnUpdateCascade qualification QualificationId Maybe OnDeleteCascade OnUpdateCascade diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index caa7c2770..db5eebb30 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -136,6 +136,7 @@ data PJTableActionData = PJActAcknowledgeData | PJActReprintData { ignoreRerout deriving (Eq, Ord, Read, Show, Generic) type PJTableExpr = ( E.SqlExpr (Entity PrintJob) + `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity Course)) @@ -143,21 +144,24 @@ type PJTableExpr = ( E.SqlExpr (Entity PrintJob) ) queryPrintJob :: PJTableExpr -> E.SqlExpr (Entity PrintJob) -queryPrintJob = $(sqlLOJproj 5 1) +queryPrintJob = $(sqlLOJproj 6 1) queryRecipient :: PJTableExpr -> E.SqlExpr (Maybe (Entity User)) -queryRecipient = $(sqlLOJproj 5 2) +queryRecipient = $(sqlLOJproj 6 2) + +queryAffected :: PJTableExpr -> E.SqlExpr (Maybe (Entity User)) +queryAffected = $(sqlLOJproj 6 3) querySender :: PJTableExpr -> E.SqlExpr (Maybe (Entity User)) -querySender = $(sqlLOJproj 5 3) +querySender = $(sqlLOJproj 6 4) queryCourse :: PJTableExpr -> E.SqlExpr (Maybe (Entity Course)) -queryCourse = $(sqlLOJproj 5 4) +queryCourse = $(sqlLOJproj 6 5) queryQualification :: PJTableExpr -> E.SqlExpr (Maybe (Entity Qualification)) -queryQualification = $(sqlLOJproj 5 5) +queryQualification = $(sqlLOJproj 6 6) -type PJTableData = DBRow (Entity PrintJob, Maybe (Entity User), Maybe (Entity User), Maybe (Entity Course), Maybe (Entity Qualification)) +type PJTableData = DBRow (Entity PrintJob, Maybe (Entity User), Maybe (Entity User), Maybe (Entity User), Maybe (Entity Course), Maybe (Entity Qualification)) resultPrintJob :: Lens' PJTableData (Entity PrintJob) resultPrintJob = _dbrOutput . _1 @@ -165,30 +169,36 @@ resultPrintJob = _dbrOutput . _1 resultRecipient :: Traversal' PJTableData (Entity User) resultRecipient = _dbrOutput . _2 . _Just +resultAffected :: Traversal' PJTableData (Entity User) +resultAffected = _dbrOutput . _3 . _Just + resultSender :: Traversal' PJTableData (Entity User) -resultSender = _dbrOutput . _3 . _Just +resultSender = _dbrOutput . _4 . _Just resultCourse :: Traversal' PJTableData (Entity Course) -resultCourse = _dbrOutput . _4 . _Just +resultCourse = _dbrOutput . _5 . _Just resultQualification :: Traversal' PJTableData (Entity Qualification) -resultQualification = _dbrOutput . _5 . _Just +resultQualification = _dbrOutput . _6 . _Just pjTableQuery :: PJTableExpr -> E.SqlQuery ( E.SqlExpr (Entity PrintJob) , E.SqlExpr (Maybe (Entity User)) , E.SqlExpr (Maybe (Entity User)) + , E.SqlExpr (Maybe (Entity User)) , E.SqlExpr (Maybe (Entity Course)) , E.SqlExpr (Maybe (Entity Qualification))) pjTableQuery (printJob `E.LeftOuterJoin` recipient + `E.LeftOuterJoin` affected `E.LeftOuterJoin` sender `E.LeftOuterJoin` course `E.LeftOuterJoin` quali ) = do E.on $ printJob E.^. PrintJobRecipient E.==. recipient E.?. UserId + E.on $ printJob E.^. PrintJobAffected E.==. affected E.?. UserId E.on $ printJob E.^. PrintJobSender E.==. sender E.?. UserId E.on $ printJob E.^. PrintJobCourse E.==. course E.?. CourseId E.on $ printJob E.^. PrintJobQualification E.==. quali E.?. QualificationId - return (printJob, recipient, sender, course, quali) + return (printJob, recipient, affected, sender, course, quali) mkPJTable :: DB (FormResult (PJTableActionData, Set PrintJobId), Widget) mkPJTable = do @@ -206,6 +216,7 @@ mkPJTable = do , sortable (Just "apcid") (i18nCell MsgPrintJobApcAcknowledge)$ \( view $ resultPrintJob . _entityVal . _printJobApcIdent -> t) -> textCell t , sortable (Just "name") (i18nCell MsgPrintJobName) $ \( view $ resultPrintJob . _entityVal . _printJobName -> n) -> textCell n , sortable (Just "recipient") (i18nCell MsgPrintRecipient) $ \(preview resultRecipient -> u) -> maybeCell u $ cellHasUserLink AdminUserR + , sortable (Just "affected") (i18nCell MsgPrintAffected) $ \(preview resultAffected -> u) -> maybeCell u $ cellHasUserLink AdminUserR , sortable (Just "sender") (i18nCell MsgPrintSender) $ \(preview resultSender -> u) -> maybeCell u $ cellHasUserLink AdminUserR , sortable (Just "course") (i18nCell MsgPrintCourse) $ \(preview $ resultCourse . _entityVal -> c) -> maybeCell c courseCell , sortable (Just "qualification")(i18nCell MsgPrintQualification) $ \(preview $ resultQualification . _entityVal -> q) -> maybeCell q qualificationCell @@ -218,6 +229,7 @@ mkPJTable = do , single ("acknowledged" , SortColumn $ queryPrintJob >>> (E.^. PrintJobAcknowledged)) , single ("apcid" , SortColumn $ queryPrintJob >>> (E.^. PrintJobApcIdent)) , single ("recipient" , sortUserNameBareM queryRecipient) + , single ("affected" , sortUserNameBareM queryAffected) , single ("sender" , sortUserNameBareM querySender ) , single ("course" , SortColumn $ queryCourse >>> (E.?. CourseName)) , single ("qualification", SortColumn $ queryQualification >>> (E.?. QualificationName)) @@ -230,6 +242,7 @@ mkPJTable = do , single ("created" , FilterColumn . E.mkDayFilter $ views (to queryPrintJob) (E.^. PrintJobCreated)) --, single ("created" , FilterColumn . E.mkDayBetweenFilter $ views (to queryPrintJob) (E.^. PrintJobCreated)) , single ("recipient" , FilterColumn . E.mkContainsFilterWithCommaPlus Just $ views (to queryRecipient) (E.?. UserDisplayName)) + , single ("affected" , FilterColumn . E.mkContainsFilterWithCommaPlus Just $ views (to queryAffected) (E.?. UserDisplayName)) , single ("sender" , FilterColumn . E.mkContainsFilterWithCommaPlus Just $ views (to querySender) (E.?. UserDisplayName)) , single ("course" , FilterColumn . E.mkContainsFilterWith (Just . CI.mk) $ views (to queryCourse) (E.?. CourseName)) , single ("qualification", FilterColumn . E.mkContainsFilterWith (Just . CI.mk) $ views (to queryQualification) (E.?. QualificationName)) @@ -245,6 +258,7 @@ mkPJTable = do -- <*> aopt (hoistField lift dayField) (fslI MsgPrintJobCreated) -- ) , prismAForm (singletonFilter "recipient" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintRecipient & setTooltip MsgTableFilterCommaPlusShort) + , prismAForm (singletonFilter "affected" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintAffected & setTooltip MsgTableFilterCommaPlusShort) , prismAForm (singletonFilter "sender" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintSender & setTooltip MsgTableFilterCommaPlusShort) , prismAForm (singletonFilter "course" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintCourse) , prismAForm (singletonFilter "qualification". maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgPrintQualification) diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index 216eec422..931b2d312 100644 --- a/src/Utils/Print.hs +++ b/src/Utils/Print.hs @@ -252,6 +252,7 @@ printLetter' pji pdf = do , pjiApcAcknowledge = printJobApcIdent , pjiRecipient = printJobRecipient , pjiSender = printJobSender + , pjiAffected = printJobAffected , pjiCourse = printJobCourse , pjiQualification = printJobQualification , pjiLmsUser = printJobLmsUser diff --git a/src/Utils/Print/CourseCertificate.hs b/src/Utils/Print/CourseCertificate.hs index 5194a2b8f..039885b7e 100644 --- a/src/Utils/Print/CourseCertificate.hs +++ b/src/Utils/Print/CourseCertificate.hs @@ -29,6 +29,7 @@ data LetterCourseCertificate = LetterCourseCertificate , ccCourseBegin :: Maybe Day , ccCourseEnd :: Maybe Day , ccCourseLang :: Maybe Lang -- maybe fix language to fit course content language + , ccParticipantId :: UserId , ccParticipant :: UserDisplayName , ccFraNumber :: Maybe Text , ccFraDepartment :: Maybe Text @@ -67,6 +68,7 @@ instance MDLetter LetterCourseCertificate where , pjiApcAcknowledge = "cc-" <> ccCourseName , pjiRecipient = Nothing , pjiSender = Nothing + , pjiAffected = Just ccParticipantId , pjiCourse = Just ccCourseId , pjiQualification = Nothing , pjiLmsUser = Nothing @@ -87,14 +89,14 @@ makeCourseCertificates Tutorial{ tutorialName = CI.original -> ccTutorialName } <- get404 ccCourseId term <- get404 termId let (ccCourseBegin, ccCourseEnd) = eq2nothing $ occurrencesBounds term occurrences - forM participants $ \uid -> do - User{userDisplayName=ccParticipant, userCompanyDepartment, userCompanyPersonalNumber} <- get404 uid + forM participants $ \ccParticipantId -> do + User{userDisplayName=ccParticipant, userCompanyDepartment, userCompanyPersonalNumber} <- get404 ccParticipantId (ccFraNumber, ccFraDepartment, ccCompany) <- if isJust userCompanyDepartment && validFraportPersonalNumber userCompanyPersonalNumber then return (userCompanyPersonalNumber, userCompanyDepartment, Nothing) else do - usrComp <- selectFirst [UserCompanyUser ==. uid] [Desc UserCompanyId] + usrComp <- selectFirst [UserCompanyUser ==. ccParticipantId] [Desc UserCompanyId] comp <- forM usrComp (get . userCompanyCompany . entityVal) let res = (comp ^? _Just . _Just . _companyName . _CI) <|> userCompanyDepartment -- if there is no company, use the department as fallback, if possible return (Nothing, Nothing, res) diff --git a/src/Utils/Print/ExpireQualification.hs b/src/Utils/Print/ExpireQualification.hs index 3977d0005..38bc535cb 100644 --- a/src/Utils/Print/ExpireQualification.hs +++ b/src/Utils/Print/ExpireQualification.hs @@ -74,6 +74,7 @@ instance MDLetter LetterExpireQualification where , pjiApcAcknowledge = "ex-" <> toPathPiece leqHolderCFN , pjiRecipient = Nothing -- to be filled later , pjiSender = Nothing + , pjiAffected = Just leqHolderID , pjiCourse = Nothing , pjiQualification = Just leqId , pjiLmsUser = Nothing diff --git a/src/Utils/Print/Letters.hs b/src/Utils/Print/Letters.hs index 0974407b4..902282fc5 100644 --- a/src/Utils/Print/Letters.hs +++ b/src/Utils/Print/Letters.hs @@ -166,6 +166,7 @@ data PrintJobIdentification = PrintJobIdentification , pjiApcAcknowledge :: Text , pjiRecipient :: Maybe UserId , pjiSender :: Maybe UserId + , pjiAffected :: Maybe UserId , pjiCourse :: Maybe CourseId , pjiQualification :: Maybe QualificationId , pjiLmsUser :: Maybe LmsIdent diff --git a/src/Utils/Print/RenewQualification.hs b/src/Utils/Print/RenewQualification.hs index 3208d43ce..7f56abc4f 100644 --- a/src/Utils/Print/RenewQualification.hs +++ b/src/Utils/Print/RenewQualification.hs @@ -150,6 +150,7 @@ instance MDLetter LetterRenewQualification where , pjiApcAcknowledge = "lms-" <> getLmsIdent lmsLogin , pjiRecipient = Nothing -- to be filled later , pjiSender = Nothing + , pjiAffected = Just qualHolderID , pjiCourse = Nothing , pjiQualification = Just qualId , pjiLmsUser = Just lmsLogin diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 03145a685..37dd9a1c7 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -787,16 +787,16 @@ fillDb = do void . insert' $ LmsUser qid_f maxMuster (LmsIdent "xyz") "a1b2c3" False now (Just LmsBlocked) (Just $ n_day' (-11)) (n_day' (-4)) (Just $ n_day' (-2)) (Just $ n_day' (-2)) Nothing True True void . insert' $ LmsUser qid_f fhamann (LmsIdent "123") "456" False now Nothing Nothing now Nothing Nothing Nothing False False - void . insert $ PrintJob "TestJob1" "AckTestJob1" "job1" "No Text herein." (n_day' (-1)) Nothing Nothing (Just svaupel) Nothing (Just qid_f) Nothing - void . insert $ PrintJob "TestJob2" "AckTestJob2" "job2" "No Text herein." (n_day' (-3)) (Just $ n_day' (-1)) (Just jost) (Just svaupel) Nothing (Just qid_f) (Just $ LmsIdent "ijk") - void . insert $ PrintJob "TestJob3" "AckTestJob3" "job3" "No Text herein." (n_day' (-2)) Nothing Nothing Nothing Nothing Nothing Nothing - void . insert $ PrintJob "TestJob4" "AckTestJob4" "job4" "No Text herein." (n_day' (-2)) Nothing (Just jost) Nothing Nothing Nothing (Just $ LmsIdent "qwvu") - void . insert $ PrintJob "TestJob5" "AckTestJob5" "job5" "No Text herein." (n_day' (-9)) Nothing (Just jost) (Just svaupel) Nothing (Just qid_r) (Just $ LmsIdent "qwvu") - void . insert $ PrintJob "TestJob6" "AckTestJob6" "job6" "No Text herein." (n_day' (-7)) Nothing (Just svaupel) Nothing Nothing (Just qid_r) Nothing - void . insert $ PrintJob "TestJob7" "AckTestJob7" "job7" "No Text herein." (n_day' (-6)) (Just $ n_day' (-8)) (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg") - void . insert $ PrintJob "TestJob8" "AckTestJob8" "job8" "No Text herein." (n_day' (-2)) (Just $ n_day' (-6)) (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg") - void . insert $ PrintJob "TestJob9" "AckTestJob9" "job9" "No Text herein." (n_day' (-1)) Nothing (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg") - void . insert $ PrintJob "TestJob0" "AckTestJob0" "job0" "No Text herein." (n_day' (-3)) Nothing Nothing Nothing Nothing Nothing (Just $ LmsIdent "hijklmn") + void . insert $ PrintJob "TestJob1" "AckTestJob1" "job1" "No Text herein." (n_day' (-1)) Nothing Nothing Nothing (Just svaupel) Nothing (Just qid_f) Nothing + void . insert $ PrintJob "TestJob2" "AckTestJob2" "job2" "No Text herein." (n_day' (-3)) (Just $ n_day' (-1)) (Just jost) (Just svaupel) Nothing Nothing (Just qid_f) (Just $ LmsIdent "ijk") + void . insert $ PrintJob "TestJob3" "AckTestJob3" "job3" "No Text herein." (n_day' (-2)) Nothing Nothing Nothing Nothing Nothing Nothing Nothing + void . insert $ PrintJob "TestJob4" "AckTestJob4" "job4" "No Text herein." (n_day' (-2)) Nothing (Just jost) Nothing Nothing Nothing Nothing (Just $ LmsIdent "qwvu") + void . insert $ PrintJob "TestJob5" "AckTestJob5" "job5" "No Text herein." (n_day' (-9)) Nothing (Just jost) Nothing (Just svaupel) Nothing (Just qid_r) (Just $ LmsIdent "qwvu") + void . insert $ PrintJob "TestJob6" "AckTestJob6" "job6" "No Text herein." (n_day' (-7)) Nothing (Just svaupel) (Just gkleen) Nothing Nothing (Just qid_r) Nothing + void . insert $ PrintJob "TestJob7" "AckTestJob7" "job7" "No Text herein." (n_day' (-6)) (Just $ n_day' (-8)) (Just svaupel) (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg") + void . insert $ PrintJob "TestJob8" "AckTestJob8" "job8" "No Text herein." (n_day' (-2)) (Just $ n_day' (-6)) (Just svaupel) (Just jost) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg") + void . insert $ PrintJob "TestJob9" "AckTestJob9" "job9" "No Text herein." (n_day' (-1)) Nothing (Just svaupel) Nothing Nothing Nothing Nothing (Just $ LmsIdent "abcdefg") + void . insert $ PrintJob "TestJob0" "AckTestJob0" "job0" "No Text herein." (n_day' (-3)) Nothing Nothing (Just jost) Nothing Nothing Nothing (Just $ LmsIdent "hijklmn") insert_ $ ProblemLog now (toJSON $ AdminProblemNewCompany fraportAg) Nothing Nothing insert_ $ ProblemLog now (toJSON $ AdminProblemNewCompany ffacil ) Nothing Nothing