feat(tutorials): first stub of schedule-opt buttons
This commit is contained in:
Sarah Vaupel
parent
0ecc3c689f
commit
fd276879ad
@ -41,6 +41,10 @@ BtnSystemMessageUnhide: Nicht mehr verstecken
|
||||
BtnCommunicationSend: Senden
|
||||
BtnCommunicationTest: Test-Nachricht verschicken
|
||||
|
||||
BtnScheduleOptIn: Abonnieren
|
||||
BtnScheduleOptOut: Deabonnieren
|
||||
BtnScheduleOptDel: Standard-Abonnement
|
||||
|
||||
|
||||
Aborted: Abgebrochen
|
||||
Remarks: Hinweise
|
||||
@ -1494,7 +1498,7 @@ BreadcrumbSubmission: Abgabe
|
||||
BreadcrumbCourseNews: Kursnachricht
|
||||
BreadcrumbCourseNewsDelete: Kursnachricht löschen
|
||||
BreadcrumbCourseEventDelete: Kurstermin löschen
|
||||
BreadcrumbCourseEventScheduleOpt: Kurstermin (de)abonnieren
|
||||
BreadcrumbScheduleOpt: Termin (de)abonnieren
|
||||
BreadcrumbProfile: Einstellungen
|
||||
BreadcrumbAllocationInfo: Ablauf einer Zentralanmeldung
|
||||
BreadcrumbCourseParticipantInvitation: Einladung zum Kursteilnehmer
|
||||
|
||||
@ -42,6 +42,10 @@ BtnScheduleViewWeek: Week
|
||||
BtnCommunicationSend: Send
|
||||
BtnCommunicationTest: Send test message
|
||||
|
||||
BtnScheduleOptIn: Subscribe
|
||||
BtnScheduleOptOut: Unsubscribe
|
||||
BtnScheduleOptDel: Default subscription
|
||||
|
||||
|
||||
Aborted: Aborted
|
||||
Remarks: Remarks
|
||||
@ -1495,7 +1499,7 @@ BreadcrumbSubmission: Submission
|
||||
BreadcrumbCourseNews: Course news
|
||||
BreadcrumbCourseNewsDelete: Delete course news
|
||||
BreadcrumbCourseEventDelete: Delete course occurrence
|
||||
BreadcrumbCourseEventScheduleOpt: (Un)subscribe to/from course event
|
||||
BreadcrumbScheduleOpt: (Un)subscribe to/from event
|
||||
BreadcrumbProfile: Settings
|
||||
BreadcrumbAllocationInfo: On central allocations
|
||||
BreadcrumbCourseParticipantInvitation: Invitation to be a course participant
|
||||
|
||||
2
routes
2
routes
@ -188,6 +188,8 @@
|
||||
/register TRegisterR POST !timeANDcapacityANDcourse-registeredANDregister-group !timeANDtutorial-registered
|
||||
/communication TCommR GET POST !tutor
|
||||
/tutor-invite TInviteR GET POST !tutorANDtutor-control
|
||||
/schedule-opt/set/#Bool TScheduleOptSetR GET POST !free
|
||||
/schedule-opt/del TScheduleOptDelR GET POST !free
|
||||
/exams CExamListR GET !tutor !corrector !exam-corrector !course-registered !course-time !exam-office
|
||||
/exams/new CExamNewR GET POST
|
||||
/exams/#ExamName ExamR:
|
||||
|
||||
@ -207,8 +207,8 @@ instance BearerAuthSite UniWorX => YesodBreadcrumbs UniWorX where
|
||||
|
||||
breadcrumb (CourseR tid ssh csh CEventsNewR) = i18nCrumb MsgMenuCourseEventNew . Just $ CourseR tid ssh csh CShowR
|
||||
breadcrumb (CourseR tid ssh csh (CourseEventR _cID sRoute)) = case sRoute of
|
||||
CEvScheduleOptSetR _ -> i18nCrumb MsgBreadcrumbCourseEventScheduleOpt . Just $ CourseR tid ssh csh CShowR
|
||||
CEvScheduleOptDelR -> i18nCrumb MsgBreadcrumbCourseEventScheduleOpt . Just $ CourseR tid ssh csh CShowR
|
||||
CEvScheduleOptSetR _ -> i18nCrumb MsgBreadcrumbScheduleOpt . Just $ CourseR tid ssh csh CShowR
|
||||
CEvScheduleOptDelR -> i18nCrumb MsgBreadcrumbScheduleOpt . Just $ CourseR tid ssh csh CShowR
|
||||
CEvEditR -> i18nCrumb MsgMenuCourseEventEdit . Just $ CourseR tid ssh csh CShowR
|
||||
CEvDeleteR -> i18nCrumb MsgBreadcrumbCourseEventDelete . Just $ CourseR tid ssh csh CShowR
|
||||
|
||||
@ -250,6 +250,8 @@ instance BearerAuthSite UniWorX => YesodBreadcrumbs UniWorX where
|
||||
TCommR -> i18nCrumb MsgMenuTutorialComm . Just $ CTutorialR tid ssh csh tutn TUsersR
|
||||
TRegisterR -> i18nCrumb MsgBreadcrumbTutorialRegister . Just $ CourseR tid ssh csh CShowR
|
||||
TInviteR -> i18nCrumb MsgBreadcrumbTutorInvite . Just $ CTutorialR tid ssh csh tutn TUsersR
|
||||
(TScheduleOptSetR _) -> i18nCrumb MsgBreadcrumbScheduleOpt . Just $ CourseR tid ssh csh CTutorialListR
|
||||
TScheduleOptDelR -> i18nCrumb MsgBreadcrumbScheduleOpt . Just $ CourseR tid ssh csh CTutorialListR
|
||||
|
||||
breadcrumb (CourseR tid ssh csh (SheetR shn sRoute)) = case sRoute of
|
||||
SShowR -> maybeT (i18nCrumb MsgBreadcrumbSheet . Just $ CourseR tid ssh csh SheetListR) $ do
|
||||
|
||||
@ -178,7 +178,7 @@ getCShowR tid ssh csh = do
|
||||
isRegistered <- case mbAuth of
|
||||
Nothing -> return False
|
||||
Just (uid,_) -> existsBy $ UniqueTutorialParticipant tutId uid
|
||||
if
|
||||
tutRegister <- if
|
||||
| mayRegister -> do
|
||||
(tutRegisterForm, tutRegisterEnctype) <- liftHandler . generateFormPost . buttonForm' $ bool [BtnRegister] [BtnDeregister] isRegistered
|
||||
return $ wrapForm tutRegisterForm def
|
||||
@ -188,6 +188,31 @@ getCShowR tid ssh csh = do
|
||||
}
|
||||
| isRegistered -> return [whamlet|_{MsgTutorialRegistered}|]
|
||||
| otherwise -> return mempty
|
||||
tutScheduleOptSet <- if
|
||||
| Just (uid,User{..}) <- mbAuth -> do
|
||||
mScheduleOpt <- getBy $ UniqueTutorialScheduleOpt tutId uid
|
||||
let currentOpt = maybe userScheduleOccurrenceDisplayDefault tutorialScheduleOptOpt $ entityVal <$> mScheduleOpt
|
||||
(tutScheduleForm, tutScheduleEnctype) <- liftHandler . generateFormPost . buttonForm' $ bool [BtnScheduleOptIn] [BtnScheduleOptOut] currentOpt
|
||||
return $ wrapForm tutScheduleForm def
|
||||
{ formAction = Just . SomeRoute $ CTutorialR tid ssh csh tutorialName (TScheduleOptSetR $ not currentOpt)
|
||||
, formEncoding = tutScheduleEnctype
|
||||
, formSubmit = FormNoSubmit
|
||||
}
|
||||
| otherwise -> return mempty
|
||||
tutScheduleOptDel <- if
|
||||
| Just (uid,_) <- mbAuth -> do
|
||||
mScheduleOpt <- getBy $ UniqueTutorialScheduleOpt tutId uid
|
||||
if is _Just mScheduleOpt
|
||||
then do
|
||||
(tutScheduleOptDelForm, tutScheduleOptDelEnctype) <- liftHandler . generateFormPost . buttonForm' $ [BtnScheduleOptDel]
|
||||
return $ wrapForm tutScheduleOptDelForm def
|
||||
{ formAction = Just . SomeRoute $ CTutorialR tid ssh csh tutorialName TScheduleOptDelR
|
||||
, formEncoding = tutScheduleOptDelEnctype
|
||||
, formSubmit = FormNoSubmit
|
||||
}
|
||||
else return mempty
|
||||
| otherwise -> return mempty
|
||||
return $ tutRegister <> tutScheduleOptSet <> tutScheduleOptDel
|
||||
]
|
||||
dbtSorting = Map.fromList
|
||||
[ ("type", SortColumn $ \tutorial -> tutorial E.^. TutorialType )
|
||||
|
||||
@ -9,5 +9,6 @@ import Handler.Tutorial.Form as Handler.Tutorial
|
||||
import Handler.Tutorial.List as Handler.Tutorial
|
||||
import Handler.Tutorial.New as Handler.Tutorial
|
||||
import Handler.Tutorial.Register as Handler.Tutorial
|
||||
import Handler.Tutorial.Schedule as Handler.Tutorial
|
||||
import Handler.Tutorial.TutorInvite as Handler.Tutorial
|
||||
import Handler.Tutorial.Users as Handler.Tutorial
|
||||
|
||||
16
src/Handler/Tutorial/Schedule.hs
Normal file
16
src/Handler/Tutorial/Schedule.hs
Normal file
@ -0,0 +1,16 @@
|
||||
module Handler.Tutorial.Schedule
|
||||
( getTScheduleOptSetR, postTScheduleOptSetR
|
||||
, getTScheduleOptDelR, postTScheduleOptDelR
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
|
||||
getTScheduleOptSetR, postTScheduleOptSetR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Bool -> Handler Html
|
||||
getTScheduleOptSetR = postTScheduleOptSetR
|
||||
postTScheduleOptSetR _tid _ssh _csh _tutn _opt = error "WIP"
|
||||
|
||||
|
||||
getTScheduleOptDelR, postTScheduleOptDelR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html
|
||||
getTScheduleOptDelR = postTScheduleOptDelR
|
||||
postTScheduleOptDelR _tid _ssh _csh _tutn = error "WIP"
|
||||
@ -153,6 +153,18 @@ instance Button UniWorX ButtonSubmitDelete where
|
||||
nullaryPathPiece ''ButtonSubmitDelete $ camelToPathPiece' 1 . dropSuffix "'"
|
||||
|
||||
|
||||
data ButtonScheduleOpt = BtnScheduleOptIn | BtnScheduleOptOut | BtnScheduleOptDel
|
||||
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
|
||||
instance Universe ButtonScheduleOpt
|
||||
instance Finite ButtonScheduleOpt
|
||||
|
||||
nullaryPathPiece ''ButtonScheduleOpt $ camelToPathPiece' 1
|
||||
|
||||
embedRenderMessage ''UniWorX ''ButtonScheduleOpt id
|
||||
instance Button UniWorX ButtonScheduleOpt where
|
||||
btnClasses = const [BCIsButton, BCPrimary]
|
||||
|
||||
|
||||
-- -- Looks like a button, but is just a link (e.g. for create course, etc.)
|
||||
-- data LinkButton = LinkButton (Route UniWorX)
|
||||
-- deriving (Enum, Eq, Ord, Bounded, Read, Show)
|
||||
|
||||
@ -260,6 +260,7 @@ $# $if NTop (Just 0) < NTop (courseCapacity course)
|
||||
_{MsgCourseEventRoom}
|
||||
<th .table__th uw-hide-column-header="note" :hiddenEventNotes:.course-event-note--hidden>
|
||||
_{MsgCourseEventNote}
|
||||
$# TODO: merge with actions column
|
||||
$if is _Just mbAuth
|
||||
<th .table__th uw-hide-column-header="schedule-actions">
|
||||
_{MsgScheduleOptActions}
|
||||
@ -282,6 +283,7 @@ $# $if NTop (Just 0) < NTop (courseCapacity course)
|
||||
<td .table__td :hiddenEventNotes:.course-event-note--hidden>
|
||||
<div .table__td-content>
|
||||
#{courseEventNote}
|
||||
$# TODO: merge with actions column
|
||||
$maybe (_, User{userScheduleOccurrenceDisplayDefault}) <- mbAuth
|
||||
<td .table__td>
|
||||
<div .table__td-content>
|
||||
|
||||
Reference in New Issue
Block a user