Fixes #298 Fixes #281

messages/uniworx/de.msg

@@ -173,7 +173,6 @@ SheetMarking: Hinweise für Korrektoren
 SheetMarkingFiles: Korrektur
 SheetType: Wertung
 SheetInvisible: Dieses Übungsblatt ist für Teilnehmer momentan unsichtbar!
-SheetInvisibleUntil date@Text: Dieses Übungsblatt ist für Teilnehmer momentan unsichtbar bis #{date}!
 SheetName: Name
 SheetDescription: Hinweise für Teilnehmer
 SheetGroup: Gruppenabgabe
@@ -519,9 +518,9 @@ CorrectorMissing: Abwesend
 CorrectorExcused: Entschuldigt
 CorrectorStateTip: Abwesende Korrektoren bekommen bei späteren Übungsblättern mehr Korrekturen zum Ausgleich zugewiesen. Entschuldigte Korrektoren müssen nicht nacharbeiten.
 
-DayIsAHoliday     tid@TermId name@Text date@Text: Datum für "#{name}" ist ein Feiertag: #{date}
-DayIsOutOfLecture tid@TermId name@Text date@Text: Datum für "#{name}" ist außerhalb der Vorlesungszeit des #{display tid}: #{date}
-DayIsOutOfTerm    tid@TermId name@Text date@Text: Datum für "#{name}" liegt nicht im Semester #{display tid}: #{date}
+DayIsAHoliday     tid@TermId name@Text date@Text: "#{name}" (#{date}) ist ein Feiertag
+DayIsOutOfLecture tid@TermId name@Text date@Text: "#{name}" (#{date}) ist außerhalb der Vorlesungszeit des #{display tid}
+DayIsOutOfTerm    tid@TermId name@Text date@Text: "#{name}" (#{date}) liegt nicht im Semester #{display tid}
 
 UploadModeNone: Kein Upload
 UploadModeAny: Upload, beliebige Datei(en)
@@ -547,7 +546,7 @@ CorrectorSubmissions: Abgabe extern mit Pseudonym
 UserSubmissions: Direkte Abgabe
 BothSubmissions: Abgabe direkt & extern mit Pseudonym
 
-SheetCorrectorSubmissionsTip: Abgabe erfolgt über ein Uni2work-externes Verfahren (zumeist in Papierform durch Einwurf) unter Angabe eines persönlichen Pseudonyms. Korrektorn können mithilfe des Pseudonyms später Korrekturergebnisse in Uni2work eintragen, damit Sie sie einsehen können.
+SheetCorrectorSubmissionsTip: Abgabe erfolgt über ein Uni2work-externes Verfahren (zumeist in Papierform durch Einwurf) unter Angabe eines persönlichen Pseudonyms. Korrektoren können mithilfe des Pseudonyms später Korrekturergebnisse in Uni2work eintragen, damit Sie sie einsehen können.
 
 SubmissionNoUploadExpected: Es ist keine Abgabe von Dateien vorgesehen.
 SubmissionReplace: Abgabe ersetzen

package.json

@@ -71,6 +71,7 @@
     "webpack-cli": "^3.3.2"
   },
   "dependencies": {
-    "flatpickr": "^4.5.7"
+    "flatpickr": "^4.5.7",
+    "npm": "^6.9.0"
   }
 }

src/Handler/Corrections.hs

@@ -447,7 +447,10 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
         unless (null unassignedUnauth) $ do
           let submissionEncrypt = encrypt :: SubmissionId -> DB CryptoFileNameSubmission
           unassignedUnauth' <- mapM submissionEncrypt $ Set.toList unassignedUnauth
-          $(addMessageFile Warning "templates/messages/submissionsAssignUnauthorized.hamlet")
+          let numUnassignedUnauth = fromIntegral $ length unassignedUnauth'
+              trigger = [whamlet|_{MsgSubmissionsAssignUnauthorized numUnassignedUnauth}|]
+              content = Right $(widgetFile "messages/submissionsAssignUnauthorized")
+          addMessageModal Warning trigger content
         unless (null unassignedAuth) $ do
           num <- updateWhereCount [SubmissionId <-. Set.toList unassignedAuth]
                     [ SubmissionRatingBy       =. Just uid
@@ -497,7 +500,10 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
         unless (null unassignedUnauth) $ do
           let submissionEncrypt = encrypt :: SubmissionId -> DB CryptoFileNameSubmission
           unassignedUnauth' <- mapM submissionEncrypt $ Set.toList unassignedUnauth
-          $(addMessageFile Warning "templates/messages/submissionsAssignUnauthorized.hamlet")
+          let numUnassignedUnauth = fromIntegral $ length unassignedUnauth'
+              trigger = [whamlet|_{MsgSubmissionsAssignUnauthorized numUnassignedUnauth}|]
+              content = Right $(widgetFile "messages/submissionsAssignUnauthorized")
+          addMessageModal Warning trigger content
         unless (null unassignedAuth) $ do
           (assigned, stillUnassigned) <- assignSubmissions shid (Just unassignedAuth)
           unless (null assigned) $
@@ -881,8 +887,8 @@ postCorrectionsCreateR = do
               , submissionRatingAssigned = Just now
               , submissionRatingTime = Nothing
               }
-          unless (null duplicate)
-            $(addMessageFile Warning "templates/messages/submissionCreateDuplicates.hamlet")
+          unless (null duplicate) $
+            addMessageModal Warning [whamlet|_{MsgSheetDuplicatePseudonym}|] $ Right $(widgetFile "messages/submissionCreateDuplicates")
           existingSubUsers <- E.select . E.from $ \(submissionUser `E.InnerJoin` submission) -> do
             E.on $ submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission
             E.where_ $ submissionUser E.^. SubmissionUserUser `E.in_` E.valList (sheetPseudonymUser <$> concat sps')
@@ -890,7 +896,9 @@ postCorrectionsCreateR = do
             return submissionUser
           unless (null existingSubUsers) . mapReaderT lift $ do
             (Map.toList -> subs) <- foldrM (\(Entity _ SubmissionUser{..}) mp -> Map.insertWith (<>) <$> (encrypt submissionUserSubmission :: DB CryptoFileNameSubmission) <*> pure (Set.fromList . map sheetPseudonymPseudonym . filter (\SheetPseudonym{..} -> sheetPseudonymUser == submissionUserUser) $ concat sps') <*> pure mp) Map.empty existingSubUsers
-            $(addMessageFile Warning "templates/messages/submissionCreateExisting.hamlet")
+            let trigger = [whamlet|_{MsgSheetCreateExisting}|]
+                content = Right $(widgetFile "messages/submissionCreateExisting")
+            addMessageModal Warning trigger content
           let sps'' = filter (not . null) $ filter (\spGroup -> not . flip any spGroup $ \SheetPseudonym{sheetPseudonymUser} -> sheetPseudonymUser `elem` map (submissionUserUser . entityVal) existingSubUsers) sps'
           forM_ sps'' $ \spGroup
             -> let

src/Handler/Sheet.hs

@@ -406,10 +406,6 @@ getSShowR tid ssh csh shn = do
     hasHints <- (/= 0) <$> count [ SheetFileSheet ==. sid, SheetFileType ==. SheetHint ]
     hasSolution <- (/= 0) <$> count [ SheetFileSheet ==. sid, SheetFileType ==. SheetSolution ]
     return (hasHints, hasSolution)
-  cTime <- Just <$> liftIO getCurrentTime
-  visibleFrom <-    traverse (formatTime SelFormatDateTime) $ sheetVisibleFrom  sheet
-  when (NTop (sheetVisibleFrom sheet) >= NTop cTime) $ addMessageI Warning $
-    maybe MsgSheetInvisible MsgSheetInvisibleUntil visibleFrom
   mPseudonym <- runMaybeT $ do
     uid <- MaybeT maybeAuthId
     Entity _ SheetPseudonym{sheetPseudonymPseudonym} <- MaybeT . runDB . getBy $ UniqueSheetPseudonymUser sid uid
@@ -421,12 +417,14 @@ getSShowR tid ssh csh shn = do
         , formEncoding = generateEnctype
         , formSubmit = FormNoSubmit
         }
+
   defaultLayout $ do
     setTitleI $ prependCourseTitle tid ssh csh $ SomeMessage shn
-    sheetFrom    <-           formatTime SelFormatDateTime  $ sheetActiveFrom   sheet
-    sheetTo      <-           formatTime SelFormatDateTime  $ sheetActiveTo     sheet
-    hintsFrom    <- traverse (formatTime SelFormatDateTime) $ sheetHintFrom     sheet
-    solutionFrom <- traverse (formatTime SelFormatDateTime) $ sheetSolutionFrom sheet
+    let visibleFrom =     visibleUTCTime SelFormatDateTime <$> sheetVisibleFrom  sheet
+    sheetFrom    <-           formatTime SelFormatDateTime  $  sheetActiveFrom   sheet
+    sheetTo      <-           formatTime SelFormatDateTime  $  sheetActiveTo     sheet
+    hintsFrom    <- traverse (formatTime SelFormatDateTime) $  sheetHintFrom     sheet
+    solutionFrom <- traverse (formatTime SelFormatDateTime) $  sheetSolutionFrom sheet
     markingText  <- runMaybeT $ assertM_ (Authorized ==) (evalAccessCorrector tid ssh csh) >> hoistMaybe (sheetMarkingText sheet)
     $(widgetFile "sheetShow")
 
@@ -702,11 +700,14 @@ correctorForm shid = wFormToAForm $ do
       | applyDefaultLoads = defaultLoads'
       | otherwise         = currentLoads'
 
-  when (not (Map.null loads) && applyDefaultLoads) $
-    addMessageI Warning MsgCorrectorsDefaulted
-
   countTutRes <- wreq checkBoxField (fslI MsgCountTutProp & setTooltip MsgCountTutPropTip) . Just . any (\(_, Load{..}) -> fromMaybe False byTutorial) $ Map.elems loads
 
+  -- when (not (Map.null loads) && applyDefaultLoads) $       -- Alert Message
+  --   addMessageI Warning MsgCorrectorsDefaulted
+  when (not (Map.null loads) && applyDefaultLoads) $          -- Alert Notification
+    wformMessage =<< messageI Warning MsgCorrectorsDefaulted
+
+
   let
     previousCorrectors :: E.SqlQuery (E.SqlExpr (Entity User))
     previousCorrectors = E.from $ \(user `E.InnerJoin` sheetCorrector `E.InnerJoin` sheet `E.InnerJoin` course `E.InnerJoin` lecturer) -> do

src/Utils/Form.hs

@@ -533,6 +533,11 @@ renderWForm formLayout = renderAForm formLayout . wFormToAForm
 idFormSectionNoinput :: Text
 idFormSectionNoinput = "form-section-noinput"
 
+-- | special id to identify form messages, see 'aformMessage' and 'formMessage'
+--   currently only treated by form generation through 'renderAForm'
+idFormMessageNoinput :: Text
+idFormMessageNoinput = "form-message-noinput"
+
 -- | Generates a form having just a form-section-header and no input title.
 --   Currently only correctly rendered by 'renderAForm' and mforms using 'widget/form.hamlet'
 --   Usage:
@@ -550,7 +555,7 @@ aformSection = formToAForm . fmap (second pure) . formSection
 wformSection :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => msg -> WForm m ()
 wformSection = void . aFormToWForm . aformSection
 
-formSection :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site msg) => msg -> MForm m (FormResult (), FieldView site) -- TODO: WIP, delete
+formSection :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site msg) => msg -> MForm m (FormResult (), FieldView site)
 formSection formSectionTitle = do
     mr <- getMessageRender
     return (FormSuccess (), FieldView
@@ -562,8 +567,6 @@ formSection formSectionTitle = do
       , fvInput    = mempty
       })
 
