chore(lms): allow table filtering by multiple LMS ids and names in several views

This commit is contained in:
Steffen Jost 2023-09-01 15:11:26 +00:00
parent 1fd24f608d
commit 4754ad4b80
13 changed files with 92 additions and 33 deletions

View File

@ -8,10 +8,11 @@ QualificationDescription: Beschreibung
QualificationValidIndicator: Gültigkeit
QualificationValidDuration: Gültigkeitsdauer
QualificationAuditDuration: Aufbewahrung Audit Log
QualificationAuditDurationTooltip: Optionaler Zeitraum zur Löschung von ELearning Daten. Hiweis: Der ELearning Server kann seine anonymisierten Daten schon früher löschen.
QualificationRefreshWithin: Erneurerungszeitraum
QualificationRefreshWithinTooltip: Optionaler Zeitraum vor Ablauf für automatischen Start des ELearnings und Versand einer Benachrichtigung per Brief oder Email
QualificationRefreshWithinTooltip: Optionaler Zeitraum vor Ablauf für automatischen Start des ELearnings und Versand einer Benachrichtigung per Brief oder Email.
QualificationRefreshReminder: 2. Erinnerung
QualificationRefreshReminderTooltip: Optionaler Zeitraum vor Ablauf zur Versendung einer zweiten Erinnerung per Brief oder Email mit identischen Zugangsdaten, sofern in diesem Zeitraum vor Ablauf noch keine Ablaufbenachrichtigung versendet wurde
QualificationRefreshReminderTooltip: Optionaler Zeitraum vor Ablauf zur Versendung einer zweiten Erinnerung per Brief oder Email mit identischen Zugangsdaten, sofern in diesem Zeitraum vor Ablauf noch keine Ablaufbenachrichtigung versendet wurde.
QualificationElearningStart: Wird das ELearning automatisch gestartet?
QualificationExpiryNotification: Ungültigkeitsbenachrichtigung?
QualificationExpiryNotificationTooltip: Nutzer werden benachrichtigt, wenn die Qualifikation ungültig wird, sofern der jeweilige Nutzer in seinen Benutzereinstellungen diese Art Benachrichtigung aktiviert hat.

View File

@ -8,10 +8,11 @@ QualificationDescription: Description
QualificationValidIndicator: Validity
QualificationValidDuration: Validity period
QualificationAuditDuration: Audit log keept
QualificationAuditDurationTooltip: Optional period for deletion of elearning data. Note that the elearning server may delete its anonymised data earlier.
QualificationRefreshWithin: Refresh within
QualificationRefreshWithinTooltip: Optional period before expiry to start elearning and send a notification by post or email
QualificationRefreshWithinTooltip: Optional period before expiry to start elearning and send a notification by post or email.
QualificationRefreshReminder: 2. Reminder
QualificationRefreshReminderTooltip: Optional period before expiry to send a second notification by post or email once more, provided that no renewal notification was sent in this period before expiry
QualificationRefreshReminderTooltip: Optional period before expiry to send a second notification by post or email once more, provided that no renewal notification was sent in this period before expiry.
QualificationElearningStart: Is elearning automatically started?
QualificationExpiryNotification: Invalidity notification?
QualificationExpiryNotificationTooltip: Qualification holder are notfied upon invalidity, provided they have activated such notification in their user settings.

View File

