Towards #267

messages/uniworx/de.msg

@@ -7,6 +7,7 @@ BtnHijack: Sitzung übernehmen
 
 Aborted: Abgebrochen
 Registered: Angemeldet
+RegisteredSince date@Text: Angemeldet seit #{date}
 RegisterFrom: Anmeldungen von
 RegisterTo: Anmeldungen bis
 DeRegUntil: Abmeldungen bis
@@ -108,7 +109,7 @@ SheetSolutionFrom: Lösung ab
 SheetMarking: Hinweise für Korrektoren
 SheetType: Wertung
 SheetInvisible: Dieses Übungsblatt ist für Teilnehmer momentan unsichtbar!
-SheetInvisibleUntil mFrom@Text: Dieses Übungsblatt ist für Teilnehmer momentan unsichtbar bis #{mFrom}!
+SheetInvisibleUntil date@Text: Dieses Übungsblatt ist für Teilnehmer momentan unsichtbar bis #{date}!
 SheetName: Name
 SheetDescription: Hinweise für Teilnehmer
 SheetGroup: Gruppenabgabe

src/Handler/Course.hs

@@ -259,25 +259,30 @@ getTermCourseListR tid = do
 getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCShowR tid ssh csh = do
   mbAid <- maybeAuthId
-  (courseEnt,(schoolMB,participants,registered),lecturers) <- runDB $ do
-      courseEnt@(Entity cid course) <- getBy404 $ TermSchoolCourseShort tid ssh csh
-      dependent <- (,,)
-          <$> get (courseSchool course)               -- join -- just fetch full school name here
-          <*> count [CourseParticipantCourse ==. cid] -- join
-          <*> (case mbAid of -- TODO: Someone please refactor this late-night mess here!
-                Nothing -> return False
-                (Just aid) -> do  regL <- getBy (UniqueParticipant aid cid)
-                                  return $ isJust regL)
-      lecturers <- E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do
-          E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
-          E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
-          return $ user E.^. UserDisplayName
-      return (courseEnt,dependent,E.unValue <$> lecturers)
-  let course = entityVal courseEnt
-  (regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerForm registered $ courseRegisterSecret course
-  registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid ssh csh CRegisterR) True
+  (course,schoolName,participants,registered,lecturers) <- runDB . maybeT notFound $ do
+    [(E.Entity cid course, E.Value schoolName, E.Value participants, E.Value registered)]
+       <- lift . E.select . E.from $
+         \((school `E.InnerJoin` course) `E.LeftOuterJoin` participant) -> do
+            E.on $ E.just (course E.^. CourseId) E.==. participant E.?. CourseParticipantCourse
+                E.&&. E.val mbAid E.==. participant E.?. CourseParticipantUser
+            E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
+            E.where_ $ course E.^. CourseTerm      E.==. E.val tid
+                 E.&&. course E.^. CourseSchool    E.==. E.val ssh
+                 E.&&. course E.^. CourseShorthand E.==. E.val csh
+            let numParticipants = E.sub_select . E.from $ \part -> do
+                  E.where_ $ part E.^. CourseParticipantCourse E.==. course E.^. CourseId
+                  return ( E.countRows :: E.SqlExpr (E.Value Int64))
+            return (course,school E.^. SchoolName, numParticipants, participant E.?. CourseParticipantRegistration)
+    lecturers <- lift . E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do
+      E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
+      E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
+      return $ user E.^. UserDisplayName
+    return (course,schoolName,participants,registered,map E.unValue lecturers)
   mRegFrom <- traverse (formatTime SelFormatDateTime) $ courseRegisterFrom course
   mRegTo   <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo course
+  mRegAt   <- traverse (formatTime SelFormatDateTime) $ registered
+  (regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerForm (isJust mRegAt) $ courseRegisterSecret course
+  registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid ssh csh CRegisterR) True
   defaultLayout $ do
     setTitle [shamlet| #{toPathPiece tid} - #{csh}|]
     $(widgetFile "course")

templates/course.hamlet

@@ -1,10 +1,9 @@
 <div .container>
   <dl .deflist>
-    $maybe school <- schoolMB
-      <dt .deflist__dt>Fakultät/Institut
-      <dd .deflist__dd>
-        <div>
-          #{schoolName school}
+    <dt .deflist__dt>Fakultät/Institut
+    <dd .deflist__dd>
+      <div>
+        #{schoolName}
 
     $maybe descr <- courseDescription course
       <dt .deflist__dt>_{MsgCourseDescription}
@@ -33,20 +32,23 @@ $#    $if NTop (Just 0) < NTop (courseCapacity course)
           #{participants}
           $maybe capacity <- courseCapacity course
             \ von #{capacity}
-      $maybe regFrom <- mRegFrom
-        <dt .deflist__dt>Anmeldezeitraum
-        <dd .deflist__dd>
-          <div>
-            Ab #{regFrom}
-            $maybe regTo <- mRegTo
-              \ bis #{regTo}
-    $if registrationOpen
+    $maybe regFrom <- mRegFrom
+      <dt .deflist__dt>Anmeldezeitraum
+      <dd .deflist__dd>
+        <div>
+          Ab #{regFrom}
+          $maybe regTo <- mRegTo
+            \ bis #{regTo}
+    $if registrationOpen || isJust mRegAt
       <dt .deflist__dt>
       <dd .deflist__dd>
         <div .course__registration>
-          <form method=post action=@{CourseR tid ssh csh CRegisterR} enctype=#{regEnctype}>
-            $# regWidget is defined through templates/widgets/registerForm
-            ^{regWidget}
+          $if registrationOpen
+            <form method=post action=@{CourseR tid ssh csh CRegisterR} enctype=#{regEnctype}>
+              $# regWidget is defined through templates/widgets/registerForm
+              ^{regWidget}
+          $maybe date <- mRegAt
+            _{MsgRegisteredSince date}
     <dt .deflist__dt>
       Material
     <dd .deflist__dd>

templates/widgets/registerForm.hamlet

@@ -5,4 +5,3 @@ $maybe secretView <- msecretView
   ^{fvInput secretView}
 $# Always display register/deregister button
 ^{fvInput btnView}
-