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|
+
+ $forall tutor <- tutors
+ -
+ ^{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
-
- ^{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
+
+ ^{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 @@
$forall assi <- assistants
- ^{nameEmailWidget' assi}
- $with numtutor <- length tutors
- $if numtutor /= 0
-
- _{MsgTutorsFor numtutor}
-
-
-
-
- $forall tutor <- tutors
- - ^{nameEmailWidget' tutor}
$with numcorrector <- length correctors
$if numcorrector /= 0
- _{MsgCorrectorsFor numcorrector}