UX/UI polish in various places

messages/uniworx/de.msg

@@ -47,7 +47,7 @@ LectureStart: Beginn Vorlesungen
 Course: Kurs
 CourseShort: Kürzel
 CourseCapacity: Kapazität
-CourseCapacityTip: Falls angegeben wird die Anzahl an Kursanmeldungen, die zugelassen werden, beschränkt
+CourseCapacityTip: Anzahl erlaubter Kursanmeldungen, leer lassen für unbeschränkte Kurskapazität
 CourseNoCapacity: In diesem Kurs sind keine Plätze mehr frei.
 CourseNotEmpty: In diesem Kurs sind momentan Teilnehmer angemeldet.
 CourseRegisterOk: Sie wurden angemeldet
@@ -75,14 +75,15 @@ CourseDescription: Beschreibung
 CourseDescriptionTip: Beliebiges HTML-Markup ist gestattet
 CourseHomepage: Homepage
 CourseShorthand: Kürzel
-CourseShorthandUnique: Muss innerhalb des Semesters eindeutig sein
+CourseShorthandUnique: Muss innerhalb Institut und Semester eindeutig sein
 CourseSemester: Semester
 CourseSchool: Institut
 CourseSchoolShort: Fach
 CourseSecretTip: Anmeldung zum Kurs erfordert Eingabe des Passworts, sofern gesetzt
+CourseSecretFormat: beliebige Zeichenkette
 CourseRegisterFromTip: Ohne Datum ist KEINE eigenständige Anmeldung von Studierenden möglich
-CourseRegisterToTip: Anmeldung darf auch ohne Begrenzung möglich sein
+CourseRegisterToTip: Anmeldung darf auch unbegrenzt offen bleiben
-CourseDeregisterUntilTip: Abmeldung darf auch ohne Begrenzung möglich sein
+CourseDeregisterUntilTip: Abmeldung darf auch unbegrenzt erlaubt bleiben
 CourseFilterSearch: Volltext-Suche
 CourseFilterRegistered: Registriert
 CourseDeleteQuestion: Wollen Sie den unten aufgeführten Kurs wirklich löschen?
@@ -342,6 +343,7 @@ LecturersFor: Dozenten
 UserListTitle: Komprehensive Benutzerliste
 AccessRightsSaved: Berechtigungsänderungen wurden gespeichert.
 
+Date: Datum
 DateTimeFormat: Datums- und Uhrzeitformat
 DateFormat: Datumsformat
 TimeFormat: Uhrzeitformat
@@ -603,6 +605,7 @@ MenuCorrectionsCreate: Abgaben registrieren
 MenuCorrectionsGrade: Abgaben bewerten
 MenuAuthPreds: Authorisierungseinstellungen
 
+AuthPredsInfo: Um eigene Veranstaltungen aus Sicht der Teilnehmer anzusehen, können Veranstalter und Korrektoren hier die Prüfung ihrer erweiterten Berechtigungen temporär deaktivieren. Abgewählte Prädikate werden nicht geprüft um Zugriffe zu gewähren, welche andernfalls nicht erlaubt wären. Diese Einstellungen gelten nur temporär bis Ihre Sitzung abgelaufen ist (d.h. bis ihr Browser-Cookie abgelaufen ist).
 AuthPredsActive: Aktive Authorisierungsprädikate
 AuthPredsActiveChanged: Authorisierungseinstellungen für aktuelle Sitzung gespeichert
 AuthTagFree: Seite ist universell zugänglich

src/Handler/Course.hs

@@ -330,11 +330,14 @@ getCourseNewR = do
             <$> iopt termNewField "tid"
             <*> iopt ciField      "ssh"
             <*> iopt ciField      "csh"
-  let noTemplateAction = courseEditHandler True Nothing
+
-  case params of -- DO NOT REMOVE: without this distinction, lecturers would never see an empty newCourseForm any more!
+
+  let noTemplateAction = courseEditHandler Nothing
+  case params of -- DO NOT REMOVE: without this distinction, lecturers would never see an empty makeCourseForm any more!
     FormMissing      -> noTemplateAction
     FormFailure msgs -> forM_ msgs (addMessage Error . toHtml) >>
                         noTemplateAction
+    FormSuccess (Nothing, Nothing, Nothing) -> noTemplateAction
     FormSuccess (fmap TermKey -> mbTid, fmap SchoolKey -> mbSsh, mbCsh) -> do
       oldCourses <- runDB $
         E.select $ E.from $ \course -> do
@@ -378,21 +381,21 @@ getCourseNewR = do
             unless cshOk $ addMessageI Warning $ MsgNoSuchCourseShorthand $ fromJust mbCsh
             when (tidOk && sshOk && cshOk) $ addMessageI Warning MsgNoSuchCourse
             return Nothing
