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

messages/uniworx/categories/qualification/de-de-formal.msg

@@ -8,10 +8,11 @@ QualificationDescription: Beschreibung
 QualificationValidIndicator: Gültigkeit
 QualificationValidDuration: Gültigkeitsdauer
 QualificationAuditDuration: Aufbewahrung Audit Log
+QualificationAuditDurationTooltip: Optionaler Zeitraum zur Löschung von E‑Learning Daten. Hiweis: Der E‑Learning Server kann seine anonymisierten Daten schon früher löschen.
 QualificationRefreshWithin: Erneurerungszeitraum
-QualificationRefreshWithinTooltip: Optionaler Zeitraum vor Ablauf für automatischen Start des E‑Learnings und Versand einer Benachrichtigung per Brief oder Email
+QualificationRefreshWithinTooltip: Optionaler Zeitraum vor Ablauf für automatischen Start des E‑Learnings 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 E‑Learning 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.

messages/uniworx/categories/qualification/en-eu.msg

@@ -8,10 +8,11 @@ QualificationDescription: Description
 QualificationValidIndicator: Validity
 QualificationValidDuration: Validity period
 QualificationAuditDuration: Audit log keept
+QualificationAuditDurationTooltip: Optional period for deletion of e‑learning data. Note that the e‑learning server may delete its anonymised data earlier.
 QualificationRefreshWithin: Refresh within
-QualificationRefreshWithinTooltip: Optional period before expiry to start e‑learning and send a notification by post or email
+QualificationRefreshWithinTooltip: Optional period before expiry to start e‑learning 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 e‑learning automatically started?
 QualificationExpiryNotification: Invalidity notification?
 QualificationExpiryNotificationTooltip: Qualification holder are notfied upon invalidity, provided they have activated such notification in their user settings.

src/Database/Esqueleto/Utils.hs

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

src/Handler/LMS.hs

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

src/Handler/LMS/Learners.hs

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

src/Handler/LMS/Report.hs

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

src/Handler/PrintCenter.hs

@@ -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 ("name"         , FilterColumn . E.mkContainsFilterWithComma id                $ views (to queryPrintJob)      (E.^. PrintJobName))
-      , single ("apcid"        , FilterColumn . E.mkContainsFilter          $ views (to queryPrintJob)      (E.^. PrintJobApcIdent))
+      , single ("apcid"        , FilterColumn . E.mkContainsFilterWithComma id                $ views (to queryPrintJob)      (E.^. PrintJobApcIdent))
-      , single ("filename"     , FilterColumn . E.mkContainsFilter          $ views (to queryPrintJob)      (E.^. PrintJobFilename))      
+      , single ("filename"     , FilterColumn . E.mkContainsFilter                            $ views (to queryPrintJob)      (E.^. PrintJobFilename))      
-      , single ("created"      , FilterColumn . E.mkDayFilter               $ views (to queryPrintJob)      (E.^. PrintJobCreated))
+      , single ("created"      , FilterColumn . E.mkDayFilter                                 $ views (to queryPrintJob)      (E.^. PrintJobCreated))
-      --, single ("created"      , FilterColumn . E.mkDayBetweenFilter               $ 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 ("recipient"    , FilterColumn . E.mkContainsFilterWithComma Just              $ views (to queryRecipient)     (E.?. UserDisplayName))
-      , single ("sender"       , FilterColumn . E.mkContainsFilterWith Just $ views (to querySender)        (E.?. UserDisplayName))
+      , single ("sender"       , FilterColumn . E.mkContainsFilterWithComma Just              $ views (to querySender)        (E.?. UserDisplayName))
-      , single ("course"       , FilterColumn . E.mkContainsFilterWith Just $ views (to queryCourse)        (E.?. CourseName))
+      , single ("course"       , FilterColumn . E.mkContainsFilterWithComma (Just . CI.mk)    $ views (to queryCourse)        (E.?. CourseName))
-      , single ("qualification", FilterColumn . E.mkContainsFilterWith Just $ views (to queryQualification) (E.?. QualificationName))
+      , single ("qualification", FilterColumn . E.mkContainsFilterWithComma (Just . CI.mk)    $ views (to queryQualification) (E.?. QualificationName))
-      , single ("lmsid"        , FilterColumn . E.mkContainsFilterWith Just $ views (to queryPrintJob)      (E.^. PrintJobLmsUser))
+      , single ("lmsid"        , FilterColumn . E.mkContainsFilterWithComma (Just . LmsIdent) $ views (to queryPrintJob)      (E.^. PrintJobLmsUser))
       
       , single ("acknowledged" , FilterColumn . E.mkExactFilterLast $ views (to queryPrintJob) (E.isJust . (E.^. PrintJobAcknowledged)))
       ]

src/Handler/Qualification.hs

@@ -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) $
+          , sortable Nothing (i18nCell MsgQualificationRefreshReminder  & cellTooltips [SomeMessage MsgQualificationRefreshReminderTooltip, SomeMessage MsgTableDiffDaysTooltip]) $
-              foldMap (textCell . formatCalendarDiffDays             ) . view (resultAllQualification . _qualificationRefreshReminder)                                  
+              foldMap (textCell . formatCalendarDiffDays             ) . view (resultAllQualification . _qualificationRefreshReminder)                   
-          , sortable (Just "qelearning") (i18nCell MsgTableLmsElearning & cellTooltip MsgQualificationElearningStart) 
+          , 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

src/Handler/Utils/Table/Columns.hs

@@ -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)
+    [ mkContainsFilterWithComma id    $ queryUser >>> (E.^. UserDisplayName)
-    , mkContainsFilter $ queryUser >>> (E.^. UserSurname)
+    , mkContainsFilterWithComma id    $ queryUser >>> (E.^. UserSurname)
-    , mkContainsFilterWith CI.mk $ queryUser >>> (E.^. UserDisplayEmail)
+    , mkContainsFilterWithComma CI.mk $ queryUser >>> (E.^. UserDisplayEmail)
     ]
   )
 

src/Handler/Utils/Table/Pagination.hs

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

src/Utils.hs

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

src/Utils/Set.hs

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

templates/lms.hamlet

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