@ -21,7 +21,7 @@ module Database.Esqueleto.Utils
, mkExactFilter, mkExactFilterWith
, mkExactFilterLast, mkExactFilterLastWith
, mkExactFilterMaybeLast
, mkContainsFilter, mkContainsFilterWith
, mkContainsFilter, mkContainsFilterWith, mkContainsFilterWithSet, mkContainsFilterWithComma
, mkDayFilter, mkDayFilterFrom, mkDayFilterTo
, mkExistsFilter
, anyFilter, allFilter
@ -77,6 +77,10 @@ import qualified Data.Text.Lazy.Builder as Text.Builder
import Data.Monoid (Last(..))
import Utils (commaSeparatedText)
import Utils.Set (concatMapSet)
{-# ANN any ("HLint: ignore Use any" :: String) #-}
{-# ANN all ("HLint: ignore Use all" :: String) #-}
@ -328,6 +332,28 @@ mkContainsFilterWith cast lenslike row criterias
| Set.null criterias = true
| otherwise = any (hasInfix $ lenslike row) (E.val . cast <$> Set.toList criterias)
-- | like `mkContainsFilterWith` but allows conversion to produce multiple needles
mkContainsFilterWithSet :: (E.SqlString b, Ord b)
=> (a -> Set.Set b)
-> (t -> E.SqlExpr (E.Value b)) -- ^ getter from query to searched element
-> t -- ^ query row
-> Set.Set a -- ^ needle collection
-> E.SqlExpr (E.Value Bool)
mkContainsFilterWithSet cast lenslike row criterias
| Set.null criterias = true
| otherwise = any (hasInfix $ lenslike row) (E.val <$> Set.toList (concatMapSet cast criterias))
-- | like `mkContainsFilterWithSet` but fixed to comma separated Texts
mkContainsFilterWithComma :: (E.SqlString b, Ord b)
=> (Text -> b)
-> (t -> E.SqlExpr (E.Value b)) -- ^ getter from query to searched element
-> t -- ^ query row
-> Set.Set Text -- ^ needle collection
-> E.SqlExpr (E.Value Bool)
mkContainsFilterWithComma cast lenslike row criterias
| Set.null criterias = true
| otherwise = any (hasInfix $ lenslike row) (E.val . cast <$> Set.toList (concatMapSet commaSeparatedText criterias))
mkDayFilter :: (t -> E.SqlExpr (E.Value UTCTime)) -- ^ getter from query to searched element
-> t -- ^ query row

View File

@ -153,11 +153,15 @@ mkLmsAllTable isAdmin = do
in anchorCell (LmsR (qualificationSchool quali) qsh) $ toWgt qnm
, sortable Nothing (i18nCell MsgQualificationDescription) $ \(view resultAllQualification -> quali) ->
maybeCell (qualificationDescription quali) markupCellLargeModal
, sortable Nothing (i18nCell MsgQualificationValidDuration & cellTooltip MsgTableDiffDaysTooltip) $
, sortable Nothing (i18nCell MsgQualificationValidDuration & cellTooltip MsgTableDiffDaysTooltip) $
foldMap (textCell . formatCalendarDiffDays . fromMonths) . view (resultAllQualification . _qualificationValidDuration)
, sortable Nothing (i18nCell MsgQualificationRefreshWithin & cellTooltip MsgTableDiffDaysTooltip) $
, sortable Nothing (i18nCell MsgQualificationRefreshWithin & cellTooltips [SomeMessage MsgQualificationRefreshWithinTooltip , SomeMessage MsgTableDiffDaysTooltip]) $
foldMap (textCell . formatCalendarDiffDays ) . view (resultAllQualification . _qualificationRefreshWithin)
-- , sortable Nothing (i18nCell MsgQualificationRefreshWithin) $ foldMap textCell . view (resultAllQualification . _qualificationRefreshWithin . to formatCalendarDiffDays) -- does not work, since there is a maybe in between
, sortable Nothing (i18nCell MsgQualificationRefreshReminder & cellTooltips [SomeMessage MsgQualificationRefreshReminderTooltip, SomeMessage MsgTableDiffDaysTooltip]) $
foldMap (textCell . formatCalendarDiffDays ) . view (resultAllQualification . _qualificationRefreshReminder)
, sortable Nothing (i18nCell MsgQualificationAuditDuration & cellTooltips [SomeMessage MsgQualificationAuditDurationTooltip, SomeMessage MsgTableDiffDaysTooltip]) $
foldMap (textCell . formatCalendarDiffDays . fromMonths) . view (resultAllQualification . _qualificationAuditDuration)
, sortable (Just "qelearning") (i18nCell MsgTableLmsElearning & cellTooltip MsgQualificationElearningStart)
$ tickmarkCell . view (resultAllQualification . _qualificationElearningStart)
, sortable Nothing (i18nCell MsgTableQualificationIsAvsLicence & cellTooltip MsgTableQualificationIsAvsLicenceTooltip)
@ -472,7 +476,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
]
dbtFilter = mconcat
[ single $ fltrUserNameEmail queryUser
, single ("ident" , FilterColumn . E.mkContainsFilterWith LmsIdent $ views (to queryLmsUser) (E.^. LmsUserIdent))
, single ("ident" , FilterColumn . E.mkContainsFilterWithComma LmsIdent $ views (to queryLmsUser) (E.^. LmsUserIdent))
, single ("status" , FilterColumn . E.mkExactFilterMaybeLast $ views (to queryLmsUser) (E.^. LmsUserStatus))
-- , single ("validity" , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) ((E.>=. E.val nowaday) . (E.^. QualificationUserValidUntil)))
, single ("validity" , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) (validQualification now))

