fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(lms): display lmsuserlist compiles but incomplete

Browse Source
This commit is contained in:
Steffen Jost 2022-02-10 16:55:22 +01:00
parent 37411b7106
commit e28c75b5e2
7 changed files with 71 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
messages/uniworx/utils/table_column/de-de-formal.msg
View File

@ -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

4
messages/uniworx/utils/table_column/en-eu.msg
View File

@ -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

16
models/lms.model
View File

@ -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

6
routes
View File

@ -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

6
src/Foundation/Navigation.hs
View File

@ -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

53
src/Handler/LMS.hs
View File

@ -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")

1
src/Utils/Lens.hs
View File

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