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

chore(lms): qualfication overview table refactored

Browse Source
This commit is contained in:
Steffen Jost 2022-04-04 13:48:14 +02:00
parent dd039f161f
commit 9483a0fc15
7 changed files with 78 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
messages/uniworx/categories/qualification/de-de-formal.msg
View File

@ -1,3 +1,13 @@
QualificationShort: Kürzel
QualificationName: Qualifikation
QualificationDescription: Beschreibung
QualificationValidDuration: Gültigkeitsdauer
QualificationAuditDuration: Aufbewahrung Audit Log
QualificationRefreshWithin: Erneurerungszeitraum
QualificationElearningStart: E-Lernen automatisch starten
TableQualificationCountActive: Aktive
TableQualificationCountActiveTooltip: Anzahl Personen mit momentan gültiger Qualifkation
TableQualificationCountTotal: Gesamt
TableLmsUser: Prüfling TableLmsUser: Prüfling
TableLmsIdent: Identifikation TableLmsIdent: Identifikation
TableLmsPin: E-Lernen Pin TableLmsPin: E-Lernen Pin
@ -20,9 +30,4 @@ LmsResultInsert: Neues LMS Ergebnis
LmsResultUpdate: LMS Ergebnis aktualisierung LmsResultUpdate: LMS Ergebnis aktualisierung
LmsResultCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel LmsResultCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
LmsUserlistCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel LmsUserlistCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
LmsDirectUpload: Direkter Upload für automatisierte Systeme LmsDirectUpload: Direkter Upload für automatisierte Systeme
QualificationDescription: Beschreibung
QualificationValidDuration: Gültigkeitsdauer
QualificationAuditDuration: Aufbewahrung Audit Log
QualificationRefreshWithin: Erneurerungszeitraum
QualificationElearningStart: E-Lernen automatisch starten

17
messages/uniworx/categories/qualification/en-eu.msg
View File

@ -1,3 +1,13 @@
QualificationShort: Shorthand
QualificationName: Qualification
QualificationDescription: Description
QualificationValidDuration: Validity period
QualificationAuditDuration: Audit log keept
QualificationRefreshWithin: Refresh within
QualificationElearningStart: Start e-learning automaticallyTableLmsUser: Examinee
TableQualificationCountActive: Active
TableQualificationCountActiveTooltip: Number of currently valid qualifcation holders
TableQualificationCountTotal: Total
TableLmsUser: Examinee TableLmsUser: Examinee
TableLmsIdent: Identifier TableLmsIdent: Identifier
TableLmsPin: E-learning pin TableLmsPin: E-learning pin
@ -20,9 +30,4 @@ LmsResultInsert: New LMS result
LmsResultUpdate: Update of LMS result LmsResultUpdate: Update of LMS result
LmsResultCsvExceptionDuplicatedKey: CSV import with ambiguous key LmsResultCsvExceptionDuplicatedKey: CSV import with ambiguous key
LmsUserlistCsvExceptionDuplicatedKey: CSV import with ambiguous key LmsUserlistCsvExceptionDuplicatedKey: CSV import with ambiguous key
LmsDirectUpload: Direct upload for automated Systems LmsDirectUpload: Direct upload for automated Systems
QualificationDescription: Description
QualificationValidDuration: Validity period
QualificationAuditDuration: Audit log keept
QualificationRefreshWithin: Refresh within
QualificationElearningStart: Start e-learning automatically

5
src/Handler/Course/List.hs
View File

@ -97,10 +97,7 @@ colCourse = sortable (Just "course") (i18nCell MsgFilterCourse)
colDescription :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) colDescription :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
colDescription = sortable Nothing mempty colDescription = sortable Nothing mempty
$ \(view resultCourse -> Entity _ Course{..}) -> $ \(view resultCourse -> Entity _ Course{..}) -> maybeCell courseDescription modalCell
case courseDescription of
Nothing -> mempty
(Just descr) -> cell $ modal (toWidget $ hasComment True) (Right $ toWidget descr)
colCShort :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) colCShort :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
colCShort = sortable (Just "cshort") (i18nCell MsgFilterCourseShort) colCShort = sortable (Just "cshort") (i18nCell MsgFilterCourseShort)

71
src/Handler/LMS.hs
View File

