diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg index 522edafb9..52e7e4c82 100644 --- a/messages/uniworx/categories/qualification/de-de-formal.msg +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -127,6 +127,7 @@ LmsActRestartWarning: Das vorhandene E‑Learning wird komplett gelöscht! Für LmsActRestartFeedback n@Int m@Int: #{n}/#{m} E‑Learning Nutzer wurden komplett neu gestartet mit neuem Login und Passwort. LmsActRestartExtend: Gültig bis ggf. erhöhen für die nächsten # Tage LmsActRestartUnblock: Entzug ggf. aufheben +LmsStateOpen: E‑Learning offen LmsStatusLocked: E‑Learning gesperrt, wird ggf. bald geöffnet LmsStatusUnlocked: E‑Learning offen, wird ggf. bald gesperrt LmsStatusResetTries: Fehlversuche werden demnächst zurückgesetzt diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg index 6cdd9c8e8..ec62d8ac6 100644 --- a/messages/uniworx/categories/qualification/en-eu.msg +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -127,8 +127,9 @@ LmsActRestartWarning: The existing e‑learning will be erased immediately! For LmsActRestartExtend: Ensure validity for the next # days LmsActRestartUnblock: Undo any revocations LmsActRestartFeedback n@Int m@Int: #{n}/#{m} e-learnings were completely restarted with new login credentials. -LmsStatusLocked: E‑Learning locked, may be opened soon -LmsStatusUnlocked: E‑Learning still open, may be locked soon +LmsStateOpen: E‑learning open +LmsStatusLocked: E‑learning locked, may be opened soon +LmsStatusUnlocked: E‑learning still open, may be locked soon LmsStatusResetTries: Failed attempts will be soon reset LmsStatusNotificationSent: E‑learning password has been sent to examinee or supervisor by letter post or by email; e‑learning is currently open LmsNotificationSend n: E‑learning notifications will be sent to #{n} #{pluralENs n "examinee"} by letter post or by email. diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index 66f23b105..207c0734d 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -20,6 +20,7 @@ module Database.Esqueleto.Utils , subSelectAnd, subSelectOr , mkExactFilter, mkExactFilterWith , mkExactFilterLast, mkExactFilterLastWith + , mkExactFilterMaybeLast , mkContainsFilter, mkContainsFilterWith , mkDayFilter, mkDayFilterFrom, mkDayFilterTo , mkExistsFilter @@ -292,9 +293,20 @@ mkExactFilterLastWith :: (PersistField b) -> Last a -- ^ needle -> E.SqlExpr (E.Value Bool) mkExactFilterLastWith cast lenslike row criterias - | Last (Just crit) <- criterias = lenslike row E.==. E.val (cast crit) + | Last (Just crit) <- criterias = lenslike row E.==. E.val (cast crit) | otherwise = true +-- | like `mkExactFilterLast` but deals with Nothing being a filter criterion as well +mkExactFilterMaybeLast :: PersistField a + => (t -> E.SqlExpr (E.Value (Maybe a))) -- ^ getter from query to searched element + -> t -- ^ query row + -> Last (Maybe a) -- ^ needle + -> E.SqlExpr (E.Value Bool) +mkExactFilterMaybeLast lenslike row criterias + | Last (Just Nothing) <- criterias = E.isNothing $ lenslike row + | Last (Just crit) <- criterias = lenslike row E.==. E.val crit + | otherwise = true + -- | generic filter creation for dbTable -- Given a lens-like function, make filter searching for needles in String-like elements -- (Keep Set here to ensure that there are no duplicates) diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs index 7b30a26a5..1271b4da4 100644 --- a/src/Foundation/I18n.hs +++ b/src/Foundation/I18n.hs @@ -254,6 +254,10 @@ mkMessageAddition ''UniWorX "Avs" "messages/uniworx/categories/avs" "de-de-forma embedRenderMessage ''UniWorX ''LmsStatus (uncurry ((<>) . (<> "Status")) . Text.splitAt 3) +instance RenderMessage UniWorX (Maybe LmsStatus) where -- useful for Filter with optionsFinite + renderMessage f ls (Just s) = renderMessage f ls s + renderMessage f ls Nothing = renderMessage f ls MsgLmsStateOpen + instance RenderMessage UniWorX AvsDataCardColor where renderMessage _foundation _ls (AvsCardColorMisc t) = Text.cons '*' t renderMessage f ls AvsCardColorGrün = renderMessage f ls MsgAvsCardColorGreen diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index 68c05a41d..dff68de66 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -473,7 +473,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.^. LmsUserStatus)) + , single ("status" , FilterColumn . E.mkExactFilterMaybeLast $ 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 -> @@ -518,7 +518,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) optionsFinite :: Field _ LmsStatus) (fslI MsgTableLmsStatus) + , prismAForm (singletonFilter "status" . maybePrism _PathPiece) mPrev $ aopt (hoistField liftHandler (selectField optionsFinite) :: (Field _ (Maybe LmsStatus))) (fslI MsgTableLmsStatus) -- , if isNothing mbRenewal then mempty -- else prismAForm (singletonFilter "renewal-due" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgFilterLmsRenewal) ] diff --git a/src/Model/Types/Lms.hs b/src/Model/Types/Lms.hs index 885c08311..ae8ae2e3c 100644 --- a/src/Model/Types/Lms.hs +++ b/src/Model/Types/Lms.hs @@ -40,7 +40,7 @@ data LmsStatus = LmsExpired | LmsSuccess deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, NFData, Universe, Finite) --- embedRenderMessage ''UniWorX ''LmsStatus (uncurry ((<>) . (<> "Status")) . Text.splitAt 3) -- neccessarily moved to Handler.Utils.Lms +-- embedRenderMessage ''UniWorX ''LmsStatus (uncurry ((<>) . (<> "Status")) . Text.splitAt 3) -- moved to src/Foundation.hs deriveJSON defaultOptions { constructorTagModifier = camelToPathPiece' 1 -- remove lms from constructor