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

chore(firm): filter working on supervision discrepancy view

Browse Source
This commit is contained in:
Steffen Jost 2025-02-12 17:02:04 +01:00 committed by Sarah Vaupel
parent 8e0eb401b5
commit aefafa32d1
12 changed files with 164 additions and 124 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
messages/uniworx/categories/firm/de-de-formal.msg
View File

@ -82,5 +82,10 @@ CompanyUserUseCompanyAddress: Verwendet Firmenkontaktaddresse
CompanyUserUseCompanyAddressTip: sofern im Benutzer keine Postanschrift hinterlegt ist
CompanyUserUseCompanyPostalError: Postalische Adresse muss leer bleiben, damit die Firmenanschrift genutzt wird!
CompanySupervisorCompanyMissing fsh@CompanyShorthand: Empfänger ist nicht mit Firma #{fsh} aus Ansprechpartnerbeziehung assoziiert
CompanySuperviseeCompanyMissing fsh@CompanyShorthand: Betroffener ist nicht mit Firma #{fsh} aus Ansprechpartnerbeziehung assoziiert
CompanySuperviseeCompanyMissing fsh@CompanyShorthand: Klient ist nicht mit Firma #{fsh} aus Ansprechpartnerbeziehung assoziiert
SupervisionViolationChoice: Firmenassoziation fehlt für
SupervisionViolationEither: Egal
SupervisionViolationSupervisor: Ansprechpartner
SupervisionViolationClient: Klient
SupervisionViolationBoth: Beide
ASChangeCompany: Firma ändern, welche Ansprechpartnerbeziehung begründet

9
messages/uniworx/categories/firm/en-eu.msg
View File

@ -15,7 +15,7 @@ FirmActionInfo: Affects alle company associates under your supervision.
FirmActNotify: Send message
FirmActResetSupervision: Reset supervisors for all company associates
FirmActResetSuperKeep: Additionally keep existing supervisors of company associates?
FirmActRemoveSupers: Terminate all company related supervisonships?
FirmActRemoveSupers: Terminate all company related supervisionships?
FirmActResetMutualSupervision: Supervisors supervise each other
FirmActResetSupersKeepAll: Keep all
FirmActResetSupersRemoveAps: Remove default supervisors only
@ -82,5 +82,10 @@ CompanyUserUseCompanyAddress: Use company postal address
CompanyUserUseCompanyAddressTip: if and only if the postal address of the user is empty
CompanyUserUseCompanyPostalError: Individual postal address must left empty for the company address to be used!
CompanySupervisorCompanyMissing fsh: Receiver is not associated with #{fsh} given as reroute reason
CompanySuperviseeCompanyMissing fsh: Supervisee is not associated with #{fsh} detailed as supervisonship reason
CompanySuperviseeCompanyMissing fsh: Supervisee is not associated with #{fsh} detailed as supervisionship reason
SupervisionViolationChoice: Company association missing for
SupervisionViolationEither: anyone
SupervisionViolationSupervisor: Supervisor
SupervisionViolationClient: Supervisee
SupervisionViolationBoth: both
ASChangeCompany: Change company for supervisionship

4
messages/uniworx/categories/user/de-de-formal.msg
View File

@ -96,7 +96,7 @@ UserHijack: Sitzung übernehmen
UserAddSupervisor: Ansprechpartner hinzufügen
UserSetSupervisor: Ansprechpartner ersetzen
UserRemoveSupervisor: Alle Ansprechpartner entfernen
UserRemoveSubordinates: Alle Ansprechpartnerbeziehungen zu Untergebenen beenden
UserRemoveClients: Alle Ansprechpartnerbeziehungen zu Untergebenen beenden
UserIsSupervisor: Ist Ansprechpartner
UserAvsSwitchCompany: Als Primärfirma verwenden
UserAvsSwitchCompanyField: Primärfirma auswählen
@ -112,7 +112,7 @@ Name !ident-ok: Name
UsersChangeSupervisorsSuccess usr@Int spr@Int: #{tshow spr} Ansprechpartner für #{tshow usr} Benutzer gesetzt.
UsersChangeSupervisorsWarning usr@Int spr@Int bad@Int: Nur _{MsgUsersChangeSupervisorsSuccess usr spr} #{tshow bad} Ansprechpartner #{pluralDE bad "wurde" "wurden"} nicht gefunden!
UsersRemoveSupervisors usr@Int: Alle Ansprechpartner für #{tshow usr} Benutzer gelöscht.
UsersRemoveSubordinates usr@Int: Alle Ansprechpartnerbeziehungen für #{tshow usr} #{pluralDE usr "ehemaligen" "ehemalige"} Ansprechpartner gelöscht.
UsersRemoveClients usr@Int: Alle Ansprechpartnerbeziehungen für #{tshow usr} #{pluralDE usr "ehemaligen" "ehemalige"} Ansprechpartner gelöscht.
UserCompanyReason: Begründung der Firmenassoziation
UserCompanyReasonTooltip: Optionale Notiz für besondere Fälle. Kann ggf. autmatische Entfernung bei AVS Firmenwechsel verhindern.
UserSupervisorReason: Begründung Ansprechpartner

4
messages/uniworx/categories/user/en-eu.msg
View File

@ -96,7 +96,7 @@ UserHijack: Hijack session
UserAddSupervisor: Add supervisor
UserSetSupervisor: Replace supervisors
UserRemoveSupervisor: Set to unsupervised
UserRemoveSubordinates: Remove all subordinates
UserRemoveClients: Remove all clients
UserIsSupervisor: Is supervisor
UserAvsSwitchCompany: Use as primary company
UserAvsSwitchCompanyField: Select primary company
@ -112,7 +112,7 @@ Name: Name
UsersChangeSupervisorsSuccess usr spr: #{pluralENsN spr "supervisor"} for #{pluralENsN usr "user"} set.
UsersChangeSupervisorsWarning usr spr bad: Only _{MsgUsersChangeSupervisorsSuccess usr spr} #{pluralENsN bad "supervisors"} could not be identified!
UsersRemoveSupervisors usr: Removed all supervisors for #{pluralENsN usr "user"}.
UsersRemoveSubordinates usr: Removed all subordinates for #{pluralENsN usr "previous supervisor"}.
UsersRemoveClients usr: Removed all clients for #{pluralENsN usr "previous supervisor"}.
UserCompanyReason: Reason for company association
UserCompanyReasonTooltip: Optional note for special cases. In some case this may prevent automatic removel upon AVS user company changes.
UserSupervisorReason: Reason for supervision