-      courseEditHandler True template
+      courseEditHandler template
 
 postCourseNewR :: Handler Html
-postCourseNewR = courseEditHandler False Nothing -- Note: Nothing is safe here, since we will create a new course.
+postCourseNewR = courseEditHandler Nothing -- Note: Nothing is safe here, since we will create a new course.
 
 getCEditR, postCEditR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
-getCEditR  = pgCEditR True
+getCEditR  = pgCEditR
-postCEditR = pgCEditR False
+postCEditR = pgCEditR
 
-pgCEditR :: Bool -> TermId -> SchoolId -> CourseShorthand -> Handler Html
+pgCEditR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
-pgCEditR isGetReq tid ssh csh = do
+pgCEditR tid ssh csh = do
   course <- runDB $ getBy $ TermSchoolCourseShort tid ssh csh
   -- IMPORTANT: both GET and POST Handler must use the same template,
   --    since an Edit is identified via CourseID, which is not embedded in the received form data for security reasons.
-  courseEditHandler isGetReq $ courseToForm <$> course
+  courseEditHandler $ courseToForm <$> course
 
 
 getCDeleteR, postCDeleteR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
@@ -408,10 +411,10 @@ postCDeleteR tid ssh csh = do
 -- | Course Creation and Editing
 -- | IMPORTANT: in case of Edit, Post/Get Request is provided with the same CourseForm template (cannot be Nothing),
 -- |            since an edit is identified via cfCourseId which is not contained in the received form data for security reasons!
-courseEditHandler :: Bool -> Maybe CourseForm -> Handler Html -- FIXME: _isGet is not used
+courseEditHandler :: Maybe CourseForm -> Handler Html
-courseEditHandler _isGet mbCourseForm = do
+courseEditHandler mbCourseForm = do
     aid <- requireAuthId -- TODO: Verify that Editor is owner of the Course to be Edited!!!
-    ((result, formWidget), formEnctype) <- runFormPost $ newCourseForm mbCourseForm
+    ((result, formWidget), formEnctype) <- runFormPost $ makeCourseForm mbCourseForm
     case result of
       (FormSuccess res@CourseForm
         { cfCourseId = Nothing
@@ -520,8 +523,13 @@ courseToForm (Entity cid Course{..}) = CourseForm
     , cfDeRegUntil = courseDeregisterUntil
     }
 
-newCourseForm :: Maybe CourseForm -> Form CourseForm
+makeCourseForm :: Maybe CourseForm -> Form CourseForm
-newCourseForm template = identForm FIDcourse $ \html -> do
+makeCourseForm template = identForm FIDcourse $ \html -> do
+    -- TODO: Refactor to avoid the four repeated calls to liftHandlerT and three runDBs
+    -- let editCid = cfCourseId =<< template -- possible start for refactoring
+
+    mr <- liftHandlerT getMessageRender -- needed for translation of placeholders
+
     userSchools <- liftHandlerT . runDB $ do
       userId <- liftHandlerT requireAuthId
       (fmap concat . sequence)
@@ -529,9 +537,9 @@ newCourseForm template = identForm FIDcourse $ \html -> do
         , map (userAdminSchool    . entityVal) <$> selectList [UserAdminUser    ==. userId] []
         ]
 
-    termsField <- liftHandlerT $ case template of
+    termsField <- case template of
           -- Change of term is only allowed if user may delete the course (i.e. no participants) or admin
-          (Just cform)  | (Just cid) <- cfCourseId cform -> do -- edit existing course
+          (Just cform)  | (Just cid) <- cfCourseId cform -> liftHandlerT $ do -- edit existing course
               _courseOld@Course{..} <- runDB $ get404 cid
               mayEditTerm <- isAuthorized TermEditR True
               mayDelete   <- isAuthorized (CourseR courseTerm courseSchool courseShorthand CDeleteR) True
@@ -539,29 +547,37 @@ newCourseForm template = identForm FIDcourse $ \html -> do
                 | (mayEditTerm == Authorized) || (mayDelete == Authorized) -> termsAllowedField
                 | otherwise ->  termsSetField [cfTerm cform]
           _allOtherCases -> return termsAllowedField
+
+    (newRegFrom,newRegTo,newDeRegUntil) <- case template of
+        (Just cform) | (Just _cid) <- cfCourseId cform -> return (Nothing,Nothing,Nothing)
+        _allIOtherCases -> do
+            mbLastTerm <- liftHandlerT $ runDB $ selectFirst [TermActive ==. True] [Desc TermName]
+            return ( (Just . toMidnight     . termStart . entityVal) <$> mbLastTerm
+                   , (Just . beforeMidnight . termEnd   . entityVal) <$> mbLastTerm
+                   , (Just . beforeMidnight . termEnd   . entityVal) <$> mbLastTerm )
+
     (result, widget) <- flip (renderAForm FormStandard) html $ CourseForm
       <$> pure (cfCourseId =<< template)