View File

@ -124,8 +124,8 @@ mkUserTable _sid qsh qid = do
, (csvLmsLock , SortColumn lmsUserToLockExpr)
]
dbtFilter = Map.fromList
[ (csvLmsIdent , FilterColumn $ E.mkContainsFilterWith LmsIdent (E.^. LmsUserIdent ))
, (csvLmsResetPin , FilterColumn $ E.mkExactFilterLast (E.^. LmsUserResetPin))
[ (csvLmsIdent , FilterColumn $ E.mkContainsFilterWithComma LmsIdent (E.^. LmsUserIdent ))
, (csvLmsResetPin , FilterColumn $ E.mkExactFilterLast (E.^. LmsUserResetPin))
]
dbtFilterUI = \mPrev -> mconcat
[ prismAForm (singletonFilter csvLmsIdent . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent)

View File

@ -120,8 +120,8 @@ mkReportTable sid qsh qid = do
, (csvLmsTimestamp, SortColumn (E.^. LmsReportTimestamp))
]
dbtFilter = Map.fromList
[ (csvLmsIdent , FilterColumn $ E.mkContainsFilterWith LmsIdent (E.^. LmsReportIdent))
, (csvLmsDate , FilterColumn $ E.mkExactFilter (E.^. LmsReportDate))
[ (csvLmsIdent , FilterColumn $ E.mkContainsFilterWithComma LmsIdent (E.^. LmsReportIdent))
, (csvLmsDate , FilterColumn $ E.mkExactFilter (E.^. LmsReportDate))
]
dbtFilterUI = \mPrev -> mconcat
[ prismAForm (singletonFilter csvLmsIdent . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent)

View File

@ -33,6 +33,7 @@ import Utils.Print
import Handler.Utils
-- import Handler.Utils.Csv
-- import qualified Data.Csv as Csv
import qualified Data.CaseInsensitive as CI
import Jobs.Queue
@ -222,16 +223,16 @@ mkPJTable = do
, single ("lmsid" , SortColumn $ queryPrintJob >>> (E.^. PrintJobLmsUser))
]
dbtFilter = mconcat
[ single ("name" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobName))
, single ("apcid" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobApcIdent))
, single ("filename" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobFilename))
, single ("created" , FilterColumn . E.mkDayFilter $ views (to queryPrintJob) (E.^. PrintJobCreated))
--, single ("created" , FilterColumn . E.mkDayBetweenFilter $ views (to queryPrintJob) (E.^. PrintJobCreated))
, single ("recipient" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryRecipient) (E.?. UserDisplayName))
, single ("sender" , FilterColumn . E.mkContainsFilterWith Just $ views (to querySender) (E.?. UserDisplayName))
, single ("course" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryCourse) (E.?. CourseName))
, single ("qualification", FilterColumn . E.mkContainsFilterWith Just $ views (to queryQualification) (E.?. QualificationName))
, single ("lmsid" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryPrintJob) (E.^. PrintJobLmsUser))
[ single ("name" , FilterColumn . E.mkContainsFilterWithComma id $ views (to queryPrintJob) (E.^. PrintJobName))
, single ("apcid" , FilterColumn . E.mkContainsFilterWithComma id $ views (to queryPrintJob) (E.^. PrintJobApcIdent))
, single ("filename" , FilterColumn . E.mkContainsFilter $ views (to queryPrintJob) (E.^. PrintJobFilename))
, single ("created" , FilterColumn . E.mkDayFilter $ views (to queryPrintJob) (E.^. PrintJobCreated))
--, single ("created" , FilterColumn . E.mkDayBetweenFilter $ views (to queryPrintJob) (E.^. PrintJobCreated))
, single ("recipient" , FilterColumn . E.mkContainsFilterWithComma Just $ views (to queryRecipient) (E.?. UserDisplayName))
, single ("sender" , FilterColumn . E.mkContainsFilterWithComma Just $ views (to querySender) (E.?. UserDisplayName))
, single ("course" , FilterColumn . E.mkContainsFilterWithComma (Just . CI.mk) $ views (to queryCourse) (E.?. CourseName))
, single ("qualification", FilterColumn . E.mkContainsFilterWithComma (Just . CI.mk) $ views (to queryQualification) (E.?. QualificationName))
, single ("lmsid" , FilterColumn . E.mkContainsFilterWithComma (Just . LmsIdent) $ views (to queryPrintJob) (E.^. PrintJobLmsUser))
, single ("acknowledged" , FilterColumn . E.mkExactFilterLast $ views (to queryPrintJob) (E.isJust . (E.^. PrintJobAcknowledged)))
]

