fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Additional Tutorial information for students

Browse Source
This commit is contained in:
Gregor Kleen 2019-04-29 11:39:09 +02:00
parent 6b86addb3e
commit aefe4c571f
5 changed files with 36 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
messages/uniworx/de.msg
View File

@ -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

28
src/Handler/Course.hs
View File

@ -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

4
src/Handler/Tutorial.hs
View File

@ -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 )

20
src/Handler/Utils/Form.hs
View File

@ -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 --

8
templates/course.hamlet
View File

@ -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}