From aefe4c571f0490040a717ae895007a4b266325f9 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Mon, 29 Apr 2019 11:39:09 +0200
Subject: [PATCH] Additional Tutorial information for students

---
 messages/uniworx/de.msg   |  1 +
 src/Handler/Course.hs     | 28 +++++++++++++++++++++-------
 src/Handler/Tutorial.hs   |  4 ++--
 src/Handler/Utils/Form.hs | 20 ++++++++++++--------
 templates/course.hamlet   |  8 --------
 5 files changed, 36 insertions(+), 25 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 7f51fb19d..4b8c7f201 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -839,6 +839,7 @@ TutorialType: Typ
 TutorialName: Bezeichnung
 TutorialParticipants: Teilnehmer
 TutorialCapacity: Kapazität
+TutorialFreeCapacity: Freie Plätze
 TutorialRoom: Regulärer Raum
 TutorialTime: Zeit
 TutorialRegistered: Angemeldet
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index eb29d534a..baceefdd1 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -274,7 +274,7 @@ getTermCourseListR tid = do
 getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCShowR tid ssh csh = do
   mbAid <- maybeAuthId
-  (cid,course,schoolName,participants,registration,defSFid,lecturers,assistants,tutors,correctors) <- runDB . maybeT notFound $ do
+  (cid,course,schoolName,participants,registration,defSFid,lecturers,assistants,correctors) <- runDB . maybeT notFound $ do
     [(E.Entity cid course, E.Value schoolName, E.Value participants, fmap entityVal -> registration)]
        <- lift . E.select . E.from $
          \((school `E.InnerJoin` course) `E.LeftOuterJoin` participant) -> do
@@ -300,18 +300,13 @@ getCShowR tid ssh csh = do
         partStaff (CourseLecturer  ,name,surn,mail) = Right (name,surn,mail)
         partStaff (_courseAssistant,name,surn,mail) = Left (name,surn,mail)
         (assistants,lecturers) = partitionWith  partStaff $ map $(unValueN 4) staff
-    tutors <- fmap (map $(unValueN 3)) . lift . E.select $ E.from $ \(tutorial `E.InnerJoin` tutor `E.InnerJoin` user) -> E.distinctOnOrderBy [E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName, E.asc $ user E.^. UserEmail ] $ do
-      E.on $ tutor E.^. TutorUser E.==. user E.^. UserId
-      E.on $ tutor E.^. TutorTutorial E.==. tutorial E.^. TutorialId
-      E.where_ $ tutorial E.^. TutorialCourse E.==. E.val cid
-      return ( user E.^. UserEmail, user E.^. UserDisplayName, user E.^. UserSurname )
     correctors <- fmap (map $(unValueN 3)) . lift . E.select $ E.from $ \(sheet `E.InnerJoin` sheetCorrector `E.InnerJoin` user) -> E.distinctOnOrderBy [E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName, E.asc $ user E.^. UserEmail ] $ do
       E.on $ sheetCorrector E.^. SheetCorrectorUser E.==. user E.^. UserId
       E.on $ sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId
       E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
       E.orderBy [ E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName ]
       return ( user E.^. UserEmail, user E.^. UserDisplayName, user E.^. UserSurname )
-    return (cid,course,schoolName,participants,registration,entityKey <$> defSFid,lecturers,assistants,tutors,correctors)
+    return (cid,course,schoolName,participants,registration,entityKey <$> defSFid,lecturers,assistants,correctors)
 
   mRegFrom <- traverse (formatTime SelFormatDateTime) $ courseRegisterFrom    course
   mRegTo   <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo      course
