Merge branch 'master' of gitlab.cip.ifi.lmu.de:jost/UniWorX

messages/uniworx/de.msg

@@ -223,6 +223,7 @@ MaterialTypeExample: Beispiel
 MaterialDescription: Beschreibung
 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

src/Handler/Material.hs

@@ -53,7 +53,13 @@ makeMaterialForm cid template = identifyForm FIDmaterial $ \html -> do
               return $ material E.^. MaterialType
         return $ defaults <> Set.fromList (mapMaybe E.unValue previouslyUsed)
 
-  ctime <- ceilingQuarterHour <$> liftIO getCurrentTime
+  now <- liftIO getCurrentTime
+  let ctime = ceilingQuarterHour now
+  let visibleToolTip = case mfVisibleFrom <$> template of
+        (Just (Just vistime))  |  vistime <= now
+          -> MsgMaterialVisibleFromEditWarning
+        _ -> MsgMaterialVisibleFromTip
+
   flip (renderAForm FormStandard) html $ MaterialForm
       <$> areq ciField        (fslI MsgMaterialName)         (mfName        <$> template)
       <*> aopt (textField & addDatalist typeOptions)
@@ -61,8 +67,8 @@ makeMaterialForm cid template = identifyForm FIDmaterial $ \html -> do
                                                              (mfType        <$> template)
       <*> aopt htmlField      (fslpI MsgMaterialDescription "Html")
                                                              (mfDescription <$> template)
-      <*> aopt utcTimeField   (fslI MsgMaterialVisibleFrom
-            & setTooltip MsgMaterialVisibleFromTip)         ((mfVisibleFrom  <$> template) <|> pure (Just ctime))
+      <*> aopt utcTimeField   (fslI MsgMaterialVisibleFrom & setTooltip visibleToolTip)
+                                                            ((mfVisibleFrom <$> template) <|> pure (Just ctime))
       <*> aopt (multiFileField oldFileIds)
                               (fslI MsgMaterialFiles)        (mfFiles <$> template)
 
@@ -83,7 +89,15 @@ getMaterialListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getMaterialListR tid ssh csh = do
   let matLink :: MaterialName -> Route UniWorX
       matLink = CourseR tid ssh csh . flip MaterialR MShowR
+
+      materialModDateCell :: IsDBTable m a => Material -> DBCell m a
+      materialModDateCell Material{materialVisibleFrom, materialLastEdit}
+        | NTop materialVisibleFrom >= NTop (Just materialLastEdit)
+            = mempty -- empty cells mean no modification after publication
+        | otherwise = dateTimeCell materialLastEdit -- modification after publication is highlighted by being shown
+
   now <- liftIO getCurrentTime
+  seeAllModificationTimestamps <- hasWriteAccessTo $ CourseR tid ssh csh MaterialNewR -- ordinary users should not see modification dates older than visibility
   table <- runDB $ do
     cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
     let row2material = entityVal . dbrOutput -- no inner join, just Entity Material
@@ -109,7 +123,9 @@ getMaterialListR tid ssh csh = do
             , sortable (Just "visible-from") (i18nCell MsgAccessibleSince)
                 $ foldMap (dateTimeCellVisible now) . materialVisibleFrom . row2material
             , sortable (Just "last-edit") (i18nCell MsgFileModified)
