chore(qualifications): supervisor page finished with sorting and infos
This commit is contained in:
Steffen Jost
parent
116764d07d
commit
6098d4554d
@ -22,6 +22,7 @@ TableQualificationLastRefresh: Zuletzt erneuert
|
||||
TableQualificationFirstHeld: Erstmalig
|
||||
TableQualificationBlockedDue: Suspendiert
|
||||
TableQualificationBlockedTooltip: Wann wurde die Qualifikation vorübergehend außer Kraft gesetzt und warum wurde dies veranlasst?
|
||||
TableQualificationBlockedTooltipSimple: Wann wurde die Qualifikation aus besonderem Grund wiederrufen?
|
||||
TableQualificationNoRenewal: Storniert
|
||||
TableQualificationNoRenewalTooltip: Es wird keine Benachrichtigung mehr versendet, wenn diese Qualifikation ablaufen sollte. Die Qualifikation kann noch gültig sein.
|
||||
QualificationUserNoRenewal: Läuft ohne Benachrichtigung aus
|
||||
@ -40,6 +41,8 @@ TableLmsNotified: Versand Benachrichtigung
|
||||
TableLmsNotifiedTooltip: Benachrichtigungen werden erst versendet wenn das LMS bestätigt die Eröffnung des E-Learning für den Benutzer bestätigt hat, was ein paar Stunden dauern kann!
|
||||
TableLmsEnded: Beended
|
||||
TableLmsStatus: Status E-Learning
|
||||
TableLmsStatusTooltip mbMonth@(Maybe Int): Zeigt an, seit wann ein E-Learning offen ist oder wann es mit Bestanden oder Durchgefalen abgeschlossen wurde. #{maybeToMessage "Anzeige erlischt " (fmap (flip pluralDEeN "Monat") mbMonth) " nach Abschluss."}
|
||||
TableLmsStatusDay: Datum letzte Statusänderung E-Learning
|
||||
TableLmsSuccess: Bestanden
|
||||
TableLmsFailed: Gesperrt
|
||||
FilterLmsValid: Aktuell gültig
|
||||
|
||||
@ -22,6 +22,7 @@ TableQualificationLastRefresh: Last renewed
|
||||
TableQualificationFirstHeld: First held
|
||||
TableQualificationBlockedDue: Suspended
|
||||
TableQualificationBlockedTooltip: Why and when was this qualification temporarily suspended?
|
||||
TableQualificationBlockedTooltipSimple: When was this qualification revoked due to extraordinary reasons?
|
||||
TableQualificationNoRenewal: Canceled
|
||||
TableQualificationNoRenewalTooltip: No renewal notifications will be send for this qualification upon expiry. The qualification may still be valid.
|
||||
QualificationUserNoRenewal: Expires without further notification
|
||||
@ -40,6 +41,8 @@ TableLmsNotified: Notification sent
|
||||
TableLmsNotifiedTooltip: Notfications are not sent before the LMS acknowledges the opening of the e-learning course for the user, which may take several hours!
|
||||
TableLmsEnded: Ended
|
||||
TableLmsStatus: Status e-learning
|
||||
TableLmsStatusTooltip mbMonth: Shows since when an e-learning is open or when it was closed, including the result. #{maybeToMessage "Shown for " (fmap (flip pluralENsN "month") mbMonth) " after closure."}
|
||||
TableLmsStatusDay: Date of last e-learning status change
|
||||
TableLmsSuccess: Completed
|
||||
TableLmsFailed: Blocked
|
||||
FilterLmsValid: Currently valid
|
||||
|
||||
@ -79,6 +79,22 @@ pluralDE num singularForm pluralForm
|
||||
| num == 1 = singularForm
|
||||
| otherwise = pluralForm
|
||||
|
||||
-- pluralDEx :: (Eq a, Num a) => Char -> a -> Text -> Text
|
||||
-- -- ^ @pluralENs n "Monat" = pluralEN n "Monat" "Monate"@
|
||||
-- pluralDEx c n t = pluralDE n t $ t `snoc` c
|
||||
|
||||
-- -- | like `pluralDEe` but also prefixes with the number
|
||||
-- pluralDExN :: (Eq a, Num a, Show a) => Char -> a -> Text -> Text
|
||||
-- pluralDExN c n t = tshow n <> cons ' ' (pluralDEx c n t)
|
||||
|
||||
pluralDEe :: (Eq a, Num a) => a -> Text -> Text
|
||||
-- ^ @pluralENs n "Monat" = pluralEN n "Monat" "Monate"@
|
||||
pluralDEe n t = pluralDE n t $ t `snoc` 'e'
|
||||
|
||||
-- | like `pluralDEe` but also prefixes with the number
|
||||
pluralDEeN :: (Eq a, Num a, Show a) => a -> Text -> Text
|
||||
pluralDEeN n t = tshow n <> cons ' ' (pluralDEe n t)
|
||||
|
||||
noneOneMoreDE :: (Eq a, Num a)
|
||||
=> a -- ^ Count
|
||||
-> Text -- ^ None
|
||||
|
||||
@ -151,26 +151,26 @@ mkQualificationAllTable = do
|
||||
-- postQualificationEditR = error "TODO"
|
||||
|
||||
data QualificationTableCsv = QualificationTableCsv -- Q..T..C.. -> qtc..
|
||||
{ qtcDisplayName :: UserDisplayName
|
||||
, qtcEmail :: UserEmail
|
||||
, qtcValidUntil :: Day
|
||||
, qtcLastRefresh :: Day
|
||||
, qtcBlocked :: Maybe Day
|
||||
, qtcLmsStarted :: Maybe UTCTime
|
||||
, qtcLmsStatus :: Maybe LmsStatus
|
||||
{ qtcDisplayName :: UserDisplayName
|
||||
, qtcEmail :: UserEmail
|
||||
, qtcValidUntil :: Day
|
||||
, qtcLastRefresh :: Day
|
||||
, qtcBlocked :: Maybe Day
|
||||
, qtcLmsStatusTxt :: Maybe Text
|
||||
, qtcLmsStatusDay :: Maybe Day
|
||||
}
|
||||
deriving Generic
|
||||
makeLenses_ ''QualificationTableCsv
|
||||
|
||||
qtcExample :: QualificationTableCsv
|
||||
qtcExample = QualificationTableCsv
|
||||
{ qtcDisplayName = "Max Mustermann"
|
||||
, qtcEmail = "m.mustermann@example.com"
|
||||
, qtcValidUntil = compDay
|
||||
, qtcLastRefresh = compDay
|
||||
, qtcBlocked = Nothing
|
||||
, qtcLmsStarted = Just compTime
|
||||
, qtcLmsStatus = Nothing
|
||||
{ qtcDisplayName = "Max Mustermann"
|
||||
, qtcEmail = "m.mustermann@example.com"
|
||||
, qtcValidUntil = compDay
|
||||
, qtcLastRefresh = compDay
|
||||
, qtcBlocked = Nothing
|
||||
, qtcLmsStatusTxt = Just "Success"
|
||||
, qtcLmsStatusDay = Just compDay
|
||||
}
|
||||
where
|
||||
compTime :: UTCTime
|
||||
@ -199,8 +199,8 @@ instance CsvColumnsExplained QualificationTableCsv where
|
||||
, ('qtcEmail , MsgTableLmsEmail)
|
||||
, ('qtcValidUntil , MsgLmsQualificationValidUntil)
|
||||
, ('qtcLastRefresh, MsgTableQualificationLastRefresh)
|
||||
, ('qtcLmsStarted , MsgLmsStarted)
|
||||
, ('qtcLmsStatus , MsgTableLmsStatus)
|
||||
, ('qtcLmsStatusTxt, MsgTableLmsStatus)
|
||||
, ('qtcLmsStatusDay, MsgTableLmsStatusDay)
|
||||
]
|
||||
|
||||
|
||||
@ -295,8 +295,10 @@ mkQualificationTable (Entity qid quali) acts cols psValidator = do
|
||||
, single ("valid-until" , SortColumn $ queryQualUser >>> (E.^. QualificationUserValidUntil))
|
||||
, single ("last-refresh" , SortColumn $ queryQualUser >>> (E.^. QualificationUserLastRefresh))
|
||||
, single ("blocked-due" , SortColumn $ queryQualUser >>> (E.^. QualificationUserBlockedDue))
|
||||
, single ("lms-started" , SortColumn $ queryLmsUser >>> (E.?. LmsUserStarted))
|
||||
, single ("lms-status" , SortColumn $ views (to queryLmsUser) (E.?. LmsUserStatus))
|
||||
-- , single ("lms-started" , SortColumn $ queryLmsUser >>> (E.?. LmsUserStarted))
|
||||
-- , single ("lms-status" , SortColumn $ views (to queryLmsUser) (E.?. LmsUserStatus))
|
||||
, single ("lms-status-plus",SortColumn $ \row -> E.coalesce [E.explicitUnsafeCoerceSqlExprValue "timestamp" $ (queryLmsUser row E.?. LmsUserStatus) E.#>>. "{day}"
|
||||
, queryLmsUser row E.?. LmsUserStarted])
|
||||
]
|
||||
dbtFilter = mconcat
|
||||
[ single $ fltrUserNameEmail queryUser
|
||||
@ -330,11 +332,20 @@ mkQualificationTable (Entity qid quali) acts cols psValidator = do
|
||||
<$> view (resultUser . _entityVal . _userDisplayName)
|
||||
<*> view (resultUser . _entityVal . _userEmail)
|
||||
<*> view (resultQualUser . _entityVal . _qualificationUserValidUntil)
|
||||
<*> view (resultQualUser . _entityVal . _qualificationUserLastRefresh)
|
||||
-- <*> view (resultQualUser . _entityVal . _qualificationUserBlockedDue . _qualificationBlockedDay)
|
||||
<*> view (resultQualUser . _entityVal . _qualificationUserLastRefresh)
|
||||
<*> preview (resultQualUser . _entityVal . _qualificationUserBlockedDue . _Just . _qualificationBlockedDay)
|
||||
<*> preview (resultLmsUser . _entityVal . _lmsUserStarted)
|
||||
<*> (join . preview (resultLmsUser . _entityVal . _lmsUserStatus))
|
||||
<*> getStatusPlusTxt
|
||||
<*> getStatusPlusDay
|
||||
getStatusPlusTxt =
|
||||
(join . preview (resultLmsUser . _entityVal . _lmsUserStatus)) >>= \case
|
||||
Just LmsBlocked{} -> return $ Just "Failed"
|
||||
Just LmsSuccess{} -> return $ Just "Success"
|
||||
Nothing -> maybeM (return Nothing) (const $ return $ Just "Open") $
|
||||
preview (resultLmsUser . _entityVal . _lmsUserStarted)
|
||||
getStatusPlusDay =
|
||||
(join . preview (resultLmsUser . _entityVal . _lmsUserStatus)) >>= \case
|
||||
Just ls -> return $ Just $ lmsStatusDay ls
|
||||
Nothing -> utctDay <<$>> preview (resultLmsUser . _entityVal . _lmsUserStarted)
|
||||
|
||||
dbtCsvDecode = Nothing
|
||||
dbtExtraReps = []
|
||||
@ -369,7 +380,7 @@ getQualificationR = postQualificationR
|
||||
postQualificationR sid qsh = do
|
||||
currentRoute <- fromMaybe (error "correctionsR called from 404-handler") <$> getCurrentRoute -- This should never be called from a 404 handler
|
||||
((lmsRes, qualificationTable), Entity qid quali) <- runDB $ do
|
||||
qent <- getBy404 $ SchoolQualificationShort sid qsh
|
||||
qent@Entity{entityVal=Qualification{qualificationAuditDuration=auditMonths}} <- getBy404 $ SchoolQualificationShort sid qsh
|
||||
let acts :: Map QualificationTableAction (AForm Handler QualificationTableActionData)
|
||||
acts = mconcat
|
||||
[ singletonMap QualificationActExpire $ pure QualificationActExpireData
|
||||
@ -381,14 +392,15 @@ postQualificationR sid qsh = do
|
||||
, colUserEmail
|
||||
, sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \( view $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> dayCell d
|
||||
, sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d
|
||||
, sortable (Just "blocked-due") (i18nCell MsgTableQualificationBlockedDue -- & cellTooltip MsgTableQualificationBlockedTooltip
|
||||
) $ \( view $ resultQualUser . _entityVal . _qualificationUserBlockedDue -> d) -> foldMap (dayCell . qualificationBlockedDay) d
|
||||
, sortable (Just "blocked-due") (i18nCell MsgTableQualificationBlockedDue & cellTooltip MsgTableQualificationBlockedTooltipSimple
|
||||
) $ \( view $ resultQualUser . _entityVal . _qualificationUserBlockedDue -> b) -> qualificationBlockedCellNoReason b
|
||||
, sortable (Just "schedule-renew")(i18nCell MsgTableQualificationNoRenewal & cellTooltip MsgTableQualificationNoRenewalTooltip
|
||||
) $ \( view $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> ifIconCell (not b) IconNoNotification
|
||||
, sortable (Just "lms-started") (i18nCell MsgTableLmsElearning <> spacerCell <> i18nCell MsgTableLmsStarted)
|
||||
$ \(preview $ resultLmsUser . _entityVal . _lmsUserStarted -> d) -> foldMap dateTimeCell d
|
||||
, sortable (Just "lms-status") (i18nCell MsgTableLmsStatus) $ \(preview $ resultLmsUser . _entityVal . _lmsUserStatus -> status) -> foldMap lmsStatusCell $ join status
|
||||
, sortable Nothing (i18nCell MsgTableLmsStatus) $ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap lmsStatusPlusCell lu
|
||||
-- , sortable (Just "lms-started") (i18nCell MsgTableLmsElearning <> spacerCell <> i18nCell MsgTableLmsStarted)
|
||||
-- $ \(preview $ resultLmsUser . _entityVal . _lmsUserStarted -> d) -> foldMap dateTimeCell d
|
||||
-- , sortable (Just "lms-status") (i18nCell MsgTableLmsStatus) $ \(preview $ resultLmsUser . _entityVal . _lmsUserStatus -> status) -> foldMap lmsStatusCell $ join status
|
||||
, sortable (Just "lms-status-plus")(i18nCell MsgTableLmsStatus & cellTooltip (MsgTableLmsStatusTooltip auditMonths))
|
||||
$ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap lmsStatusPlusCell lu
|
||||
]
|
||||
psValidator = def
|
||||
tbl <- mkQualificationTable qent acts colChoices psValidator
|
||||
|
||||
@ -345,6 +345,11 @@ lmsStatusPlusCell :: IsDBTable m a => LmsUser -> DBCell m a
|
||||
lmsStatusPlusCell LmsUser{lmsUserStatus=Just lStat} = lmsStatusCell lStat
|
||||
lmsStatusPlusCell LmsUser{lmsUserStarted} = iconCell IconWaitingForUser <> spacerCell <> dateCell lmsUserStarted
|
||||
|
||||
qualificationBlockedCellNoReason :: IsDBTable m a => Maybe QualificationBlocked -> DBCell m a
|
||||
qualificationBlockedCellNoReason Nothing = mempty
|
||||
qualificationBlockedCellNoReason (Just QualificationBlocked{qualificationBlockedDay=d}) =
|
||||
iconCell IconBlocked <> spacerCell <> dayCell d
|
||||
|
||||
qualificationBlockedCell :: IsDBTable m a => Maybe QualificationBlocked -> DBCell m a
|
||||
qualificationBlockedCell Nothing = mempty
|
||||
qualificationBlockedCell (Just QualificationBlocked{..})
|
||||
|
||||
@ -525,13 +525,13 @@ fillDb = do
|
||||
void . insert' $ UserFunction jost avn SchoolAdmin
|
||||
void . insert' $ UserFunction gkleen ifi SchoolAdmin
|
||||
void . insert' $ UserFunction gkleen mi SchoolAdmin
|
||||
void . insert' $ UserFunction fhamann ifi SchoolAdmin
|
||||
-- void . insert' $ UserFunction fhamann ifi SchoolAdmin -- goto-example for non-admin supervisor
|
||||
void . insert' $ UserFunction jost ifi SchoolAdmin
|
||||
void . insert' $ UserFunction jost mi SchoolAdmin
|
||||
void . insert' $ UserFunction svaupel ifi SchoolAdmin
|
||||
void . insert' $ UserFunction svaupel mi SchoolAdmin
|
||||
void . insert' $ UserFunction gkleen ifi SchoolLecturer
|
||||
void . insert' $ UserFunction fhamann ifi SchoolLecturer
|
||||
-- void . insert' $ UserFunction fhamann ifi SchoolLecturer -- goto-example for non-admin supervisor
|
||||
void . insert' $ UserFunction jost ifi SchoolLecturer
|
||||
void . insert' $ UserFunction svaupel ifi SchoolLecturer
|
||||
void . insert' $ UserFunction sbarth ifi SchoolLecturer
|
||||
|
||||
Loading…
Reference in New Issue
Block a user