refactor(firm); supervisor table sorting and company column
This commit is contained in:
parent
2c12477c57
commit
069561763c
@ -597,7 +597,7 @@ type SuperCompanyTableExpr = E.SqlExpr (Entity User)
|
||||
querySuperUser :: SuperCompanyTableExpr -> E.SqlExpr (Entity User)
|
||||
querySuperUser = id
|
||||
|
||||
type SuperCompanyTableData = DBRow (Entity User, E.Value Word64, E.Value Word64)
|
||||
type SuperCompanyTableData = DBRow (Entity User, E.Value Word64, E.Value Word64, [(E.Value CompanyName, E.Value CompanyShorthand, E.Value Bool)])
|
||||
|
||||
resultSuperUser :: Lens' SuperCompanyTableData (Entity User)
|
||||
resultSuperUser = _dbrOutput . _1
|
||||
@ -608,12 +608,27 @@ resultSuperCompanySupervised = _dbrOutput . _2 . _unValue
|
||||
resultSuperCompanyReroutes :: Lens' SuperCompanyTableData Word64
|
||||
resultSuperCompanyReroutes = _dbrOutput . _3 . _unValue
|
||||
|
||||
resultSuperCompanies :: Lens' SuperCompanyTableData [(E.Value CompanyName, E.Value CompanyShorthand, E.Value Bool)]
|
||||
resultSuperCompanies = _dbrOutput . _4
|
||||
|
||||
|
||||
instance HasEntity SuperCompanyTableData User where
|
||||
hasEntity = resultSuperUser
|
||||
|
||||
instance HasUser SuperCompanyTableData where
|
||||
hasUser = resultSuperUser . _entityVal
|
||||
|
||||
firmQuerySupervisedBy :: CompanyId -> Maybe (E.SqlExpr (Entity UserSupervisor) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (Entity User) -> E.SqlQuery ()
|
||||
firmQuerySupervisedBy cid mbFltr usr = do
|
||||
(usrSpr :& usrCmp) <- E.from $ E.table @UserSupervisor
|
||||
`E.innerJoin` E.table @UserCompany
|
||||
`E.on` (\(usrSpr :& usrCmp) -> usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser)
|
||||
let basecond = usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
|
||||
E.&&. usrCmp E.^. UserCompanyCompany E.==. E.val cid
|
||||
E.where_ $ maybe basecond ((basecond E.&&.).($ usrSpr)) mbFltr
|
||||
|
||||
firmCountForSupervisor :: CompanyId -> Maybe (E.SqlExpr (Entity UserSupervisor) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (Entity User) -> E.SqlExpr (E.Value Word64)
|
||||
firmCountForSupervisor = ((E.subSelectCount .) .) . firmQuerySupervisedBy
|
||||
|
||||
mkFirmSuperTable :: Bool -> CompanyId -> DB (FormResult (FirmSuperActionData, Set UserId), Widget)
|
||||
mkFirmSuperTable isAdmin cid = do
|
||||
@ -621,34 +636,31 @@ mkFirmSuperTable isAdmin cid = do
|
||||
-- fsh = unCompanyKey cid
|
||||
resultDBTable = DBTable{..}
|
||||
where
|
||||
dbtSQLQuery = \usr -> do
|
||||
-- refactor this
|
||||
let subs = do
|
||||
(usrSpr :& usrCmp) <- E.from $ E.table @UserSupervisor
|
||||
`E.innerJoin` E.table @UserCompany
|
||||
`E.on` (\(usrSpr :& usrCmp) -> usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser)
|
||||
E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
|
||||
E.&&. usrCmp E.^. UserCompanyCompany E.==. E.val cid
|
||||
subs' = do
|
||||
(usrSpr :& usrCmp) <- E.from $ E.table @UserSupervisor
|
||||
`E.innerJoin` E.table @UserCompany
|
||||
`E.on` (\(usrSpr :& usrCmp) -> usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser)
|
||||
E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
|
||||
E.&&. usrCmp E.^. UserCompanyCompany E.==. E.val cid
|
||||
E.&&. usrSpr E.^. UserSupervisorRerouteNotifications
|
||||
E.where_ $ E.exists subs
|
||||
return (usr, E.subSelectCount subs, E.subSelectCount subs')
|
||||
dbtSQLQuery = \usr -> do
|
||||
E.where_ $ E.exists $ firmQuerySupervisedBy cid Nothing usr
|
||||
return ( usr
|
||||
, usr & firmCountForSupervisor cid Nothing
|
||||
, usr & firmCountForSupervisor cid (Just (E.^. UserSupervisorRerouteNotifications))
|
||||
)
|
||||
dbtRowKey = querySuperUser >>> (E.^. UserId)
|
||||
dbtProj = dbtProjId
|
||||
dbtProj = dbtProjSimple $ \(usr, supervised, rerouted) -> do
|
||||
cmps <- E.select $ 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.==. E.val (entityKey usr)
|
||||
E.orderBy [E.asc $ cmp E.^. CompanyName]
|
||||
return (cmp E.^. CompanyName, cmp E.^. CompanyShorthand, usrCmp E.^. UserCompanySupervisor)
|
||||
return (usr, supervised, rerouted, cmps)
|
||||
dbtColonnade = formColonnade $ mconcat
|
||||
[ guardMonoid isAdmin $ dbSelect (applying _2) id (return . view (resultSuperUser . _entityKey))
|
||||
, colUserNameModalHdr MsgTableSupervisor ForProfileDataR
|
||||
, sortable (Just "matriculation") (i18nCell MsgTableMatrikelNr) $ \(view resultSuperUser -> entUsr) -> cellHasMatrikelnummerLinked entUsr
|
||||
, sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \( view resultSuperCompanies -> cmps) ->
|
||||
intercalate semicolonCell [companyCell cmpShort cmpName isSuper | (E.Value cmpName, E.Value cmpShort, E.Value isSuper) <- cmps]
|
||||
, sortable (Just "personal-number") (i18nCell MsgCompanyPersonalNumber) $ \(view $ resultSuperUser . _userCompanyPersonalNumber -> t) -> foldMap textCell t
|
||||
, sortable (Just "postal-pref") (i18nCell MsgPrefersPostal) $ \(view $ resultSuperUser . _userPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b
|
||||
, colUserEmail
|
||||
, sortable Nothing (i18nCell MsgTableCompanyNrEmpSupervised) $ \(view resultSuperCompanySupervised -> nr) -> wgtCell $ word2widget nr
|
||||
, sortable Nothing (i18nCell MsgTableCompanyNrEmpRerouted ) $ \(view resultSuperCompanyReroutes -> nr) -> wgtCell $ word2widget nr
|
||||
, sortable (Just "supervised") (i18nCell MsgTableCompanyNrEmpSupervised) $ \(view resultSuperCompanySupervised -> nr) -> wgtCell $ word2widget nr
|
||||
, sortable (Just "rerouted") (i18nCell MsgTableCompanyNrEmpRerouted ) $ \(view resultSuperCompanyReroutes -> nr) -> wgtCell $ word2widget nr
|
||||
]
|
||||
dbtSorting = mconcat
|
||||
[ single $ sortUserNameLink querySuperUser
|
||||
@ -656,6 +668,14 @@ mkFirmSuperTable isAdmin cid = do
|
||||
, singletonMap "matriculation" $ SortColumn $ querySuperUser >>> (E.^. UserMatrikelnummer)
|
||||
, singletonMap "personal-number" $ SortColumn $ querySuperUser >>> (E.^. UserCompanyPersonalNumber)
|
||||
, singletonMap "postal-pref" $ SortColumn $ querySuperUser >>> (E.^. UserPrefersPostal)
|
||||
, singletonMap "supervised" $ SortColumn $ querySuperUser >>> firmCountForSupervisor cid Nothing
|
||||
, singletonMap "rerouted" $ SortColumn $ querySuperUser >>> firmCountForSupervisor cid (Just (E.^. UserSupervisorRerouteNotifications))
|
||||
, singletonMap "user-company" $ 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.==. querySuperUser row E.^. UserId
|
||||
E.orderBy [E.asc $ cmp E.^. CompanyName]
|
||||
return (cmp E.^. CompanyName)
|
||||
)
|
||||
]
|
||||
dbtFilter = mconcat
|
||||
[ single $ fltrUserNameEmail querySuperUser
|
||||
|
||||
@ -29,6 +29,9 @@ type CourseLink = (TermId, SchoolId, CourseShorthand) -- TODO: Refactor with Wit
|
||||
spacerCell :: IsDBTable m a => DBCell m a
|
||||
spacerCell = cell [whamlet| |]
|
||||
|
||||
semicolonCell :: IsDBTable m a => DBCell m a
|
||||
semicolonCell = cell [whamlet|; |]
|
||||
|
||||
tellCell :: IsDBTable m a => a -> DBCell m a -> DBCell m a
|
||||
tellCell = flip mappend . writerCell . tell
|
||||
|
||||
|
||||
@ -23,8 +23,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
<tr .table__row .table__row--head>
|
||||
<th .table__th>_{MsgTableCompanyNrSupersDefault}
|
||||
<th .table__th>_{MsgTableCompanyNrRerouteDefault}
|
||||
<th .table__th>_{MsgPrefersPostal}
|
||||
<th .table__th>
|
||||
<th .table__th colspan=2>_{MsgPrefersPostal}
|
||||
<tr .table__row>
|
||||
<td .table__td>#{nrCompanySupervisors}
|
||||
<td .table__td>#{nrCompanyDefaultReroutes}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user