fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(qualifications): supervisor page finished with sorting and infos

Browse Source
This commit is contained in:
Steffen Jost 2023-02-07 15:32:41 +01:00
parent 116764d07d
commit 6098d4554d
6 changed files with 70 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
messages/uniworx/categories/qualification/de-de-formal.msg
View File

@ -22,6 +22,7 @@ TableQualificationLastRefresh: Zuletzt erneuert
TableQualificationFirstHeld: Erstmalig TableQualificationFirstHeld: Erstmalig
TableQualificationBlockedDue: Suspendiert TableQualificationBlockedDue: Suspendiert
TableQualificationBlockedTooltip: Wann wurde die Qualifikation vorübergehend außer Kraft gesetzt und warum wurde dies veranlasst? 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 TableQualificationNoRenewal: Storniert
TableQualificationNoRenewalTooltip: Es wird keine Benachrichtigung mehr versendet, wenn diese Qualifikation ablaufen sollte. Die Qualifikation kann noch gültig sein. 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 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! 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 TableLmsEnded: Beended
TableLmsStatus: Status E-Learning 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 TableLmsSuccess: Bestanden
TableLmsFailed: Gesperrt TableLmsFailed: Gesperrt
FilterLmsValid: Aktuell gültig FilterLmsValid: Aktuell gültig

3
messages/uniworx/categories/qualification/en-eu.msg
View File

@ -22,6 +22,7 @@ TableQualificationLastRefresh: Last renewed
TableQualificationFirstHeld: First held TableQualificationFirstHeld: First held
TableQualificationBlockedDue: Suspended TableQualificationBlockedDue: Suspended
TableQualificationBlockedTooltip: Why and when was this qualification temporarily suspended? TableQualificationBlockedTooltip: Why and when was this qualification temporarily suspended?
TableQualificationBlockedTooltipSimple: When was this qualification revoked due to extraordinary reasons?
TableQualificationNoRenewal: Canceled TableQualificationNoRenewal: Canceled
TableQualificationNoRenewalTooltip: No renewal notifications will be send for this qualification upon expiry. The qualification may still be valid. TableQualificationNoRenewalTooltip: No renewal notifications will be send for this qualification upon expiry. The qualification may still be valid.
QualificationUserNoRenewal: Expires without further notification 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! 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 TableLmsEnded: Ended
TableLmsStatus: Status e-learning 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 TableLmsSuccess: Completed
TableLmsFailed: Blocked TableLmsFailed: Blocked
FilterLmsValid: Currently valid FilterLmsValid: Currently valid

16
src/Foundation/I18n.hs
View File

@ -79,6 +79,22 @@ pluralDE num singularForm pluralForm
| num == 1 = singularForm | num == 1 = singularForm
| otherwise = pluralForm | 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) noneOneMoreDE :: (Eq a, Num a)
=> a -- ^ Count => a -- ^ Count
-> Text -- ^ None -> Text -- ^ None

70
src/Handler/Qualification.hs
View File

