From ceace36abdaa9cc065ada8be54de02d7a7fe9b9a Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 29 May 2019 10:33:14 +0200
Subject: [PATCH] MaterialVisible has an icon now and no more alert

---
 .vscode/tasks.json               |  5 +++++
 messages/uniworx/de.msg          |  1 -
 src/Handler/Material.hs          |  8 ++------
 src/Handler/Utils.hs             | 20 +++++++++++++++++++-
 src/Handler/Utils/Table/Cells.hs |  4 +++-
 templates/material-show.hamlet   |  6 +++---
 6 files changed, 32 insertions(+), 12 deletions(-)

diff --git a/.vscode/tasks.json b/.vscode/tasks.json
index 8b60430d0..9c9d0aef8 100644
--- a/.vscode/tasks.json
+++ b/.vscode/tasks.json
@@ -43,6 +43,11 @@
         "panel": "dedicated",
         "showReuseMessage": false
       }
+    },
+    {
+      "type": "npm",
+      "script": "yesod:lint",
+      "problemMatcher": []
     }
   ]
 }
\ No newline at end of file
diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index d7a6a484b..8513fc2db 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -239,7 +239,6 @@ MaterialVisibleFrom: Sichtbar für Teilnehmer ab
 MaterialVisibleFromTip: Ohne Datum nie sichtbar für Teilnehmer; leer lassen ist nur sinnvoll für unfertige Materialien oder zur ausschließlichen Verteilung an Korrektoren
 MaterialVisibleFromEditWarning: Das Datum der Veröffentlichung liegt in der Vergangenheit und sollte nicht mehr verändert werden, da dies die Benutzer verwirren könnte.
 MaterialInvisible: Dieses Material ist für Teilnehmer momentan unsichtbar!
-MaterialInvisibleUntil date@Text: Dieses Material ist für Teilnehmer momentan unsichtbar bis #{date}!
 MaterialFiles: Dateien
 MaterialHeading materialName@MaterialName: Material "#{materialName}"
 MaterialListHeading: Materialien
diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs
index 119fa5027..dbf6c8bad 100644
--- a/src/Handler/Material.hs
+++ b/src/Handler/Material.hs
@@ -222,12 +222,8 @@ getMShowR tid ssh csh mnm = do
       }
     return (matEnt,fileTable')
 
-  let matVisFro = materialVisibleFrom material
-  now <- liftIO getCurrentTime
-  materialLastEdit    <-           formatTime SelFormatDateTime  $ materialLastEdit    material
-  materialVisibleFrom <- traverse (formatTime SelFormatDateTime) matVisFro
-  when (NTop matVisFro >= NTop (Just now)) $ addMessageI Warning $
-    maybe MsgMaterialInvisible MsgMaterialInvisibleUntil materialVisibleFrom
+  let matLastEdit      = formatTimeW    SelFormatDateTime  $  materialLastEdit    material
+  let matVisibleFromMB = visibleUTCTime SelFormatDateTime <$> materialVisibleFrom material
 
   let headingLong  = prependCourseTitle tid ssh csh $ MsgMaterialHeading mnm
       headingShort = prependCourseTitle tid ssh csh $ SomeMessage mnm
diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs
index e1aea383f..0384c83e5 100644
--- a/src/Handler/Utils.hs
+++ b/src/Handler/Utils.hs
@@ -80,7 +80,7 @@ serveSomeFiles archiveName source = do
   results <- runDB . runConduit $ source .| peekN 2
 
   $logDebugS "serveSomeFiles" . tshow $ length results
-  
+
   case results of
     []         -> notFound
     [file]     -> sendThisFile file
@@ -91,9 +91,27 @@ serveSomeFiles archiveName source = do
         source .| produceZip ZipInfo{..} .| Conduit.map toFlushBuilder
 
 
+
+---------
+-- Simple utilities for consistent display
+-- Please use these throughout, to ensure that users have a consistent experience
+
 tidFromText :: Text -> Maybe TermId
 tidFromText = fmap TermKey . maybeRight . termFromText
 
+-- | Display given UTCTime and maybe an invisible icon if it is in the future
+--
+--   Also see `Handler.Utils.Table.Cells.dateTimeCellVisible` for a similar function (in case of refactoring)
+visibleUTCTime :: SelDateTimeFormat -> UTCTime -> Widget
+visibleUTCTime dtf t = do
+    let timeStampWgt = formatTimeW dtf t
+    now <- liftIO getCurrentTime
+    if now >= t
+      then timeStampWgt
+      else $(widgetFile "widgets/date-time/yet-invisible")
+
+
+-- | Simple link to a known route
 simpleLink :: Widget -> Route UniWorX -> Widget
 simpleLink lbl url = [whamlet|<a href=@{url}>^{lbl}|]
 
diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs
index 5ec84c9fe..620e6776b 100644
--- a/src/Handler/Utils/Table/Cells.hs
+++ b/src/Handler/Utils/Table/Cells.hs
@@ -131,7 +131,9 @@ dateCell t = cell $ formatTime SelFormatDate t >>= toWidget
 dateTimeCell :: IsDBTable m a => UTCTime -> DBCell m a
 dateTimeCell t = cell $ formatTime SelFormatDateTime t >>= toWidget
 
--- | Show a date, and highlight date earlier than given watershed with an icon
+-- | Show a date, and highlight date earlier than given watershed with an icon and cell class Warning
+--
+--   Cannot use `Handler.Utils.visibleUTCTime`, since setting the UrgencyClass must be done outside the monad, hence the watershed argument.
 dateTimeCellVisible :: IsDBTable m a => UTCTime -> UTCTime -> DBCell m a
 dateTimeCellVisible watershed t
     | watershed < t = cell $(widgetFile "widgets/date-time/yet-invisible") & addUrgencyClass
diff --git a/templates/material-show.hamlet b/templates/material-show.hamlet
index c3e00bc22..e31b5c9c0 100644
--- a/templates/material-show.hamlet
+++ b/templates/material-show.hamlet
@@ -10,11 +10,11 @@ $maybe descr <- materialDescription
     $maybe matKind <- materialType
       <dt .deflist__dt>_{MsgMaterialType}
       <dd .deflist__dd>#{matKind}
-    $maybe matVisible <- materialVisibleFrom
+    $maybe matVisibleFromWgt <- matVisibleFromMB
       <dt .deflist__dt>_{MsgVisibleFrom}
-      <dd .deflist__dd>#{matVisible}
+      <dd .deflist__dd>^{matVisibleFromWgt}
     <dt .deflist__dt>_{MsgFileModified}
-    <dd .deflist__dd>#{materialLastEdit}
+    <dd .deflist__dd>^{matLastEdit}
 
 $if hasFiles
   <section>