fraport/fradrive
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
TableLmsIdent: Identifikation
TableLmsPin: E-Lernen Pin
@ -20,9 +30,4 @@ LmsResultInsert: Neues LMS Ergebnis
LmsResultUpdate: LMS Ergebnis aktualisierung
LmsResultCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
LmsUserlistCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
LmsDirectUpload: Direkter Upload für automatisierte Systeme
QualificationDescription: Beschreibung
QualificationValidDuration: Gültigkeitsdauer
QualificationAuditDuration: Aufbewahrung Audit Log
QualificationRefreshWithin: Erneurerungszeitraum
QualificationElearningStart: E-Lernen automatisch starten
LmsDirectUpload: Direkter Upload für automatisierte Systeme

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
TableLmsIdent: Identifier
TableLmsPin: E-learning pin
@ -20,9 +30,4 @@ LmsResultInsert: New LMS result
LmsResultUpdate: Update of LMS result
LmsResultCsvExceptionDuplicatedKey: CSV import with ambiguous key
LmsUserlistCsvExceptionDuplicatedKey: CSV import with ambiguous key
LmsDirectUpload: Direct upload for automated Systems
QualificationDescription: Description
QualificationValidDuration: Validity period
QualificationAuditDuration: Audit log keept
QualificationRefreshWithin: Refresh within
QualificationElearningStart: Start e-learning automatically
LmsDirectUpload: Direct upload for automated Systems

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 = sortable Nothing mempty
$ \(view resultCourse -> Entity _ Course{..}) ->
case courseDescription of
Nothing -> mempty
(Just descr) -> cell $ modal (toWidget $ hasComment True) (Right $ toWidget descr)
$ \(view resultCourse -> Entity _ Course{..}) -> maybeCell courseDescription modalCell
colCShort :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
colCShort = sortable (Just "cshort") (i18nCell MsgFilterCourseShort)

71
src/Handler/LMS.hs
View File

@ -45,56 +45,55 @@ getLmsAllR = do
setTitleI MsgMenuQualifications
$(widgetFile "lms-all")
type AllQualificationTableData = DBRow (Entity Qualification, Ex.Value Word64)
queryAllQualification :: Lens' AllQualificationTableData Qualification
queryAllQualification = _dbrOutput . _1 . _entityVal
type AllQualificationTableData = DBRow (Entity Qualification, Ex.Value Word64, Ex.Value Word64)
resultAllQualification :: Lens' AllQualificationTableData Qualification
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 = do
now <- liftIO getCurrentTime
let
resultDBTable = DBTable{..}
where
dbtSQLQuery quali = do
-- 1. Just a constant dummy for debugging:
-- let x = E.val (42::Word64)
-- return (quali, x)
--
-- 2. SubSelect with old syntax:
-- x <- pure . E.subSelectCount . E.from $ \quser ->
-- E.where_ $ quser E.^. QualificationUserQualification E.==. quali E.^. QualificationId
-- return (quali, x)
--
-- 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)
cusers <- pure . Ex.subSelectCount $ do
quser <- Ex.from $ Ex.table @QualificationUser
Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId
cactive <- pure . Ex.subSelectCount $ do
quser <- Ex.from $ Ex.table @QualificationUser
Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. quali Ex.^. QualificationId
E.&&. quser Ex.^. QualificationUserValidUntil Ex.>=. E.val now
-- Failed attempt using Join/GroupBy instead of subselect: see branch csv-osis-demo-groupby-problem
return (quali, cactive, cusers)
dbtRowKey = (E.^. QualificationId)
dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference?
dbtColonnade = dbColonnade $ mconcat
[ colSchool $ queryAllQualification . _qualificationSchool
, sortable (Just "qualification-short") (i18nCell MsgTableLmsIdent) $ \(view queryAllQualification -> quali) ->
[ colSchool $ resultAllQualification . _qualificationSchool
, sortable (Just "qshort") (i18nCell MsgQualificationShort) $ \(view resultAllQualification -> quali) ->
let qsh = qualificationShorthand quali in
anchorCell (LmsR (qualificationSchool quali) qsh) $ toWgt qsh
, sortable Nothing (i18nCell MsgTableLmsUser) $ \(view $ _dbrOutput . _1 . _entityKey -> qualid) -> sqlCell $ do
num <- fmap (maybe 0 (max 0 . Ex.unValue) . listToMaybe) .
Ex.select $ do
quser <- Ex.from $ Ex.table @QualificationUser
Ex.where_ $ quser Ex.^. QualificationUserQualification Ex.==. Ex.val qualid
pure Ex.countRows
return $ word2widget num
, sortable Nothing (i18nCell MsgMenuAdminTest) $ \(view $ _dbrOutput . _2 . _unValue -> n) -> wgtCell $ word2widget n
] -- TODO: add more columns for manual debugging view !!!
, sortable (Just "qname") (i18nCell MsgQualificationName) $ \(view resultAllQualification -> quali) ->
let qsh = qualificationShorthand quali
qnm = qualificationName quali
in anchorCell (LmsR (qualificationSchool quali) qsh) $ toWgt qnm
, sortable Nothing (i18nCell MsgQualificationDescription) $ \(view resultAllQualification -> quali) ->
maybeCell (qualificationDescription quali) markupCellLargeModal
, sortable Nothing (i18nCell MsgTableQualificationCountActive & cellTooltip MsgTableQualificationCountActiveTooltip)
$ \(view resultAllQualificationActive -> n) -> wgtCell $ word2widget n
, sortable Nothing (i18nCell MsgTableQualificationCountTotal) $ \(view resultAllQualificationTotal -> n) -> wgtCell $ word2widget n
]
dbtSorting = mconcat
[
sortSchool $ to (E.^. QualificationSchool)
, singletonMap "qualification-short" $ SortColumn (E.^. QualificationShorthand)
, singletonMap "qshort" $ SortColumn (E.^. QualificationShorthand)
, singletonMap "qname" $ SortColumn (E.^. QualificationName)
]
dbtFilter = mconcat
[
@ -113,7 +112,7 @@ mkLmsAllTable = do
dbtExtraReps = []
resultDBTableValidator = def
& defaultSorting [SortAscBy "school", SortAscBy "qualification-short"]
& defaultSorting [SortAscBy "school", SortAscBy "qshort"]
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 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
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
, esqueletoMarkupOutput
, I18nStoredMarkup
, markupIsSmallish
) where
import Import.NoModel
@ -136,3 +137,7 @@ instance PersistFieldSql StoredMarkup where
sqlType _ = SqlOther "jsonb"
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 ->
void . insert' $ UserSchool uid avn False
qid_f <- insert' $ Qualification avn "F" "Vorfeldführerschein" Nothing (Just 24) (Just $ 5 * 12) Nothing True
qid_r <- insert' $ Qualification avn "R" "Rollfeldführerschein" Nothing (Just 24) (Just $ 5 * 12) Nothing False
qid_l <- insert' $ Qualification ifi "L" "Lehrbefähigung" Nothing Nothing (Just $ 5 * 12) Nothing False
void . insert' $ QualificationUser jost qid_f now now now -- TODO: better dates!
let f_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf den Fahrstrassen des Vorfeldes.|]
let r_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|]
let l_descr = Just $ htmlToStoredMarkup [shamlet|<p>für unhabilitierte|]
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 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 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 svaupel qid_l now now now
void . insert' $ QualificationUser gkleen qid_l now now now