NotificationSheetInactive

.vscode/tasks.json

@@ -6,7 +6,11 @@
         {
             "label": "echo",
             "type": "shell",
-            "command": "echo Hello"
+            "command": "echo Hello",
+            "group": {
+                "kind": "build",
+                "isDefault": true
+            }
         }
     ]
 }

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
+MailSubjectSheetSoonInactive 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.
+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}"

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

src/Handler/Sheet.hs

@@ -85,8 +85,7 @@ data SheetForm = SheetForm
       { sfName         :: SheetName
       , sfDescription  :: Maybe Html
       , sfType         :: SheetType
-      , sfGrouping     :: SheetGroup
+      , sfGrouping     :: SheetGroup      
-      , sfMarkingText  :: Maybe Html
       , 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)
+      <*> sheetGroupAFormReq  (fslI MsgSheetGroup)        (sfGrouping    <$> template)      
-      <*> aopt htmlField      (fslI MsgSheetMarking)      (sfMarkingText <$> 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
+          , sfGrouping     = sheetGrouping          
-          , sfMarkingText  = sheetMarkingText
           , 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
+        , sfGrouping     = sheetGrouping        
-        , sfMarkingText  = sheetMarkingText
         , 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

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

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
 
 
+

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))
+    

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)
 

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

templates/mail/sheetSoonInactive.hamlet

@@ -0,0 +1,17 @@
+$newline never
+\<!doctype html>
+<html>
+  <head>
+    <meta charset="UTF-8">
+    <style>
+      h1 {
+        font-size: 1.25em;
+        font-variant: small-caps;
+        font-weight: normal;
+      }
+  <body>
+    <h1>
+      _{MsgMailSheetSoonInactiveIntro (CI.original courseName) termDesc sheetName}
+    <p>
+      <a href=@{CSheetR tid ssh csh shn SShowR}>
+        #{sheetName}

templates/sheetShow.hamlet

@@ -5,12 +5,6 @@ $maybe descr <- sheetDescription sheet
     <p>
       #{descr}
 
-$maybe marking <- sheetMarkingText sheet
-  <section>
-    <h2>_{MsgSheetMarking}
-    <p>
-      #{marking}
-
 <section>
   <dl .deflist>
     <dt .deflist__dt>_{MsgSheetActiveFrom}