-      <*> areq ciField (fslI MsgCourseName)          (cfName     <$> template)
+      <*> areq ciField (fslI MsgCourseName)                             (cfName       <$> template)
       <*> aopt htmlField (fslI MsgCourseDescription
-                         & setTooltip MsgCourseDescriptionTip)   (cfDesc     <$> template)
+                         & setTooltip MsgCourseDescriptionTip)          (cfDesc       <$> template)
-      <*> aopt urlField  (fslI MsgCourseHomepage)                (cfLink     <$> template)
+      <*> aopt urlField  (fslI MsgCourseHomepage)                       (cfLink       <$> template)
       <*> areq ciField (fslI MsgCourseShorthand
             -- & addAttr "disabled" "disabled"
-            & setTooltip MsgCourseShorthandUnique)
+            & setTooltip MsgCourseShorthandUnique)                      (cfShort      <$> template)
-                                                (cfShort  <$> template)
+      <*> areq termsField                     (fslI MsgCourseSemester)  (cfTerm       <$> template)
-      <*> areq termsField                   (fslI MsgCourseSemester)    (cfTerm     <$> template)
+      <*> areq (schoolFieldFor userSchools)   (fslI MsgCourseSchool)    (cfSchool     <$> template)
-      <*> areq (schoolFieldFor userSchools) (fslI MsgCourseSchool)      (cfSchool   <$> template)
+      <*> aopt (natFieldI MsgCourseCapacity)  (fslI MsgCourseCapacity
-      <*> aopt (natField "Kapazität")       (fslI MsgCourseCapacity
+            & setTooltip MsgCourseCapacityTip)                          (cfCapacity   <$> template)
-            & setTooltip MsgCourseCapacityTip)                          (cfCapacity <$> template)
+      <*> aopt textField      (fslpI MsgCourseSecret (mr MsgCourseSecretFormat)
-      <*> aopt textField      (fslpI MsgCourseSecret "beliebige Zeichenkette"
+            & setTooltip MsgCourseSecretTip)                            (cfSecret     <$> template)
-            & setTooltip MsgCourseSecretTip)                            (cfSecret   <$> template)
+      <*> areq checkBoxField  (fslI  MsgMaterialFree)                   (cfMatFree    <$> template)
-      <*> areq checkBoxField  (fslI  MsgMaterialFree)                   (cfMatFree  <$> template)
+      <*> aopt utcTimeField   (fslpI MsgRegisterFrom (mr MsgDate)
-      <*> aopt utcTimeField   (fslpI MsgRegisterFrom "Datum"
+            & setTooltip MsgCourseRegisterFromTip)                      (deepAlt (cfRegFrom    <$> template) newRegFrom)
-            & setTooltip MsgCourseRegisterFromTip)                      (cfRegFrom  <$> template)
+      <*> aopt utcTimeField   (fslpI MsgRegisterTo   (mr MsgDate)
-      <*> aopt utcTimeField   (fslpI MsgRegisterTo   "Datum"
+            & setTooltip MsgCourseRegisterToTip)                        (deepAlt (cfRegTo      <$> template) newRegTo)
-            & setTooltip MsgCourseRegisterToTip)                        (cfRegTo    <$> template)
+      <*> aopt utcTimeField   (fslpI MsgDeRegUntil   (mr MsgDate)
-      <*> aopt utcTimeField   (fslpI MsgDeRegUntil   "Datum"
+            & setTooltip MsgCourseDeregisterUntilTip)                   (deepAlt (cfDeRegUntil <$> template) newDeRegUntil)
-            & setTooltip MsgCourseDeregisterUntilTip)                   (cfDeRegUntil <$> template)
       <*  submitButton
     return $ case result of
       FormSuccess courseResult

src/Handler/Home.hs

@@ -259,6 +259,7 @@ getInfoLecturerR :: Handler Html
 getInfoLecturerR =
   siteLayoutMsg' MsgInfoLecturerTitle $ do
     setTitleI MsgInfoLecturerTitle
+    -- TODO: Translation. This is simply too much for a simple message and too akwward to cut into bits. Create i18nWidgetFile tool.
     $(widgetFile "infoLecturer")
 
 
@@ -288,6 +289,6 @@ postAuthPredsR = do
     addMessageI Success MsgAuthPredsActiveChanged
     redirect $ fromMaybe AuthPredsR mReferer
 
-  defaultLayout $ do
+  siteLayoutMsg MsgAuthPredsActive $ do
     setTitleI MsgAuthPredsActive
     $(widgetFile "authpreds")

src/Handler/Utils/DateTime.hs

