chore(lms): clean learner icons and sorting

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

@@ -66,7 +66,7 @@ TableLmsResetTries: E‑Learning Versuche zurücksetzen
 LmsStatusBlocked: Durchgefallen wegen zu vieler Fehlversuche
 LmsStatusExpired: Durchgefallen nach Fristablauf
 LmsStatusSuccess: E#{nonBreakableDash}Learning bestanden
-LmsStatusPlanned: E#{nonBreakableDash}Learning wird gerade eröffnet (nur für Admin sichtbar)
+LmsStatusPlanned: E#{nonBreakableDash}Learning wird gerade noch eröffnet (nur für Admin sichtbar)
 LmsStatusDelay: Hinweis: Statusänderung können in seltenen Fällen mehrere Stunden bis zur Anzeige benötigen.
 FilterLmsValid: Aktuell gültig
 FilterLmsRenewal: Erneuerung anstehend

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

@@ -66,7 +66,7 @@ TableLmsResetTries: Reset e‑learning attempts
 LmsStatusBlocked: Failed after too many attempts
 LmsStatusExpired: Failed due to expiry
 LmsStatusSuccess: Passed
-LmsStatusPlanned: E#{nonBreakableDash}learning is about to be opened (visible to Admins only)
+LmsStatusPlanned: E#{nonBreakableDash}learning is about to be opened soon (visible to Admins only)
 LmsStatusDelay: Note that status changes may occassionaly require more than a hour to be displayed here.
 FilterLmsValid: Currently valid
 FilterLmsRenewal: Renewal due

src/Handler/LMS/Learners.hs

@@ -105,20 +105,23 @@ mkUserTable _sid qsh qid = do
         dbtRowKey = (E.^. LmsUserId)
         dbtProj = dbtProjId
         dbtColonnade = dbColonnade $ mconcat
-          [ sortable (Just csvLmsIdent)     (i18nCell MsgTableLmsIdent)    $ \(view $ _dbrOutput . _entityVal . _lmsUserIdent . _getLmsIdent -> ident) -> textCell ident
+          [ sortable (Just csvLmsIdent)     (i18nCell MsgTableLmsIdent)      $ \(view $ _dbrOutput . _entityVal . _lmsUserIdent . _getLmsIdent -> ident) -> textCell ident
           , sortable (Just csvLmsPin)       (i18nCell MsgTableLmsPin & cellAttrs <>~ [("uw-hide-column-default-hidden",mempty)]
-                                                                         ) $ \(view $ _dbrOutput . _entityVal . _lmsUserPin                  -> pin  ) -> textCell pin
+                                                                         )   $ \(view $ _dbrOutput . _entityVal . _lmsUserPin                  -> pin  ) -> textCell pin
-          , sortable (Just csvLmsResetPin)  (i18nCell MsgTableLmsResetPin) $ \(view $ _dbrOutput . _entityVal . _lmsUserResetPin             -> reset) -> ifIconCell reset IconReset
+          , sortable (Just csvLmsResetPin)  (i18nCell MsgTableLmsResetPin)   $ \(view $ _dbrOutput . _entityVal . _lmsUserResetPin             -> reset) -> ifIconCell reset IconReset
-          , sortable (Just csvLmsDelete)    (i18nCell MsgTableLmsDelete)   $ \(view $ _dbrOutput . _entityVal . _lmsUserToDelete cutoff           -> del  ) -> ifIconCell del   IconRemoveUser
+          , sortable (Just csvLmsDelete)    (i18nCell MsgTableLmsDelete)     $ \(view $ _dbrOutput . _entityVal . _lmsUserToDelete cutoff      -> del  ) -> ifIconCell del   IconRemoveUser
-          , sortable Nothing                (i18nCell MsgTableLmsStaff)       $ \(view $ _dbrOutput . _entityVal -> lu) -> iconBoolCell (lmsUserStaff lu)
+          , sortable Nothing                (i18nCell MsgTableLmsStaff)      $ \(view $ _dbrOutput . _entityVal . _lmsUserStaff                -> staff) -> ifIconCell staff IconOK
-          , sortable Nothing                (i18nCell MsgTableLmsResetTries)  $ \(view $ _dbrOutput . _entityVal -> lu) -> iconBoolCell (lmsUserToResetTries lu)
+          , sortable (Just csvLmsResetTries)(i18nCell MsgTableLmsResetTries) $ \(view $ _dbrOutput . _entityVal . _lmsUserToResetTries         -> reset) -> ifIconCell reset IconResetTries
-          , sortable Nothing                (i18nCell MsgTableLmsLock)        $ \(view $ _dbrOutput . _entityVal -> lu) -> ifIconCell   (lmsUserToLock lu) IconLocked
+          , sortable (Just csvLmsLock)      (i18nCell MsgTableLmsLock)       $ \(view $ _dbrOutput . _entityVal . _lmsUserToLock               -> lock ) -> ifIconCell lock  IconLocked
           ]
         dbtSorting = Map.fromList
