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

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
+resultQualUser = _dbrOutput . _3 . _Just
-
-resultAvsPID :: Traversal' LicenceTableData AvsPersonId 
-resultAvsPID = _dbrOutput . _3
 
 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 $ \(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
-        [ 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
@@ -432,6 +434,7 @@ mkLicenceTable dbtIdent aLic apids defAct = do
         ]
       dbtSorting = mconcat
         [ 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))

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 :: (IsDBTable m c, HasQualification a) => a -> DBCell m c
-qualificationCell Qualification{..} = anchorCell link name
+qualificationCell (view hasQualification -> Qualification{..}) = anchorCell link name
   where
     link = QualificationR qualificationSchool qualificationShorthand
     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
     link = QualificationR qualificationSchool 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
     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

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