chore(lms): display lmsuserlist compiles but incomplete

messages/uniworx/utils/table_column/de-de-formal.msg

@@ -61,4 +61,6 @@ SelectColumn: Auswahl
 CsvExport: CSV-Export
 TableProportion c@Text of'@Text prop@Rational !ident-ok: #{c}/#{of'} (#{rationalToFixed2 (100 * prop)}%)
 TableProportionNoRatio c@Text of'@Text !ident-ok: #{c}/#{of'}
-TableExamFinished: Ergebnisse sichtbar ab
+TableExamFinished: Ergebnisse sichtbar ab
+TableLmsIdent: Identifikation
+TableLmsFailed: Gesperrt

messages/uniworx/utils/table_column/en-eu.msg

@@ -61,4 +61,6 @@ SelectColumn: Selection
 CsvExport: CSV export
 TableProportion c of' prop: #{c}/#{of'} (#{rationalToFixed2 (100 * prop)}%)
 TableProportionNoRatio c of': #{c}/#{of'}
-TableExamFinished: Results visible from
+TableExamFinished: Results visible from
+TableLmsIdent: Identifier 
+TableLmsFailed: Blocked

models/lms.model

@@ -1,26 +1,32 @@
 Qualification
-  name Text
+  name              (CI Text)
+  shorthand         (CI Text)
+  -- to be expanded later 
   deriving Generic
 
 -- LMS Interface Tables, need regular processing by background jobs
 
 LmsUser
-  user              UserId 
-  ident             LmsIdent
   qualification     QualificationId
+  user              UserId 
+  ident             LmsIdent  
   pin               Text
   resetPin          Bool
   delete            Bool
+  started           UTCTime
+  UniqueLmsUser qualification ident 
   deriving Generic
 
 LmsUserlist
+  qualification     QualificationId
   ident             LmsIdent
   failed            Bool
-  UniqueLmsUserlist ident
+  UniqueLmsUserlist qualification ident
   deriving Generic
 
 LmsResult
+  qualification     QualificationId
   ident             LmsIdent
   success           UTCTime
-  UniqueLmsResult   ident
+  UniqueLmsResult   qualification ident
   deriving Generic

routes

