diff --git a/messages/uniworx/utils/buttons/de-de-formal.msg b/messages/uniworx/utils/buttons/de-de-formal.msg index adf9d75ab..63aa1c547 100644 --- a/messages/uniworx/utils/buttons/de-de-formal.msg +++ b/messages/uniworx/utils/buttons/de-de-formal.msg @@ -7,6 +7,7 @@ BtnAbort: Abbrechen BtnDelete: Löschen BtnRegister: Anmelden BtnDeregister: Abmelden +MassRegister: Andere anmelden BtnCourseRegister: Zum Kurs anmelden BtnCourseDeregister: Vom Kurs abmelden BtnExamRegister: Anmelden zur Prüfung diff --git a/messages/uniworx/utils/buttons/en-eu.msg b/messages/uniworx/utils/buttons/en-eu.msg index 5b3a7aadc..a83a7b3aa 100644 --- a/messages/uniworx/utils/buttons/en-eu.msg +++ b/messages/uniworx/utils/buttons/en-eu.msg @@ -7,6 +7,7 @@ BtnAbort: Abort BtnDelete: Delete BtnRegister: Register BtnDeregister: Deregister +MassRegister: Register others BtnCourseRegister: Enrol for course BtnCourseDeregister: Leave course BtnExamRegister: Enrol for exam diff --git a/src/Handler/Course/Show.hs b/src/Handler/Course/Show.hs index ee3807fc3..85be88849 100644 --- a/src/Handler/Course/Show.hs +++ b/src/Handler/Course/Show.hs @@ -29,7 +29,7 @@ import Handler.Exam.List (mkExamTable) getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getCShowR tid ssh csh = do - mbAid <- maybeAuthId + mbAid <- maybeAuthId now <- liftIO getCurrentTime (cid,course,courseVisible,schoolName,participants,registration,lecturers,assistants,administrators,correctors,tutors,news,events,submissionGroup,_mayReRegister,(mayViewSheets, mayViewAnySheet), (mayViewMaterials, mayViewAnyMaterial),courseQualifications) <- runDB . maybeT notFound $ do [(E.Entity cid course, E.Value courseVisible, E.Value schoolName, E.Value participants, fmap entityVal -> registration)] @@ -145,7 +145,9 @@ getCShowR tid ssh csh = do } | otherwise -> return . modal $(widgetFile "course/login-to-register") . Left . SomeRoute $ AuthR LoginR - registrationOpen <- hasWriteAccessTo $ CourseR tid ssh csh CRegisterR + registrationOpen <- hasWriteAccessTo $ CourseR tid ssh csh CRegisterR + mayMassRegister <- hasWriteAccessTo $ CourseR tid ssh csh CAddUserR + isRegistered <- MsgRenderer mr <- getMsgRenderer @@ -164,9 +166,10 @@ getCShowR tid ssh csh = do dbtRowKey = (E.^. TutorialId) dbtProj = over (_dbrOutput . _2) E.unValue <$> dbtProjId dbtColonnade = dbColonnade $ mconcat - [ sortable (Just "type") (i18nCell MsgTableTutorialType) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> textCell $ CI.original tutorialType - , sortable (Just "name") (i18nCell MsgTableTutorialName) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> indicatorCell <> anchorCell (CTutorialR tid ssh csh tutorialName TUsersR) [whamlet|#{tutorialName}|] - , sortable (Just "tutors") (i18nCell MsgTableTutorialTutors) $ \(view $ resultTutorial . _entityKey -> tutid) -> sqlCell $ do + [ sortable (Just "type") (i18nCell MsgTableTutorialType) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> textCell $ CI.original tutorialType + , sortable (Just "first-day") (i18nCell MsgTableTutorialFirstDay) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> cellMaybe dayCell tutorialFirstDay + , sortable (Just "name") (i18nCell MsgTableTutorialName) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> indicatorCell <> anchorCell (CTutorialR tid ssh csh tutorialName TUsersR) [whamlet|#{tutorialName}|] + , sortable (Just "tutors") (i18nCell MsgTableTutorialTutors) $ \(view $ resultTutorial . _entityKey -> tutid) -> sqlCell $ do tutTutors <- 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 @@ -194,25 +197,30 @@ getCShowR tid ssh csh = do E.where_ $ participant E.^. TutorialParticipantTutorial E.==. E.val tutid in return $ E.val tutorialCapacity' E.-. numParticipants return . toWidget $ tshow freeCapacity - , sortable Nothing (mempty & cellAttrs <>~ pure ("uw-hide-columns--hider-label", mr MsgTableActionsHead)) $ \(view resultTutorial -> Entity tutId Tutorial{..}) -> sqlCell $ do - mayRegister <- (== Authorized) <$> evalAccessDB (CTutorialR tid ssh csh tutorialName TRegisterR) True - isRegistered <- case mbAid of - Nothing -> return False - Just uid -> existsBy $ UniqueTutorialParticipant tutId uid - if - | mayRegister -> do - (tutRegisterForm, tutRegisterEnctype) <- liftHandler . generateFormPost . buttonForm' $ bool [BtnRegister] [BtnDeregister] isRegistered - return $ wrapForm tutRegisterForm def - { formAction = Just . SomeRoute $ CTutorialR tid ssh csh tutorialName TRegisterR - , formEncoding = tutRegisterEnctype - , formSubmit = FormNoSubmit - } - | isRegistered -> return [whamlet|_{MsgTutorialRegistered}|] - | otherwise -> return mempty + , guardMonoid (not mayMassRegister || isJust registration) $ + sortable Nothing (mempty & cellAttrs <>~ pure ("uw-hide-columns--hider-label", mr MsgTableActionsHead)) $ \(view resultTutorial -> Entity tutId Tutorial{..}) -> sqlCell $ do + mayRegister <- (== Authorized) <$> evalAccessDB (CTutorialR tid ssh csh tutorialName TRegisterR) True + isRegistered <- case mbAid of + Nothing -> return False + Just uid -> existsBy $ UniqueTutorialParticipant tutId uid + if + | mayRegister -> do + (tutRegisterForm, tutRegisterEnctype) <- liftHandler . generateFormPost . buttonForm' $ bool [BtnRegister] [BtnDeregister] isRegistered + return $ wrapForm tutRegisterForm def + { formAction = Just . SomeRoute $ CTutorialR tid ssh csh tutorialName TRegisterR + , formEncoding = tutRegisterEnctype + , formSubmit = FormNoSubmit + } + | isRegistered -> return [whamlet|_{MsgTutorialRegistered}|] + | otherwise -> return mempty + , guardMonoid mayMassRegister $ + sortable Nothing (mempty & cellAttrs <>~ pure ("uw-hide-columns--hider-label", mr MsgTableActionsHead)) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> + cell $ linkButton mempty (msg2widget MsgMassRegister) [BCIsButton, BCPrimary] (SomeRoute $ CTutorialR tid ssh csh tutorialName TAddUserR) ] dbtSorting = Map.fromList [ ("type", SortColumn $ \tutorial -> tutorial E.^. TutorialType ) , ("name", SortColumn $ \tutorial -> tutorial E.^. TutorialName ) + , ("first-day", SortColumnNullsInv $ \tutorial -> tutorial E.^. TutorialFirstDay ) , ("room", SortColumn $ \tutorial -> tutorial E.^. TutorialRoom ) , ("register-from", SortColumn $ \tutorial -> tutorial E.^. TutorialRegisterFrom ) , ("register-to", SortColumn $ \tutorial -> tutorial E.^. TutorialRegisterTo ) @@ -235,7 +243,7 @@ getCShowR tid ssh csh = do dbtExtraReps = [] tutorialDBTableValidator = def - & defaultSorting [SortAscBy "type", SortDescBy "name"] + & defaultSorting [SortAscBy "type", SortDescBy "first-day", SortAscBy "name"] (Any hasTutorials, tutorialTable) <- runDB $ dbTable tutorialDBTableValidator tutorialDBTable (Any hasExams, examTable) <- runDB . mkExamTable $ Entity cid course diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 67780ec37..55b5c32e3 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -1064,6 +1064,46 @@ fillDb = do , tutorialTutorControlled = True , tutorialFirstDay = Just firstDay } + insert_ Tutorial + { tutorialName = mkName "Sondertutoriumsvorlage" + , tutorialCourse = c + , tutorialType = "Vorlage_Sondertutorium" + , tutorialCapacity = capacity + , tutorialRoom = Just $ case weekDay of + Monday -> "A380" + Tuesday -> "B747" + Wednesday -> "MD11" + Thursday -> "A380" + _ -> "B777" + , tutorialRoomHidden = False + , tutorialTime = Occurrences + { occurrencesScheduled = Set.empty + , occurrencesExceptions = Set.fromList + [ ExceptOccur + { exceptDay = succ $ succ firstDay + , exceptStart = TimeOfDay 8 25 0 + , exceptEnd = TimeOfDay 16 25 0 + } + , ExceptOccur + { exceptDay = succ $ succ $ succ $ succ firstDay + , exceptStart = TimeOfDay 9 20 0 + , exceptEnd = TimeOfDay 16 20 0 + } + , ExceptOccur + { exceptDay = succ $ succ $ secondDay + , exceptStart = TimeOfDay 10 12 0 + , exceptEnd = TimeOfDay 12 13 0 + } + ] + } + , tutorialRegGroup = Just "sondertutorium" + , tutorialRegisterFrom = jtt TermDayStart 0 Nothing toMidnight + , tutorialRegisterTo = jtt TermDayLectureStart (-1) Nothing toMidnight + , tutorialDeregisterUntil = jtt TermDayLectureStart (-5) (Just Monday) toMidnight + , tutorialLastChanged = now + , tutorialTutorControlled = True + , tutorialFirstDay = Just $ succ $ succ $ firstDay + } void . insert' $ Exam { examCourse = c , examName = mkName "Theorieprüfung"