@ -45,56 +45,55 @@ getLmsAllR = do
setTitleI MsgMenuQualifications setTitleI MsgMenuQualifications
$(widgetFile "lms-all") $(widgetFile "lms-all")
type AllQualificationTableData = DBRow (Entity Qualification, Ex.Value Word64) type AllQualificationTableData = DBRow (Entity Qualification, Ex.Value Word64, Ex.Value Word64)
queryAllQualification :: Lens' AllQualificationTableData Qualification resultAllQualification :: Lens' AllQualificationTableData Qualification
queryAllQualification = _dbrOutput . _1 . _entityVal resultAllQualification = _dbrOutput . _1 . _entityVal
resultAllQualificationActive :: Lens' AllQualificationTableData Word64
resultAllQualificationActive = _dbrOutput . _2 . _unValue
resultAllQualificationTotal :: Lens' AllQualificationTableData Word64
resultAllQualificationTotal = _dbrOutput . _3 . _unValue
mkLmsAllTable :: DB (Any, Widget) mkLmsAllTable :: DB (Any, Widget)
mkLmsAllTable = do mkLmsAllTable = do
now <- liftIO getCurrentTime
let let
resultDBTable = DBTable{..} resultDBTable = DBTable{..}
where where
dbtSQLQuery quali = do dbtSQLQuery quali = do
-- 1. Just a constant dummy for debugging: cusers <- pure . Ex.subSelectCount $ do
-- let x = E.val (42::Word64) quser <- Ex.from $ Ex.table @QualificationUser
-- return (quali, x) Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId
-- cactive <- pure . Ex.subSelectCount $ do
-- 2. SubSelect with old syntax: quser <- Ex.from $ Ex.table @QualificationUser
-- x <- pure . E.subSelectCount . E.from $ \quser -> Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId
-- E.where_ $ quser E.^. QualificationUserQualification E.==. quali E.^. QualificationId E.&&. quser Ex.^. QualificationUserValidUntil Ex.>=. E.val now
-- return (quali, x) -- Failed attempt using Join/GroupBy instead of subselect: see branch csv-osis-demo-groupby-problem
-- return (quali, cactive, cusers)
-- 3. SubSelect with new syntax:
x <- pure . Ex.subSelectCount $ do
quser <- Ex.from $ Ex.table @QualificationUser
Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId
return (quali, x)
--
-- 4. Join / GroupBy
--Ex.on $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId
--Ex.groupBy (quali E.^. QualificationId)
--return (quali, count $ quser E.^. QualificationUserId)
dbtRowKey = (E.^. QualificationId) dbtRowKey = (E.^. QualificationId)
dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference? dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference?
dbtColonnade = dbColonnade $ mconcat dbtColonnade = dbColonnade $ mconcat
[ colSchool $ queryAllQualification . _qualificationSchool [ colSchool $ resultAllQualification . _qualificationSchool
, sortable (Just "qualification-short") (i18nCell MsgTableLmsIdent) $ \(view queryAllQualification -> quali) -> , sortable (Just "qshort") (i18nCell MsgQualificationShort) $ \(view resultAllQualification -> quali) ->
let qsh = qualificationShorthand quali in let qsh = qualificationShorthand quali in
anchorCell (LmsR (qualificationSchool quali) qsh) $ toWgt qsh anchorCell (LmsR (qualificationSchool quali) qsh) $ toWgt qsh
, sortable Nothing (i18nCell MsgTableLmsUser) $ \(view $ _dbrOutput . _1 . _entityKey -> qualid) -> sqlCell $ do , sortable (Just "qname") (i18nCell MsgQualificationName) $ \(view resultAllQualification -> quali) ->
num <- fmap (maybe 0 (max 0 . Ex.unValue) . listToMaybe) . let qsh = qualificationShorthand quali
Ex.select $ do qnm = qualificationName quali
quser <- Ex.from $ Ex.table @QualificationUser in anchorCell (LmsR (qualificationSchool quali) qsh) $ toWgt qnm
Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. Ex.val qualid , sortable Nothing (i18nCell MsgQualificationDescription) $ \(view resultAllQualification -> quali) ->
pure Ex.countRows maybeCell (qualificationDescription quali) markupCellLargeModal
return $ word2widget num , sortable Nothing (i18nCell MsgTableQualificationCountActive & cellTooltip MsgTableQualificationCountActiveTooltip)
, sortable Nothing (i18nCell MsgMenuAdminTest) $ \(view $ _dbrOutput . _2 . _unValue -> n) -> wgtCell $ word2widget n $ \(view resultAllQualificationActive -> n) -> wgtCell $ word2widget n
, sortable Nothing (i18nCell MsgTableQualificationCountTotal) $ \(view resultAllQualificationTotal -> n) -> wgtCell $ word2widget n
] -- TODO: add more columns for manual debugging view !!! ]
dbtSorting = mconcat dbtSorting = mconcat
[ [
sortSchool $ to (E.^. QualificationSchool) sortSchool $ to (E.^. QualificationSchool)
, singletonMap "qualification-short" $ SortColumn (E.^. QualificationShorthand) , singletonMap "qshort" $ SortColumn (E.^. QualificationShorthand)
, singletonMap "qname" $ SortColumn (E.^. QualificationName)
] ]
dbtFilter = mconcat dbtFilter = mconcat
[ [
@ -113,7 +112,7 @@ mkLmsAllTable = do
dbtExtraReps = [] dbtExtraReps = []
resultDBTableValidator = def resultDBTableValidator = def
& defaultSorting [SortAscBy "school", SortAscBy "qualification-short"] & defaultSorting [SortAscBy "school", SortAscBy "qshort"]
dbTable resultDBTableValidator resultDBTable dbTable resultDBTableValidator resultDBTable

5
src/Handler/Utils/Table/Cells.hs
View File

@ -130,6 +130,11 @@ csvCell route = anchorCell route iconFileCSV
modalCell :: (IsDBTable m a, ToWidget UniWorX w) => w -> DBCell m a modalCell :: (IsDBTable m a, ToWidget UniWorX w) => w -> DBCell m a
modalCell content = cell $ modal (toWidget $ hasComment True) (Right $ toWidget content) modalCell content = cell $ modal (toWidget $ hasComment True) (Right $ toWidget content)
markupCellLargeModal :: IsDBTable m a => StoredMarkup -> DBCell m a
markupCellLargeModal mup
| markupIsSmallish mup = cell $ toWidget mup
| otherwise = modalCell mup
----------------- -----------------
-- Datatype cells -- Datatype cells
timeCell :: IsDBTable m a => UTCTime -> DBCell m a timeCell :: IsDBTable m a => UTCTime -> DBCell m a

5
src/Model/Types/Markup.hs
View File

@ -4,6 +4,7 @@ module Model.Types.Markup
, htmlToStoredMarkup, plaintextToStoredMarkup, preEscapedToStoredMarkup , htmlToStoredMarkup, plaintextToStoredMarkup, preEscapedToStoredMarkup
, esqueletoMarkupOutput , esqueletoMarkupOutput
, I18nStoredMarkup , I18nStoredMarkup
, markupIsSmallish
) where ) where
import Import.NoModel import Import.NoModel
@ -136,3 +137,7 @@ instance PersistFieldSql StoredMarkup where
sqlType _ = SqlOther "jsonb" sqlType _ = SqlOther "jsonb"
type I18nStoredMarkup = I18n StoredMarkup type I18nStoredMarkup = I18n StoredMarkup
-- | determine whether the StoredMarkup is small-ish
markupIsSmallish :: StoredMarkup -> Bool
markupIsSmallish StoredMarkup{markupInput} = GT /= LT.compareLength markupInput 32

