From 0ffb85cb290366913f7376f71281e3b61df0eec7 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 20 Dec 2022 13:27:53 +0100 Subject: [PATCH] chore(avs): show avs person number on avs problems pages --- src/Handler/Admin/Avs.hs | 27 +++++++++++++++------------ src/Handler/Utils/Table/Cells.hs | 16 +++++++++------- src/Utils/Lens.hs | 3 +++ 3 files changed, 27 insertions(+), 19 deletions(-) diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs index b4bc8fc29..dd3d727df 100644 --- a/src/Handler/Admin/Avs.hs +++ b/src/Handler/Admin/Avs.hs @@ -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)) diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index fb3bccc90..eabd8d596 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/src/Handler/Utils/Table/Cells.hs @@ -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 diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index dba76b879..b0bfaa548 100644 --- a/src/Utils/Lens.hs +++ b/src/Utils/Lens.hs @@ -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