diff --git a/messages/uniworx/categories/firm/de-de-formal.msg b/messages/uniworx/categories/firm/de-de-formal.msg index c7a92efb3..edd830d85 100644 --- a/messages/uniworx/categories/firm/de-de-formal.msg +++ b/messages/uniworx/categories/firm/de-de-formal.msg @@ -48,6 +48,7 @@ FilterSupervisorCompany fsh@CompanyShorthand: Hat aktiven Ansprechpartner, #{fsh FilterSupervisorForeign fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der selbst nicht #{fsh} angehört FilterForeignSupervisor: Hat firmenfremde Ansprechpartner FilterFirmExtern: Externe Firma +FilterFirmPrimary: Ist primäre Firma in FRADrive 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 043312a20..600a90c10 100644 --- a/messages/uniworx/categories/firm/en-eu.msg +++ b/messages/uniworx/categories/firm/en-eu.msg @@ -48,6 +48,7 @@ FilterSupervisorCompany fsh: Has active company supervisor belonging to #{fsh} FilterSupervisorForeign fsh: Has active supervisor not belonging to #{fsh} FilterForeignSupervisor: Has company-external supervisors FilterFirmExtern: External company +FilterFirmPrimary: Is primary company in FRADrive FirmSupervisorOf fsh@CompanyShorthand: Supervisors belonging to #{fsh} FirmSupervisorIndependent: Independent supervisors FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index 32655b867..b85686994 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -796,7 +796,7 @@ queryUserUser = $(sqlIJproj 2 1) queryUserUserCompany :: UserCompanyTableExpr -> E.SqlExpr (Entity UserCompany) queryUserUserCompany = $(sqlIJproj 2 2) -type UserCompanyTableData = DBRow (Entity User, Entity UserCompany, E.Value Word64, E.Value Word64) +type UserCompanyTableData = DBRow (Entity User, Entity UserCompany, E.Value Word64, E.Value Word64) -- , E.Value Bool) resultUserUser :: Lens' UserCompanyTableData (Entity User) resultUserUser = _dbrOutput . _1 @@ -810,6 +810,9 @@ resultUserCompanySupervisors = _dbrOutput . _3 . _unValue resultUserCompanyReroutes :: Lens' UserCompanyTableData Word64 resultUserCompanyReroutes = _dbrOutput . _4 . _unValue +-- resultUserCompanyPrimary :: Lens' UserCompanyTableData Bool +-- resultUserCompanyPrimary = _dbrOutput . _5 . _unValue + instance HasEntity UserCompanyTableData User where hasEntity = resultUserUser @@ -837,20 +840,24 @@ mkFirmUserTable isAdmin cid = do (usr :& usrCmp) <- E.from $ E.table @User `E.leftJoin` E.table @UserCompany `E.on` (\(usr :& usrCmp) -> usr E.^. UserId E.=?. usrCmp E.?. UserCompanyUser E.&&. usrCmp E.?. UserCompanyCompany E.==. E.justVal cid) E.where_ $ E.isTrue (usrCmp E.?. UserCompanySupervisor) - E.||. E.exists (firmQuerySupervisedBy cid Nothing usr) + E.||. E.exists (firmQuerySupervisedBy cid Nothing usr) return (usr E.^. UserId, usr E.^. UserDisplayName, usrCmp E.?. UserCompanySupervisor) let -- supervisorField :: Field Handler UserId -- supervisorField = selectField' (Just $ SomeMessage MsgMultiNoSelection) $ procOptions rawSupers supervisorsField = multiSelectField' (Just $ SomeMessage MsgMultiNoSelection) $ procOptions rawSupers - fsh = unCompanyKey cid resultDBTable = DBTable{..} where dbtSQLQuery = \(usr `E.InnerJoin` usrCmp) -> do EL.on $ usr E.^. UserId E.==. usrCmp E.^. UserCompanyUser E.where_ $ usrCmp E.^. UserCompanyCompany E.==. E.val cid + -- let isPrimary = E.notExists (do + -- other <- E.from $ E.table @UserCompany + -- E.where_ $ other E.^. UserCompanyUser E.==. usrCmp E.^. UserCompanyUser + -- E.&&. other E.^. UserCompanyPriority E.>. usrCmp E.^. UserCompanyPriority + -- ) return (usr, usrCmp, firmCountUserSupervisors usrCmp, firmCountUserSupervisorsReroute usrCmp) dbtRowKey = queryUserUser >>> (E.^. UserId) dbtProj = dbtProjId @@ -928,15 +935,25 @@ mkFirmUserTable isAdmin cid = do usrSpr <- E.from $ E.table @UserSupervisor E.where_ $ usrSpr E.^. UserSupervisorUser E.==. queryUserUser row E.^. UserId E.&&. usrSpr E.^. UserSupervisorSupervisor `E.in_` E.vals criteria + , singletonMap "is-primary-company" $ FilterColumn $ \row (getLast -> criterion) -> + let checkPrimary = do + other <- E.from $ E.table @UserCompany + E.where_ $ other E.^. UserCompanyUser E.==. queryUserUserCompany row E.^. UserCompanyUser + E.&&. other E.^. UserCompanyPriority E.>. queryUserUserCompany row E.^. UserCompanyPriority + in case criterion of + Nothing -> E.true + Just False -> E.exists checkPrimary + Just True -> E.notExists checkPrimary ] -- superField = selectField $ ???? dbtFilterUI mPrev = mconcat [ fltrUserNameEmailHdrUI MsgTableCompanyUser mPrev -- , prismAForm (singletonFilter "supervisor-is" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift supervisorField) (fslI MsgFilterSupervisor) , prismAForm (multiFilter "supervisors-are" . maybePrism monoPathPieces) mPrev $ aopt (hoistField lift supervisorsField) (fslI MsgFilterSupervisor & setTooltip MsgMultiSelectTip) - , prismAForm (singletonFilter "has-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterSupervisor) + , prismAForm (singletonFilter "has-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterSupervisor) , prismAForm (singletonFilter "has-company-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorCompany fsh) , prismAForm (singletonFilter "has-foreign-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorForeign fsh) + , prismAForm (singletonFilter "is-primary-company" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterFirmPrimary) ] dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } acts :: Map FirmUserAction (AForm Handler FirmUserActionData)