View File

@ -97,11 +97,11 @@ mkQualificationAllTable isAdmin = do
maybeCell (qualificationDescription quali) markupCellLargeModal
, sortable Nothing (i18nCell MsgQualificationValidDuration & cellTooltip MsgTableDiffDaysTooltip) $
foldMap (textCell . formatCalendarDiffDays . fromMonths) . view (resultAllQualification . _qualificationValidDuration)
, sortable Nothing (i18nCell MsgQualificationRefreshWithin & cellTooltip MsgQualificationRefreshWithinTooltip) $
, sortable Nothing (i18nCell MsgQualificationRefreshWithin & cellTooltips [SomeMessage MsgQualificationRefreshWithinTooltip , SomeMessage MsgTableDiffDaysTooltip]) $
foldMap (textCell . formatCalendarDiffDays ) . view (resultAllQualification . _qualificationRefreshWithin)
, sortable Nothing (i18nCell MsgQualificationRefreshReminder & cellTooltip MsgQualificationRefreshReminderTooltip) $
foldMap (textCell . formatCalendarDiffDays ) . view (resultAllQualification . _qualificationRefreshReminder)
, sortable (Just "qelearning") (i18nCell MsgTableLmsElearning & cellTooltip MsgQualificationElearningStart)
, sortable Nothing (i18nCell MsgQualificationRefreshReminder & cellTooltips [SomeMessage MsgQualificationRefreshReminderTooltip, SomeMessage MsgTableDiffDaysTooltip]) $
foldMap (textCell . formatCalendarDiffDays ) . view (resultAllQualification . _qualificationRefreshReminder)
, sortable (Just "qelearning") (i18nCell MsgTableLmsElearning & cellTooltip MsgQualificationElearningStart)
$ tickmarkCell . view (resultAllQualification . _qualificationElearningStart)
, sortable (Just "noteexpiry") (i18nCell MsgQualificationExpiryNotification & cellTooltip MsgQualificationExpiryNotificationTooltip)
$ tickmarkCell . view (resultAllQualification . _qualificationExpiryNotification)
@ -598,7 +598,7 @@ postQualificationR sid qsh = do
, sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) (dayCell . view ( resultQualUser . _entityVal . _qualificationUserValidUntil))
, sortable (Just "blocked") (i18nCell MsgQualificationValidIndicator & cellTooltip MsgTableQualificationBlockedTooltipSimple) $ \row ->
qualificationValidReasonCell' (Just $ LmsUserR sid qsh) isAdmin nowaday (row ^? resultQualBlock) row
, sortable (Just "schedule-renew")(i18nCell MsgTableQualificationNoRenewal & cellTooltip MsgTableQualificationNoRenewalTooltip
, sortable (Just "schedule-renew")(i18nCell MsgTableQualificationNoRenewal & cellTooltip MsgTableQualificationNoRenewalTooltip
) $ \( view $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> ifIconCell (not b) IconNoNotification
, sortable (Just "lms-status-plus")(i18nCell MsgTableLmsStatus & cellTooltipWgt Nothing (lmsStatusInfoCell isAdmin auditMonths))
$ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap (lmsStatusCell isAdmin linkLmsUser) lu

View File

@ -10,7 +10,7 @@ import Import hiding (link)
import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E hiding ((->.))
import Database.Esqueleto.Utils (mkExactFilter, mkExactFilterWith, mkContainsFilter, mkContainsFilterWith, anyFilter)
import Database.Esqueleto.Utils (mkExactFilter, mkExactFilterWith, mkContainsFilter, mkContainsFilterWith, mkContainsFilterWithComma, anyFilter)
--import Database.Esqueleto.Experimental ((:&)(..))
--import qualified Database.Esqueleto.Experimental as Ex
@ -399,9 +399,9 @@ fltrUserNameEmail :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool
=> (a -> E.SqlExpr (Entity User))
-> (d, FilterColumn t fs)
fltrUserNameEmail queryUser = ( "user-name-email", FilterColumn $ anyFilter
[ mkContainsFilter $ queryUser >>> (E.^. UserDisplayName)
, mkContainsFilter $ queryUser >>> (E.^. UserSurname)
, mkContainsFilterWith CI.mk $ queryUser >>> (E.^. UserDisplayEmail)
[ mkContainsFilterWithComma id $ queryUser >>> (E.^. UserDisplayName)
, mkContainsFilterWithComma id $ queryUser >>> (E.^. UserSurname)
, mkContainsFilterWithComma CI.mk $ queryUser >>> (E.^. UserDisplayEmail)
]
)

View File

@ -48,7 +48,7 @@ module Handler.Utils.Table.Pagination
, linkEitherCell, linkEitherCellM, linkEitherCellM'
, maybeAnchorCellM, maybeAnchorCellM', maybeLinkEitherCellM'
, anchorCellC, anchorCellCM, anchorCellCM', linkEitherCellCM', maybeLinkEitherCellCM'
, cellTooltip, cellTooltipIcon, cellTooltipWgt
, cellTooltip, cellTooltips, cellTooltipIcon, cellTooltipWgt
, listCell, listCell', listCellOf, listCellOf'
, ilistCell, ilistCell', ilistCellOf, ilistCellOf'
, formCell, DBFormResult(..), getDBFormResult
@ -1704,6 +1704,13 @@ i18nCell msg = cell $ do
cellTooltip :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a -> DBCell m a
cellTooltip = cellTooltipIcon Nothing
cellTooltips :: (RenderMessage UniWorX msg, IsDBTable m a) => [msg] -> DBCell m a -> DBCell m a
cellTooltips msgs = cellTooltipWgt Nothing [whamlet|
$forall msg <- msgs
<p>
_{msg}
|]
cellTooltipIcon :: (RenderMessage UniWorX msg, IsDBTable m a) => Maybe Icon -> msg -> DBCell m a -> DBCell m a
cellTooltipIcon icn = cellTooltipWgt icn . msg2widget

View File

@ -503,6 +503,10 @@ snakecase2camelcase t = Text.concat $ map textToCapital words
words = Text.splitOn '_' t
-}
-- also see Utils.Form.cfCommaSeparatedSet
commaSeparatedText :: Text -> Set Text
commaSeparatedText = Set.fromList . mapMaybe (assertM' (not . Text.null) . Text.strip) . Text.split (==',')
-----------
-- Fixed --

View File

@ -6,6 +6,7 @@ module Utils.Set
( setIntersectNotOne
, setIntersections
, setMapMaybe
, concatMapSet
, setSymmDiff
, setProduct
, setPartitionEithers
@ -55,6 +56,9 @@ setIntersections (h:t) = foldl' Set.intersection h t
setMapMaybe :: Ord b => (a -> Maybe b) -> Set a -> Set b
setMapMaybe f = Set.fromList . mapMaybe f . Set.toList
concatMapSet :: Ord b => (a -> Set b) -> Set a -> Set b
concatMapSet f = Set.foldl ((. f) . (<>)) mempty
-- | Symmetric difference of two sets.
setSymmDiff :: Ord a => Set a -> Set a -> Set a
setSymmDiff x y = (x `Set.difference` y) `Set.union` (y `Set.difference` x)

View File

@ -15,7 +15,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<dd .deflist__dd>_{MsgMonths (fromIntegral dvalid)}
$maybe daudit <- qualificationAuditDuration quali
<dt .deflist__dt>_{MsgQualificationAuditDuration}
<dt .deflist__dt>_{MsgQualificationAuditDuration} ^{iconTooltip (msg2widget MsgQualificationAuditDurationTooltip) Nothing True}
<dd .deflist__dd>_{MsgMonths (fromIntegral daudit)}
$maybe drefresh <- qualificationRefreshWithin quali
@ -29,6 +29,17 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
, #
$if drd > 0
_{MsgDays (fromIntegral drd)}
$maybe drefresh <- qualificationRefreshReminder quali
<dt .deflist__dt>_{MsgQualificationRefreshReminder} ^{iconTooltip (msg2widget MsgQualificationRefreshReminderTooltip) Nothing True}
<dd .deflist__dd>
$with drm <- cdMonths drefresh
$with drd <- cdDays drefresh
$if drm > 0
_{MsgMonths (fromIntegral drm)}
$if drd > 0
, #
$if drd > 0
_{MsgDays (fromIntegral drd)}
<dt .deflist__dt>_{MsgQualificationElearningStart}
<dd .deflist__dd>#{boolSymbol (qualificationElearningStart quali)}