parent
8397c468a0
commit
64ff002ffb
@ -51,6 +51,7 @@ FilterSupervisor: Hat aktiven Ansprechpartner
|
||||
FilterSupervisorCompany fsh@CompanyShorthand: Hat aktiven Ansprechpartner, #{fsh} der angehört
|
||||
FilterSupervisorForeign fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der selbst nicht #{fsh} angehört
|
||||
FilterForeignSupervisor: Hat firmenfremde Ansprechpartner
|
||||
FilterIsForeignSupervisee: Ist Ansprechpartner für Firmenfremde
|
||||
FilterFirmExtern: Externe Firma
|
||||
FilterFirmExternTooltip: Hat die Firma eine Postanschrift im AVS?
|
||||
FilterFirmPrimary: Ist primäre Firma in FRADrive
|
||||
|
||||
@ -51,6 +51,7 @@ FilterSupervisor: Has active supervisor
|
||||
FilterSupervisorCompany fsh: Has active company supervisor belonging to #{fsh}
|
||||
FilterSupervisorForeign fsh: Has active supervisor not belonging to #{fsh}
|
||||
FilterForeignSupervisor: Has company-external supervisors
|
||||
FilterIsForeignSupervisee: Supervisor for company external users
|
||||
FilterFirmExtern: External company
|
||||
FilterFirmExternTooltip: i.e. is a postal address registered within AVS?
|
||||
FilterFirmPrimary: Is primary company in FRADrive
|
||||
|
||||
@ -1204,21 +1204,22 @@ mkFirmSuperTable :: Bool -> CompanyId -> DB (FormResult (FirmSuperActionData, Se
|
||||
mkFirmSuperTable isAdmin cid = do
|
||||
msgSupervisorUnchanged <- messageI Info MsgFirmSuperActSwitchSuperInfo
|
||||
let
|
||||
reasonSuperior = Just $ tshow SupervisorReasonAvsSuperior
|
||||
reasonSuperior = tshow SupervisorReasonAvsSuperior
|
||||
-- fsh = unCompanyKey cid
|
||||
resultDBTable = DBTable{..}
|
||||
where
|
||||
dbtSQLQuery = \(usr `E.LeftOuterJoin` usrCmp) -> do
|
||||
EL.on $ usr E.^. UserId E.=?. usrCmp E.?. UserCompanyUser E.&&. usrCmp E.?. UserCompanyCompany E.?=. E.val cid
|
||||
E.where_ $ E.isTrue (usrCmp E.?. UserCompanySupervisor)
|
||||
E.||. E.exists (firmQuerySupervisedBy cid Nothing usr)
|
||||
E.where_ $ E.isTrue (usrCmp E.?. UserCompanySupervisor) E.||. E.exists (firmQuerySupervisedBy cid Nothing usr)
|
||||
-- let uc_reason = E.joinV (usrCmp E.?. UserCompanyReason)
|
||||
return ( usr
|
||||
, usr & firmCountForSupervisor cid Nothing
|
||||
, usr & firmCountForSupervisor cid (Just (E.^. UserSupervisorRerouteNotifications))
|
||||
, usrCmp E.?. UserCompanySupervisor
|
||||
, usrCmp E.?. UserCompanySupervisorReroute
|
||||
, (usrCmp E.?. UserCompanyReason E.?=. E.val reasonSuperior) E.||.
|
||||
E.exists (firmQuerySupervisedBy cid (Just (\usrSpr -> usrSpr E.^. UserSupervisorReason E.==. E.val reasonSuperior)) usr)
|
||||
-- , (E.isJust uc_reason E.&&. uc_reason E.==. E.justVal reasonSuperior) -- NOTE: this is problematic, as obvious approaches caused errors such as: Failed to parse Haskell type bool, received PersistNull, since the SQL comparison with NULL returns NULL
|
||||
, (E.coalesceDefault [E.joinV (usrCmp E.?. UserCompanyReason)] (E.val mempty) E.==. E.val reasonSuperior) -- works as well
|
||||
E.||. E.exists (firmQuerySupervisedBy cid (Just (\usrSpr -> usrSpr E.^. UserSupervisorReason E.==. E.justVal reasonSuperior)) usr)
|
||||
)
|
||||
dbtRowKey = querySuperUser >>> (E.^. UserId)
|
||||
dbtProj = dbtProjSimple $ \(usr, supervised, rerouted, supervisor, reroute, isSuperior) -> do
|
||||
@ -1239,18 +1240,11 @@ mkFirmSuperTable isAdmin cid = do
|
||||
, colUserEmail
|
||||
, sortable (Just "supervised") (i18nCell MsgTableCompanyNrEmpSupervised) $ \(view resultSuperCompanySupervised -> nr) -> wgtCell $ word2widget nr
|
||||
, sortable (Just "rerouted") (i18nCell MsgTableCompanyNrEmpRerouted ) $ \(view resultSuperCompanyReroutes -> nr) -> wgtCell $ word2widget nr
|
||||
-- , sortable (Just "def-super") (i18nCell MsgTableIsDefaultSupervisor) $ \(view resultSuperCompanyDefaultSuper -> mb) -> case mb of { Nothing -> iconCell IconSupervisorForeign; Just True -> iconCell IconSupervisor; Just False -> iconSpacerCell }
|
||||
, sortable (Just "def-super") (i18nCell MsgTableIsDefaultSupervisor) $ view resultSuperCompanyDefaultSuper >>> \case
|
||||
Nothing -> iconCell IconSupervisorForeign
|
||||
(Just True ) -> iconCell IconSupervisor
|
||||
(Just False) -> iconSpacerCell
|
||||
, sortable Nothing (i18nCell MsgTableSuperior) $ \row ->
|
||||
let mb = row ^. resultSuperCompanyDefaultSuper
|
||||
sp = row ^. resultSuperCompanySuperior
|
||||
in case (mb,sp) of
|
||||
(_ , False) -> iconSpacerCell
|
||||
(Nothing , True ) -> iconCell IconSuperior <> iconCell IconSupervisorForeign
|
||||
(Just _ , True ) -> iconCell IconSuperior
|
||||
, sortable Nothing (i18nCell MsgTableSuperior) $ view resultSuperCompanySuperior >>> flip ifIconCell IconSuperior
|
||||
, sortable (Just "def-reroute") (i18nCell MsgTableIsDefaultReroute) $ \(view resultSuperCompanyDefaultReroute -> mb) -> tickmarkCell (mb == Just True)
|
||||
, sortable Nothing (i18nCell MsgTableUserEdit) $ \(view resultSuperUser -> entUsr) -> cellEditUserModal entUsr
|
||||
]
|
||||
@ -1273,9 +1267,29 @@ mkFirmSuperTable isAdmin cid = do
|
||||
]
|
||||
dbtFilter = mconcat
|
||||
[ single $ fltrUserNameEmail querySuperUser
|
||||
, singletonMap "is-foreign-supervisor" $ FilterColumn $ \(querySuperUserCompany -> suc) (getLast -> criterion) ->
|
||||
case criterion of
|
||||
Nothing -> E.true
|
||||
Just True -> E.isNothing $ suc E.?. UserCompanyUser
|
||||
Just False -> E.isJust $ suc E.?. UserCompanyUser
|
||||
, singletonMap "super-relation-foreign" $ FilterColumn $ \row (getLast -> criterion) ->
|
||||
let checkSuper = do
|
||||
usrSpr <- E.from $ E.table @UserSupervisor
|
||||
E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. querySuperUser row E.^. UserId
|
||||
E.&&. E.exists (do
|
||||
usr <- E.from $ E.table @UserCompany
|
||||
E.where_ $ usr E.^. UserCompanyCompany E.!=. E.val cid
|
||||
E.&&. usr E.^. UserCompanyUser E.==. usrSpr E.^. UserSupervisorUser
|
||||
)
|
||||
in case criterion of
|
||||
Nothing -> E.true
|
||||
Just True -> E.exists checkSuper
|
||||
Just False -> E.notExists checkSuper
|
||||
]
|
||||
dbtFilterUI mPrev = mconcat
|
||||
[ fltrUserNameEmailHdrUI MsgTableSupervisor mPrev
|
||||
, prismAForm (singletonFilter "is-foreign-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmSuperForeign)
|
||||
, prismAForm (singletonFilter "super-relation-foreign" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterIsForeignSupervisee)
|
||||
]
|
||||
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
|
||||
acts :: Map FirmSuperAction (AForm Handler FirmSuperActionData)
|
||||
@ -1362,7 +1376,7 @@ postFirmSupersR fsh = do
|
||||
|
||||
formFirmAction <- runFirmActionFormPost cid (FirmSupersR fsh) isAdmin [FirmActAddSupervisors, FirmActResetSupervision, FirmActChangeContactFirm]
|
||||
|
||||
siteLayout (citext2widget fsh) $ do
|
||||
siteLayout (citext2widget companyName) $ do
|
||||
setTitle $ citext2Html $ fsh <> " Supers"
|
||||
let firmContactInfo = $(widgetFile "firm-contact-info")
|
||||
$(i18nWidgetFile "firm-supervisors")
|
||||
|
||||
@ -655,14 +655,14 @@ fillDb = do
|
||||
, let rcName = CI.mk $ "Random Corp " <> tshow n <> bool "" " GmbH" (even n)
|
||||
, let rcShort = CI.mk $ "RC" <> tshow n
|
||||
]
|
||||
void . insert' $ UserCompany jost fraportAg True True 0 False $ Just "Vorgesetzter"
|
||||
void . insert' $ UserCompany svaupel nice True False 2 False $ Just "Vorgesetzter"
|
||||
void . insert' $ UserCompany jost fraportAg True True 0 False $ Just $ tshow SupervisorReasonAvsSuperior
|
||||
void . insert' $ UserCompany svaupel nice True False 2 False $ Just $ tshow SupervisorReasonAvsSuperior
|
||||
void . insert' $ UserCompany svaupel ffacil False False 1 False $ Just "Irgendwas"
|
||||
void . insert' $ UserCompany svaupel bpol True False 2 False $ Just "Irgendwas"
|
||||
void . insert' $ UserCompany svaupel fraGround True False 1 False $ Just "Irgendwas"
|
||||
void . insert' $ UserCompany gkleen nice False False 1 True $ Just "Winterdienst"
|
||||
void . insert' $ UserCompany gkleen fraGround False True 2 False $ Just "Irgendwas"
|
||||
void . insert' $ UserCompany gkleen bpol False True 1 False $ Just "Irgendwas"
|
||||
void . insert' $ UserCompany gkleen bpol False True 1 False $ Just $ tshow SupervisorReasonAvsSuperior
|
||||
void . insert' $ UserCompany fhamann bpol False False 1 True $ Just "Irgendwas"
|
||||
void . insert' $ UserCompany fhamann ffacil True True 2 True $ Just "Irgendwas"
|
||||
void . insert' $ UserCompany fhamann nice False False 3 False $ Just "Winterdienst"
|
||||
@ -687,14 +687,14 @@ 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 "Staff")
|
||||
, UserSupervisor jost svaupel False (Just fraportAg) (Just "Staff")
|
||||
let supvs = [ UserSupervisor jost gkleen True (Just fraportAg) (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 svaupel gkleen False (Just nice) (Just "Staff")
|
||||
, UserSupervisor svaupel fhamann True (Just nice) (Just "Staff")
|
||||
, UserSupervisor sbarth tinaTester True (Just nice) (Just "Staff")
|
||||
, UserSupervisor sbarth tinaTester True (Just nice) (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")
|
||||
|
||||
Loading…
Reference in New Issue
Block a user