16
test/Database/Fill.hs
View File

@ -457,15 +457,19 @@ fillDb = do
for_ [jost] $ \uid -> for_ [jost] $ \uid ->
void . insert' $ UserSchool uid avn False void . insert' $ UserSchool uid avn False
qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" Nothing (Just 24) (Just $ 5 * 12) Nothing True let f_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf den Fahrstrassen des Vorfeldes.|]
qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" Nothing (Just 24) (Just $ 5 * 12) Nothing False let r_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|]
qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" Nothing Nothing (Just $ 5 * 12) Nothing False let l_descr = Just $ htmlToStoredMarkup [shamlet|<p>für unhabilitierte|]
void . insert' $ QualificationUser jost qid_f now now now -- TODO: better dates!
qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" f_descr (Just 24) (Just $ 5 * 12) Nothing True
qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 24) (Just $ 5 * 12) Nothing False
qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" l_descr Nothing (Just $ 5 * 12) Nothing False
void . insert' $ QualificationUser jost qid_f (addUTCTime nominalDay now) (addUTCTime (negate nominalDay) now) (addUTCTime (negate nominalDay) now) -- TODO: better dates!
void . insert' $ QualificationUser gkleen qid_f now now now void . insert' $ QualificationUser gkleen qid_f now now now
void . insert' $ QualificationUser maxMuster qid_f now now now void . insert' $ QualificationUser maxMuster qid_f now now now
void . insert' $ QualificationUser svaupel qid_f now now now void . insert' $ QualificationUser svaupel qid_f (addUTCTime nominalDay now) (addUTCTime (negate nominalDay) now) (addUTCTime (negate nominalDay) now)
void . insert' $ QualificationUser gkleen qid_r now now now void . insert' $ QualificationUser gkleen qid_r now now now
void . insert' $ QualificationUser maxMuster qid_r now now now void . insert' $ QualificationUser maxMuster qid_r (addUTCTime nominalDay now) (addUTCTime (negate nominalDay) now) (addUTCTime (negate nominalDay) now)
void . insert' $ QualificationUser fhamann qid_r now now now void . insert' $ QualificationUser fhamann qid_r now now now
void . insert' $ QualificationUser svaupel qid_l now now now void . insert' $ QualificationUser svaupel qid_l now now now
void . insert' $ QualificationUser gkleen qid_l now now now void . insert' $ QualificationUser gkleen qid_l now now now