fraport/fradrive-old
Archived
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 :: LicenceTableExpr -> E.SqlExpr (Maybe (Entity Qualification))
queryQualification = $(E.sqlIJproj 2 2) . $(E.sqlLOJproj 2 2) 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 :: Lens' LicenceTableData (Entity User)
resultUser = _dbrOutput . _1 resultUser = _dbrOutput . _2
resultQualUser :: Traversal' LicenceTableData (Entity QualificationUser) resultQualUser :: Traversal' LicenceTableData (Entity QualificationUser)
resultQualUser = _dbrOutput . _2 . _Just resultQualUser = _dbrOutput . _3 . _Just
resultAvsPID :: Traversal' LicenceTableData AvsPersonId
resultAvsPID = _dbrOutput . _3
resultQualification :: Traversal' LicenceTableData (Entity Qualification) resultQualification :: Traversal' LicenceTableData (Entity Qualification)
resultQualification = _dbrOutput . _4 . _Just 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.=?. qualUser E.?. QualificationUserUser
E.on $ user E.^. UserId E.==. usrAvs E.^. UserAvsUser E.on $ user E.^. UserId E.==. usrAvs E.^. UserAvsUser
E.where_ $ fltrLic qual E.&&. (usrAvs E.^. UserAvsPersonId `E.in_` E.vals apids) 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)) dbtRowKey = (queryUserAvs >>> (E.^. UserAvsPersonId))
&&& (queryQualification >>> (E.?. QualificationId)) &&& (queryQualification >>> (E.?. QualificationId))
--dbtProj = dbtProjSimple $ \(user, qualUsr, E.Value api, quali) -> return (user, qualUsr, api, quali) --dbtProj = dbtProjSimple $ \(user, qualUsr, E.Value api, quali) -> return (user, qualUsr, api, quali) -- just remove Value wrapper in 3rd element
dbtProj = dbtProjSimple $ pure . over _3 E.unValue -- just remove Value wrapper in 3rd element dbtProj = dbtProjFilteredPostId
dbtColonnade = mconcat 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 , 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 "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 "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 , 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 ) $ \(preview $ resultQualUser . _entityVal . _qualificationUserBlockedDue -> b) -> cellMaybe qualificationBlockedCell b
] ]
dbtSorting = mconcat dbtSorting = mconcat
[ single $ sortUserNameLink queryUser [ single $ sortUserNameLink queryUser
, single ("avspersonno" , SortColumn $ queryUserAvs >>> (E.^. UserAvsNoPerson))
, single ("qualification" , SortColumn $ queryQualification >>> (E.?. QualificationShorthand)) , single ("qualification" , SortColumn $ queryQualification >>> (E.?. QualificationShorthand))
, single ("valid-until" , SortColumn $ queryQualUser >>> (E.?. QualificationUserValidUntil)) , single ("valid-until" , SortColumn $ queryQualUser >>> (E.?. QualificationUserValidUntil))
, single ("last-refresh" , SortColumn $ queryQualUser >>> (E.?. QualificationUserLastRefresh)) , 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)} ^{modal "Beschreibung" (Right $ toWidget descr)}
|] |]
qualificationCell :: IsDBTable m a => Qualification -> DBCell m a qualificationCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c
qualificationCell Qualification{..} = anchorCell link name qualificationCell (view hasQualification -> Qualification{..}) = anchorCell link name
where where
link = QualificationR qualificationSchool qualificationShorthand link = QualificationR qualificationSchool qualificationShorthand
name = citext2widget qualificationName name = citext2widget qualificationName
qualificationShortCell :: IsDBTable m a => Qualification -> DBCell m a qualificationShortCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c
qualificationShortCell Qualification{..} = anchorCell link name qualificationShortCell (view hasQualification -> Qualification{..}) = anchorCell link name
where where
link = QualificationR qualificationSchool qualificationShorthand link = QualificationR qualificationSchool qualificationShorthand
name = citext2widget qualificationShorthand name = citext2widget qualificationShorthand
qualificationDescrCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c
qualificationDescrCell :: IsDBTable m a => Qualification -> DBCell m a qualificationDescrCell (view hasQualification -> q@Qualification{..}) = qualificationCell q <> desc
qualificationDescrCell q@Qualification{..} = qualificationCell q <> desc
where where
desc = case qualificationDescription of desc = case qualificationDescription of
Nothing -> mempty Nothing -> mempty
@ -335,3 +334,6 @@ lmsStatusCell ls = iconCell ic <> spacerCell <> dayCell (lmsStatusDay ls)
qualificationBlockedCell :: IsDBTable m a => Maybe QualificationBlocked -> DBCell m a qualificationBlockedCell :: IsDBTable m a => Maybe QualificationBlocked -> DBCell m a
qualificationBlockedCell Nothing = mempty qualificationBlockedCell Nothing = mempty
qualificationBlockedCell (Just qb) = msgCell qb <> spacerCell <> iconCell IconBlocked <> spacerCell <> dayCell (qualificationBlockedDay qb) 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 instance HasQualification a => HasQualification (Entity a) where
hasQualification = _entityVal . hasQualification hasQualification = _entityVal . hasQualification
instance HasUserAvs a => HasUserAvs (Entity a) where
hasUserAvs = _entityVal . hasUserAvs
-- BUILD SERVER FAILS TO MAKE HADDOCK FOR THE ONE BELOW: -- BUILD SERVER FAILS TO MAKE HADDOCK FOR THE ONE BELOW:
-- makeClassyFor_ "HasEntity" "hasEntity" ''Entity -- makeClassyFor_ "HasEntity" "hasEntity" ''Entity
-- class HasEntity c record | c -> record where -- class HasEntity c record | c -> record where