diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg index cd5154eb4..14ea89611 100644 --- a/messages/uniworx/categories/qualification/de-de-formal.msg +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -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 \ No newline at end of file +LmsDirectUpload: Direkter Upload für automatisierte Systeme \ No newline at end of file diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg index c41c93063..988f43c6b 100644 --- a/messages/uniworx/categories/qualification/en-eu.msg +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -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 \ No newline at end of file +LmsDirectUpload: Direct upload for automated Systems \ No newline at end of file diff --git a/src/Handler/Course/List.hs b/src/Handler/Course/List.hs index 02c5f7b43..c62fdc82a 100644 --- a/src/Handler/Course/List.hs +++ b/src/Handler/Course/List.hs @@ -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) diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index e95a19ebe..45d9a4947 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -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 diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index b5f58a691..b796bad69 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/src/Handler/Utils/Table/Cells.hs @@ -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 diff --git a/src/Model/Types/Markup.hs b/src/Model/Types/Markup.hs index ef644c961..bba69312b 100644 --- a/src/Model/Types/Markup.hs +++ b/src/Model/Types/Markup.hs @@ -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 \ No newline at end of file diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 17a3f2d34..b29309461 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -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|

Berechtigung zum Führen eines Fahrzeuges auf den Fahrstrassen des Vorfeldes.|] + let r_descr = Just $ htmlToStoredMarkup [shamlet|

Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|] + let l_descr = Just $ htmlToStoredMarkup [shamlet|

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