diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 38273c400..09a7067c1 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -274,6 +274,7 @@ DateFormat: Datumsformat TimeFormat: Uhrzeitformat DownloadFiles: Dateien automatisch herunterladen DownloadFilesTip: Wenn gesetzt werden Dateien von Abgaben und Übungsblättern automatisch als Download behandelt, ansonsten ist das Verhalten browserabhängig (es können z.B. PDFs im Browser geöffnet werden). +NotificationSettings: Erwünschte Benachrichtigungen InvalidDateTimeFormat: Ungültiges Datums- und Zeitformat, JJJJ-MM-TTTHH:MM[:SS] Format erwartet AmbiguousUTCTime: Der angegebene Zeitpunkt lässt sich nicht eindeutig zu UTC konvertieren @@ -320,8 +321,8 @@ MailTestDateTime: Test der Datumsformattierung: German: Deutsch GermanGermany: Deutsch (Deutschland) -MailSubjectSubmissionRated csh@CourseShorthand: Ihre #{csh}-Abgabe wurde bewertet -MailSubmissionRatedIntro courseName@Text termDesc@Text: Ihre Abgabe im Kurs #{courseName} (#{termDesc}) wurde bewertet. +MailSubjectSubmissionRated csh@CourseShorthand: Ihre #{csh}-Abgabe wurde korrigiert +MailSubmissionRatedIntro courseName@Text termDesc@Text: Ihre Abgabe im Kurs #{courseName} (#{termDesc}) wurde korrigiert. MailSubjectSheetActive csh@CourseShorthand sheetName@SheetName: #{sheetName} in #{csh} wurde herausgegeben MailSheetActiveIntro courseName@Text termDesc@Text sheetName@SheetName: Sie können nun #{sheetName} im Kurs #{courseName} (#{termDesc}) herunterladen. @@ -347,4 +348,9 @@ SheetGroupRegisteredGroups: Registrierte Gruppen SheetGroupNoGroups: Keine Gruppenabgabe SheetGroupMaxGroupsize: Maximale Gruppengröße -SheetFiles: Übungsblatt-Dateien \ No newline at end of file +SheetFiles: Übungsblatt-Dateien + +NotificationTriggerSubmissionRatedGraded: Meine Abgabe in einem gewerteten Übungsblatt wurde korrigiert +NotificationTriggerSubmissionRated: Meine Abgabe wurde korrigiert +NotificationTriggerSheetActive: Ich kann ein neues Übungsblatt herunterladen +NotificationTriggerSheetInactive: Ich kann ein Übungsblatt bald nicht mehr abgeben \ No newline at end of file diff --git a/src/Foundation.hs b/src/Foundation.hs index 60bb47215..e68f2d310 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -89,6 +89,8 @@ import qualified Data.Yaml as Yaml import Text.Shakespeare.Text (st) +import Yesod.Form.I18n.German + instance DisplayAble b => DisplayAble (E.CryptoID a b) where display = display . ciphertext @@ -180,7 +182,8 @@ mkMessageVariant "UniWorX" "PWHash" "messages/pw-hash" "de" -- This instance is required to use forms. You can modify renderMessage to -- achieve customized and internationalized form validation messages. instance RenderMessage UniWorX FormMessage where - renderMessage _ _ = defaultFormMessage + renderMessage f (l:ls) = renderMessage f ls -- TODO + renderMessage _ [] = germanFormMessage instance RenderMessage UniWorX TermIdentifier where renderMessage foundation ls TermIdentifier{..} = case season of @@ -189,10 +192,9 @@ instance RenderMessage UniWorX TermIdentifier where where renderMessage' = renderMessage foundation ls instance RenderMessage UniWorX StudyFieldType where - renderMessage foundation ls = \case - FieldPrimary -> renderMessage' MsgFieldPrimary - FieldSecondary -> renderMessage' MsgFieldSecondary - where renderMessage' = renderMessage foundation ls + renderMessage foundation ls = renderMessage foundation ls . \case + FieldPrimary -> MsgFieldPrimary + FieldSecondary -> MsgFieldSecondary newtype ShortTermIdentifier = ShortTermIdentifier TermIdentifier deriving (Eq, Ord, Read, Show) @@ -207,35 +209,31 @@ instance RenderMessage UniWorX String where renderMessage f ls str = renderMessage f ls $ Text.pack str instance RenderMessage UniWorX SheetFileType where - renderMessage foundation ls = \case - SheetExercise -> renderMessage' MsgSheetExercise - SheetHint -> renderMessage' MsgSheetHint - SheetSolution -> renderMessage' MsgSheetSolution - SheetMarking -> renderMessage' MsgSheetMarking - where renderMessage' = renderMessage foundation ls + renderMessage foundation ls = renderMessage foundation ls . \case + SheetExercise -> MsgSheetExercise + SheetHint -> MsgSheetHint + SheetSolution -> MsgSheetSolution + SheetMarking -> MsgSheetMarking instance RenderMessage UniWorX CorrectorState where - renderMessage foundation ls = \case - CorrectorNormal -> renderMessage' MsgCorrectorNormal - CorrectorMissing -> renderMessage' MsgCorrectorMissing - CorrectorExcused -> renderMessage' MsgCorrectorExcused - where renderMessage' = renderMessage foundation ls + renderMessage foundation ls = renderMessage foundation ls . \case + CorrectorNormal -> MsgCorrectorNormal + CorrectorMissing -> MsgCorrectorMissing + CorrectorExcused -> MsgCorrectorExcused instance RenderMessage UniWorX Load where - renderMessage foundation ls = \case - (Load {byTutorial=Nothing , byProportion=p}) -> renderMessage' $ MsgCorByProportionOnly p - (Load {byTutorial=Just True , byProportion=p}) -> renderMessage' $ MsgCorByProportionIncludingTutorial p - (Load {byTutorial=Just False, byProportion=p}) -> renderMessage' $ MsgCorByProportionExcludingTutorial p - where renderMessage' = renderMessage foundation ls + renderMessage foundation ls = renderMessage foundation ls . \case + (Load {byTutorial=Nothing , byProportion=p}) -> MsgCorByProportionOnly p + (Load {byTutorial=Just True , byProportion=p}) -> MsgCorByProportionIncludingTutorial p + (Load {byTutorial=Just False, byProportion=p}) -> MsgCorByProportionExcludingTutorial p instance RenderMessage UniWorX SheetType where - renderMessage foundation ls = \case - Bonus{..} -> renderMessage' $ MsgSheetTypeBonus' maxPoints - Normal{..} -> renderMessage' $ MsgSheetTypeNormal' maxPoints - Pass{..} -> renderMessage' $ MsgSheetTypePass' maxPoints passingPoints - NotGraded{} -> renderMessage' MsgSheetTypeNotGraded' - where renderMessage' = renderMessage foundation ls + renderMessage foundation ls = renderMessage foundation ls . \case + Bonus{..} -> MsgSheetTypeBonus' maxPoints + Normal{..} -> MsgSheetTypeNormal' maxPoints + Pass{..} -> MsgSheetTypePass' maxPoints passingPoints + NotGraded{} -> MsgSheetTypeNotGraded' newtype MsgLanguage = MsgLanguage Lang deriving (Eq, Ord, Show, Read) @@ -246,6 +244,13 @@ instance RenderMessage UniWorX MsgLanguage where where mr = renderMessage foundation ls +instance RenderMessage UniWorX NotificationTrigger where + renderMessage foundation ls = renderMessage foundation ls . \case + NTSubmissionRatedGraded -> MsgNotificationTriggerSubmissionRatedGraded + NTSubmissionRated -> MsgNotificationTriggerSubmissionRated + NTSheetActive -> MsgNotificationTriggerSheetActive + NTSheetInactive -> MsgNotificationTriggerSheetInactive + instance RenderMessage UniWorX (UnsupportedAuthPredicate (Route UniWorX)) where renderMessage f ls (UnsupportedAuthPredicate tag route) = renderMessage f ls $ MsgUnsupportedAuthPredicate tag (show route) diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index ddd2cbe9c..3761df6af 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -24,6 +24,8 @@ import Utils.Lens -- import Yesod.Colonnade import Data.Monoid (Any(..)) import qualified Data.Map as Map +import Data.Map ((!)) +import qualified Data.Set as Set -- import qualified Data.Set as Set import qualified Database.Esqueleto as E -- import Database.Esqueleto ((^.)) @@ -37,6 +39,7 @@ data SettingsForm = SettingsForm , stgDate :: DateTimeFormat , stgTime :: DateTimeFormat , stgDownloadFiles :: Bool + , stgNotificationSettings :: NotificationSettings } makeSettingForm :: Maybe SettingsForm -> Form SettingsForm @@ -53,13 +56,30 @@ makeSettingForm template = identForm FIDsettings $ \html -> do <*> areq checkBoxField (fslI MsgDownloadFiles & setTooltip MsgDownloadFilesTip ) (stgDownloadFiles <$> template) + <*> formToAForm (nsFieldView =<< renderAForm FormStandard nsForm mempty) <* submitButton return (result, widget) -- no validation required here + where + nsForm = fmap (\m -> NotificationSettings $ \nt -> m ! nt) . sequenceA . flip Map.fromSet (Set.fromList universeF) $ \nt -> + areq checkBoxField (fslI nt) (flip notificationAllowed nt . stgNotificationSettings <$> template) + nsFieldView :: (FormResult NotificationSettings, Widget) -> MForm Handler (FormResult NotificationSettings, [FieldView UniWorX]) + nsFieldView (res, fvInput) = do + mr <- getMessageRender + let fvLabel = toHtml $ mr MsgNotificationSettings + fvTooltip = mempty + fvRequired = True + fvErrors + | FormFailure (err:_) <- res = Just $ toHtml err + | otherwise = Nothing + fvId <- newIdent + return (res, pure FieldView{..}) + -- areq nsField (fslI MsgNotificationSettings) (stgNotficationSettings <$> template) -getProfileR :: Handler Html -getProfileR = do +getProfileR, postProfileR :: Handler Html +getProfileR = postProfileR +postProfileR = do (uid, User{..}) <- requireAuthPair let settingsTemplate = Just $ SettingsForm { stgMaxFavourties = userMaxFavourites @@ -68,6 +88,7 @@ getProfileR = do , stgDate = userDateFormat , stgTime = userTimeFormat , stgDownloadFiles = userDownloadFiles + , stgNotificationSettings = userNotificationSettings } ((res,formWidget), formEnctype) <- runFormPost $ makeSettingForm settingsTemplate case res of @@ -79,6 +100,7 @@ getProfileR = do , UserDateFormat =. stgDate , UserTimeFormat =. stgTime , UserDownloadFiles =. stgDownloadFiles + , UserNotificationSettings =. stgNotificationSettings ] when (stgMaxFavourties < userMaxFavourites) $ do -- prune Favourites to user-defined size @@ -135,11 +157,6 @@ getProfileR = do $(widgetFile "profile") $(widgetFile "dsgvDisclaimer") -postProfileR :: Handler Html -postProfileR = do - -- TODO - getProfileR - postProfileDataR :: Handler Html postProfileDataR = do (uid, User{..}) <- requireAuthPair diff --git a/src/Jobs.hs b/src/Jobs.hs index cdc14d86d..5008b0e35 100644 --- a/src/Jobs.hs +++ b/src/Jobs.hs @@ -468,7 +468,7 @@ performJob JobSendNotification{ jNotification = NotificationSubmissionRated{..}, addAlternatives $ do provideAlternative $ Aeson.object [ "submission" Aeson..= ciphertext csid - , "submission-rating-points" Aeson..= submissionRatingPoints + , "submission-rating-points" Aeson..= (guard (sheetType /= NotGraded) *> submissionRatingPoints) , "submission-rating-comment" Aeson..= submissionRatingComment , "submission-rating-time" Aeson..= submissionRatingTime , "submission-rating-by" Aeson..= (userDisplayName <$> corrector)