4
messages/uniworx/utils/table_column/de-de-formal.msg
View File

@ -103,7 +103,7 @@ TableCompanyPostalPreference: Benachrichtigungspräferenz neue Firmenangehörige
TableCompanyPinPassword: Pin Passwort für PDF Anhänge
TableSupervisor: Ansprechpartner
TableSupervisorActive: Aktiver Ansprechpartner
TableSupervisee: Ansprechpartner für
TableSupervisee: Klient
TableReason: Begründung
TableCreationTime: Erstellungszeit
TableJob !ident-ok: Job
@ -118,7 +118,7 @@ TableFilterComma: Es können mehrere alternative Suchkriterien mit Komma getrenn
TableFilterCommaPlus: Mehrere alternative Suchkriterien mit Komma trennen. Mindestens ein Suchkriterium muss erfüllt werden, zusätzlich zu allen Suchkriterien mit vorangestelltem Plus-Symbol.
TableFilterCommaPlusShort: Unterstützt mehrere Kriterien mit Komma-Plus, siehe oben.
TableFilterCommaName: Mehrere Namen mit Komma trennen.
TableFilterCommaNameNr: Mehrere Namen oder Nummern mit Komma trennen. Nummern werden nur exakt gesucht.
TableFilterCommaNameNr: Mehrere Namen oder exakte Nummern mit Komma trennen.
TableUserEdit: Benutzer bearbeiten
TableRows: Zeilen
TableUserParkingToken day@Text: Parkmarke #{day}

2
messages/uniworx/utils/table_column/en-eu.msg
View File

@ -103,7 +103,7 @@ TableCompanyPostalPreference: Default notification preference
TableCompanyPinPassword: Pin password for PDF attachments
TableSupervisor: Supervisor
TableSupervisorActive: Active supervisor
TableSupervisee: Supervisor for
TableSupervisee: Supervisee
TableReason: Reason
TableCreationTime: Creation
TableJob !ident-ok: Job

125
src/Handler/Firm.hs
View File

