From a3beca87d1c245ec93515907da32aea38a30238f Mon Sep 17 00:00:00 2001 From: Steffen Date: Wed, 12 Jun 2024 15:00:40 +0200 Subject: [PATCH] chore(firm): filter associates by valid qualficiations towards #157 --- messages/uniworx/categories/firm/de-de-formal.msg | 1 + messages/uniworx/categories/firm/en-eu.msg | 1 + .../uniworx/utils/table_column/de-de-formal.msg | 1 + messages/uniworx/utils/table_column/en-eu.msg | 1 + src/Handler/Firm.hs | 13 ++++++++++++- src/Handler/Utils/Form.hs | 6 ++++++ src/Handler/Utils/Table/Columns.hs | 15 +++++++++++++++ 7 files changed, 37 insertions(+), 1 deletion(-) diff --git a/messages/uniworx/categories/firm/de-de-formal.msg b/messages/uniworx/categories/firm/de-de-formal.msg index edd830d85..1caf455ef 100644 --- a/messages/uniworx/categories/firm/de-de-formal.msg +++ b/messages/uniworx/categories/firm/de-de-formal.msg @@ -49,6 +49,7 @@ FilterSupervisorForeign fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der s FilterForeignSupervisor: Hat firmenfremde Ansprechpartner FilterFirmExtern: Externe Firma FilterFirmPrimary: Ist primäre Firma in FRADrive +FilterHasQualification: Hat Firmenangehörige mit aktuell gültiger Qualifikation FirmSupervisorOf fsh@CompanyShorthand: Ansprechpartner #{fsh} angehörig FirmSupervisorIndependent: Ansprechpartner ohne jegliche Firmenzugehörigkeit FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh} diff --git a/messages/uniworx/categories/firm/en-eu.msg b/messages/uniworx/categories/firm/en-eu.msg index 600a90c10..0af0ef403 100644 --- a/messages/uniworx/categories/firm/en-eu.msg +++ b/messages/uniworx/categories/firm/en-eu.msg @@ -49,6 +49,7 @@ FilterSupervisorForeign fsh: Has active supervisor not belonging to #{fsh} FilterForeignSupervisor: Has company-external supervisors FilterFirmExtern: External company FilterFirmPrimary: Is primary company in FRADrive +FilterHasQualification: Has company associates with currently valid qualification FirmSupervisorOf fsh@CompanyShorthand: Supervisors belonging to #{fsh} FirmSupervisorIndependent: Independent supervisors FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users diff --git a/messages/uniworx/utils/table_column/de-de-formal.msg b/messages/uniworx/utils/table_column/de-de-formal.msg index 43031fd5b..03d31eace 100644 --- a/messages/uniworx/utils/table_column/de-de-formal.msg +++ b/messages/uniworx/utils/table_column/de-de-formal.msg @@ -73,6 +73,7 @@ TableDiffDaysTooltip: Zeitspanne nach ISO 8601. Beispiel: "P2Y3M4D" ist eine Zei TableExamOfficeLabel: Label-Name TableExamOfficeLabelStatus: Label-Farbe TableExamOfficeLabelPriority: Label-Priorität +TableQualification: Qualifikation TableQualifications: Qualifikationen TableCompany: Firma TableCompanyFilter: Firma oder Nummer diff --git a/messages/uniworx/utils/table_column/en-eu.msg b/messages/uniworx/utils/table_column/en-eu.msg index 8546022d9..0dacc0a75 100644 --- a/messages/uniworx/utils/table_column/en-eu.msg +++ b/messages/uniworx/utils/table_column/en-eu.msg @@ -73,6 +73,7 @@ TableDiffDaysTooltip: Duration given according to ISO 8601. Example: "P2Y3M4D" i TableExamOfficeLabel: Label name TableExamOfficeLabelStatus: Label colour TableExamOfficeLabelPriority: Label priority +TableQualification: Qualification TableQualifications: Qualifications TableCompany: Company TableCompanyFilter: Company/Nr diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index b85686994..23d5acc21 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -464,7 +464,7 @@ resultAllCompanyDefaultReroutes = _dbrOutput . _4 . _unValue mkFirmAllTable :: Bool -> UserId -> DB (FormResult (FirmActionData, Set CompanyId), Widget) mkFirmAllTable isAdmin uid = do - -- now <- liftIO getCurrentTime + now <- liftIO getCurrentTime mr <- getMessageRender let resultDBTable = DBTable{..} @@ -701,6 +701,16 @@ mkFirmAllTable isAdmin uid = do Just False -> E.notExists checkSuper ) , single ("company-postal", FilterColumn $ E.mkExactFilterLast $ views (to queryAllCompany) (E.isJust . (E.^. CompanyPostAddress))) + , single ("qualification" , FilterColumn . E.mkExistsFilter $ \row (CI.mk -> criterion :: CI Text) -> do + (usrCmp :& usrQual :& qual) <- E.from $ E.table @UserCompany + `E.innerJoin` E.table @QualificationUser + `E.on` (\(usrCmp :& usrQual) -> usrCmp E.^. UserCompanyUser E.==. usrQual E.^. QualificationUserUser) + `E.innerJoin` E.table @Qualification + `E.on` (\(_ :& usrQual :& qual) -> qual E.^. QualificationId E.==. usrQual E.^. QualificationUserQualification) + E.where_ $ usrCmp E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId + E.&&. qual E.^. QualificationShorthand E.==. E.val criterion + E.&&. validQualification now usrQual + ) ] dbtFilterUI mPrev = mconcat [ fltrCompanyNameUI mPrev @@ -711,6 +721,7 @@ mkFirmAllTable isAdmin uid = do , prismAForm (singletonFilter "is-default-supervisor") mPrev $ aopt textField (fslI MsgFirmSuperDefault) , prismAForm (singletonFilter "foreign-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterForeignSupervisor) , prismAForm (singletonFilter "company-postal" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterFirmExtern) + , fltrQualificationHdrUI MsgFilterHasQualification mPrev ] dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtParams = DBParamsForm diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index f992e76d8..9392ec58c 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -594,6 +594,12 @@ degreeField = selectField $ optionsPersistKey [] [Asc StudyDegreeName, Asc Study degreeFieldEnt :: Field Handler (Entity StudyDegree) degreeFieldEnt = selectField $ optionsPersist [] [Asc StudyDegreeName, Asc StudyDegreeShorthand, Asc StudyDegreeKey] id +qualificationField :: Field Handler QualificationId +qualificationField = selectField $ optionsPersistKey [] [Asc QualificationName] qualificationName + +qualificationFieldShort :: Field Handler QualificationShorthand +qualificationFieldShort = selectField $ (qualificationShorthand . entityVal) <<$>> optionsPersist [] [Asc QualificationName] qualificationName + qualificationFieldEnt :: Field Handler (Entity Qualification) qualificationFieldEnt = selectField $ optionsPersist [] [Asc QualificationName] qualificationName diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs index b8f3cfff6..e04364f1e 100644 --- a/src/Handler/Utils/Table/Columns.hs +++ b/src/Handler/Utils/Table/Columns.hs @@ -470,6 +470,8 @@ fltrUserMatriclenrUI mPrev = ---------------- -- User E-Mail +---------------- + colUserEmail :: (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c) colUserEmail = sortable (Just "user-email") (i18nCell MsgTableEmail) cellHasEMail @@ -719,6 +721,19 @@ fltrRelevantStudyFeaturesSemesterUI :: DBFilterUI fltrRelevantStudyFeaturesSemesterUI = fltrFeaturesSemesterUI +-------------------- +-- Qualifications +-------------------- + +fltrQualification :: OpticFilterColumn t QualificationShorthand +fltrQualification queryQual = singletonMap "qualification" . FilterColumn $ mkExactFilter (view queryQual) + +fltrQualificationUI :: DBFilterUI +fltrQualificationUI = fltrQualificationHdrUI MsgTableQualification + +fltrQualificationHdrUI :: (RenderMessage UniWorX msg) => msg -> DBFilterUI +fltrQualificationHdrUI msg mPrev = prismAForm (singletonFilter "qualification" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift qualificationFieldShort) (fslI msg) + --------------- -- Companies --