From 3254d34dc4f6586abecb501567111d6c675c8d12 Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <>
Date: Thu, 20 Aug 2020 18:53:56 +0200
Subject: [PATCH] feat(schedule): better handling of hrefs

---
 src/Utils/Schedule.hs                  | 8 +++++++-
 src/Utils/Schedule/Types.hs            | 2 +-
 templates/widgets/schedule/week.hamlet | 8 ++++----
 3 files changed, 12 insertions(+), 6 deletions(-)

diff --git a/src/Utils/Schedule.hs b/src/Utils/Schedule.hs
index d4e836378..c1fc1812b 100644
--- a/src/Utils/Schedule.hs
+++ b/src/Utils/Schedule.hs
@@ -57,7 +57,7 @@ weekSchedule uid _weekOffset = do
     return (course, courseEvent)
 
   tutorials <- liftHandler . runDB $ E.select $ E.from $ \(course `E.InnerJoin` tutorial) -> do
-    E.on $ course   E.^. CourseId   E.==. tutorial            E.^. TutorialCourse
+    E.on $ course E.^. CourseId E.==. tutorial E.^. TutorialCourse
     E.where_ $ (E.exists $ E.from $ \tutorialParticipant -> E.where_ $
               tutorialParticipant E.^. TutorialParticipantTutorial E.==. tutorial E.^. TutorialId
         E.&&. tutorialParticipant E.^. TutorialParticipantUser     E.==. E.val uid
@@ -164,6 +164,12 @@ weekSchedule uid _weekOffset = do
       Left ExceptOccur{..} -> [whamlet| _{MsgScheduleOccur}: |] <> formatTimeRangeW SelFormatTime (LocalTime exceptDay exceptStart) (Just (LocalTime exceptDay exceptEnd))
       Left ExceptNoOccur{} -> [whamlet| _{MsgScheduleNoOccur} |] -- <> formatTimeW SelFormatDateTime exceptTime
 
+    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"?
+      SETExam{..} -> CExamR courseTerm courseSchool courseShorthand seteName EShowR
+
   $(widgetFile "widgets/schedule/week")
 
 
diff --git a/src/Utils/Schedule/Types.hs b/src/Utils/Schedule/Types.hs
index 49b4d069f..1fc095fba 100644
--- a/src/Utils/Schedule/Types.hs
+++ b/src/Utils/Schedule/Types.hs
@@ -19,7 +19,7 @@ data ScheduleEntryType = SETCourseEvent    { setceType     :: CI Text  }  -- TOD
                        | SETTutorial       { settType      :: CI Text
                                            , settName      :: TutorialName
                                            }  -- TODO: TutorialType not possible here (comes from data family instance)
-                       | SETExamOccurrence { seteoName     :: ExamName }
+                       | SETExam           { seteName      :: ExamName }
                        -- TODO: more?
                        deriving (Eq, Ord, Show, Read, Generic, Typeable)
 
diff --git a/templates/widgets/schedule/week.hamlet b/templates/widgets/schedule/week.hamlet
index 6a65b3127..06416ea60 100644
--- a/templates/widgets/schedule/week.hamlet
+++ b/templates/widgets/schedule/week.hamlet
@@ -18,8 +18,8 @@ $newline never
               <div .table__td-content>
                 $maybe dayEvents <- Map.lookup day events
                   $maybe slotEvents <- Map.lookup slot dayEvents
-                    $forall ScheduleEntry{seCourse=Entity _ Course{courseTerm,courseSchool,courseShorthand,courseName},seType,seRoom,seOccurrence} <- slotEvents
-                      <a href=@{CourseR courseTerm courseSchool courseShorthand CShowR} .schedule--entry-link>
+                    $forall se@ScheduleEntry{seCourse=Entity _ Course{courseName},seType,seRoom,seOccurrence} <- slotEvents
+                      <a href=@{scheduleEntryToHref se} .schedule--entry-link>
                         <div .schedule--entry>
                           #{CI.original courseName}: #
                           $case seType
@@ -28,8 +28,8 @@ $newline never
                             $of SETTutorial{..}
                               #{settName} #
                               (#{CI.original settType})
-                            $of SETExamOccurrence{..}
-                              #{seteoName}
+                            $of SETExam{..}
+                              #{seteName}
                           <br>
 
                           $maybe room <- seRoom