@ -151,26 +151,26 @@ mkQualificationAllTable = do
-- postQualificationEditR = error "TODO" -- postQualificationEditR = error "TODO"
data QualificationTableCsv = QualificationTableCsv -- Q..T..C.. -> qtc.. data QualificationTableCsv = QualificationTableCsv -- Q..T..C.. -> qtc..
{ qtcDisplayName :: UserDisplayName { qtcDisplayName :: UserDisplayName
, qtcEmail :: UserEmail , qtcEmail :: UserEmail
, qtcValidUntil :: Day , qtcValidUntil :: Day
, qtcLastRefresh :: Day , qtcLastRefresh :: Day
, qtcBlocked :: Maybe Day , qtcBlocked :: Maybe Day
, qtcLmsStarted :: Maybe UTCTime , qtcLmsStatusTxt :: Maybe Text
, qtcLmsStatus :: Maybe LmsStatus , qtcLmsStatusDay :: Maybe Day
} }
deriving Generic deriving Generic
makeLenses_ ''QualificationTableCsv makeLenses_ ''QualificationTableCsv
qtcExample :: QualificationTableCsv qtcExample :: QualificationTableCsv
qtcExample = QualificationTableCsv qtcExample = QualificationTableCsv
{ qtcDisplayName = "Max Mustermann" { qtcDisplayName = "Max Mustermann"
, qtcEmail = "m.mustermann@example.com" , qtcEmail = "m.mustermann@example.com"
, qtcValidUntil = compDay , qtcValidUntil = compDay
, qtcLastRefresh = compDay , qtcLastRefresh = compDay
, qtcBlocked = Nothing , qtcBlocked = Nothing
, qtcLmsStarted = Just compTime , qtcLmsStatusTxt = Just "Success"
, qtcLmsStatus = Nothing , qtcLmsStatusDay = Just compDay
} }
where where
compTime :: UTCTime compTime :: UTCTime
@ -199,8 +199,8 @@ instance CsvColumnsExplained QualificationTableCsv where
, ('qtcEmail , MsgTableLmsEmail) , ('qtcEmail , MsgTableLmsEmail)
, ('qtcValidUntil , MsgLmsQualificationValidUntil) , ('qtcValidUntil , MsgLmsQualificationValidUntil)
, ('qtcLastRefresh, MsgTableQualificationLastRefresh) , ('qtcLastRefresh, MsgTableQualificationLastRefresh)
, ('qtcLmsStarted , MsgLmsStarted) , ('qtcLmsStatusTxt, MsgTableLmsStatus)
, ('qtcLmsStatus , MsgTableLmsStatus) , ('qtcLmsStatusDay, MsgTableLmsStatusDay)
] ]
@ -295,8 +295,10 @@ mkQualificationTable (Entity qid quali) acts cols psValidator = do
, single ("valid-until" , SortColumn $ queryQualUser >>> (E.^. QualificationUserValidUntil)) , single ("valid-until" , SortColumn $ queryQualUser >>> (E.^. QualificationUserValidUntil))
, single ("last-refresh" , SortColumn $ queryQualUser >>> (E.^. QualificationUserLastRefresh)) , single ("last-refresh" , SortColumn $ queryQualUser >>> (E.^. QualificationUserLastRefresh))
, single ("blocked-due" , SortColumn $ queryQualUser >>> (E.^. QualificationUserBlockedDue)) , single ("blocked-due" , SortColumn $ queryQualUser >>> (E.^. QualificationUserBlockedDue))
, single ("lms-started" , SortColumn $ queryLmsUser >>> (E.?. LmsUserStarted)) -- , single ("lms-started" , SortColumn $ queryLmsUser >>> (E.?. LmsUserStarted))
, single ("lms-status" , SortColumn $ views (to queryLmsUser) (E.?. LmsUserStatus)) -- , 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 dbtFilter = mconcat
[ single $ fltrUserNameEmail queryUser [ single $ fltrUserNameEmail queryUser
@ -330,11 +332,20 @@ mkQualificationTable (Entity qid quali) acts cols psValidator = do
<$> view (resultUser . _entityVal . _userDisplayName) <$> view (resultUser . _entityVal . _userDisplayName)
<*> view (resultUser . _entityVal . _userEmail) <*> view (resultUser . _entityVal . _userEmail)
<*> view (resultQualUser . _entityVal . _qualificationUserValidUntil) <*> view (resultQualUser . _entityVal . _qualificationUserValidUntil)
<*> view (resultQualUser . _entityVal . _qualificationUserLastRefresh) <*> view (resultQualUser . _entityVal . _qualificationUserLastRefresh)
-- <*> view (resultQualUser . _entityVal . _qualificationUserBlockedDue . _qualificationBlockedDay)
<*> preview (resultQualUser . _entityVal . _qualificationUserBlockedDue . _Just . _qualificationBlockedDay) <*> preview (resultQualUser . _entityVal . _qualificationUserBlockedDue . _Just . _qualificationBlockedDay)
<*> preview (resultLmsUser . _entityVal . _lmsUserStarted) <*> getStatusPlusTxt
<*> (join . preview (resultLmsUser . _entityVal . _lmsUserStatus)) <*> 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 dbtCsvDecode = Nothing
dbtExtraReps = [] dbtExtraReps = []
@ -369,7 +380,7 @@ getQualificationR = postQualificationR
postQualificationR sid qsh = do postQualificationR sid qsh = do
currentRoute <- fromMaybe (error "correctionsR called from 404-handler") <$> getCurrentRoute -- This should never be called from a 404 handler 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 ((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) let acts :: Map QualificationTableAction (AForm Handler QualificationTableActionData)
acts = mconcat acts = mconcat
[ singletonMap QualificationActExpire $ pure QualificationActExpireData [ singletonMap QualificationActExpire $ pure QualificationActExpireData
@ -381,14 +392,15 @@ postQualificationR sid qsh = do
, colUserEmail , colUserEmail
, sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \( view $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> dayCell d , 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 "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d
, sortable (Just "blocked-due") (i18nCell MsgTableQualificationBlockedDue -- & cellTooltip MsgTableQualificationBlockedTooltip , sortable (Just "blocked-due") (i18nCell MsgTableQualificationBlockedDue & cellTooltip MsgTableQualificationBlockedTooltipSimple
) $ \( view $ resultQualUser . _entityVal . _qualificationUserBlockedDue -> d) -> foldMap (dayCell . qualificationBlockedDay) d ) $ \( view $ resultQualUser . _entityVal . _qualificationUserBlockedDue -> b) -> qualificationBlockedCellNoReason b
, 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 ) $ \( view $ resultQualUser . _entityVal . _qualificationUserScheduleRenewal -> b) -> ifIconCell (not b) IconNoNotification
, sortable (Just "lms-started") (i18nCell MsgTableLmsElearning <> spacerCell <> i18nCell MsgTableLmsStarted) -- , sortable (Just "lms-started") (i18nCell MsgTableLmsElearning <> spacerCell <> i18nCell MsgTableLmsStarted)
$ \(preview $ resultLmsUser . _entityVal . _lmsUserStarted -> d) -> foldMap dateTimeCell d -- $ \(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") (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-status-plus")(i18nCell MsgTableLmsStatus & cellTooltip (MsgTableLmsStatusTooltip auditMonths))
$ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap lmsStatusPlusCell lu
] ]
psValidator = def psValidator = def
tbl <- mkQualificationTable qent acts colChoices psValidator tbl <- mkQualificationTable qent acts colChoices psValidator

5
src/Handler/Utils/Table/Cells.hs
View File

@ -345,6 +345,11 @@ lmsStatusPlusCell :: IsDBTable m a => LmsUser -> DBCell m a
lmsStatusPlusCell LmsUser{lmsUserStatus=Just lStat} = lmsStatusCell lStat lmsStatusPlusCell LmsUser{lmsUserStatus=Just lStat} = lmsStatusCell lStat
lmsStatusPlusCell LmsUser{lmsUserStarted} = iconCell IconWaitingForUser <> spacerCell <> dateCell lmsUserStarted 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 :: IsDBTable m a => Maybe QualificationBlocked -> DBCell m a
qualificationBlockedCell Nothing = mempty qualificationBlockedCell Nothing = mempty
qualificationBlockedCell (Just QualificationBlocked{..}) qualificationBlockedCell (Just QualificationBlocked{..})

4
test/Database/Fill.hs
View File

@ -525,13 +525,13 @@ fillDb = do
void . insert' $ UserFunction jost avn SchoolAdmin void . insert' $ UserFunction jost avn SchoolAdmin
void . insert' $ UserFunction gkleen ifi SchoolAdmin void . insert' $ UserFunction gkleen ifi SchoolAdmin
void . insert' $ UserFunction gkleen mi 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 ifi SchoolAdmin
void . insert' $ UserFunction jost mi SchoolAdmin void . insert' $ UserFunction jost mi SchoolAdmin
void . insert' $ UserFunction svaupel ifi SchoolAdmin void . insert' $ UserFunction svaupel ifi SchoolAdmin
void . insert' $ UserFunction svaupel mi SchoolAdmin void . insert' $ UserFunction svaupel mi SchoolAdmin
void . insert' $ UserFunction gkleen ifi SchoolLecturer 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 jost ifi SchoolLecturer
void . insert' $ UserFunction svaupel ifi SchoolLecturer void . insert' $ UserFunction svaupel ifi SchoolLecturer
void . insert' $ UserFunction sbarth ifi SchoolLecturer void . insert' $ UserFunction sbarth ifi SchoolLecturer