From 36ad24dba5f1273340a5ddaff1f1b61f65e7fe06 Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Mon, 17 Jan 2022 21:58:09 +0100
Subject: [PATCH] Add page for a course

Also added a relation between courses and challenges
---
 Application.hs          |  1 +
 Foundation.hs           |  2 ++
 Handler/Course.hs       | 38 ++++++++++++++++++++++++++++++++++++++
 config/models           |  4 ++++
 config/routes           |  1 +
 gonito.cabal            |  1 +
 templates/course.hamlet |  3 +++
 7 files changed, 50 insertions(+)
 create mode 100644 Handler/Course.hs
 create mode 100644 templates/course.hamlet

diff --git a/Application.hs b/Application.hs
index ac5dbab..c6c697c 100644
--- a/Application.hs
+++ b/Application.hs
@@ -63,6 +63,7 @@ import Handler.Evaluate
 import Handler.Swagger
 import Handler.Team
 import Handler.Announcements
+import Handler.Course
 
 -- This line actually creates our YesodDispatch instance. It is the second half
 -- of the call to mkYesodData which occurs in Foundation.hs. Please see the
diff --git a/Foundation.hs b/Foundation.hs
index acd7d1b..fc22c2f 100644
--- a/Foundation.hs
+++ b/Foundation.hs
@@ -233,6 +233,8 @@ instance Yesod App where
 
     isAuthorized (CompareFormR _ _) _ = regularAuthorization
 
+    isAuthorized (CourseR _) _ = regularAuthorization
+
     isAuthorized MyTeamsR _ = isTrustedAuthorized
     isAuthorized CreateTeamR _ = isTrustedAuthorized
 
diff --git a/Handler/Course.hs b/Handler/Course.hs
new file mode 100644
index 0000000..228209c
--- /dev/null
+++ b/Handler/Course.hs
@@ -0,0 +1,38 @@
+module Handler.Course where
+
+import Import
+
+import Handler.Shared
+import Handler.ListChallenges
+
+import qualified Database.Esqueleto      as E
+import           Database.Esqueleto      ((^.))
+
+
+data CourseInfo = CourseInfo {
+   courseInfoCourse :: Course,
+   courseInfoChallenges :: [Entity Challenge]
+}
+
+getCourseR :: Text -> Handler Html
+getCourseR courseCode = do
+  courseInfo <- fetchCourseInfo courseCode
+
+  defaultLayout $ do
+    setTitle "Course"
+    $(widgetFile "course")
+
+fetchCourseInfo :: Text -> Handler CourseInfo
+fetchCourseInfo courseCode = do
+  (Entity courseId course) <- runDB $ getBy404 $ UniqueCourseCode courseCode
+
+  challenges <- runDB $ E.select $ E.from $ \(challenge, course_challenge) -> do
+    E.where_ (course_challenge ^. CourseChallengeCourse E.==. E.val courseId
+              E.&&. course_challenge ^. CourseChallengeChallenge E.==. challenge ^. ChallengeId)
+    E.orderBy [E.asc (challenge ^. ChallengeName)]
+    return challenge
+
+  return $ CourseInfo {
+    courseInfoCourse = course,
+    courseInfoChallenges = filter (\ch -> (challengeArchived $ entityVal ch) /= Just True) challenges
+  }
diff --git a/config/models b/config/models
index 86e0129..e565ac2 100644
--- a/config/models
+++ b/config/models
@@ -212,6 +212,10 @@ Teacher
     user UserId
     course CourseId
     UniqueTeacherCourse user course
+CourseChallenge
+    challenge ChallengeId
+    course CourseId
+    UniqueCourseChallenge challenge course
 -- for "KPI" dashboard
 Indicator
     test TestId
diff --git a/config/routes b/config/routes
index d3a42c1..c6e3430 100644
--- a/config/routes
+++ b/config/routes
@@ -15,6 +15,7 @@
 /test-progress/#Int/#Int TestProgressR GET
 /api/test-progress/#Int/#Int TestProgressJsonR GET
 /list-challenges ListChallengesR GET
+/course/#Text CourseR GET
 
 /test-announcements TestAnnouncementsR GET
 
diff --git a/gonito.cabal b/gonito.cabal
index ddd4fda..fc54261 100644
--- a/gonito.cabal
+++ b/gonito.cabal
@@ -65,6 +65,7 @@ library
                      Handler.Team
                      Handler.Announcements
                      Web.Announcements
+                     Handler.Course
 
     if flag(dev) || flag(library-only)
         cpp-options:   -DDEVELOPMENT
diff --git a/templates/course.hamlet b/templates/course.hamlet
new file mode 100644
index 0000000..8423034
--- /dev/null
+++ b/templates/course.hamlet
@@ -0,0 +1,3 @@
+<h1>#{courseName $ courseInfoCourse courseInfo}
+
+^{listChallengesCore $ courseInfoChallenges courseInfo}