-          [ (csvLmsIdent    , SortColumn (E.^. LmsUserIdent))
+          [ (csvLmsIdent      , SortColumn (E.^. LmsUserIdent))
-          , (csvLmsPin      , SortColumn (E.^. LmsUserPin))
+          , (csvLmsPin        , SortColumn (E.^. LmsUserPin))
-          , (csvLmsResetPin , SortColumn (E.^. LmsUserResetPin))
+          , (csvLmsResetPin   , SortColumn (E.^. LmsUserResetPin))
-          , (csvLmsDelete   , SortColumn (lmsUserToDeleteExpr cutoff))
+          , (csvLmsDelete     , SortColumn (lmsUserToDeleteExpr cutoff))
+          -- , (csvLmsStaff   , E.false) -- currently always false
+          , (csvLmsResetTries , SortColumn lmsUserToResetTriesExpr)
+          , (csvLmsLock       , SortColumn lmsUserToLockExpr)
           ]
         dbtFilter = Map.fromList
           [ (csvLmsIdent    , FilterColumn $ E.mkContainsFilterWith LmsIdent (E.^. LmsUserIdent ))
@@ -160,8 +163,8 @@ getLmsLearnersR sid qsh = do
   lmsTable <- runDB $ do
     qid <- getKeyBy404 $ SchoolQualificationShort sid qsh
     view _2 <$> mkUserTable sid qsh qid
-  siteLayoutMsg MsgMenuLmsUsers $ do
+  siteLayoutMsg MsgMenuLmsLearners $ do
-    setTitleI MsgMenuLmsUsers
+    setTitleI MsgMenuLmsLearners
     lmsTable
 
 getLmsLearnersDirectR :: SchoolId -> QualificationShorthand -> Handler TypedContent

src/Handler/Utils/LMS.hs

@@ -23,11 +23,10 @@ module Handler.Utils.LMS
   , csvFilenameLmsResult
   , csvFilenameLmsReport
   , lmsDeletionDate
-  , lmsUserToDelete, _lmsUserToDelete
+  , lmsUserToDelete     , _lmsUserToDelete      , lmsUserToDeleteExpr
-  , lmsUserToDeleteExpr
+  , lmsUserToResetTries , _lmsUserToResetTries  , lmsUserToResetTriesExpr
-  , lmsUserToResetTries
+  , lmsUserToLock       , _lmsUserToLock        , lmsUserToLockExpr
-  , lmsUserToLock
+  , lmsUserStaff        , _lmsUserStaff
-  , lmsUserStaff
   , lmsStatusInfoCell
   , lmsStatusIcon, lmsUserStatusWidget
   , randomLMSIdent, randomLMSIdentBut
@@ -152,20 +151,35 @@ lmsUserToDelete _ _ = False
 _lmsUserToDelete :: Day -> Getter LmsUser Bool
 _lmsUserToDelete cutoff = to $ lmsUserToDelete cutoff
 
+lmsUserToResetTriesExpr :: E.SqlExpr (Entity LmsUser) -> E.SqlExpr (E.Value Bool)
+lmsUserToResetTriesExpr luser = (luser E.^. LmsUserResetTries) E.&&. (luser E.^. LmsUserLocked) E.&&.
+                                ((luser E.^. LmsUserStatus) `E.in_` E.justValList [LmsBlocked, LmsExpired])
 
 lmsUserToResetTries :: LmsUser -> Bool
 lmsUserToResetTries LmsUser{..} = lmsUserResetTries && lmsUserLocked &&
                                   (lmsUserStatus == Just LmsBlocked || lmsUserStatus == Just LmsExpired)
                                   -- only reset blocked learners
 
+_lmsUserToResetTries :: Getter LmsUser Bool
+_lmsUserToResetTries = to lmsUserToResetTries
+
 -- | Answers "Should the LMS lock a user out?"
 --   Note that LmsUserLocked only logs the current LMS state, not what it should be.
+lmsUserToLockExpr :: E.SqlExpr (Entity LmsUser) -> E.SqlExpr (E.Value Bool)
+lmsUserToLockExpr luser = E.isJust (luser E.^. LmsUserStatus)
+
 lmsUserToLock :: LmsUser -> Bool
 lmsUserToLock LmsUser{..} = isJust lmsUserStatus -- only open LMS should be accessible
 
+_lmsUserToLock :: Getter LmsUser Bool
+_lmsUserToLock = to lmsUserToLock
+
 lmsUserStaff :: LmsUser -> Bool
 lmsUserStaff = const False -- legacy, currently ignored
 
+_lmsUserStaff :: Getter LmsUser Bool
+_lmsUserStaff = to lmsUserStaff
+
 -- random generation of LmsIdentifiers, maybe this should be in Model.Types.Lms since length specifications are type-y?
 
 lengthIdent :: Int
@@ -230,7 +244,7 @@ lmsStatusInfoCell extendedInfo auditMonths =
           <dd>_{MsgLmsStatusLocked}
           <dt>^{icon IconUnlocked}
           <dd>_{MsgLmsStatusUnlocked}
-          <dt>^{icon IconUndo}
+          <dt>^{icon IconResetTries}
           <dd>_{MsgLmsStatusResetTries}
     <p>
       _{MsgLmsStatusDelay}
@@ -242,34 +256,44 @@ lmsStatusIcon LmsExpired{} = IconExpired
 lmsStatusIcon _other       = IconNotOK
 
 lmsUserStatusWidget :: Bool -> LmsUser -> Widget
-lmsUserStatusWidget isAdmin luser
+lmsUserStatusWidget adminInfo luser = case luser of
-    | isAdmin   = lmsUserStatusWidgetAux isAdmin luser <> toWidget lockIcon <> toWidget resetIcon
+    LmsUser{lmsUserStatus=Just lStat, lmsUserStatusDay=mbDay} ->
-    | otherwise = lmsUserStatusWidgetAux isAdmin luser
-  where
-    lmsUserStatusWidgetAux _ LmsUser{lmsUserStatus=Just lStat, lmsUserStatusDay=Just aday} =
       [whamlet|$newline never
-        ^{formatTimeW SelFormatDate aday}
+        $maybe aday <- mbDay
+          ^{formatTimeW SelFormatDate aday}
+        $nothing
+          --.--.----
         \ ^{iconFixed (lmsStatusIcon lStat)}
+        $if adminInfo
+          \ ^{lockIcon}
+          \ ^{resetIcon}
       |]
-    -- previously: IconWaitingForUser for lmsUserStatus==Nothing
+
-    lmsUserStatusWidgetAux _ LmsUser{lmsUserNotified=Just d} =
+    LmsUser{lmsUserNotified=Just d} ->
       [whamlet|$newline never
         ^{formatTimeW SelFormatDate d}
         \ ^{iconFixed IconNotificationSent}
+        $if adminInfo
+          \ ^{lockIcon}
+          \ ^{resetIcon}
       |]
-    lmsUserStatusWidgetAux True LmsUser{lmsUserStarted} =  -- E-Learning started, but not yet notified; only intended for Admins
-      [whamlet|$newline never
-        ^{formatTimeW SelFormatDate lmsUserStarted}
-        \ ^{iconFixed IconPlanned}
-      |]
-    lmsUserStatusWidgetAux _ _ = mempty
 
+    LmsUser{lmsUserStarted=dstart} | adminInfo ->  -- E-Learning started, but not yet notified; only intended for Admins;
+      [whamlet|$newline never
+        ^{formatTimeW SelFormatDate dstart}
+        \ ^{iconFixed IconPlanned}
+        $if adminInfo
+          \ ^{resetIcon}
+      |] -- would always display Iconlocked
+    
+    _ -> mempty
+
+  where
     lockIcon
       | lmsUserLocked luser == lmsUserToLock luser = mempty
       | lmsUserLocked luser                        = iconFixed IconLocked
       | otherwise                                  = iconFixed IconUnlocked
 
     resetIcon
-      | lmsUserResetTries luser = iconFixed IconUndo
+      | lmsUserResetTries luser = iconFixed IconResetTries
       | otherwise = mempty
-

src/Utils/Icon.hs

@@ -113,7 +113,7 @@ data Icon
   | IconExpired
   | IconLocked
   | IconUnlocked
-  | IconUndo -- also see IconReset
+  | IconResetTries -- also see IconReset
   deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic)
   deriving anyclass (Universe, Finite, NFData)
 
@@ -204,7 +204,7 @@ iconText = \case
     IconExpired                 -> "hourglass-end"
     IconLocked                  -> "lock"
     IconUnlocked                -> "lock-open-alt"
-    IconUndo                    -> "trash-undo"
+    IconResetTries              -> "trash-undo"
 
 nullaryPathPiece ''Icon $ camelToPathPiece' 1
 deriveLift ''Icon