refactor(schedule-week): refactor module
This commit is contained in:
Sarah Vaupel
parent
3416e63f6f
commit
693b36e789
@ -23,9 +23,7 @@ data ScheduleEntryType = SETCourseEvent { setceType :: CI Text
|
||||
, settName :: TutorialName
|
||||
} -- TODO: TutorialType not possible here (comes from data family instance)
|
||||
| SETExamOccurrence { seteoExamName :: ExamName
|
||||
, seteoOccurrenceName :: ExamOccurrenceName
|
||||
}
|
||||
-- TODO: more?
|
||||
deriving (Eq, Ord, Show, Read, Generic, Typeable)
|
||||
|
||||
type ScheduleEntryRoom = Maybe Text -- TODO: is Maybe Text okay for every ScheduleEntryType?
|
||||
|
||||
@ -5,22 +5,25 @@ module Utils.Schedule.Week
|
||||
import Import
|
||||
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
import Handler.Utils.DateTime (formatTimeRangeW, formatTimeW)
|
||||
|
||||
import Utils.Schedule.Types
|
||||
import Utils.Course (mayViewCourse, isCourseLecturer)
|
||||
|
||||
import Utils.Schedule.Types
|
||||
|
||||
|
||||
-- TODO: very temporary slot representation
|
||||
type TimeSlot = Int
|
||||
firstSlot, lastSlot, slotStep :: Int
|
||||
firstSlot = 8
|
||||
lastSlot = 20
|
||||
lastSlot = 18
|
||||
slotStep = 2
|
||||
|
||||
slotsToDisplay :: [TimeSlot]
|
||||
@ -69,17 +72,18 @@ weekSchedule uid _weekOffset = do
|
||||
return (course, tutorial)
|
||||
|
||||
-- TODO: this makes the exam table redundant once the weekOffset is implemented
|
||||
-- TODO: check for exam visibility for participants!
|
||||
exams <- liftHandler . runDB $ E.select $ E.from $ \(course `E.InnerJoin` (exam `E.InnerJoin` examOccurrence) `E.LeftOuterJoin` examRegistration) -> do
|
||||
-- TODO: for lecturers, do not display one entry for each exam occurrences, but instead collect all occurrences happening at the same time in a list
|
||||
exams <- liftHandler . runDB $ E.select $ E.from $ \((course `E.InnerJoin` exam) `E.LeftOuterJoin` examOccurrence) -> do
|
||||
E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
|
||||
E.on $ exam E.^. ExamId E.==. examOccurrence E.^. ExamOccurrenceExam
|
||||
E.on $ E.just (exam E.^. ExamId) E.==. examRegistration E.?. ExamRegistrationExam
|
||||
E.on $ E.just (exam E.^. ExamId) E.==. examOccurrence E.?. ExamOccurrenceExam
|
||||
E.where_ $ isCourseLecturer (Just uid) ata (course E.^. CourseId)
|
||||
E.||. (examRegistration E.?. ExamRegistrationUser E.==. E.just (E.val uid)
|
||||
E.&&. mayViewCourse (Just uid) ata now course Nothing) -- do NOT remove, this is actually necessary here!
|
||||
-- (There can be exam participants that are
|
||||
-- not enrolled, me thinks)
|
||||
return (course, exam, examOccurrence, examRegistration)
|
||||
E.||. (E.exists $ E.from $ \examRegistration -> E.where_ $
|
||||
examRegistration E.?. ExamRegistrationUser E.==. E.just (E.val uid)
|
||||
E.&&. E.maybe E.false (\visibleFrom -> visibleFrom E.<=. E.val now) (exam E.^. ExamVisibleFrom)
|
||||
E.&&. mayViewCourse (Just uid) ata now course Nothing) -- do NOT remove, this is actually necessary here!
|
||||
-- (There can be exam participants that are
|
||||
-- not enrolled, me thinks)
|
||||
return (course, exam, examOccurrence)
|
||||
|
||||
let
|
||||
courseEventToScheduleEntries :: (Entity Course, Entity CourseEvent) -> [ScheduleEntry]
|
||||
@ -108,13 +112,11 @@ weekSchedule uid _weekOffset = do
|
||||
let seOccurrence = Right (Left exception) in ScheduleEntry{..}
|
||||
in scheduleds <> exceptions
|
||||
|
||||
-- TODO: work in progress
|
||||
-- TODO: maybe exam registration is not even necessary here => refactor select to exists check for registration
|
||||
examToScheduleEntries :: (Entity Course, Entity Exam, Entity ExamOccurrence, Maybe (Entity ExamRegistration)) -> [ScheduleEntry]
|
||||
examToScheduleEntries (seCourse@(Entity _ Course{}), Entity _ Exam{..}, Entity _ ExamOccurrence{..}, _mbExamRegistration) =
|
||||
examToScheduleEntries :: (Entity Course, Entity Exam, Maybe (Entity ExamOccurrence)) -> [ScheduleEntry]
|
||||
examToScheduleEntries (_, _, Nothing) = mempty
|
||||
examToScheduleEntries (seCourse@(Entity _ Course{}), Entity _ Exam{..}, Just (Entity _ ExamOccurrence{..})) =
|
||||
let seType = SETExamOccurrence
|
||||
{ seteoExamName = examName
|
||||
, seteoOccurrenceName = examOccurrenceName
|
||||
}
|
||||
seRoom = Just examOccurrenceRoom
|
||||
seOccurrence = Left $ ScheduleEntryExamOccurrence
|
||||
@ -167,15 +169,16 @@ weekSchedule uid _weekOffset = do
|
||||
_ -> True -- TODO: maybe filter out ExceptNoOccurs? (Should NoOccurs be displayed or not?)
|
||||
in filter isRegularWithoutException occurrencesInSlot
|
||||
|
||||
-- TODO: Internationalize week start (and/or make configurable)
|
||||
-- TODO: auto-hide saturday and sunday (if there are no events scheduled)?
|
||||
-- TODO: weekday messages deprecated / not used => remove
|
||||
|
||||
currentWeek :: [Day]
|
||||
currentWeek = currentWeekAux $ utctDay now
|
||||
where currentWeekAux day
|
||||
| Monday <- dayOfWeek day = [day .. toEnum (fromEnum day + 6)]
|
||||
| otherwise = currentWeekAux $ pred day
|
||||
|
||||
-- TODO: Internationalize week start (and/or make configurable)
|
||||
-- TODO: auto-hide saturday and sunday (if there are no events scheduled)?
|
||||
-- TODO: weekday messages deprecated / not used => remove
|
||||
weekDays :: [(Day, UniWorXMessage, Text)]
|
||||
weekDays = zipWith (\x (y,z) -> (x,y,z)) currentWeek
|
||||
[ (MsgScheduleWeekDayMonday , "mon")
|
||||
@ -187,23 +190,25 @@ weekSchedule uid _weekOffset = do
|
||||
, (MsgScheduleWeekDaySunday , "sun")
|
||||
]
|
||||
|
||||
formatOccurrenceW :: ScheduleEntryOccurrence -> Widget
|
||||
formatOccurrenceW = \case
|
||||
Right (Right ScheduleWeekly{..}) -> [whamlet| _{MsgScheduleTime}: |] <> formatTimeRangeW SelFormatTime scheduleStart (Just scheduleEnd)
|
||||
Right (Left ExceptOccur{..}) -> [whamlet| _{MsgScheduleOccur}: |] <> formatTimeRangeW SelFormatTime (LocalTime exceptDay exceptStart) (Just $ LocalTime exceptDay exceptEnd)
|
||||
Right (Left ExceptNoOccur{}) -> [whamlet| _{MsgScheduleNoOccur} |] -- <> formatTimeW SelFormatDateTime exceptTime
|
||||
Left ScheduleEntryExamOccurrence{..} -> [whamlet| _{MsgScheduleOccur}: |] <> formatTimeRangeW SelFormatTime (LocalTime seeoDay seeoStart) (LocalTime seeoDay <$> seeoEnd)
|
||||
|
||||
scheduleEntryToHref :: ScheduleEntry -> Route UniWorX
|
||||
scheduleEntryToHref ScheduleEntry{seCourse=Entity _ Course{..},seType} = case seType of
|
||||
SETCourseEvent{} -> CourseR courseTerm courseSchool courseShorthand CShowR -- TODO: link to events table? (TODO currently has no id)
|
||||
SETTutorial{} -> CourseR courseTerm courseSchool courseShorthand CShowR -- TODO: link to table with id "tutorials"?
|
||||
SETExamOccurrence{..} -> CExamR courseTerm courseSchool courseShorthand seteoExamName EShowR
|
||||
|
||||
$(widgetFile "widgets/schedule/week")
|
||||
|
||||
|
||||
-- Helper functions for this module
|
||||
-- Local helper functions
|
||||
|
||||
-- | To which route should each schedule entry link to?
|
||||
scheduleEntryToHref :: ScheduleEntry -> Route UniWorX
|
||||
scheduleEntryToHref ScheduleEntry{seCourse=Entity _ Course{..},seType} = case seType of
|
||||
SETCourseEvent{} -> CourseR courseTerm courseSchool courseShorthand CShowR -- TODO: link to events table? (TODO currently has no id)
|
||||
SETTutorial{} -> CourseR courseTerm courseSchool courseShorthand CShowR -- TODO: link to table with id "tutorials"?
|
||||
SETExamOccurrence{..} -> CExamR courseTerm courseSchool courseShorthand seteoExamName EShowR
|
||||
|
||||
-- | Calls formatTimeRangeW with the correct arguments and prepends an occurrence descriptor based on the occurrence type
|
||||
formatOccurrenceW :: ScheduleEntryOccurrence -> Widget
|
||||
formatOccurrenceW = \case
|
||||
Right (Right ScheduleWeekly{..}) -> [whamlet| _{MsgScheduleTime}: |] <> formatTimeRangeW SelFormatTime scheduleStart (Just scheduleEnd)
|
||||
Right (Left ExceptOccur{..}) -> [whamlet| _{MsgScheduleOccur}: |] <> formatTimeRangeW SelFormatTime (LocalTime exceptDay exceptStart) (Just $ LocalTime exceptDay exceptEnd)
|
||||
Right (Left ExceptNoOccur{}) -> [whamlet| _{MsgScheduleNoOccur} |] -- <> formatTimeW SelFormatDateTime exceptTime
|
||||
Left ScheduleEntryExamOccurrence{..} -> [whamlet| _{MsgScheduleOccur}: |] <> formatTimeRangeW SelFormatTime (LocalTime seeoDay seeoStart) (LocalTime seeoDay <$> seeoEnd)
|
||||
|
||||
-- | Convert from DayOfWeek to Day of this week using the current time (as UTCTime)
|
||||
dayOfWeekToDayWith :: DayOfWeek -> UTCTime -> Day
|
||||
|
||||
@ -30,7 +30,6 @@ $newline never
|
||||
(#{CI.original settType})
|
||||
$of SETExamOccurrence{..}
|
||||
#{seteoExamName} #
|
||||
(#{seteoOccurrenceName})
|
||||
<br>
|
||||
|
||||
$maybe room <- seRoom
|
||||
|
||||
Reference in New Issue
Block a user