chore(lms): filtering qualfication overview
This commit is contained in:
Steffen Jost
parent
7cacb78f01
commit
3d546c9e82
@ -19,9 +19,14 @@ TableLmsPin: E-Lernen Pin
|
||||
TableLmsResetPin: Pin zurücksetzen?
|
||||
TableLmsDelete: Löschen?
|
||||
TableLmsStaff: Interner Mitarbeiter?
|
||||
TableLmsReceived: Erhalten
|
||||
TableLmsStarted: Begonnen
|
||||
TableLmsReceived: Letzte Rückmeldung
|
||||
TableLmsEnded: Beended
|
||||
TableLmsStatus: Status E-Lernen
|
||||
TableLmsSuccess: Bestanden
|
||||
TableLmsFailed: Gesperrt
|
||||
FilterLmsValid: Aktuell gültig
|
||||
FilterLmsRenewal: Erneuerung anstehend
|
||||
CsvColumnLmsIdent: E-Lernen Identifikator, einzigartig pro Qualifikation und Teilnehmer
|
||||
CsvColumnLmsPin: PIN des E-Lernen Zugangs
|
||||
CsvColumnLmsResetPin: Wird die PIN bei der nächsten Synchronisation zurückgesetzt?
|
||||
|
||||
@ -19,9 +19,14 @@ TableLmsElearning: E-learning
|
||||
TableLmsResetPin: Reset pin?
|
||||
TableLmsDelete: Delete?
|
||||
TableLmsStaff: Staff?
|
||||
TableLmsReceived: Received
|
||||
TableLmsStarted: Started
|
||||
TableLmsReceived: Last received
|
||||
TableLmsEnded: Ended
|
||||
TableLmsStatus: Status e-learning
|
||||
TableLmsSuccess: Completed
|
||||
TableLmsFailed: Blocked
|
||||
FilterLmsValid: Currently valid
|
||||
FilterLmsRenewal: Renewal due
|
||||
CsvColumnLmsIdent: E-learning identifier, unique for each qualfication and user
|
||||
CsvColumnLmsPin: PIN for e-learning access
|
||||
CsvColumnLmsResetPin: Will the e-learning PIN be reset upon next synchronisation?
|
||||
|
||||
@ -19,7 +19,7 @@ import Import
|
||||
|
||||
import Handler.Utils
|
||||
-- import Handler.Utils.Csv
|
||||
import Handler.Utils.LMS
|
||||
-- import Handler.Utils.LMS
|
||||
|
||||
import qualified Data.Map as Map
|
||||
-- import qualified Data.Csv as Csv
|
||||
@ -166,9 +166,12 @@ instance HasEntity LmsTableData User where
|
||||
instance HasUser LmsTableData where
|
||||
hasUser = resultUser . _entityVal
|
||||
|
||||
mkLmsTable :: QualificationId -> DB (Any, Widget)
|
||||
mkLmsTable qid = do
|
||||
mkLmsTable :: Entity Qualification -> DB (Any, Widget)
|
||||
mkLmsTable (Entity qid quali) = do
|
||||
now <- liftIO getCurrentTime
|
||||
let
|
||||
nowaday = utctDay now
|
||||
mbRenewal = addGregorianDurationClip <$> qualificationRefreshWithin quali <*> Just nowaday
|
||||
resultDBTable = DBTable{..}
|
||||
where
|
||||
dbtSQLQuery = runReaderT $ do
|
||||
@ -190,21 +193,34 @@ mkLmsTable qid = do
|
||||
, sortable (Just "valid-until") (i18nCell MsgTableQualificationValidUntil) $ \( 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 csvLmsIdent) (i18nCell MsgTableLmsIdent) $ \(preview $ resultLmsUser . _entityVal . _lmsUserIdent . _getLmsIdent -> lid) -> foldMap textCell lid
|
||||
, sortable (Just csvLmsSuccess) (i18nCell MsgTableLmsSuccess) $ \(preview $ resultLmsUser . _entityVal . _lmsUserStatus -> status) -> foldMap lmsStatusCell $ join status
|
||||
] -- TODO: add more columns for manual debugging view !!!
|
||||
, 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
|
||||
, sortable (Just "lms-received") (i18nLms MsgTableLmsReceived) $ \(preview $ resultLmsUser . _entityVal . _lmsUserReceived -> d) -> foldMap dateTimeCell $ join d
|
||||
, sortable (Just "lms-ended") (i18nLms MsgTableLmsEnded) $ \(preview $ resultLmsUser . _entityVal . _lmsUserEnded -> d) -> foldMap dateTimeCell $ join d
|
||||
]
|
||||
where
|
||||
i18nLms :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a
|
||||
i18nLms msg = cell [whamlet|LMS #|] <> i18nCell msg
|
||||
dbtSorting = mconcat
|
||||
[ single $ sortUserNameLink queryUser
|
||||
, single $ sortUserEmail queryUser
|
||||
, single ("valid-until" , SortColumn $ queryQualUser >>> (E.^. QualificationUserValidUntil))
|
||||
, single ("last-refresh", SortColumn $ queryQualUser >>> (E.^. QualificationUserLastRefresh))
|
||||
, single ("first-held" , SortColumn $ queryQualUser >>> (E.^. QualificationUserFirstHeld))
|
||||
-- , single (csvLmsIdent , SortColumn $ queryLmsUser >>> (E.?. LmsResultIdent))
|
||||
-- , (csvLmsSuccess, SortColumn $ queryLmsResult >>> (E.^. LmsResultSuccess))
|
||||
-- , (csvLmsSuccess, SortColumn $ views (to queryLmsResult) (E.^. LmsResultSuccess))
|
||||
, single ("lms-ident" , SortColumn $ queryLmsUser >>> (E.?. LmsUserIdent))
|
||||
, single ("lms-status" , SortColumn $ views (to queryLmsUser) (E.?. LmsUserStatus))
|
||||
, single ("lms-started" , SortColumn $ queryLmsUser >>> (E.?. LmsUserStarted))
|
||||
, single ("lms-received", SortColumn $ queryLmsUser >>> (E.?. LmsUserReceived))
|
||||
, single ("lms-ended" , SortColumn $ queryLmsUser >>> (E.?. LmsUserEnded))
|
||||
]
|
||||
dbtFilter = mconcat
|
||||
[ single $ fltrUserNameEmail queryUser
|
||||
, single ("lms-ident" , FilterColumn . E.mkContainsFilterWith (Just . LmsIdent) $ views (to queryLmsUser) (E.?. LmsUserIdent))
|
||||
, single ("validity" , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) ((E.>=. E.val nowaday) . (E.^. QualificationUserValidUntil)))
|
||||
, maybe mempty (\renewal ->
|
||||
single ("renewal-due" , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) ((E.<=. E.val renewal) . E.just . (E.^. QualificationUserValidUntil))))
|
||||
mbRenewal
|
||||
-- , single $ fltrUserNameEmail queryUser
|
||||
--("user" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryUser) (E.^. UserDisplayName))
|
||||
-- , ("email" , FilterColumn . E.mkContainsFilterWith Just $ views (to queryUser) (E.^. UserEmail))
|
||||
@ -213,10 +229,13 @@ mkLmsTable qid = do
|
||||
]
|
||||
dbtFilterUI mPrev = mconcat
|
||||
[ fltrUserNameEmailHdrUI MsgTableLmsUser mPrev
|
||||
, prismAForm (singletonFilter "lms-ident" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent)
|
||||
, prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid)
|
||||
, if isNothing mbRenewal then mempty
|
||||
else prismAForm (singletonFilter "renewal-due" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgFilterLmsRenewal)
|
||||
-- , fltrUserNameEmailUI mPrev
|
||||
-- prismAForm (singletonFilter "user" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsUser)
|
||||
--, prismAForm (singletonFilter "email" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableEmail)
|
||||
-- , prismAForm (singletonFilter csvLmsIdent . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent)
|
||||
-- , prismAForm (singletonFilter csvLmsSuccess . maybePrism _PathPiece) mPrev $ aopt (hoistField lift checkBoxField) (fslI MsgTableLmsSuccess)
|
||||
]
|
||||
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
|
||||
@ -228,15 +247,15 @@ mkLmsTable qid = do
|
||||
dbtExtraReps = []
|
||||
|
||||
resultDBTableValidator = def
|
||||
& defaultSorting [SortAscBy csvLmsIdent]
|
||||
-- & defaultSorting [SortAscBy csvLmsIdent]
|
||||
dbTable resultDBTableValidator resultDBTable
|
||||
|
||||
getLmsR, postLmsR :: SchoolId -> QualificationShorthand -> Handler Html
|
||||
getLmsR = postLmsR
|
||||
postLmsR sid qsh = do
|
||||
(lmsTable, quali) <- runDB $ do
|
||||
Entity qid quali <- getBy404 $ SchoolQualificationShort sid qsh
|
||||
tbl <- view _2 <$> mkLmsTable qid
|
||||
qent@(Entity _qid quali) <- getBy404 $ SchoolQualificationShort sid qsh
|
||||
tbl <- view _2 <$> mkLmsTable qent
|
||||
return (tbl, quali)
|
||||
let heading = citext2widget $ qualificationName quali
|
||||
siteLayout heading $ do
|
||||
|
||||
@ -299,7 +299,7 @@ cryptoidCell :: (IsDBTable m a, PathPiece cid) => cid -> DBCell m a
|
||||
cryptoidCell = addCellClass ("cryptoid" :: Text) . textCell . toPathPiece
|
||||
|
||||
lmsStatusCell :: IsDBTable m a => LmsStatus -> DBCell m a
|
||||
lmsStatusCell ls = iconCell ic <> dayCell (lmsStatusDay ls)
|
||||
lmsStatusCell ls = iconCell ic <> spacerCell <> dayCell (lmsStatusDay ls)
|
||||
where
|
||||
ic | isLmsSuccess ls = IconOK
|
||||
| otherwise = IconNotOK
|
||||
@ -468,6 +468,7 @@ fillDb = do
|
||||
void . insert' $ QualificationUser gkleen qid_f (n_day $ -3) (n_day $ -4) (n_day $ -20)
|
||||
void . insert' $ QualificationUser maxMuster qid_f (n_day 0) (n_day $ -2) (n_day $ -8)
|
||||
void . insert' $ QualificationUser svaupel qid_f (n_day 1) (n_day $ -1) (n_day $ -2)
|
||||
void . insert' $ QualificationUser sbarth qid_f (n_day 400) (n_day $ -40) (n_day $ -1200)
|
||||
void . insert' $ QualificationUser gkleen qid_r (n_day $ -7) (n_day $ -2) (n_day $ -9)
|
||||
void . insert' $ QualificationUser maxMuster qid_r (n_day 1) (n_day $ -1) (n_day $ -2)
|
||||
void . insert' $ QualificationUser fhamann qid_r (n_day $ -3) (n_day $ -1) (n_day $ -2)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user