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

chore(avs): show avs person number on avs problems pages

Browse Source
This commit is contained in:
Steffen Jost 2022-12-20 13:27:53 +01:00
parent bac476e266
commit 0ffb85cb29
3 changed files with 27 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
src/Handler/Admin/Avs.hs
View File

@ -380,16 +380,16 @@ queryQualUser = $(E.sqlIJproj 2 1) . $(E.sqlLOJproj 2 2)
queryQualification :: LicenceTableExpr -> E.SqlExpr (Maybe (Entity Qualification))
queryQualification = $(E.sqlIJproj 2 2) . $(E.sqlLOJproj 2 2)
type LicenceTableData = DBRow (Entity User, Maybe (Entity QualificationUser), AvsPersonId, Maybe (Entity Qualification))
type LicenceTableData = DBRow (Entity UserAvs, Entity User, Maybe (Entity QualificationUser), Maybe (Entity Qualification))
resultUserAvs :: Lens' LicenceTableData (Entity UserAvs)
resultUserAvs = _dbrOutput . _1
resultUser :: Lens' LicenceTableData (Entity User)
resultUser = _dbrOutput . _1
resultUser = _dbrOutput . _2
resultQualUser :: Traversal' LicenceTableData (Entity QualificationUser)
resultQualUser = _dbrOutput . _2 . _Just
resultAvsPID :: Traversal' LicenceTableData AvsPersonId
resultAvsPID = _dbrOutput . _3
resultQualUser = _dbrOutput . _3 . _Just
resultQualification :: Traversal' LicenceTableData (Entity Qualification)
resultQualification = _dbrOutput . _4 . _Just
@ -415,15 +415,17 @@ mkLicenceTable dbtIdent aLic apids defAct = do
E.on $ user E.^. UserId E.=?. qualUser E.?. QualificationUserUser
E.on $ user E.^. UserId E.==. usrAvs E.^. UserAvsUser
E.where_ $ fltrLic qual E.&&. (usrAvs E.^. UserAvsPersonId `E.in_` E.vals apids)
return (user, qualUser, usrAvs E.^. UserAvsPersonId, qual)
return (usrAvs, user, qualUser, qual)
dbtRowKey = (queryUserAvs >>> (E.^. UserAvsPersonId))
&&& (queryQualification >>> (E.?. QualificationId))
--dbtProj = dbtProjSimple $ \(user, qualUsr, E.Value api, quali) -> return (user, qualUsr, api, quali)
dbtProj = dbtProjSimple $ pure . over _3 E.unValue -- just remove Value wrapper in 3rd element
--dbtProj = dbtProjSimple $ \(user, qualUsr, E.Value api, quali) -> return (user, qualUsr, api, quali) -- just remove Value wrapper in 3rd element
dbtProj = dbtProjFilteredPostId
dbtColonnade = mconcat
[ dbSelect (applying _2) id $ \DBRow{dbrOutput=(_,_,apid,_)} -> return apid -- return . view resultAvsPID -- does not type due to traversal
[ dbSelect (applying _2) id $ return . view (resultUserAvs . _userAvsPersonId)
-- $ \DBRow{dbrOutput=(_,_,apid,_)} -> return apid -- return . view resultAvsPID -- does not type due to traversal
, colUserNameLink AdminUserR
, sortable (Just "qualification") (i18nCell MsgTableQualifications) $ \(preview $ resultQualification . _entityVal -> q) -> cellMaybe qualificationShortCell q
, sortable (Just "avspersonno") (i18nCell MsgAvsPersonNo) $ \(view resultUserAvs -> a) -> avsPersonNoCell a
, sortable (Just "qualification") (i18nCell MsgTableQualifications) $ \(preview resultQualification -> q) -> cellMaybe qualificationShortCell q
, sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \(preview $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> cellMaybe dayCell d
, sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \(preview $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> cellMaybe dayCell d
, sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \(preview $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> cellMaybe dayCell d
@ -431,7 +433,8 @@ mkLicenceTable dbtIdent aLic apids defAct = do
) $ \(preview $ resultQualUser . _entityVal . _qualificationUserBlockedDue -> b) -> cellMaybe qualificationBlockedCell b
]
dbtSorting = mconcat
[ single $ sortUserNameLink queryUser
[ single $ sortUserNameLink queryUser
, single ("avspersonno" , SortColumn $ queryUserAvs >>> (E.^. UserAvsNoPerson))
, single ("qualification" , SortColumn $ queryQualification >>> (E.?. QualificationShorthand))
, single ("valid-until" , SortColumn $ queryQualUser >>> (E.?. QualificationUserValidUntil))
, single ("last-refresh" , SortColumn $ queryQualUser >>> (E.?. QualificationUserLastRefresh))

16
src/Handler/Utils/Table/Cells.hs
View File

@ -271,21 +271,20 @@ courseCell Course{..} = anchorCell link name `mappend` desc
^{modal "Beschreibung" (Right $ toWidget descr)}
|]
qualificationCell :: IsDBTable m a => Qualification -> DBCell m a
qualificationCell Qualification{..} = anchorCell link name
qualificationCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c
qualificationCell (view hasQualification -> Qualification{..}) = anchorCell link name
where
link = QualificationR qualificationSchool qualificationShorthand
name = citext2widget qualificationName
qualificationShortCell :: IsDBTable m a => Qualification -> DBCell m a
qualificationShortCell Qualification{..} = anchorCell link name
qualificationShortCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c
qualificationShortCell (view hasQualification -> Qualification{..}) = anchorCell link name
where
link = QualificationR qualificationSchool qualificationShorthand
name = citext2widget qualificationShorthand
qualificationDescrCell :: IsDBTable m a => Qualification -> DBCell m a
qualificationDescrCell q@Qualification{..} = qualificationCell q <> desc
qualificationDescrCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c
qualificationDescrCell (view hasQualification -> q@Qualification{..}) = qualificationCell q <> desc
where
desc = case qualificationDescription of
Nothing -> mempty
@ -335,3 +334,6 @@ lmsStatusCell ls = iconCell ic <> spacerCell <> dayCell (lmsStatusDay ls)
qualificationBlockedCell :: IsDBTable m a => Maybe QualificationBlocked -> DBCell m a
qualificationBlockedCell Nothing = mempty
qualificationBlockedCell (Just qb) = msgCell qb <> spacerCell <> iconCell IconBlocked <> spacerCell <> dayCell (qualificationBlockedDay qb)
avsPersonNoCell :: (IsDBTable m c, HasUserAvs a) => a -> DBCell m c
avsPersonNoCell = numCell . view _userAvsNoPerson

3
src/Utils/Lens.hs
View File

@ -151,6 +151,9 @@ instance HasStudyDegree a => HasStudyDegree (Entity a) where
instance HasQualification a => HasQualification (Entity a) where
hasQualification = _entityVal . hasQualification
instance HasUserAvs a => HasUserAvs (Entity a) where
hasUserAvs = _entityVal . hasUserAvs
-- BUILD SERVER FAILS TO MAKE HADDOCK FOR THE ONE BELOW:
-- makeClassyFor_ "HasEntity" "hasEntity" ''Entity
-- class HasEntity c record | c -> record where