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

chore(lms): add lms status filter option

Browse Source
This commit is contained in:
Steffen Jost 2023-07-05 17:07:21 +00:00
parent bf8cd4fa89
commit c9efbd56f1
3 changed files with 7 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/Foundation/I18n.hs
View File

@ -248,9 +248,12 @@ mkMessageVariant ''UniWorX ''ButtonMessage "messages/button" "de"
mkMessageVariant ''UniWorX ''FrontendMessage "messages/frontend" "de-de-formal"
embedRenderMessage ''UniWorX ''AvsLicence id -- required by UniWorXAvsMessages
mkMessageAddition ''UniWorX "Qualification" "messages/uniworx/categories/qualification" "de-de-formal"
mkMessageAddition ''UniWorX "Avs" "messages/uniworx/categories/avs" "de-de-formal"
embedRenderMessage ''UniWorX ''LmsStatus (uncurry ((<>) . (<> "Status")) . Text.splitAt 3)
instance RenderMessage UniWorX AvsDataCardColor where
renderMessage _foundation _ls (AvsCardColorMisc t) = Text.cons '*' t
renderMessage f ls AvsCardColorGrün = renderMessage f ls MsgAvsCardColorGreen

4
src/Handler/LMS.hs
View File

@ -450,7 +450,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
dbtFilter = mconcat
[ single $ fltrUserNameEmail queryUser
, single ("ident" , FilterColumn . E.mkContainsFilterWith LmsIdent $ views (to queryLmsUser) (E.^. LmsUserIdent))
-- , single ("status" , FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) ((E.>=. E.val nowaday) . (E.^. LmsUserStatus))) -- LmsStatus cannot be filtered easily within the DB
, single ("status" , FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) (E.^. LmsUserStatus))
-- , single ("validity" , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) ((E.>=. E.val nowaday) . (E.^. QualificationUserValidUntil)))
, single ("validity" , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) (validQualification now))
-- , single ("renewal-due" , FilterColumn $ \(queryQualUser -> quser) criterion ->
@ -495,7 +495,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
, prismAForm (singletonFilter "ident" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableLmsIdent)
, prismAForm (singletonFilter "validity" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsValid)
, prismAForm (singletonFilter "notified" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterLmsNotified)
-- , prismAForm (singletonFilter "status" . maybePrism _PathPiece) mPrev $ aopt (selectField' (Just $ SomeMessage MsgTableNoFilter) $ return (optionsPairs [(MsgTableLmsSuccess,"success"::Text),(MsgTableLmsFailed,"blocked")])) (fslI MsgTableLmsStatus)
, prismAForm (singletonFilter "status" . maybePrism _PathPiece) mPrev $ aopt (selectField' (Just $ SomeMessage MsgTableNoFilter) optionsFinite :: Field _ LmsStatus) (fslI MsgTableLmsStatus)
-- , if isNothing mbRenewal then mempty
-- else prismAForm (singletonFilter "renewal-due" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgFilterLmsRenewal)
]

2
src/Model/Types/Lms.hs
View File

@ -40,6 +40,8 @@ data LmsStatus = LmsExpired
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, NFData)
deriving anyclass (Universe, Finite)
-- embedRenderMessage ''UniWorX ''LmsStatus (uncurry ((<>) . (<> "Status")) . Text.splitAt 3) -- neccessarily moved to Handler.Utils.Lms
deriveJSON defaultOptions
{ constructorTagModifier = camelToPathPiece' 1 -- remove lms from constructor
, fieldLabelModifier = camelToPathPiece' 1