fix(qualifications): counts for lms/quals correct now

src/Handler/LMS.hs

@@ -25,7 +25,7 @@ import Import
 
 import Jobs
 import Handler.Utils
--- import Handler.Utils.Csv
+import Handler.Utils.Users
 import Handler.Utils.LMS
 
 
@@ -47,7 +47,6 @@ import Handler.LMS.Userlist as Handler.LMS
 import Handler.LMS.Result   as Handler.LMS
 import Handler.LMS.Fake     as Handler.LMS -- TODO: remove in production!
 
--- import Handler.Utils.Qualification (validQualification)
 
 -- avoids repetition of local definitions
 single :: (k,a) -> Map k a
@@ -108,19 +107,19 @@ resultAllQualificationTotal  = _dbrOutput . _3 . _unValue
   
 mkLmsAllTable :: Bool -> DB (Any, Widget)
 mkLmsAllTable isAdmin = do
-  now <- liftIO getCurrentTime
+  svs <- getSupervisees   
-  
   let
     resultDBTable = DBTable{..}
       where
         dbtSQLQuery quali = do
-          let cusers = Ex.subSelectCount $ do
+          let filterSvs luser = luser Ex.^. LmsUserQualification Ex.==. quali Ex.^. QualificationId                  
-                quser <- Ex.from $ Ex.table @QualificationUser
+                         Ex.&&. (E.val isAdmin E.||. luser Ex.^. LmsUserUser `Ex.in_` E.vals svs)
-                Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId
+              cusers = Ex.subSelectCount $ do 
+                luser <- Ex.from $ Ex.table @LmsUser
+                Ex.where_ $ filterSvs luser 
               cactive = Ex.subSelectCount $ do 
-                quser <- Ex.from $ Ex.table @QualificationUser
+                luser <- Ex.from $ Ex.table @LmsUser
-                Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId
+                Ex.where_ $ filterSvs luser Ex.&&. E.isNothing (luser E.^. LmsUserStatus)
-                      Ex.&&. validQualification (utctDay now) quser
           -- Failed attempt using Join/GroupBy instead of subselect: see branch csv-osis-demo-groupby-problem
           return (quali, cactive, cusers)
         dbtRowKey = (Ex.^. QualificationId)

src/Handler/Qualification.hs

@@ -16,7 +16,7 @@ import Import
 
 -- import Jobs
 import Handler.Utils
--- import Handler.Utils.Csv
+import Handler.Utils.Users
 import Handler.Utils.LMS
 
 
@@ -46,8 +46,9 @@ getQualificationSchoolR ssh = redirect (QualificationAllR, [("qualification-over
 
 getQualificationAllR :: Handler Html
 getQualificationAllR = do
+  isAdmin <- hasReadAccessTo AdminR
   qualiTable <- runDB $ do
-    view _2 <$> mkQualificationAllTable  
+    view _2 <$> mkQualificationAllTable isAdmin
   siteLayoutMsg MsgMenuQualifications $ do
     setTitleI MsgMenuQualifications
     $(widgetFile "qualification-all")
@@ -62,15 +63,9 @@ resultAllQualificationActive = _dbrOutput . _2 . _unValue
 resultAllQualificationTotal  :: Lens' AllQualificationTableData Word64
 resultAllQualificationTotal  = _dbrOutput . _3 . _unValue
 
-getSupervisees :: DB (Set UserId)
-getSupervisees = do 
-  uid <- requireAuthId
-  svs <- userSupervisorUser . entityVal <<$>> selectList [UserSupervisorSupervisor ==. uid] [Asc UserSupervisorUser]
-  return $ Set.insert uid $ Set.fromAscList svs 
 
-
+mkQualificationAllTable :: Bool -> DB (Any, Widget)
-mkQualificationAllTable :: DB (Any, Widget)
+mkQualificationAllTable isAdmin = do 
-mkQualificationAllTable = do 
   svs <- getSupervisees 
   now <- liftIO getCurrentTime
   let    
@@ -78,7 +73,7 @@ mkQualificationAllTable = do
       where
         dbtSQLQuery quali = do         
           let filterSvs quser = quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId                  
-                         Ex.&&. quser Ex.^. QualificationUserUser `Ex.in_` E.vals svs
+                         Ex.&&. (E.val isAdmin E.||. quser Ex.^. QualificationUserUser `Ex.in_` E.vals svs)
               cusers = Ex.subSelectCount $ do 
                 quser <- Ex.from $ Ex.table @QualificationUser
                 Ex.where_ $ filterSvs quser 

src/Handler/Utils/Users.hs

@@ -18,6 +18,7 @@ module Handler.Utils.Users
   , getPostalAddress, getPostalPreferenceAndAddress
   , abbrvName
   , getReceivers
+  , getSupervisees
   ) where
 
 import Import
@@ -110,6 +111,13 @@ getReceivers uid = do
         then directResult
         else return (underling, receivers, uid `elem` (entityKey <$> receivers))
 
+-- | return underlings for currently logged in user
+getSupervisees :: DB (Set UserId)
+getSupervisees = do 
+  uid <- requireAuthId
+  svs <- userSupervisorUser . entityVal <<$>> selectList [UserSupervisorSupervisor ==. uid] [Asc UserSupervisorUser]
+  return $ Set.insert uid $ Set.fromAscList svs 
+
 
 computeUserAuthenticationDigest :: AuthenticationMode -> Digest SHA3_256
 computeUserAuthenticationDigest = hashlazy . JSON.encode