-                $ dateTimeCell . materialLastEdit . row2material
+                $ if seeAllModificationTimestamps
+                    then dateTimeCell . materialLastEdit . row2material
+                    else materialModDateCell . row2material
             ]
       , dbtSorting   = Map.fromList
             [ ( "type"         , SortColumn (E.^. MaterialType)        )
@@ -128,6 +144,8 @@ getMaterialListR tid ssh csh = do
     $(widgetFile "material-list")
 
 
+
+
 getMFileR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> FilePath -> Handler TypedContent
 getMFileR tid ssh csh mnm title = serveOneFile fileQuery
   where
@@ -151,9 +169,16 @@ getMShowR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler Ht
 getMShowR tid ssh csh mnm = do
   let matLink :: FilePath -> Route UniWorX
       matLink = CourseR tid ssh csh . MaterialR mnm . MFileR
+
+  seeAllModificationTimestamps <- hasWriteAccessTo $ CourseR tid ssh csh MaterialNewR -- ordinary users should not see modification dates older than visibility
+
   ( Entity _mid material@Material{materialType, materialDescription}
     , (Any hasFiles,fileTable)) <- runDB $ do
     matEnt <- fetchMaterial tid ssh csh mnm
+    let materialModDateCell :: (IsDBTable m c) => (t -> E.Value UTCTime) -> Colonnade Sortable t (DBCell m c)
+        materialModDateCell = if seeAllModificationTimestamps
+          then colFileModification
+          else colFileModificationWhen $ \t -> NTop (Just t) > NTop (materialVisibleFrom $ entityVal matEnt)
     let psValidator = def & defaultSortingByFileTitle
     fileTable' <- dbTable psValidator DBTable
       { dbtSQLQuery = \(matFile `E.InnerJoin` file) -> do
@@ -165,7 +190,7 @@ getMShowR tid ssh csh mnm = do
       , dbtColonnade = widgetColonnade $ mconcat
             [ dbRowIndicator -- important: contains writer to indicate that the tables is not empty
             , colFilePathSimple   (view $ _dbrOutput . _1) matLink
-            , colFileModification (view $ _dbrOutput . _2)
+            , materialModDateCell (view $ _dbrOutput . _2)
             ]
       , dbtProj = \dbr -> guardAuthorizedFor (matLink $ dbr ^. _dbrOutput . _1 . _Value) dbr
       , dbtStyle    = def

src/Handler/Utils/Table/Cells.hs

@@ -53,11 +53,15 @@ pathPieceCell = cell . toWidget . toPathPiece
 sqlCell :: (IsDBTable (YesodDB UniWorX) a) => YesodDB UniWorX Widget -> DBCell (YesodDB UniWorX) a
 sqlCell act = mempty & cellContents .~ lift act
 
-markCell :: (IsDBTable m a) => (a -> Bool) -> (a -> DBCell m a) -> a -> DBCell m a
+markCell :: (IsDBTable m a) => (t -> Bool) -> (t -> DBCell m a) -> (t -> DBCell m a)
 markCell condition normal x
   | condition x = normal x <> cell (isVisibleWidget False)
   | otherwise   = normal x
 
+ifCell :: (IsDBTable m a) => (t -> Bool) -> (t -> DBCell m a) -> (t -> DBCell m a) -> (t -> DBCell m a)
+ifCell decision cTrue cFalse x
+  | decision x = cTrue  x
+  | otherwise  = cFalse x
 
 -- Recall: for line numbers, use dbRow
 

src/Handler/Utils/Table/Columns.hs

@@ -69,6 +69,11 @@ colFilePathSimple row2path row2link = sortable (Just "path") (i18nCell MsgFileTi
 colFileModification :: (IsDBTable m c) => (t -> E.Value UTCTime) -> Colonnade Sortable t (DBCell m c)
 colFileModification row2time = sortable (Just "time") (i18nCell MsgFileModified) (dateTimeCell . E.unValue . row2time)
 
+colFileModificationWhen :: (IsDBTable m c) => (UTCTime -> Bool) -> (t -> E.Value UTCTime) -> Colonnade Sortable t (DBCell m c)
+colFileModificationWhen condition row2time = sortable (Just "time") (i18nCell MsgFileModified) (conDTCell . E.unValue . row2time)
+  where conDTCell = ifCell condition dateTimeCell $ const mempty
+
+
 sortFilePath :: IsString s => (r -> E.SqlExpr (Entity File)) -> (s, SortColumn r)
 sortFilePath queryPath = ("path", SortColumn $ queryPath >>> (E.^. FileTitle))