chore(tutorial): add mass register button
This commit is contained in:
parent
edc23630a7
commit
e1093701ca
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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"
|
||||
|
||||
Reference in New Issue
Block a user