BUGFIX: Exercise had no VisibleFrom Date defaultet to always False, now True if ActiveFrom time has been reached.

messages/de.msg

@@ -29,8 +29,8 @@ SheetDelText       submissionNo@Int: Dies kann nicht mehr rückgängig gemacht w
 SheetDelOk         tid@TermIdentifier courseShortHand@Text sheetName@Text: #{termToText tid}-#{courseShortHand}: Übungsblatt #{sheetName} gelöscht.
 
 Unauthorized: Sie haben hierfür keine explizite Berechtigung.
-UnauthorizedAnd l@Text r@Text: "#{l}" und "#{r}"
+UnauthorizedAnd l@Text r@Text: #{l} UND #{r}
-UnauthorizedOr  l@Text r@Text: "#{l}" oder "#{r}"
+UnauthorizedOr  l@Text r@Text: #{l} ODER #{r}
 UnauthorizedSchoolAdmin: Sie sind nicht als Administrator für dieses Institut eingetragen.
 UnauthorizedSchoolLecturer: Sie sind nicht als Veranstalter für dieses Institut eingetragen.
 UnauthorizedLecturer: Sie sind nicht als Veranstalter für diese Veranstaltung eingetragen.
@@ -52,7 +52,7 @@ SubmissionTitle tid@TermIdentifier courseShortHand@Text sheetName@Text: #{termTo
 SubmissionMember g@Int: Mitabgebende(r) ##{tshow g}
 SubmissionArchive: Zip-Archiv der Abgabedatei(en)
 SubmissionFile: Datei zur Abgabe
-SubmissionAlreadyExistsFor user@Text: #{user} hat bereits eine Abgabe zu diesem Übungsblatt.
+SubmissionAlreadyExistsFor user@Text: #{user} hat bereits eine Abgabe zu diesem bÜbungsblatt.
 
 EMail: E-Mail
 EMailUnknown email@Text: E-Mail #{email} gehört zu keinem bekannten Benutzer.

src/Foundation.hs

@@ -282,13 +282,14 @@ knownTags = -- should not throw exceptions, i.e. no getBy404 or requireAuthId
          Entity cid _ <- MaybeT . getBy $ CourseTermShort tid csh
          Entity sid Sheet{..} <- MaybeT . getBy $ CourseSheet cid shn
          cTime <- liftIO getCurrentTime
+         let started = sheetActiveFrom <= cTime  ||  NTop sheetVisibleFrom <= (NTop $ Just cTime)
          case subRoute of
-           SFileR SheetExercise _ -> guard $ maybe False (<= cTime) sheetVisibleFrom
+           SFileR SheetExercise _ -> guard started
            SFileR SheetHint     _ -> guard $ maybe False (<= cTime) sheetHintFrom
            SFileR SheetSolution _ -> guard $ maybe False (<= cTime) sheetSolutionFrom
            SFileR SheetMarking  _ -> mzero -- only for correctors and lecturers
-           SubmissionNewR -> guard $ sheetActiveFrom <= cTime && cTime <= sheetActiveTo
+           SubmissionNewR         -> guard $ sheetActiveFrom <= cTime && cTime <= sheetActiveTo
-           _ -> guard $ maybe False (<= cTime) sheetVisibleFrom
+           _ -> guard started
          return Authorized
        r -> do
          $logErrorS "AccessControl" $ "'!time' used on route that doesn't support it: " <> tshow r

src/Handler/Sheet.hs

@@ -160,7 +160,7 @@ getSheetList courseEnt = do
         [ headed "Blatt"       $ \(sid,sheet,_) -> simpleLink (toWgt $ sheetName sheet) $ CSheetR tid csh (sheetName sheet) SShowR
         , headed "Abgabe ab"   $ toWgt . formatTimeGerWD . sheetActiveFrom . snd3
         , headed "Abgabe bis"  $ toWgt . formatTimeGerWD . sheetActiveTo   . snd3
-        , headed "Bewertung"   $ toWgt . show . sheetType . snd3
+        , headed "Bewertung"   $ toWgt . display . sheetType . snd3
         ]
   let colAdmin = mconcat -- only show edit button for allowed course assistants
         [ headed "Korrigiert"  $ toWgt . snd . trd3

src/Model/Types.hs

@@ -43,6 +43,9 @@ type Points = Centi
 toPoints :: Integral a => a -> Points
 toPoints = MkFixed . fromIntegral
 
+pToI :: Points -> Integer
+pToI = fromPoints -- TODO: do we want to multiply?
+
 fromPoints :: Integral a => Points -> a
 fromPoints (MkFixed c) = fromInteger c
 
@@ -52,6 +55,13 @@ data SheetType
   | Pass   { maxPoints, passingPoints :: Points }
   | NotGraded
   deriving (Show, Read, Eq)
+
+instance DisplayAble SheetType where
+  display (Bonus {..}) = tshow (pToI maxPoints) <> " Bonuspunkte"
+  display (Normal{..}) = tshow (pToI maxPoints) <> " Punkte"
+  display (Pass  {..}) = "Bestanden ab " <> tshow (pToI passingPoints) <> " von " <> tshow (pToI maxPoints)
+  display (NotGraded)  = "Unbewertet"
+
 deriveJSON defaultOptions ''SheetType
 derivePersistFieldJSON "SheetType"
 

src/Utils.hs

@@ -151,6 +151,16 @@ mcons :: Maybe a -> [a] -> [a]
 mcons Nothing  xs = xs
 mcons (Just x) xs = x:xs
 
+newtype NTop a = NTop a -- treat Nothing as Top for Ord (Maybe a); default implementation treats Nothing as bottom
+
+instance Eq a  => Eq (NTop (Maybe a)) where
+  (NTop x) == (NTop y) = x == y
+
+instance Ord a => Ord (NTop (Maybe a)) where
+  compare (NTop Nothing)  (NTop Nothing) = EQ
+  compare (NTop Nothing)  _              = GT
+  compare _               (NTop Nothing) = LT
+  compare (NTop (Just x)) (NTop (Just y)) = compare x y
 
 ---------------
 -- Exception --

templates/sheetShow.hamlet

@@ -13,7 +13,7 @@
                       <h2 #description>Hinweise
                       <p> #{descr}
                     <h3>Bewertung
-                    <p> #{show $ sheetType sheet}
+                    <p> #{display $ sheetType sheet}
                       $maybe marking <- sheetMarkingText sheet
                         <p> #{marking}
                     <br>