From e28c75b5e2a9e66ea1db7dabf97150d5aa97d437 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 10 Feb 2022 16:55:22 +0100 Subject: [PATCH] chore(lms): display lmsuserlist compiles but incomplete --- .../utils/table_column/de-de-formal.msg | 4 +- messages/uniworx/utils/table_column/en-eu.msg | 4 +- models/lms.model | 16 ++++-- routes | 6 +-- src/Foundation/Navigation.hs | 6 +-- src/Handler/LMS.hs | 53 ++++++++++++++++--- src/Utils/Lens.hs | 1 + 7 files changed, 71 insertions(+), 19 deletions(-) diff --git a/messages/uniworx/utils/table_column/de-de-formal.msg b/messages/uniworx/utils/table_column/de-de-formal.msg index e91267835..b6da6d5ba 100644 --- a/messages/uniworx/utils/table_column/de-de-formal.msg +++ b/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 \ No newline at end of file +TableExamFinished: Ergebnisse sichtbar ab +TableLmsIdent: Identifikation +TableLmsFailed: Gesperrt \ No newline at end of file diff --git a/messages/uniworx/utils/table_column/en-eu.msg b/messages/uniworx/utils/table_column/en-eu.msg index 5913fddca..4596dbe20 100644 --- a/messages/uniworx/utils/table_column/en-eu.msg +++ b/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 \ No newline at end of file +TableExamFinished: Results visible from +TableLmsIdent: Identifier +TableLmsFailed: Blocked \ No newline at end of file diff --git a/models/lms.model b/models/lms.model index 64d4acc67..994eac3df 100644 --- a/models/lms.model +++ b/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 diff --git a/routes b/routes index 5ef536254..72e6d6ae7 100644 --- a/routes +++ b/routes @@ -255,6 +255,6 @@ !/*WellKnownFileName WellKnownR GET !free -- OSIS CSV Export Demo -/lms LmsR GET -/lms/userlist LmsUserlistR GET -/lms/result LmsResultR GET +/lms/#QualificationId LmsR GET +/lms/#QualificationId/userlist LmsUserlistR GET +/lms/#QualificationId/result LmsResultR GET diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index f15d4cdb9..c0013e960 100644 --- a/src/Foundation/Navigation.hs +++ b/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 LmsUserlistR = i18nCrumb MsgMenuLmsUserlist $ Just LmsR -breadcrumb LmsResultR = i18nCrumb MsgMenuLmsResult $ Just LmsR +breadcrumb (LmsR _qid) = i18nCrumb MsgMenuLms Nothing +breadcrumb (LmsUserlistR qid) = i18nCrumb MsgMenuLmsUserlist $ Just $ LmsR qid +breadcrumb (LmsResultR qid) = i18nCrumb MsgMenuLmsResult $ Just $ LmsR qid breadcrumb ProfileR = i18nCrumb MsgBreadcrumbProfile Nothing breadcrumb SetDisplayEmailR = i18nCrumb MsgUserDisplayEmail $ Just ProfileR diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index 351036b40..15fbecaa5 100644 --- a/src/Handler/LMS.hs +++ b/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 = do +getLmsR :: QualificationId -> Handler Html +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 -getLmsUserlistR = do +mkUserlistTable :: QualificationId -> DB (Any, Widget) +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") diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index ce25d9f26..2d9458f31 100644 --- a/src/Utils/Lens.hs +++ b/src/Utils/Lens.hs @@ -113,6 +113,7 @@ makeClassyFor_ ''StudyDegree makeClassyFor_ ''StudyTerms makeClassyFor_ ''StudySubTerms +makeClassyFor_ ''Qualification makeClassyFor_ ''LmsUser makeClassyFor_ ''LmsUserlist makeClassyFor_ ''LmsResult