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

fix(print): fix #167 by sotring affected user in PrintJob

Browse Source
This commit is contained in:
Steffen Jost 2024-06-20 18:22:35 +02:00
parent c38e87e1e0
commit 73aecc2df8
10 changed files with 46 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
messages/uniworx/categories/print/de-de-formal.msg
View File

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

1
messages/uniworx/categories/print/en-eu.msg
View File

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

1
models/print.model
View File

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

34
src/Handler/PrintCenter.hs
View File

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

1
src/Utils/Print.hs
View File

@ -252,6 +252,7 @@ printLetter' pji pdf = do
, pjiApcAcknowledge = printJobApcIdent
, pjiRecipient = printJobRecipient
, pjiSender = printJobSender
, pjiAffected = printJobAffected
, pjiCourse = printJobCourse
, pjiQualification = printJobQualification
, pjiLmsUser = printJobLmsUser

8
src/Utils/Print/CourseCertificate.hs
View File

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

1
src/Utils/Print/ExpireQualification.hs
View File

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

1
src/Utils/Print/Letters.hs
View File

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

1
src/Utils/Print/RenewQualification.hs
View File

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

20
test/Database/Fill.hs
View File

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