chore(lms): add field for suspending qualifications
This commit is contained in:
Steffen Jost
parent
aab9881ad4
commit
d1e81c16c6
@ -49,9 +49,9 @@ QualificationUser
|
||||
user UserId OnDeleteCascade OnUpdateCascade
|
||||
qualification QualificationId OnDeleteCascade OnUpdateCascade
|
||||
validUntil Day
|
||||
lastRefresh Day -- lastRefresh > validUntil possible, if Qualification^elearningOnly == False
|
||||
firstHeld Day -- first time the qualification was earned, should never change
|
||||
blockedDue Text Maybe -- isJust means that the qualification is currently revoked
|
||||
lastRefresh Day -- lastRefresh > validUntil possible, if Qualification^elearningOnly == False
|
||||
firstHeld Day -- first time the qualification was earned, should never change
|
||||
blockedDue QualificationBlocked Maybe -- isJust means that the qualification is currently revoked
|
||||
-- temporärer Entzug vorsehen
|
||||
-- Begründungsfeld vorsehen
|
||||
UniqueQualificationUser qualification user
|
||||
|
||||
@ -14,7 +14,7 @@ module Database.Esqueleto.Utils
|
||||
, mkExactFilter, mkExactFilterWith
|
||||
, mkExactFilterLast, mkExactFilterLastWith
|
||||
, mkContainsFilter, mkContainsFilterWith
|
||||
, mkDayFilter, mkDayBetweenFilter
|
||||
, mkDayFilter, mkDayFilterFrom, mkDayFilterTo
|
||||
, mkExistsFilter
|
||||
, anyFilter, allFilter
|
||||
, orderByList
|
||||
@ -269,12 +269,20 @@ mkDayFilter lenslike row criterias
|
||||
| otherwise = true
|
||||
|
||||
|
||||
mkDayBetweenFilter :: (t -> E.SqlExpr (E.Value UTCTime)) -- ^ getter from query to searched element
|
||||
mkDayFilterFrom :: (t -> E.SqlExpr (E.Value UTCTime)) -- ^ getter from query to searched element
|
||||
-> t -- ^ query row
|
||||
-> Last (Day,Day) -- ^ a day range to filter for
|
||||
-> Last Day -- ^ a day range to filter for
|
||||
-> E.SqlExpr (E.Value Bool)
|
||||
mkDayBetweenFilter lenslike row criterias
|
||||
| Last (Just (from,to)) <- criterias = day (lenslike row) `E.between` (E.val from, E.val to)
|
||||
mkDayFilterFrom lenslike row criterias
|
||||
| Last (Just crit) <- criterias = day (lenslike row) E.>=. E.val crit
|
||||
| otherwise = true
|
||||
|
||||
mkDayFilterTo :: (t -> E.SqlExpr (E.Value UTCTime)) -- ^ getter from query to searched element
|
||||
-> t -- ^ query row
|
||||
-> Last Day -- ^ a day range to filter for
|
||||
-> E.SqlExpr (E.Value Bool)
|
||||
mkDayFilterTo lenslike row criterias
|
||||
| Last (Just crit) <- criterias = day (lenslike row) E.<=. E.val crit
|
||||
| otherwise = true
|
||||
|
||||
|
||||
|
||||
@ -178,7 +178,7 @@ data LmsTableCsv = LmsTableCsv -- L..T..C.. -> ltc..
|
||||
, ltcValidUntil :: Day
|
||||
, ltcLastRefresh :: Day
|
||||
, ltcFirstHeld :: Day
|
||||
, ltcBlockedDue :: Maybe Text
|
||||
, ltcBlockedDue :: Maybe QualificationBlocked
|
||||
, ltcLmsIdent :: Maybe LmsIdent
|
||||
, ltcLmsStatus :: Maybe LmsStatus
|
||||
, ltcLmsStarted :: Maybe UTCTime
|
||||
@ -364,12 +364,13 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do
|
||||
E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val nowaday
|
||||
| otherwise -> E.true
|
||||
)
|
||||
, single ("lms-notified", FilterColumn $ \(view (to queryLmsUser) -> luser) criterion ->
|
||||
case getLast criterion of
|
||||
Just True -> E.isJust $ luser E.?. LmsUserNotified
|
||||
Just False -> E.isNothing $ luser E.?. LmsUserNotified
|
||||
Nothing -> E.true
|
||||
)
|
||||
, single ("lms-notified", FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) (E.isJust . (E.?. LmsUserNotified)))
|
||||
--, single ("lms-notified", FilterColumn $ \(view (to queryLmsUser) -> luser) criterion ->
|
||||
-- case getLast criterion of
|
||||
-- Just True -> E.isJust $ luser E.?. LmsUserNotified
|
||||
-- Just False -> E.isNothing $ luser E.?. LmsUserNotified
|
||||
-- Nothing -> E.true
|
||||
-- )
|
||||
]
|
||||
dbtFilterUI mPrev = mconcat
|
||||
[ fltrUserNameEmailHdrUI MsgLmsUser mPrev
|
||||
@ -458,7 +459,7 @@ postLmsR sid qsh = do
|
||||
, 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 "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \( view $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> dayCell d
|
||||
, sortable (Just "blocked-due") (i18nCell MsgTableQualificationBlockedDue) $ \( view $ resultQualUser . _entityVal . _qualificationUserBlockedDue -> t) -> foldMap textCell t
|
||||
, sortable (Just "blocked-due") (i18nCell MsgTableQualificationBlockedDue) $ \( view $ resultQualUser . _entityVal . _qualificationUserBlockedDue -> b) -> qualificationBlockedCell b
|
||||
, sortable (Just "lms-ident") (i18nLms MsgTableLmsIdent) $ \(preview $ resultLmsUser . _entityVal . _lmsUserIdent . _getLmsIdent -> lid) -> foldMap textCell lid
|
||||
, sortable (Just "lms-status") (i18nLms MsgTableLmsStatus) $ \(preview $ resultLmsUser . _entityVal . _lmsUserStatus -> status) -> foldMap lmsStatusCell $ join status
|
||||
, sortable (Just "lms-started") (i18nLms MsgTableLmsStarted) $ \(preview $ resultLmsUser . _entityVal . _lmsUserStarted -> d) -> foldMap dateTimeCell d
|
||||
|
||||
@ -315,4 +315,8 @@ lmsStatusCell :: IsDBTable m a => LmsStatus -> DBCell m a
|
||||
lmsStatusCell ls = iconCell ic <> spacerCell <> dayCell (lmsStatusDay ls)
|
||||
where
|
||||
ic | isLmsSuccess ls = IconOK
|
||||
| otherwise = IconNotOK
|
||||
| otherwise = IconNotOK
|
||||
|
||||
qualificationBlockedCell :: IsDBTable m a => Maybe QualificationBlocked -> DBCell m a
|
||||
qualificationBlockedCell Nothing = mempty
|
||||
qualificationBlockedCell (Just qb) = iconCell IconBlocked <> msgCell qb <> dayCell (qualificationBlockedDay qb)
|
||||
|
||||
@ -28,6 +28,7 @@ deriveJSON defaultOptions
|
||||
} ''LmsIdent
|
||||
|
||||
-- TODO: Is this a good idea? An ordinary Enum and a separate Day column in the DB would be better, e.g. allowing use of insertSelect in Jobs.Handler.LMS?
|
||||
-- ...also see similar type QualificationBlocked
|
||||
data LmsStatus = LmsBlocked { lmsStatusDay :: Day }
|
||||
| LmsSuccess { lmsStatusDay :: Day }
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable, NFData)
|
||||
@ -54,6 +55,28 @@ instance Csv.ToField LmsStatus where
|
||||
toField (LmsSuccess d) = "Success: " <> Csv.toField d
|
||||
|
||||
|
||||
data QualificationBlocked
|
||||
= QualificationBlockedLms { qualificationBlockedDay :: Day }
|
||||
| QualificationBlockedAvs { qualificationBlockedDay :: Day }
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable, NFData)
|
||||
|
||||
deriveJSON defaultOptions
|
||||
{ constructorTagModifier = camelToPathPiece' 1 -- remove lms from constructor, since the object is tagged with lms already
|
||||
, fieldLabelModifier = camelToPathPiece' 2 -- just day suffices for the day field
|
||||
, omitNothingFields = True
|
||||
, sumEncoding = TaggedObject "lms-status" "lms-result"
|
||||
} ''QualificationBlocked
|
||||
derivePersistFieldJSON ''QualificationBlocked
|
||||
|
||||
instance Csv.ToField QualificationBlocked where
|
||||
toField (QualificationBlockedLms d) = "Blocked by LMS: " <> Csv.toField d
|
||||
toField (QualificationBlockedAvs d) = "Blocked by AVS: " <> Csv.toField d
|
||||
|
||||
-- | ToMessage instance ignores contained timestamp
|
||||
instance ToMessage QualificationBlocked where
|
||||
toMessage (QualificationBlockedLms _) = "LMS"
|
||||
toMessage (QualificationBlockedAvs _) = "AVS"
|
||||
|
||||
-- | LMS interface requires Bool to be encoded by 0 or 1 only
|
||||
newtype LmsBool = LmsBool { lms2bool :: Bool }
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user