@ -19,6 +19,7 @@ module Handler.Firm
import Import
-- import Jobs
import Utils.Company
import Handler.Utils
import Handler.Utils.Company
import Handler.Utils.Communication
@ -1532,7 +1533,7 @@ handleFirmCommR ultDest cs = do
-----------------------
-- Supervision Sanity
data ActSupervision = ASChangeCompany
data ActSupervision = ASChangeCompany -- | ASRemoveCompany |
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
deriving anyclass (Universe, Finite)
@ -1542,54 +1543,43 @@ embedRenderMessage ''UniWorX ''ActSupervision id
data ActSupervisionData = ASChangeCompanyData
deriving (Eq, Ord, Read, Show, Generic)
data SupervisionViolation = SupervisionViolationEither | SupervisionViolationClient | SupervisionViolationSupervisor | SupervisionViolationBoth
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
deriving anyclass (Universe, Finite)
nullaryPathPiece ''SupervisionViolation $ camelToPathPiece' 1
embedRenderMessage ''UniWorX ''SupervisionViolation id
supervisionViolationField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Field m SupervisionViolation
-- supervisionViolationField = radioGroupField (Just $ SomeMessage MsgSupervisionViolationEither) $ optionsFinite
supervisionViolationField = radioGroupField Nothing $ optionsFinite
type TblSupervisionData = DBRow (Entity UserSupervisor, Entity User, Entity User)
mkSupervisonTable :: DB (FormResult (ActSupervisionData, Set UserSupervisorId), Widget)
mkSupervisonTable = over _1 postprocess <$> dbTable validator DBTable{..}
mkSupervisionTable :: DB (FormResult (ActSupervisionData, Set UserSupervisorId), Widget)
mkSupervisionTable = over _1 postprocess <$> dbTable validator DBTable{..}
where
dbtIdent = "sanity-super" :: Text
dbtStyle = def
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout}
queryRelation :: (E.SqlExpr (Entity UserSupervisor) `E.InnerJoin` E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity User)) -> E.SqlExpr (Entity UserSupervisor)
queryRelation = $(E.sqlIJproj 3 1)
querySupervisor :: (E.SqlExpr (Entity UserSupervisor) `E.InnerJoin` E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity User)) -> E.SqlExpr (Entity User)
querySupervisor = $(E.sqlIJproj 3 2)
querySubordinate :: (E.SqlExpr (Entity UserSupervisor) `E.InnerJoin` E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity User)) -> E.SqlExpr (Entity User)
querySubordinate = $(E.sqlIJproj 3 3)
queryRelation :: (E.SqlExpr (Entity UserSupervisor) `E.InnerJoin` E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity User)) -> E.SqlExpr (Entity UserSupervisor)
queryRelation = $(E.sqlIJproj 3 1)
querySupervisor :: (E.SqlExpr (Entity UserSupervisor) `E.InnerJoin` E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity User)) -> E.SqlExpr (Entity User)
querySupervisor = $(E.sqlIJproj 3 2)
queryClient :: (E.SqlExpr (Entity UserSupervisor) `E.InnerJoin` E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity User)) -> E.SqlExpr (Entity User)
queryClient = $(E.sqlIJproj 3 3)
resultRelation :: Lens' TblSupervisionData (Entity UserSupervisor)
resultRelation = _dbrOutput . _1
resultSupervisor :: Lens' TblSupervisionData (Entity User)
resultSupervisor = _dbrOutput . _2
resultSubordinate :: Lens' TblSupervisionData (Entity User)
resultSubordinate = _dbrOutput . _3
resultRelation :: Lens' TblSupervisionData (Entity UserSupervisor)
resultRelation = _dbrOutput . _1
resultSupervisor :: Lens' TblSupervisionData (Entity User)
resultSupervisor = _dbrOutput . _2
resultClient :: Lens' TblSupervisionData (Entity User)
resultClient = _dbrOutput . _3
dbtSQLQuery (uus `E.InnerJoin` spr `E.InnerJoin` sub) = do
EL.on $ uus E.^. UserSupervisorSupervisor E.==. spr E.^. UserId
EL.on $ uus E.^. UserSupervisorUser E.==. sub E.^. UserId
let usrHasNotCmp qUsr = E.notExists $ do
uc <- E.from $ E.table @UserCompany
E.where_ $ uc E.^. UserCompanyCompany E.=?. uus E.^. UserSupervisorCompany
E.&&. uc E.^. UserCompanyUser E.==. uus E.^. qUsr
E.where_ $ E.isJust (uus E.^. UserSupervisorCompany)
E.&&. (usrHasNotCmp UserSupervisorSupervisor E.||. usrHasNotCmp UserSupervisorUser)
-- E.where_ $ E.isJust (uus E.^. UserSupervisorCompany) -- types, but yields incorrect result
-- E.&&. E.notExists (do
-- uc <- E.from (
-- (do
-- uc <- E.from $ E.table @UserCompany
-- E.where_ $ uc E.^. UserCompanyCompany E.=?. uus E.^. UserSupervisorCompany
-- E.&&. uc E.^. UserCompanyUser E.==. uus E.^. UserSupervisorUser
-- pure uc
-- ) `E.unionAll_` (do
-- uc <- E.from $ E.table @UserCompany
-- E.where_ $ uc E.^. UserCompanyCompany E.=?. uus E.^. UserSupervisorCompany
-- E.&&. uc E.^. UserCompanyUser E.==. uus E.^. UserSupervisorSupervisor
-- pure uc
-- ))
-- E.where_ $ uc E.^. UserCompanyCompany E.=?. uus E.^. UserSupervisorCompany
-- )
return (uus, spr, sub)
dbtRowKey = queryRelation >>> (E.^. UserSupervisorId)
dbtProj = dbtProjId
@ -1597,36 +1587,69 @@ mkSupervisonTable = over _1 postprocess <$> dbTable validator DBTable{..}
[ dbSelect (applying _2) id (return . view (resultRelation . _entityKey))
, sortable (Just "reroute") (i18nCell MsgTableRerouteActive) $ \(view $ resultRelation . _entityVal . _userSupervisorRerouteNotifications -> b) -> ifIconCell b IconReroute
, sortable (Just "reason") (i18nCell MsgUserSupervisorReason) $ \(view $ resultRelation . _entityVal . _userSupervisorReason -> r) -> maybeCell r textCell
, sortable (Just "cshort") (i18nCell MsgUserSupervisorCompany) $ \(view $ resultRelation . _entityVal . _userSupervisorCompany -> c) -> maybeCell c companyIdCell\
, sortable (Just "super") (i18nCell MsgTableSupervisor) $ \(view $ resultSupervisor -> u) -> cellHasUserModal ForProfileDataR u
, sortable (Just "super-com") (i18nCell MsgTableCompanies) $ \(view $ resultSupervisor . _entityKey -> uid) -> flip (set' cellContents) mempty $ liftHandler $ runDB $ -- why does sqlCell not work here? Mismatch "YesodDB UniWorX" and "RWST (Maybe (Env,FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX"
, sortable (Just "rel-comp") (i18nCell MsgUserSupervisorCompany) $ \(view $ resultRelation . _entityVal . _userSupervisorCompany -> c) -> maybeCell c companyIdCell\
, sortable (Just "supervisor") (i18nCell MsgTableSupervisor) $ \(view $ resultSupervisor -> u) -> cellHasUserModal ForProfileDataR u
, sortable (Just "super-comp") (i18nCell MsgTableCompanies) $ \(view $ resultSupervisor . _entityKey -> uid) -> flip (set' cellContents) mempty $ liftHandler $ runDB $ -- why does sqlCell not work here? Mismatch "YesodDB UniWorX" and "RWST (Maybe (Env,FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX"
maybeMonoid <$> wgtCompanies True uid
, sortable (Just "subordinate") (i18nCell MsgTableSupervisee) $ \(view $ resultSubordinate -> u) -> cellHasUserModal ForProfileDataR u
, sortable (Just "sub-company") (i18nCell MsgTableCompanies) $ \(view $ resultSubordinate . _entityKey -> uid) -> flip (set' cellContents) mempty $ liftHandler $ runDB $ -- why does sqlCell not work here? Mismatch "YesodDB UniWorX" and "RWST (Maybe (Env,FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX"
, sortable (Just "client") (i18nCell MsgTableSupervisee) $ \(view $ resultClient -> u) -> cellHasUserModal ForProfileDataR u
, sortable (Just "client-comp") (i18nCell MsgTableCompanies) $ \(view $ resultClient . _entityKey -> uid) -> flip (set' cellContents) mempty $ liftHandler $ runDB $ -- why does sqlCell not work here? Mismatch "YesodDB UniWorX" and "RWST (Maybe (Env,FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX"
maybeMonoid <$> wgtCompanies True uid
]
validator = def -- validator = def & defaultSorting [ SortAscBy "cshort" ]
validator = def & defaultSorting [SortAscBy "rel-comp", SortAscBy "supervisor", SortAscBy "client"]
& defaultFilter (singletonMap "violation" [toPathPiece SupervisionViolationEither])
dbtSorting = Map.fromList
[ ("reason" , SortColumn $ queryRelation >>> (E.^. UserSupervisorReason))
, ("cshort" , SortColumn $ queryRelation >>> (E.^. UserSupervisorCompany))
, ("rel-comp" , SortColumn $ queryRelation >>> (E.^. UserSupervisorCompany))
, ("reroute" , SortColumn $ queryRelation >>> (E.^. UserSupervisorRerouteNotifications))
, ("super" , SortColumn $ querySupervisor >>> (E.^. UserDisplayName))
, ("subordinate" , SortColumn $ querySubordinate >>> (E.^. UserDisplayName))
, ("supervisor" , SortColumn $ querySupervisor >>> (E.^. UserDisplayName))
, ("client" , SortColumn $ queryClient >>> (E.^. UserDisplayName))
, ("super-comp" , SortColumn (\row -> E.subSelect $ do
(cmp :& usrCmp) <- E.from $ E.table @Company `E.innerJoin` E.table @UserCompany `E.on` (\(cmp :& usrCmp) -> cmp E.^. CompanyId E.==. usrCmp E.^. UserCompanyCompany)
E.where_ $ usrCmp E.^. UserCompanyUser E.==. querySupervisor row E.^. UserId
E.orderBy [E.asc $ cmp E.^. CompanyName]
return (cmp E.^. CompanyName)
))
, ("user-company" , SortColumn (\row -> E.subSelect $ do
, ("client-comp" , SortColumn (\row -> E.subSelect $ do
(cmp :& usrCmp) <- E.from $ E.table @Company `E.innerJoin` E.table @UserCompany `E.on` (\(cmp :& usrCmp) -> cmp E.^. CompanyId E.==. usrCmp E.^. UserCompanyCompany)
E.where_ $ usrCmp E.^. UserCompanyUser E.==. querySubordinate row E.^. UserId
E.where_ $ usrCmp E.^. UserCompanyUser E.==. queryClient row E.^. UserId
E.orderBy [E.asc $ cmp E.^. CompanyName]
return (cmp E.^. CompanyName)
))
]
dbtFilter = mempty
dbtFilterUI = mempty
dbtFilter = Map.fromList
[ ("violation", FilterColumn $ \(queryRelation -> us) (getLast -> criterion) -> case criterion of
Just SupervisionViolationSupervisor -> missingCompanySupervisor us
Just SupervisionViolationClient -> missingCompanyClient us
Just SupervisionViolationBoth -> missingCompanySupervisor us E.&&. missingCompanyClient us
_ -> missingCompanySupervisor us E.||. missingCompanyClient us
)
, ("rel-company", FilterColumn $ E.mkExistsFilter $ \(queryRelation -> us) (commaSeparatedText -> criteria) -> do
let numCrits = setMapMaybe readMay criteria
cmp <- E.from $ E.table @Company
E.where_ $ cmp E.^. CompanyId E.=?. us E.^. UserSupervisorCompany
E.&&. E.or (
bcons (notNull numCrits)
(E.mkExactFilter (E.^. CompanyAvsId) cmp numCrits)
[E.mkContainsFilterWith CI.mk (E.^. CompanyName) cmp criteria
,E.mkContainsFilterWith CI.mk (E.^. CompanyShorthand) cmp criteria
]
)
)
, ("supervisor-company", fltrCompanyNameNrUsr (querySupervisor >>> (E.^. UserId)))
, ("client-company" , fltrCompanyNameNrUsr (queryClient >>> (E.^. UserId)))
, ("supervisor", FilterColumn . E.mkContainsFilter $ querySupervisor >>> (E.^. UserDisplayName))
, ("client" , FilterColumn . E.mkContainsFilter $ queryClient >>> (E.^. UserDisplayName))
]
dbtFilterUI mPrev = mconcat -- Maybe (Map FilterKey [Text]) -> AForm DB (Map FilterKey [Text])
[ prismAForm (singletonFilter "violation" . maybePrism _PathPiece) mPrev $ aopt supervisionViolationField (fslI MsgSupervisionViolationChoice)
, prismAForm (singletonFilter "rel-company") mPrev $ aopt textField (fslI MsgUserSupervisorCompany & setTooltip MsgTableFilterCommaNameNr)
, prismAForm (singletonFilter "supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor)
, fltrCompanyNameNrUsrHdrUI "supervisor-company" (someMessages [MsgTableSupervisor, MsgTableCompany]) mPrev
, prismAForm (singletonFilter "client") mPrev $ aopt textField (fslI MsgTableSupervisee)
, fltrCompanyNameNrUsrHdrUI "client-company" (someMessages [MsgTableSupervisee, MsgTableCompany]) mPrev
]
dbtParams = DBParamsForm
{ dbParamsFormMethod = POST
, dbParamsFormAction = Nothing
@ -1657,7 +1680,7 @@ mkSupervisonTable = over _1 postprocess <$> dbTable validator DBTable{..}
getFirmsSupervisionR, postFirmsSupervisionR :: Handler Html
getFirmsSupervisionR = postFirmsSupervisionR
postFirmsSupervisionR = do
(svRes, svTbl) <- runDB mkSupervisonTable
(svRes, svTbl) <- runDB mkSupervisionTable
formResult svRes $ \case
(ASChangeCompanyData, relations) -> do
addMessage Info $ text2Html [st|Firmenwechsel Ansprechpartnerbeziehung noch nicht implementiert. #{Set.size relations} empfangen.|]

10
src/Handler/Users.hs
View File

@ -61,7 +61,7 @@ instance HasEntity (DBRow (Entity User)) User where
instance HasUser (DBRow (Entity User)) where
hasUser = _dbrOutput . _entityVal
data UserAction = UserAvsSync | UserLdapSync | UserAddSupervisor | UserSetSupervisor | UserRemoveSupervisor | UserRemoveSubordinates
data UserAction = UserAvsSync | UserLdapSync | UserAddSupervisor | UserSetSupervisor | UserRemoveSupervisor | UserRemoveClients
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
deriving anyclass (Universe, Finite)
@ -74,7 +74,7 @@ data UserActionData = UserAvsSyncData
| UserAddSupervisorData { getActionSupervisors :: Set Text, getActionRerouteNotifications :: Bool, getActionSupervisorReason :: Maybe Text }
| UserSetSupervisorData { getActionSupervisors :: Set Text, getActionRerouteNotifications :: Bool, getActionSupervisorReason :: Maybe Text }
| UserRemoveSupervisorData
| UserRemoveSubordinatesData
| UserRemoveClientsData
deriving (Eq, Ord, Read, Show, Generic)
@ -207,7 +207,7 @@ postUsersR = do
<*> apopt boolField' (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just False)
<*> aopt (textField & cfStrip & addDatalist superReasons) (fslI MsgUserSupervisorReason & setTooltip MsgUserSupervisorReasonTooltip) Nothing
, singletonMap UserRemoveSupervisor $ pure UserRemoveSupervisorData
, singletonMap UserRemoveSubordinates $ pure UserRemoveSubordinatesData
, singletonMap UserRemoveClients $ pure UserRemoveClientsData
]
over _1 postprocess <$> dbTable psValidator DBTable
@ -400,9 +400,9 @@ postUsersR = do
runDB $ deleteWhere [UserSupervisorUser <-. Set.toList userSet]
addMessageI Success $ MsgUsersRemoveSupervisors $ Set.size userSet
redirectKeepGetParams UsersR
(UserRemoveSubordinatesData, userSet) -> do
(UserRemoveClientsData, userSet) -> do
runDB $ deleteWhere [UserSupervisorSupervisor <-. Set.toList userSet]
addMessageI Success $ MsgUsersRemoveSubordinates $ Set.size userSet
addMessageI Success $ MsgUsersRemoveClients $ Set.size userSet
redirectKeepGetParams UsersR
(act, usersSet)
| isActionSupervisor act -> do

2
src/Handler/Utils/Avs.hs
View File

@ -449,7 +449,7 @@ updateAvsUserByADC newAvsDataContact@(AvsDataContact apid newAvsPersonInfo newAv
-- when userCompanySupervisor $ reportAdminProblem $ AdminProblemSupervisorNewCompany usrId userCompanyCompany newCompanyId userCompanySupervisorReroute
-- delete ucidOld
-- void $ insertUnique newUserComp{userCompanyPriority} -- keep priority, if insert succeeds
-- -- adjust supervison
-- -- adjust supervision
-- let oldCompDefSuperFltr = mconcat [UserSupervisorCompany ~~. oldCompanyId, UserSupervisorReason ~=. superReasonComDef]
-- deleteWhere $ (UserSupervisorSupervisor ==. usrId) : oldCompDefSuperFltr
-- oldAPs <- deleteWhereCount $ (UserSupervisorUser ==. usrId) : oldCompDefSuperFltr

107
src/Handler/Utils/Table/Columns.hs
View File

@ -275,10 +275,10 @@ colFileModificationWhen condition row2time = sortable (Just "time") (i18nCell Ms
where conDTCell = ifCell condition dateTimeCell $ const mempty
sortFilePath :: (IsFileReference record, IsString s) => (t -> E.SqlExpr (Entity record)) -> (s, SortColumn t r')
sortFilePath :: (IsFileReference record) => (t -> E.SqlExpr (Entity record)) -> (SortingKey, SortColumn t r')
sortFilePath queryPath = ("path", SortColumn $ queryPath >>> (E.^. fileReferenceTitleField))
sortFileModification :: (IsFileReference record, IsString s) => (t -> E.SqlExpr (Entity record)) -> (s, SortColumn t r')
sortFileModification :: (IsFileReference record) => (t -> E.SqlExpr (Entity record)) -> (SortingKey, SortColumn t r')
sortFileModification queryModification = ("time", SortColumn $ queryModification >>> (E.^. fileReferenceModifiedField))
defaultSortingByFileTitle :: PSValidator m x -> PSValidator m x
@ -345,7 +345,7 @@ colUserNameModalHdrAdmin :: (IsDBTable m c, HasEntity a User, RenderMessage UniW
colUserNameModalHdrAdmin colHeader userLink = sortable (Just "user-name") (i18nCell colHeader) (cellHasUserModalAdmin userLink)
-- | Intended to work with @nameWidget@, showing highlighter Surname within Displayname
sortUserName :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t r')
sortUserName :: (t -> E.SqlExpr (Entity User)) -> (SortingKey, SortColumn t r')
sortUserName = ("user-name",) . sortUserNameBare
sortUserNameBare :: (t -> E.SqlExpr (Entity User)) -> SortColumn t r'
@ -360,13 +360,13 @@ sortUserNameBareM queryUser = SortColumns $ queryUser >>> \user ->
]
-- | Alias for sortUserName for consistency, since column comes in two variants
sortUserNameLink :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t r')
sortUserNameLink :: (t -> E.SqlExpr (Entity User)) -> (SortingKey, SortColumn t r')
sortUserNameLink = sortUserName
sortUserSurname :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t r')
sortUserSurname :: (t -> E.SqlExpr (Entity User)) -> (SortingKey, SortColumn t r')
sortUserSurname queryUser = ("user-surname", SortColumn $ queryUser >>> (E.^. UserSurname))
sortUserDisplayName :: IsString a => (t -> E.SqlExpr (Entity User)) -> (a, SortColumn t r')
sortUserDisplayName :: (t -> E.SqlExpr (Entity User)) -> (SortingKey, SortColumn t r')
sortUserDisplayName queryUser = ("user-display-name", SortColumn $ queryUser >>> (E.^. UserDisplayName))
defaultSortingByName :: PSValidator m x -> PSValidator m x
@ -375,37 +375,37 @@ defaultSortingByName =
defaultSorting [SortAscBy "user-name"] -- new way, working with single sorter
-- | Alias for sortUserName for consistency
fltrUserNameLink :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d) => (a -> E.SqlExpr (Entity User)) -> (d, FilterColumn t fs)
fltrUserNameLink :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool))) => (a -> E.SqlExpr (Entity User)) -> (FilterKey, FilterColumn t fs)
fltrUserNameLink = fltrUserName
fltrUserName :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
fltrUserName :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)))
=> (a -> E.SqlExpr (Entity User))
-> (d, FilterColumn t fs)
-> (FilterKey, FilterColumn t fs)
fltrUserName queryUser = ( "user-name", FilterColumn $ mkContainsFilter queryName )
where
queryName = queryUser >>> (E.^. UserDisplayName)
fltrUserNameExact :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
fltrUserNameExact :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)))
=> (a -> E.SqlExpr (Entity User))
-> (d, FilterColumn t fs)
-> (FilterKey, FilterColumn t fs)
fltrUserNameExact queryUser = ( "user-name", FilterColumn $ mkExactFilter queryName )
where
queryName = queryUser >>> (E.^. UserDisplayName)
fltrUserSurname :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
fltrUserSurname :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)))
=> (a -> E.SqlExpr (Entity User))
-> (d, FilterColumn t fs)
-> (FilterKey, FilterColumn t fs)
fltrUserSurname queryUser = ( "user-surname", FilterColumn $ mkContainsFilter $ queryUser >>> (E.^. UserSurname))
fltrUserDisplayName :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
fltrUserDisplayName :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)))
=> (a -> E.SqlExpr (Entity User))
-> (d, FilterColumn t fs)
-> (FilterKey, FilterColumn t fs)
fltrUserDisplayName queryUser = ( "user-display-name", FilterColumn $ mkContainsFilter $ queryUser >>> (E.^. UserDisplayName))
-- | Search all names, i.e. DisplayName, Surname, EMail
fltrUserNameEmail :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
fltrUserNameEmail :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)))
=> (a -> E.SqlExpr (Entity User))
-> (d, FilterColumn t fs)
-> (FilterKey, FilterColumn t fs)
fltrUserNameEmail queryUser = ( "user-name-email", FilterColumn $ anyFilter
[ mkContainsFilterWithCommaPlus id $ queryUser >>> (E.^. UserDisplayName)
, mkContainsFilterWithCommaPlus id $ queryUser >>> (E.^. UserSurname)
@ -457,14 +457,12 @@ fltrUserMatriculationUI mPrev = prismAForm (singletonFilter "user-matriculation"
colUserMatriclenr :: (IsDBTable m c, HasEntity a User) => Bool -> Colonnade Sortable a (DBCell m c)
colUserMatriclenr isAdmin = sortable (Just "user-matriclenumber") (i18nCell MsgTableMatrikelNr) $ cellHasMatrikelnummerLinked isAdmin
sortUserMatriclenr :: IsString d => (t -> E.SqlExpr (Entity User)) -> (d, SortColumn t r')
sortUserMatriclenr :: (t -> E.SqlExpr (Entity User)) -> (SortingKey, SortColumn t r')
sortUserMatriclenr queryUser = ("user-matriclenumber", SortColumn $ queryUser >>> (E.^. UserMatrikelnummer))
fltrUserMatriclenr :: ( IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool))
, IsString d
)
fltrUserMatriclenr :: ( IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)))
=> (a -> E.SqlExpr (Entity User))
-> (d, FilterColumn t fs)
-> (FilterKey, FilterColumn t fs)
fltrUserMatriclenr queryUser = ("user-matriclenumber", FilterColumn . mkContainsFilterWithComma Just $ queryUser >>> (E.^. UserMatrikelnummer))
fltrUserMatriclenrUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
@ -479,14 +477,12 @@ fltrUserMatriclenrUI mPrev =
colUserEmail :: (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)
colUserEmail = sortable (Just "user-email") (i18nCell MsgTableEmail) cellHasEMail
sortUserEmail :: IsString d => (t -> E.SqlExpr (Entity User)) -> (d, SortColumn t r')
sortUserEmail :: (t -> E.SqlExpr (Entity User)) -> (SortingKey, SortColumn t r')
sortUserEmail queryUser = ( "user-email", SortColumn $ queryUser >>> (E.^. UserDisplayEmail))
fltrUserEmail :: ( IsFilterColumn t (a -> Set (CI Text) -> E.SqlExpr (E.Value Bool))
, IsString d
)
fltrUserEmail :: ( IsFilterColumn t (a -> Set (CI Text) -> E.SqlExpr (E.Value Bool)))
=> (a -> E.SqlExpr (Entity User))
-> (d, FilterColumn t fs)
-> (FilterKey, FilterColumn t fs)
fltrUserEmail queryUser = ("user-email", FilterColumn . mkContainsFilter $ queryUser >>> (E.^. UserDisplayEmail))
fltrUserEmailUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
@ -498,7 +494,7 @@ fltrUserEmailUI mPrev =
colUserLetterEmailPin :: (IsDBTable m c, HasEntity a User) => Colonnade Sortable a (DBCell m c)
colUserLetterEmailPin = sortable (Just "user-mail-pref-pin") (i18nCell MsgPrefersPostal) cellMailPrefPin
sortUserLetterEmailPin :: IsString d => (t -> E.SqlExpr (Entity User)) -> (d, SortColumn t r')
sortUserLetterEmailPin :: (t -> E.SqlExpr (Entity User)) -> (SortingKey, SortColumn t r')
sortUserLetterEmailPin queryUser = ( "user-mail-pref-pin" , SortColumn (toSortVal . queryUser))
where
toSortVal :: E.SqlExpr (Entity User) -> E.SqlExpr (E.Value Int64)
@ -618,14 +614,12 @@ fltrStudyFeaturesSemesterUI mPrev = prismAForm (singletonFilter "features-semest
colFeaturesSemester :: (IsDBTable m c, HasStudyFeatures x) => Getting (Leftmost x) a x -> Colonnade Sortable a (DBCell m c)
colFeaturesSemester feature = sortable (Just "features-semester") (i18nCell MsgTableStudyFeatureAge) $ maybe mempty cellHasSemester . firstOf feature
sortFeaturesSemester :: IsString d => (t -> E.SqlExpr (Maybe (Entity StudyFeatures))) -> (d, SortColumn t r')
sortFeaturesSemester :: (t -> E.SqlExpr (Maybe (Entity StudyFeatures))) -> (SortingKey, SortColumn t r')
sortFeaturesSemester queryFeatures = ("features-semester", SortColumn $ queryFeatures >>> (E.?. StudyFeaturesSemester))
fltrFeaturesSemester :: ( IsFilterColumn t (a -> Set Int -> E.SqlExpr (E.Value Bool))
, IsString d
)
fltrFeaturesSemester :: ( IsFilterColumn t (a -> Set Int -> E.SqlExpr (E.Value Bool)))
=> (a -> E.SqlExpr (Maybe (Entity StudyFeatures)))
-> (d, FilterColumn t fs)
-> (FilterKey, FilterColumn t fs)
fltrFeaturesSemester queryFeatures = ("features-semester", FilterColumn . mkExactFilterWith Just $ queryFeatures >>> (E.?. StudyFeaturesSemester))
fltrFeaturesSemesterUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
@ -636,14 +630,12 @@ fltrFeaturesSemesterUI mPrev =
colField :: (IsDBTable m c, HasStudyTerms x) => Getting (Leftmost x) a x -> Colonnade Sortable a (DBCell m c)
colField terms = sortable (Just "terms") (i18nCell MsgTableStudyTerm) $ maybe mempty cellHasField . firstOf terms
sortField :: IsString d => (t -> E.SqlExpr (Maybe (Entity StudyTerms))) -> (d, SortColumn t r')
sortField :: (t -> E.SqlExpr (Maybe (Entity StudyTerms))) -> (SortingKey, SortColumn t r')
sortField queryTerms = ("terms", SortColumn $ queryTerms >>> (E.?. StudyTermsName))
fltrField :: ( IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool))
, IsString d
)
fltrField :: ( IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)))
=> (a -> E.SqlExpr (Maybe (Entity StudyTerms)))
-> (d, FilterColumn t fs)
-> (FilterKey, FilterColumn t fs)
fltrField queryFeatures = ( "terms"
, FilterColumn $ anyFilter
[ mkContainsFilterWith Just $ queryFeatures >>> E.joinV . (E.?. StudyTermsName)
@ -660,14 +652,12 @@ fltrFieldUI mPrev =
colDegreeShort :: (IsDBTable m c, HasStudyDegree x) => Getting (Leftmost x) a x -> Colonnade Sortable a (DBCell m c)
colDegreeShort terms = sortable (Just "degree-short") (i18nCell MsgTableDegreeShort) $ maybe mempty cellHasDegreeShort . firstOf terms
sortDegreeShort :: IsString d => (t -> E.SqlExpr (Maybe (Entity StudyDegree))) -> (d, SortColumn t r')
sortDegreeShort :: (t -> E.SqlExpr (Maybe (Entity StudyDegree))) -> (SortingKey, SortColumn t r')
sortDegreeShort queryTerms = ("degree-short", SortColumn $ queryTerms >>> (E.?. StudyDegreeShorthand))
fltrDegree :: ( IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool))
, IsString d
)
fltrDegree :: ( IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)))
=> (a -> E.SqlExpr (Maybe (Entity StudyDegree)))
-> (d, FilterColumn t fs)
-> (FilterKey, FilterColumn t fs)
fltrDegree queryFeatures = ( "degree"
, FilterColumn $ anyFilter
[ mkContainsFilterWith Just $ queryFeatures >>> E.joinV . (E.?. StudyDegreeName)
@ -785,7 +775,7 @@ colUserCompany = sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \
icnSuper = text2markup " " <> icon IconSupervisor
pure $ toWgt $ mconcat companies
sortUserCompany :: IsString d => (t -> E.SqlExpr (Entity User)) -> (d, SortColumn t r')
sortUserCompany :: (t -> E.SqlExpr (Entity User)) -> (SortingKey, SortColumn t r')
sortUserCompany queryUser = ( "user-company"
, SortColumn $ queryUser >>> (\user -> E.subSelect $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
@ -795,9 +785,9 @@ sortUserCompany queryUser = ( "user-company"
))
-- | Search companies by name or shorthand
fltrCompanyName :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
fltrCompanyName :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)))
=> (a -> E.SqlExpr (Entity Company))
-> (d, FilterColumn t fs)
-> (FilterKey, FilterColumn t fs)
fltrCompanyName query = ( "company-name", FilterColumn $ anyFilter
[ mkContainsFilterWithComma CI.mk $ query >>> (E.^. CompanyName)
, mkContainsFilterWithComma CI.mk $ query >>> (E.^. CompanyShorthand)
@ -814,9 +804,9 @@ fltrCompanyNameHdrUI msg mPrev =
fltrCompanyNameNr :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
fltrCompanyNameNr :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)))
=> (a -> E.SqlExpr (Entity Company))
-> (d, FilterColumn t fs)
-> (FilterKey, FilterColumn t fs)
fltrCompanyNameNr query = ("company-name-number", FilterColumn $ \needle (setFoldMap commaSeparatedText -> criterias) ->
let numCrits = setMapMaybe readMay criterias
fltrCName = mkContainsFilterWith CI.mk (query >>> (E.^. CompanyName)) needle criterias
@ -838,13 +828,30 @@ fltrCompanyNameNrHdrUI msg mPrev =
prismAForm (singletonFilter "company-name-number") mPrev $ aopt textField (fslI msg & setTooltip MsgTableFilterCommaNameNr)
fltrCompanyNameNrUsrHdrUI :: (RenderMessage UniWorX msg) => FilterKey -> msg -> Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
fltrCompanyNameNrUsrHdrUI fk msg mPrev =
prismAForm (singletonFilter fk) mPrev $ aopt textField (fslI msg & setTooltip MsgTableFilterCommaNameNr)
fltrCompanyNameNrUsr :: (IsFilterColumn t (a -> Set (CI Text) -> E.SqlExpr (E.Value Bool)))
=> (a -> E.SqlExpr (E.Value (Key User))) -> FilterColumn t fs
fltrCompanyNameNrUsr query = FilterColumn . E.mkExistsFilter $ \(query -> user) criterion ->
E.from $ \(usrComp `E.InnerJoin` comp) -> do
let testname = (E.val criterion :: E.SqlExpr (E.Value (CI Text))) `E.isInfixOf`
(E.explicitUnsafeCoerceSqlExprValue "citext" (comp E.^. CompanyName) :: E.SqlExpr (E.Value (CI Text)))
testnumber nr = E.val nr E.==. comp E.^. CompanyAvsId
testcrit = maybe testname testnumber $ readMay $ CI.original criterion
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
E.where_ $ usrComp E.^. UserCompanyUser E.==. user E.&&. testcrit
---------
-- AVS --
---------
fltrAVSCardNos :: (IsFilterColumnHandler t ([Text] -> Handler (a -> E.SqlExpr (E.Value Bool))), IsString k)
=> (a -> E.SqlExpr (Entity User)) -> (k, FilterColumn t fs)
fltrAVSCardNos :: (IsFilterColumnHandler t ([Text] -> Handler (a -> E.SqlExpr (E.Value Bool))))
=> (a -> E.SqlExpr (Entity User)) -> (FilterKey, FilterColumn t fs)
fltrAVSCardNos queryUser = ("avs-card", fch)
where
fch = FilterColumnHandler $ \case

10
src/Utils/Company.hs
View File

@ -31,16 +31,16 @@ usrDoesNotBelong uid fsh = E.isJust fsh E.&&. E.notExists (do
missingCompanySupervisor :: E.SqlExpr (Entity UserSupervisor) -> E.SqlExpr (E.Value Bool)
missingCompanySupervisor us = (us E.^. UserSupervisorSupervisor) `usrDoesNotBelong` (us E.^. UserSupervisorCompany)
-- | given a supervisionship, true if subordinate is NOT associated with the supervisionship-company
missingCompanySubordinate :: E.SqlExpr (Entity UserSupervisor) -> E.SqlExpr (E.Value Bool)
missingCompanySubordinate us = (us E.^. UserSupervisorUser) `usrDoesNotBelong` (us E.^. UserSupervisorCompany)
-- | given a supervisionship, true if client is NOT associated with the supervisionship-company
missingCompanyClient :: E.SqlExpr (Entity UserSupervisor) -> E.SqlExpr (E.Value Bool)
missingCompanyClient us = (us E.^. UserSupervisorUser) `usrDoesNotBelong` (us E.^. UserSupervisorCompany)
-- | once per day, check if there are supervisionships where supervisor or subordinate are not associated witht the supervisionship-company
-- | once per day, check if there are supervisionships where supervisor or client are not associated witht the supervisionship-company
areThereInsaneCompanySupervisions :: HandlerFor UniWorX Bool
areThereInsaneCompanySupervisions = $(memcachedByHere) (Just . Right $ 22 * diffHour) [st|isane-company-supervision|] $ do
res <- runDBRead $ E.selectExists $ do
us <- E.from $ E.table @UserSupervisor
E.where_ $ E.isJust (us E.^. UserSupervisorCompany)
E.&&. (missingCompanySupervisor us E.||. missingCompanySubordinate us)
E.&&. (missingCompanySupervisor us E.||. missingCompanyClient us)
$logInfoS "sanity" [st|Are there insane company supervisions: #{tshow res}|]
return res

4
test/Database/Fill.hs
View File

@ -688,16 +688,16 @@ fillDb = do
-- void . insert' $ UserSupervisor svaupel gkleen False
-- void . insert' $ UserSupervisor svaupel fhamann True
-- void . insert' $ UserSupervisor sbarth tinaTester True
let supvs = [ UserSupervisor jost gkleen True (Just fraportAg) (Just $ tshow SupervisorReasonAvsSuperior)
let supvs = [ UserSupervisor jost gkleen True (Just fraGround) (Just $ tshow SupervisorReasonAvsSuperior)
, UserSupervisor jost svaupel False (Just fraportAg) (Just $ tshow SupervisorReasonAvsSuperior)
, UserSupervisor jost sbarth False (Just fraportAg) (Just "Staff")
, UserSupervisor jost tinaTester True (Just fraportAg) (Just "Staff")
, UserSupervisor jost jost True (Just fraportAg) (Just "Staff")
, UserSupervisor jost jost True (Just fraportAg) (Just "Staff")
, UserSupervisor svaupel gkleen False (Just nice) (Just "Staff")
, UserSupervisor svaupel fhamann True (Just nice) (Just "Staff")
, UserSupervisor sbarth tinaTester True (Just fraportAg) (Just $ tshow SupervisorReasonAvsSuperior)
, UserSupervisor gkleen fhamann False (Just fraGround) (Just "Staff")
, UserSupervisor gkleen gkleen True (Just fraGround) (Just "Staff")
, UserSupervisor tinaTester tinaTester False Nothing (Just "Staff")
]
++ take 444 [ UserSupervisor fhamann uid True Nothing (Just $ tshow SupervisorReasonCompanyDefault) | Entity uid _ <- matUsers, uid /= jost]