-
-
 -------------------
 -- Special Forms --
 -------------------
@@ -582,6 +585,33 @@ formSection' formSectionTitleSettings = mreq noinputField sectionSettings Nothin
     sectionSettings = formSectionTitleSettings { fsId = Just idFormSectionNoinput }
 
 
+-- | Similar to aformSection, generates a form having just a view widget, but no input.
+--   Currently only correctly rendered by 'renderAForm' and mforms using 'widget/form.hamlet'
+--   Usage:
+--   @
+--      (,) <$  formMessage (Message Info html1)
+--          <*> areq intField "int here" Nothing
+--          <*  formSection (Message Warning html2)
+--          <*> areq doubleField "double there " Nothing
+--          <*  submitButton
+--   @
+
+aformMessage :: (MonadHandler m) => Message -> AForm m ()
+aformMessage = formToAForm . fmap (second pure) . formMessage
+
+wformMessage :: (MonadHandler m) => Message -> WForm m ()
+wformMessage = void . aFormToWForm . aformMessage
+
+formMessage :: (MonadHandler m) => Message -> MForm m (FormResult (), FieldView site)
+formMessage Message{..} = do
+    return (FormSuccess (), FieldView
+      { fvLabel    = mempty
+      , fvTooltip  = Nothing
+      , fvId       = idFormMessageNoinput
+      , fvErrors   = Nothing
+      , fvRequired = False
+      , fvInput    = [whamlet|<div .notification .notification-#{toPathPiece messageStatus}>#{messageContent}|]
+      })
 
 ---------------------
 -- Form evaluation --
@@ -635,7 +665,7 @@ runInputResult form = do
   postRes <- runInputPostResult form
   getRes  <- runInputGetResult form
   return $ case (postRes, getRes) of
-    (FormSuccess a, _) -> FormSuccess a 
+    (FormSuccess a, _) -> FormSuccess a
     (_, FormSuccess b) -> FormSuccess b
     (postRes', _)      -> postRes'
 

templates/default-layout.lucius

@@ -554,3 +554,55 @@ section {
 .headline-one {
   margin-bottom: 10px;
 }
+
+/* Notification style used as requested by @hamanf in #298, but class was not globally available. Copied from dead-code. For @hamanf to clean up: */
+
+.notification {
+  position: relative;
+  border-radius: 3px;
+  padding: 10px 20px 20px;
+  margin: 40px 0;
+  color: var(--color-dark);
+  box-shadow: 0 0 4px 2px inset currentColor;
+  padding-left: 20%;
+
+  &::before {
+    content: 'i';
+    position: absolute;
+    display: flex;
+    left: 0;
+    top: 0;
+    height: 100%;
+    width: 20%;
+    font-size: 100px;
+    align-items: center;
+    justify-content: center;
+  }
+}
+
+@media (max-width: 768px) {
+
+  .notification {
+
+    padding-left: 40px;
+
+    &::before {
+      height: auto;
+      width: 45px;
+      font-size: 40px;
+      top: 15px;
+    }
+  }
+}
+
+.notification-danger {
+  color: #c51919 ;
+
+  &::before {
+    content: '!';
+  }
+}
+
+.notification__content {
+  color: var(--color-font);
+}

templates/messages/submissionsAssignUnauthorized.hamlet

@@ -1,4 +1,4 @@
-_{MsgSubmissionsAssignUnauthorized (fromIntegral (length unassignedUnauth'))}
+_{MsgSubmissionsAssignUnauthorized numUnassignedUnauth}
 
 <ul>
   $forall cID <- unassignedUnauth'

templates/sheetShow.hamlet

@@ -7,6 +7,13 @@ $maybe descr <- sheetDescription sheet
 
 <section>
   <dl .deflist>
+    <dt .deflist__dt>_{MsgAccessibleSince}
+    <dd .deflist__dd>
+      $maybe invisible <- visibleFrom
+        ^{invisible}
+      $nothing
+        #{isVisible False}
+        _{MsgSheetInvisible}
     <dt .deflist__dt>_{MsgSheetActiveFrom}
     <dd .deflist__dd>#{sheetFrom}
     <dt .deflist__dt>_{MsgSheetActiveTo}