@@ -1,6 +1,7 @@
 module Handler.Utils.DateTime
   ( utcToLocalTime
   , localTimeToUTC, TZ.LocalToUTCResult(..)
+  , toMidnight, beforeMidnight, toMidday, toMorning
   , formatTime, formatTime', formatTimeW
   , getTimeLocale, getDateTimeFormat
   , validDateTimeFormats, dateTimeFormatOptions
@@ -29,6 +30,24 @@ utcToLocalTime = TZ.utcToLocalTimeTZ appTZ
 localTimeToUTC :: LocalTime -> LocalToUTCResult
 localTimeToUTC = TZ.localTimeToUTCFull appTZ
 
+-- | Local midnight of given day
+toMidnight :: Day -> UTCTime
+toMidnight     d = localTimeToUTCTZ appTZ $ LocalTime d midnight
+
+-- | Local midnight of given day
+toMidday :: Day -> UTCTime
+toMidday       d = localTimeToUTCTZ appTZ $ LocalTime d midday
+
+-- | One second before the end of day
+beforeMidnight :: Day -> UTCTime
+beforeMidnight d = localTimeToUTCTZ appTZ $ LocalTime d $ TimeOfDay 23 59 59
+
+-- | 6am in the morning
+toMorning :: Day -> UTCTime
+toMorning      d = localTimeToUTCTZ appTZ $ LocalTime d $ TimeOfDay 6 0 0
+
+
+
 class FormatTime t => HasLocalTime t where
   toLocalTime :: t -> LocalTime
 
@@ -150,7 +169,6 @@ addWeeks n utct = localTimeToUTCTZ appTZ newLocal
     newDay   = addDays (7*n) oldDay
     newLocal = oldLocal { localDay = newDay }
 
-
 weeksToAdd :: UTCTime -> UTCTime -> Integer
 -- ^ Number of weeks needed to add so that first
 --   time occurs later than second time

src/Model/Types.hs

@@ -709,8 +709,7 @@ pseudonymFragments = folding
 
 
 data AuthTag
-  = AuthFree
+  = AuthAdmin
-  | AuthAdmin
   | AuthNoEscalation
   | AuthDeprecated
   | AuthDevelopment
@@ -729,6 +728,7 @@ data AuthTag
   | AuthAuthentication
   | AuthRead
   | AuthWrite
+  | AuthFree
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
 
 instance Universe AuthTag

src/Utils.hs

@@ -326,6 +326,13 @@ maybeAdd (Just x) (Just y) = Just (x + y)
 maybeAdd Nothing y  = y
 maybeAdd x Nothing  = x
 
+-- | Deep alternative to avoid any occurrence of Nothing at all costs, left-biased
+deepAlt :: Maybe (Maybe a) -> Maybe (Maybe a) -> Maybe (Maybe a)
+deepAlt Nothing        altSnd  = altSnd
+deepAlt altFst         Nothing = altFst
+deepAlt (Just Nothing) altSnd  = altSnd
+deepAlt altFst         _       = altFst
+
 maybeEmpty :: Monoid m => Maybe a -> (a -> m) -> m
 maybeEmpty = flip foldMap
 

templates/authpreds.hamlet

@@ -1,3 +1,4 @@
+_{MsgAuthPredsInfo}
 <form method=post action=@{AuthPredsR} enctype=#{authActiveEnctype}>
   $maybe referer <- mReferer
     <input type=hidden name=#{toPathPiece GetReferer} value=#{toPathPiece referer}>

templates/infoLecturer.hamlet

@@ -10,13 +10,13 @@ hier die wichtigsten Neuerungen.
       Alle Veranstaltungen müssen ein Kürzel zur Identifikation besitzen,
       z.B. EiP, ProMo, SysPrak, etc.
       <br>
-      Das Kürzel muss innerhalb Institut und Semesters eindeutig sein.
+      Das Kürzel muss innerhalb Institut und Semester eindeutig sein.
 
     <dt .deflist__dt> Kurse klonen
     <dd .deflist__dd>
       Veranstalter können <em>alle</em> Kurse Ihres Instituts für das aktuelle Semesters klonen.
       <br>
-      Dabei werden vor allem Kurkürzel und die Kursbeschreibung übernommen;
+      Dabei werden vor allem Kurskürzel und die Kursbeschreibung übernommen;
       nicht jedoch Übungsblätter, Klausuren oder Anmeldungen.
       <br>
       Die Kursbeschreibung kann in Html verfasst werden und
@@ -42,7 +42,7 @@ hier die wichtigsten Neuerungen.
   <dl .deflist>
     <dt .deflist__dt> Korrektoren
     <dd .deflist__dd>
-      Korrektoren werden ad hoc pro Übungsblatt vom Veranstalter festgelegt;
+      Korrektoren und Korrekturweise werden ad hoc pro Übungsblatt vom Veranstalter festgelegt;
       es gibt keine Korrektoren Eintragung in der Veranstaltungskonfiguration mehr.
 
       Für ein neues Blatt werden die Einstellung des vorangegangenen