diff --git a/.vscode/tasks.json b/.vscode/tasks.json index 6c2838596..c5f9eaf8e 100644 --- a/.vscode/tasks.json +++ b/.vscode/tasks.json @@ -6,7 +6,11 @@ { "label": "echo", "type": "shell", - "command": "echo Hello" + "command": "echo Hello", + "group": { + "kind": "build", + "isDefault": true + } } ] } \ No newline at end of file diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 2c30a1c50..a3cb7f570 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -343,9 +343,10 @@ MailSubmissionRatedIntro courseName@Text termDesc@Text: Ihre Abgabe im Kurs #{co 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. -MailSubjectSheetInactive csh@CourseShorthand sheetName@SheetName: #{sheetName} in #{csh} kann nur noch kurze Zeit abgegeben werden -MailSheetInactiveIntro courseName@Text termDesc@Text sheetName@SheetName: Dia Abgabefirst für #{sheetName} im Kurs #{courseName} (#{termDesc}) endet in Kürze. - +MailSubjectSheetSoonInactive csh@CourseShorthand sheetName@SheetName: #{sheetName} in #{csh} kann nur noch kurze Zeit abgegeben werden +MailSheetSoonInactiveIntro courseName@Text termDesc@Text sheetName@SheetName: Abgabefirst für #{sheetName} im Kurs #{courseName} (#{termDesc}) endet in Kürze. +MailSubjectSheetInactive csh@CourseShorthand sheetName@SheetName: Abgabfristt für #{sheetName} in #{csh} abgelaufen +MailSheetInactiveIntro courseName@Text termDesc@Text sheetName@SheetName: Dia Abgabefirst für #{sheetName} im Kurs #{courseName} (#{termDesc}) beendet. MailSubjectSupport: Supportanfrage SheetTypeBonus: Bonus @@ -371,7 +372,8 @@ 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 +NotificationTriggerSheetSoonInactive: Ich kann ein Übungsblatt bald nicht mehr abgeben +NotificationTriggerSheetInactive: Abgabefrist eines meiner Übungsblätter ist abgelaufen CorrCreate: Abgaben erstellen UnknownPseudonymWord pseudonymWord@Text: Unbekanntes Pseudonym-Wort "#{pseudonymWord}" diff --git a/src/Foundation.hs b/src/Foundation.hs index b625042b6..d0a98d10c 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -255,8 +255,8 @@ instance RenderMessage UniWorX NotificationTrigger where NTSubmissionRatedGraded -> MsgNotificationTriggerSubmissionRatedGraded NTSubmissionRated -> MsgNotificationTriggerSubmissionRated NTSheetActive -> MsgNotificationTriggerSheetActive - NTSheetInactive -> MsgNotificationTriggerSheetInactive - + NTSheetSoonInactive -> MsgNotificationTriggerSheetSoonInactive + NTSheetInactive -> MsgNotificationTriggerSheetInactive instance RenderMessage UniWorX (UnsupportedAuthPredicate (Route UniWorX)) where renderMessage f ls (UnsupportedAuthPredicate tag route) = renderMessage f ls $ MsgUnsupportedAuthPredicate tag (show route) @@ -877,7 +877,7 @@ defaultLinks = -- Define the menu items of the header. { menuItemLabel = "Hilfe" , menuItemIcon = Just "question" , menuItemRoute = HelpR - , menuItemModal = False -- True -- TODO: Does not work yet, issue #212 + , menuItemModal = True -- TODO: Does not work yet, issue #212 , menuItemAccessCallback' = return True } , NavbarRight $ MenuItem @@ -891,7 +891,7 @@ defaultLinks = -- Define the menu items of the header. { menuItemLabel = "Login" , menuItemIcon = Just "sign-in-alt" , menuItemRoute = AuthR LoginR - , menuItemModal = False -- True -- TODO: Does not work yet, issue #212 + , menuItemModal = True -- TODO: Does not work yet, issue #212 , menuItemAccessCallback' = isNothing <$> maybeAuthPair } , NavbarSecondary $ MenuItem diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index d59de841d..e001b3a84 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -85,8 +85,7 @@ data SheetForm = SheetForm { sfName :: SheetName , sfDescription :: Maybe Html , sfType :: SheetType - , sfGrouping :: SheetGroup - , sfMarkingText :: Maybe Html + , sfGrouping :: SheetGroup , sfVisibleFrom :: Maybe UTCTime , sfActiveFrom :: UTCTime , sfActiveTo :: UTCTime @@ -98,6 +97,7 @@ data SheetForm = SheetForm , sfSolutionFrom :: Maybe UTCTime , sfSolutionF :: Maybe (Source Handler (Either FileId File)) , sfMarkingF :: Maybe (Source Handler (Either FileId File)) + , sfMarkingText :: Maybe Html -- Keine SheetId im Formular! } @@ -120,8 +120,7 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do <$> areq ciField (fslI MsgSheetName) (sfName <$> template) <*> aopt htmlField (fslI MsgSheetDescription) (sfDescription <$> template) <*> sheetTypeAFormReq (fslI MsgSheetType) (sfType <$> template) - <*> sheetGroupAFormReq (fslI MsgSheetGroup) (sfGrouping <$> template) - <*> aopt htmlField (fslI MsgSheetMarking) (sfMarkingText <$> template) + <*> sheetGroupAFormReq (fslI MsgSheetGroup) (sfGrouping <$> template) <*> aopt utcTimeField (fslI MsgSheetVisibleFrom & setTooltip MsgSheetVisibleFromTip) ((sfVisibleFrom <$> template) <|> pure (Just ctime)) @@ -141,6 +140,7 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do <*> aopt (multiFileField $ oldFileIds SheetSolution) (fslI MsgSheetSolution) (sfSolutionF <$> template) <*> aopt (multiFileField $ oldFileIds SheetMarking) (fslI MsgSheetMarking & setTooltip MsgSheetMarkingTip) (sfMarkingF <$> template) + <*> aopt htmlField (fslI MsgSheetMarking) (sfMarkingText <$> template) <* submitButton return $ case result of FormSuccess sheetResult @@ -159,7 +159,7 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do ] ] getSheetListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html -getSheetListR tid ssh csh = do +getSheetListR tid ssh csh = do muid <- maybeAuthId Entity cid _ <- runDB . getBy404 $ TermSchoolCourseShort tid ssh csh let @@ -419,8 +419,7 @@ getSheetNewR tid ssh csh = do { sfName = stepTextCounterCI sheetName , sfDescription = sheetDescription , sfType = sheetType - , sfGrouping = sheetGrouping - , sfMarkingText = sheetMarkingText + , sfGrouping = sheetGrouping , sfVisibleFrom = addOneWeek <$> sheetVisibleFrom , sfActiveFrom = addOneWeek sheetActiveFrom , sfActiveTo = addOneWeek sheetActiveTo @@ -432,6 +431,7 @@ getSheetNewR tid ssh csh = do , sfSolutionFrom = addOneWeek <$> sheetSolutionFrom , sfSolutionF = Nothing , sfMarkingF = Nothing + , sfMarkingText = sheetMarkingText } _other -> Nothing let action newSheet = -- More specific error message for new sheet could go here, if insertUnique returns Nothing @@ -454,8 +454,7 @@ getSEditR tid ssh csh shn = do { sfName = sheetName , sfDescription = sheetDescription , sfType = sheetType - , sfGrouping = sheetGrouping - , sfMarkingText = sheetMarkingText + , sfGrouping = sheetGrouping , sfVisibleFrom = sheetVisibleFrom , sfActiveFrom = sheetActiveFrom , sfActiveTo = sheetActiveTo @@ -467,6 +466,7 @@ getSEditR tid ssh csh shn = do , sfSolutionFrom = sheetSolutionFrom , sfSolutionF = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetSolution , sfMarkingF = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetMarking + , sfMarkingText = sheetMarkingText } let action newSheet = do replaceRes <- myReplaceUnique sid $ newSheet diff --git a/src/Jobs/Crontab.hs b/src/Jobs/Crontab.hs index 955c09ee4..0610e459b 100644 --- a/src/Jobs/Crontab.hs +++ b/src/Jobs/Crontab.hs @@ -54,10 +54,17 @@ determineCrontab = execWriterT $ do , cronRateLimit = appNotificationRateLimit } tell $ HashMap.singleton - (JobCtlQueue $ JobQueueNotification NotificationSheetInactive{..}) + (JobCtlQueue $ JobQueueNotification NotificationSheetSoonInactive{..}) Cron { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ . max sheetActiveFrom $ addUTCTime (-nominalDay) sheetActiveTo , cronRepeat = CronRepeatOnChange , cronRateLimit = appNotificationRateLimit } + tell $ HashMap.singleton + (JobCtlQueue $ JobQueueNotification NotificationSheetInactive{..}) + Cron + { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ sheetActiveTo + , cronRepeat = CronRepeatOnChange + , cronRateLimit = appNotificationRateLimit + } runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ sheetJobs diff --git a/src/Jobs/Handler/QueueNotification.hs b/src/Jobs/Handler/QueueNotification.hs index 1767f7133..e37859e70 100644 --- a/src/Jobs/Handler/QueueNotification.hs +++ b/src/Jobs/Handler/QueueNotification.hs @@ -36,12 +36,17 @@ determineNotificationCandidates NotificationSheetActive{..} = E.select . E.from E.on $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser E.where_ $ sheet E.^. SheetId E.==. E.val nSheet return user -determineNotificationCandidates NotificationSheetInactive{..} = E.select . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> do +determineNotificationCandidates NotificationSheetSoonInactive{..} = E.select . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> do E.on $ sheet E.^. SheetCourse E.==. courseParticipant E.^. CourseParticipantCourse E.on $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser E.where_ $ sheet E.^. SheetId E.==. E.val nSheet return user - +determineNotificationCandidates NotificationSheetInactive{..} = E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` sheet) -> do + E.on $ lecturer E.^. LecturerCourse E.==. sheet E.^. SheetCourse + E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId + E.where_ $ sheet E.^. SheetId E.==. E.val nSheet + return user + classifyNotification :: Notification -> DB NotificationTrigger classifyNotification NotificationSubmissionRated{..} = do Sheet{sheetType} <- belongsToJust submissionSheet =<< getJust nSubmission @@ -49,6 +54,8 @@ classifyNotification NotificationSubmissionRated{..} = do NotGraded -> NTSubmissionRated _other -> NTSubmissionRatedGraded classifyNotification NotificationSheetActive{} = return NTSheetActive +classifyNotification NotificationSheetSoonInactive{} = return NTSheetSoonInactive classifyNotification NotificationSheetInactive{} = return NTSheetInactive + diff --git a/src/Jobs/Handler/SendNotification/SheetInactive.hs b/src/Jobs/Handler/SendNotification/SheetInactive.hs index 5caf09e0a..16f865167 100644 --- a/src/Jobs/Handler/SendNotification/SheetInactive.hs +++ b/src/Jobs/Handler/SendNotification/SheetInactive.hs @@ -6,7 +6,8 @@ #-} module Jobs.Handler.SendNotification.SheetInactive - ( dispatchNotificationSheetInactive + ( dispatchNotificationSheetSoonInactive + , dispatchNotificationSheetInactive ) where import Import @@ -17,6 +18,24 @@ import Handler.Utils.Mail import Text.Hamlet import qualified Data.CaseInsensitive as CI +dispatchNotificationSheetSoonInactive :: SheetId -> UserId -> Handler () +dispatchNotificationSheetSoonInactive nSheet jRecipient = userMailT jRecipient $ do + (Course{..}, Sheet{..}) <- liftHandlerT . runDB $ do + sheet <- getJust nSheet + course <- belongsToJust sheetCourse sheet + return (course, sheet) + setSubjectI $ MsgMailSubjectSheetSoonInactive courseShorthand sheetName + + MsgRenderer mr <- getMailMsgRenderer + let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm + tid = courseTerm + ssh = courseSchool + csh = courseShorthand + shn = sheetName + + addAlternatives $ do + providePreferredAlternative ($(ihamletFile "templates/mail/sheetSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + dispatchNotificationSheetInactive :: SheetId -> UserId -> Handler () dispatchNotificationSheetInactive nSheet jRecipient = userMailT jRecipient $ do (Course{..}, Sheet{..}) <- liftHandlerT . runDB $ do @@ -34,3 +53,4 @@ dispatchNotificationSheetInactive nSheet jRecipient = userMailT jRecipient $ do addAlternatives $ do providePreferredAlternative ($(ihamletFile "templates/mail/sheetInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + \ No newline at end of file diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index 4d3bbb85f..c80ee9ecf 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -24,10 +24,11 @@ data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notifica | JobHelpRequest { jSender :: Either (Maybe Email) UserId , jRequestTime :: UTCTime , jHelpRequest :: Text, jReferer :: Maybe Text } - | JobSetLogSettings { jInstance :: InstanceId, jLogSettings :: LogSettings } + | JobSetLogSettings { jInstance :: InstanceId, jLogSettings :: LogSettings } deriving (Eq, Ord, Show, Read, Generic, Typeable) data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId } | NotificationSheetActive { nSheet :: SheetId } + | NotificationSheetSoonInactive { nSheet :: SheetId } | NotificationSheetInactive { nSheet :: SheetId } deriving (Eq, Ord, Show, Read, Generic, Typeable) diff --git a/src/Model/Types.hs b/src/Model/Types.hs index b7b4fc76a..9ba9a8e43 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -487,6 +487,7 @@ derivePersistFieldJSON ''Value data NotificationTrigger = NTSubmissionRatedGraded | NTSubmissionRated | NTSheetActive + | NTSheetSoonInactive | NTSheetInactive deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) @@ -515,7 +516,8 @@ instance Default NotificationSettings where NTSubmissionRatedGraded -> True NTSubmissionRated -> False NTSheetActive -> True - NTSheetInactive -> False + NTSheetSoonInactive -> False + NTSheetInactive -> True instance ToJSON NotificationSettings where toJSON v = toJSON . HashMap.fromList $ map (id &&& notificationAllowed v) universeF diff --git a/templates/mail/sheetSoonInactive.hamlet b/templates/mail/sheetSoonInactive.hamlet new file mode 100644 index 000000000..a198fd65c --- /dev/null +++ b/templates/mail/sheetSoonInactive.hamlet @@ -0,0 +1,17 @@ +$newline never +\ + + + +