@@ -255,6 +255,6 @@
 !/*WellKnownFileName WellKnownR GET !free
 
 -- OSIS CSV Export Demo
-/lms  					LmsR  				GET
+/lms/#QualificationId           LmsR  				GET
-/lms/userlist		LmsUserlistR	GET
+/lms/#QualificationId/userlist	LmsUserlistR	GET
-/lms/result 		LmsResultR		GET
+/lms/#QualificationId/result 		LmsResultR		GET

src/Foundation/Navigation.hs

@@ -133,9 +133,9 @@ breadcrumb HealthR          = i18nCrumb MsgMenuHealth          Nothing
 breadcrumb InstanceR        = i18nCrumb MsgMenuInstance        Nothing
 breadcrumb StatusR          = i18nCrumb MsgMenuHealth          Nothing  -- never displayed
 
-breadcrumb LmsR             = i18nCrumb MsgMenuLms             Nothing
+breadcrumb (LmsR         _qid) = i18nCrumb MsgMenuLms             Nothing
-breadcrumb LmsUserlistR     = i18nCrumb MsgMenuLmsUserlist   $ Just LmsR 
+breadcrumb (LmsUserlistR  qid) = i18nCrumb MsgMenuLmsUserlist   $ Just $ LmsR qid
-breadcrumb LmsResultR       = i18nCrumb MsgMenuLmsResult     $ Just LmsR
+breadcrumb (LmsResultR    qid) = i18nCrumb MsgMenuLmsResult     $ Just $ LmsR qid
 
 breadcrumb ProfileR         = i18nCrumb MsgBreadcrumbProfile   Nothing
 breadcrumb SetDisplayEmailR = i18nCrumb MsgUserDisplayEmail  $ Just ProfileR

src/Handler/LMS.hs

@@ -5,6 +5,8 @@
 
 module Handler.LMS
   ( getLmsR
+  , getLmsUserlistR
+  , getLmsResultR
   )
   where
 
@@ -12,6 +14,7 @@ import Import
 
 import Handler.Utils
 
+import qualified Data.Map as Map
 import qualified Data.Csv as Csv
 import qualified Data.Conduit.List as C
 import qualified Database.Esqueleto.Legacy as E
@@ -67,8 +70,9 @@ getYMTH :: MonadHandler m => m Text
 getYMTH = formatTime' "%Y%m%d%H" =<< liftIO getCurrentTime
 
 
-getLmsR :: Handler Html
+getLmsR :: QualificationId -> Handler Html
-getLmsR = do  
+getLmsR _qid = do  
+  -- TODO !!! filter table by qid !!!
   {-
   dbtCsvName <- csvLmsUserFilename
   let dbtIdent     = "lmsUsers" :: Text
@@ -132,15 +136,52 @@ getLmsR = do
     $(widgetFile "lms")
 
 
-getLmsUserlistR :: Handler Html
+mkUserlistTable :: QualificationId -> DB (Any, Widget)
-getLmsUserlistR = do  
+mkUserlistTable qid = do
+  let 
+    userlistTable = DBTable{..}
+      where
+        dbtSQLQuery lmslist = do 
+          E.where_ $ lmslist E.^. LmsUserlistQualification E.==. E.val qid
+          return lmslist
+        dbtRowKey = (E.^. LmsUserlistId)
+        dbtProj   = dbtProjFilteredPostId
+        dbtColonnade = dbColonnade $ mconcat 
+          [ sortable (Just "ident")  (i18nCell MsgTableLmsIdent)  $ \DBRow{ dbrOutput = Entity _ LmsUserlist{..} } -> textCell  lmsUserlistIdent
+          , sortable (Just "failed") (i18nCell MsgTableLmsFailed) $ \DBRow{ dbrOutput = Entity _ LmsUserlist{..} } -> isBadCell lmsUserlistFailed
+          ]
+        dbtSorting = Map.fromList
+          [ ("ident" , SortColumn $ \lmslist -> lmslist E.^. LmsUserlistIdent)
+          , ("failed", SortColumn $ \lmslist -> lmslist E.^. LmsUserlistFailed)
+          ]
+        dbtFilter = mempty          -- TODO !!! continue here !!!  
+        dbtFilterUI = const mempty  -- TODO !!! continue here !!! Manual filtering useful to deal with user complaints!
+        dbtStyle = def
+        dbtParams = def
+        dbtIdent :: Text
+        dbtIdent = "lms-userlist"
+        dbtCsvEncode = noCsvEncode
+        dbtCsvDecode = Nothing      -- TODO !!! continue here !!! CSV Import is the purpose of this page! Just save to DB, create Job to deal with it later!
+        dbtExtraReps = []
+    
+    userlistDBTableValidator = def 
+      & defaultSorting [SortAscBy "ident"]
+  
+  dbTable userlistDBTableValidator userlistTable
+
+
+getLmsUserlistR :: QualificationId -> Handler Html
+getLmsUserlistR qid = do  
+  lmsTable <- runDB $ view _2 <$> mkUserlistTable qid
   siteLayoutMsg MsgMenuLmsUserlist $ do
     setTitleI MsgMenuLmsUserlist
     $(widgetFile "lms-userlist")
 
 
-getLmsResultR :: Handler Html
+
-getLmsResultR = do  
+getLmsResultR :: QualificationId -> Handler Html
+getLmsResultR _qid = do  
+  let lmsTable = [whamlet|TODO|]  -- TODO: remove me, just for debugging
   siteLayoutMsg MsgMenuLmsResult $ do
     setTitleI MsgMenuLmsResult
     $(widgetFile "lms-result")

src/Utils/Lens.hs

@@ -113,6 +113,7 @@ makeClassyFor_ ''StudyDegree
 makeClassyFor_ ''StudyTerms
 makeClassyFor_ ''StudySubTerms
 
+makeClassyFor_ ''Qualification
 makeClassyFor_ ''LmsUser
 makeClassyFor_ ''LmsUserlist
 makeClassyFor_ ''LmsResult