@@ -336,11 +331,30 @@ getCShowR tid ssh csh = do
         dbtColonnade = dbColonnade $ mconcat
           [ sortable (Just "type") (i18nCell MsgTutorialType) $ \DBRow{ dbrOutput = Entity _ Tutorial{..} } -> textCell $ CI.original tutorialType
           , sortable (Just "name") (i18nCell MsgTutorialName) $ \DBRow{ dbrOutput = Entity _ Tutorial{..} } -> indicatorCell <> textCell (CI.original tutorialName)
+          , sortable Nothing (i18nCell MsgTutorialTutors) $ \DBRow{ dbrOutput = Entity tutid _ } -> sqlCell $ do
+              tutors <- fmap (map $(unValueN 3)) . E.select . E.from $ \(tutor `E.InnerJoin` user) -> do
+                E.on $ tutor E.^. TutorUser E.==. user E.^. UserId
+                E.where_ $ tutor E.^. TutorTutorial E.==. E.val tutid
+                return (user E.^. UserEmail, user E.^. UserDisplayName, user E.^. UserSurname)
+              return [whamlet|
+                       <ul .list--iconless .list--inline .list--comma-separated>
+                         $forall tutor <- tutors
+                           <li>
+                             ^{nameEmailWidget' tutor}
+                     |]
           , sortable (Just "room") (i18nCell MsgTutorialRoom) $ \DBRow{ dbrOutput = Entity _ Tutorial{..} } -> textCell tutorialRoom
           , sortable Nothing (i18nCell MsgTutorialTime) $ \DBRow{ dbrOutput = Entity _ Tutorial{..} } -> occurencesCell tutorialTime
           , sortable (Just "register-from") (i18nCell MsgTutorialRegisterFrom) $ \DBRow{ dbrOutput = Entity _ Tutorial{..} } -> maybeDateTimeCell tutorialRegisterFrom
           , sortable (Just "register-to") (i18nCell MsgTutorialRegisterTo) $ \DBRow{ dbrOutput = Entity _ Tutorial{..} } -> maybeDateTimeCell tutorialRegisterTo
           , sortable (Just "deregister-until") (i18nCell MsgTutorialDeregisterUntil) $ \DBRow{ dbrOutput = Entity _ Tutorial{..} } -> maybeDateTimeCell tutorialDeregisterUntil
+          , sortable Nothing (i18nCell MsgTutorialFreeCapacity) $ \DBRow{ dbrOutput = Entity tutid Tutorial{..} } -> case tutorialCapacity of
+              Nothing -> mempty
+              Just tutorialCapacity' -> sqlCell $ do
+                [E.Value freeCapacity] <- E.select $ let numParticipants = E.sub_select . E.from $ \participant -> do
+                                                           E.where_ $ participant E.^. TutorialParticipantTutorial E.==. E.val tutid
+                                                           return E.countRows :: E.SqlQuery (E.SqlExpr (E.Value Int))
+                                                      in return $ E.val tutorialCapacity' E.-. numParticipants
+                return . toWidget . tshow $ max 0 freeCapacity
           , sortable Nothing mempty $ \DBRow{ dbrOutput = Entity tutId Tutorial{..} } -> sqlCell $ do
               mayRegister <- (== Authorized) <$> evalAccessDB (CTutorialR tid ssh csh tutorialName TRegisterR) True
               isRegistered <- case mbAid of
diff --git a/src/Handler/Tutorial.hs b/src/Handler/Tutorial.hs
index c8c5bd108..3e8264169 100644
--- a/src/Handler/Tutorial.hs
+++ b/src/Handler/Tutorial.hs
@@ -63,8 +63,8 @@ getCTutorialListR tid ssh csh = do
           , sortable (Just "register-to") (i18nCell MsgTutorialRegisterTo) $ \DBRow{ dbrOutput = (Entity _ Tutorial{..}, _) } -> maybeDateTimeCell tutorialRegisterTo
           , sortable (Just "deregister-until") (i18nCell MsgTutorialDeregisterUntil) $ \DBRow{ dbrOutput = (Entity _ Tutorial{..}, _) } -> maybeDateTimeCell tutorialDeregisterUntil
           , sortable Nothing mempty $ \DBRow{ dbrOutput = (Entity _ Tutorial{..}, _) } -> cell $ do
-              linkButton [whamlet|_{MsgTutorialEdit}|] [BCIsButton] . SomeRoute $ CTutorialR tid ssh csh tutorialName TEditR
-              linkButton [whamlet|_{MsgTutorialDelete}|] [BCIsButton, BCDanger] . SomeRoute $ CTutorialR tid ssh csh tutorialName TDeleteR
+              linkButton mempty [whamlet|_{MsgTutorialEdit}|] [BCIsButton] . SomeRoute $ CTutorialR tid ssh csh tutorialName TEditR
+              linkButton mempty [whamlet|_{MsgTutorialDelete}|] [BCIsButton, BCDanger] . SomeRoute $ CTutorialR tid ssh csh tutorialName TDeleteR
           ]
         dbtSorting = Map.fromList
           [ ("type", SortColumn $ \tutorial -> tutorial E.^. TutorialType )
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 5f334f22f..bc0817d50 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -131,14 +131,18 @@ nullaryPathPiece ''ButtonSubmitDelete $ camelToPathPiece' 1 . dropSuffix "'"
 -- instance PathPiece LinkButton where
 --     LinkButton route = ???
 
-linkButton :: Widget -> [ButtonClass UniWorX] -> SomeRoute UniWorX -> Widget -- Alternative: Handler.Utils.simpleLink
-linkButton lbl cls url = do
-  url' <- toTextUrl url
-  [whamlet|
-    $newline never
-    <a href=#{url'} class=#{unwords $ map toPathPiece cls} role=button>
-      ^{lbl}
-  |]
+linkButton :: Widget -> Widget -> [ButtonClass UniWorX] -> SomeRoute UniWorX -> Widget -- Alternative: Handler.Utils.simpleLink
+linkButton defWdgt lbl cls url = do
+  access <- evalAccess (urlRoute url) False
+  case access of
+    Unauthorized _ -> defWdgt
+    _other -> do
+      url' <- toTextUrl url
+      [whamlet|
+        $newline never
+        <a href=#{url'} class=#{unwords $ map toPathPiece cls} role=button>
+          ^{lbl}
+      |]
 
 --------------------------
 -- Interactive fieldset --
diff --git a/templates/course.hamlet b/templates/course.hamlet
index 2d4f134be..dfe9c0235 100644
--- a/templates/course.hamlet
+++ b/templates/course.hamlet
@@ -33,14 +33,6 @@
             <ul .list--inline .list--comma-separated>
               $forall assi <- assistants
                 <li>^{nameEmailWidget' assi}
-    $with numtutor <- length tutors
-      $if numtutor /= 0
-        <dt .deflist__dt>_{MsgTutorsFor numtutor}
-        <dd .deflist__dd>
-          <div>
-            <ul .list--inline .list--comma-separated>
-              $forall tutor <- tutors
-                <li>^{nameEmailWidget' tutor}
     $with numcorrector <- length correctors
       $if numcorrector /= 0
         <dt .deflist__dt>_{MsgCorrectorsFor numcorrector}