Refactor route functionality into Controllers

CHANGELOG.md

@@ -12,6 +12,9 @@
 
 - Started a changelog.
 - Updated pull request template
+- Refactored graph and course related route functionality into controllers
+
+### ♻️ Refactoring
 
 ## [0.5.0] - 2023-08-13
 

README.md

@@ -80,13 +80,15 @@ If you are contributing to Courseography, you should run the following to instal
 
 This project would not exist without the contributions of many students in the Department of Computer Science. In alphabetical order, our contributors are:
 
+Ismail Ahmed,
 Alex Baluta,
 Mehdi Benallegue,
 Alexander Biggs,
 Kelly Bell,
 Ching Chang,
 Christina Chen,
 Eugene Cheung,
+Mimis Chlympatsos,
 Kael Deverell,
 Spencer Elliott,
 Lana El Sanyoura,

app/Controllers/Course.hs

@@ -0,0 +1,41 @@
+module Controllers.Course
+    (retrieveCourse, index, courseInfo, depts) where
+
+import Config (databasePath)
+import Control.Monad.IO.Class (liftIO)
+import qualified Data.Text as T (Text, unlines, unpack)
+import Data.List (sort, nub)
+import Database.Persist (Entity)
+import Database.Persist.Sqlite (SqlPersistM, runSqlite, selectList, entityVal)
+import Database.Tables as Tables (Courses, coursesCode)
+import Happstack.Server.SimpleHTTP (ServerPart, Response, toResponse)
+import Util.Happstack (createJSONResponse)
+import qualified Database.CourseQueries as CourseHelpers (queryCourse, getDeptCourses)
+
+-- | Takes a course code (e.g. \"CSC108H1\") and sends a JSON representation
+-- of the course as a response.
+retrieveCourse :: T.Text -> ServerPart Response
+retrieveCourse = liftIO . CourseHelpers.queryCourse
+
+-- | Builds a list of all course codes in the database.
+index :: ServerPart Response
+index = do
+  response <- liftIO $ runSqlite databasePath $ do
+      coursesList :: [Entity Courses] <- selectList [] []
+      let codes = map (coursesCode . entityVal) coursesList
+      return $ T.unlines codes :: SqlPersistM T.Text
+  return $ toResponse response
+
+  -- | Returns all course info for a given department.
+courseInfo :: T.Text -> ServerPart Response
+courseInfo dept = fmap createJSONResponse (CourseHelpers.getDeptCourses dept)
+
+-- | Return a list of all departments.
+depts :: ServerPart Response
+depts = do
+    deptList <- liftIO $ runSqlite databasePath $ do
+        coursesList :: [Entity Courses] <- selectList [] []
+        return $ sort . nub $ map g coursesList :: SqlPersistM [String]
+    return $ createJSONResponse deptList
+    where
+        g = take 3 . T.unpack . coursesCode . entityVal

app/Controllers/Graph.hs

@@ -0,0 +1,48 @@
+module Controllers.Graph (graphResponse, findAndSavePrereqsResponse, index) where
+
+import Happstack.Server (ServerPart, Response, toResponse, ok)
+import MasterTemplate (masterTemplate, header)
+import Scripts (graphScripts)
+import Text.Blaze ((!))
+import qualified Text.Blaze.Html5 as H
+import qualified Text.Blaze.Html5.Attributes as A
+import DynamicGraphs.GraphOptions (CourseGraphOptions (..))
+import DynamicGraphs.WriteRunDot (getBody, generateAndSavePrereqResponse)
+import Control.Monad.IO.Class (liftIO)
+import Data.Aeson (decode)
+import Data.Maybe (fromJust)
+import Database.Tables as Tables
+import Database.Persist.Sqlite
+    ( Entity,
+      SelectOpt(Asc),
+      (==.),
+      selectList,
+      runSqlite,
+      SqlPersistM )
+import Config (databasePath)
+import Util.Happstack (createJSONResponse)
+
+graphResponse :: ServerPart Response
+graphResponse =
+   ok $ toResponse $
+    masterTemplate "Courseography - Graph"
+                []
+                (do
+                    header "graph"
+                    H.div ! A.id "container" $ ""
+                )
+                graphScripts
+
+findAndSavePrereqsResponse :: ServerPart Response
+findAndSavePrereqsResponse = do
+    body <- getBody
+    let coursesOptions :: CourseGraphOptions = fromJust $ decode body
+    liftIO $ generateAndSavePrereqResponse coursesOptions
+
+
+index :: ServerPart Response
+index = liftIO (runSqlite databasePath $ do
+    graphsList :: [Entity Graph] <- selectList [GraphDynamic ==. False] [Asc GraphTitle]
+    return $ createJSONResponse graphsList :: SqlPersistM Response)
+
+

app/Database/CourseQueries.hs

@@ -1,40 +1,39 @@
 {-|
     Module: Database.CourseQueries
     Description: Respond to various requests involving database course
-                 information.
+                 information. Includes helpers for response functionality
+                 defined in Controllers.Course
 
 This module contains the functions that perform different database queries
 and serve the information back to the client.
 -}
 
 module Database.CourseQueries
-    (retrieveCourse,
-     retrievePost,
+    (retrievePost,
      returnCourse,
-     allCourses,
      prereqsForCourse,
-     courseInfo,
-     getDeptCourses,
-     queryGraphs,
-     deptList,
      returnMeeting,
      getGraph,
      getGraphJSON,
      getMeetingTime,
-     buildTime) where
+     buildTime,
+     queryCourse,
+     getDeptCourses
+     ) where
 
 import Config (databasePath)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Data.Aeson (object, toJSON, (.=))
-import Data.List
+import Data.List (partition)
 import Data.Maybe (fromJust, fromMaybe)
-import qualified Data.Text as T
-import Database.DataType
-import Database.Persist
-import Database.Persist.Sqlite
+import qualified Data.Text as T (Text, append, tail, isPrefixOf, toUpper, filter, snoc)
+import Database.DataType ( ShapeType( Node ) , ShapeType( Hybrid ), ShapeType( BoolNode ))
+import Database.Persist.Sqlite (Entity, PersistEntity, SqlPersistM, PersistValue( PersistInt64 ), runSqlite, selectList,
+                                entityKey, entityVal, selectFirst, (==.), (<-.), get, keyToValues, PersistValue( PersistText ),
+                                rawSql)
 import Database.Tables as Tables
-import Happstack.Server.SimpleHTTP
-import Svg.Builder
+import Happstack.Server.SimpleHTTP (ServerPart, Response, Request, askRq, lookText', ifModifiedSince)
+import Svg.Builder (intersectsWithShape, buildPath, buildEllipses, buildRect)
 import Util.Happstack (createJSONResponse)
 
 -- | Queries the database for all matching lectures, tutorials,
@@ -58,11 +57,6 @@ returnCourse lowerStr = runSqlite databasePath $ do
         Just <$> buildCourse meetings
                                 (entityVal course)
 
--- | Takes a course code (e.g. \"CSC108H1\") and sends a JSON representation
--- of the course as a response.
-retrieveCourse :: T.Text -> ServerPart Response
-retrieveCourse = liftIO . queryCourse
-
 -- | Queries the database for all information about @course@, constructs a JSON object
 -- representing the course and returns the appropriate JSON response.
 queryCourse :: T.Text -> IO Response
@@ -207,15 +201,6 @@ getGraph graphName =
 
                 return (Just response) :: SqlPersistM (Maybe Response)
 
--- | Builds a list of all course codes in the database.
-allCourses :: IO Response
-allCourses = do
-  response <- runSqlite databasePath $ do
-      courses :: [Entity Courses] <- selectList [] []
-      let codes = map (coursesCode . entityVal) courses
-      return $ T.unlines codes :: SqlPersistM T.Text
-  return $ toResponse response
-
 -- | Retrieves the prerequisites for a course (code) as a string.
 prereqsForCourse :: T.Text -> IO (Either String T.Text)
 prereqsForCourse courseCode = runSqlite databasePath $ do
@@ -228,10 +213,6 @@ prereqsForCourse courseCode = runSqlite databasePath $ do
                 coursesPrereqString $
                 entityVal courseEntity) :: SqlPersistM (Either String T.Text)
 
--- | Returns all course info for a given department.
-courseInfo :: T.Text -> ServerPart Response
-courseInfo dept = fmap createJSONResponse (getDeptCourses dept)
-
 getDeptCourses :: MonadIO m => T.Text -> m [Course]
 getDeptCourses dept =
     liftIO $ runSqlite databasePath $ do
@@ -245,23 +226,6 @@ getDeptCourses dept =
             allTimes <- mapM buildMeetTimes courseMeetings
             buildCourse allTimes course
 
--- | Return a list of all departments.
-deptList :: IO Response
-deptList = do
-    depts <- runSqlite databasePath $ do
-        courses :: [Entity Courses] <- selectList [] []
-        return $ sort . nub $ map g courses :: SqlPersistM [String]
-    return $ createJSONResponse depts
-    where
-        g = take 3 . T.unpack . coursesCode . entityVal
-
--- | Queries the graphs table and returns a JSON response of Graph JSON
--- objects.
-queryGraphs :: IO Response
-queryGraphs = runSqlite databasePath $ do
-    graphs :: [Entity Graph] <- selectList [GraphDynamic ==. False] [Asc GraphTitle]
-    return $ createJSONResponse graphs :: SqlPersistM Response
-
 -- | Queries the database for all times regarding a specific meeting (lecture, tutorial or practial) for
 -- a @course@, returns a list of Time.
 getMeetingTime :: (T.Text, T.Text, T.Text) -> SqlPersistM [Time]

app/DynamicGraphs/WriteRunDot.hs

@@ -2,13 +2,12 @@ module DynamicGraphs.WriteRunDot where
 
 import Control.Monad (forM_)
 import Control.Monad.IO.Class (liftIO)
-import Data.Aeson (decode)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 import Data.GraphViz hiding (Str)
 import Data.Hash.MD5 (Str (Str), md5s)
 import Data.List (sort)
-import Data.Maybe (fromJust, fromMaybe)
+import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8)
 import Database.CourseQueries (getGraph)
@@ -43,12 +42,6 @@ getBody = do
         Just rqbody -> return . unBody $ rqbody
         Nothing     -> return ""
 
-findAndSavePrereqsResponse :: ServerPart Response
-findAndSavePrereqsResponse = do
-    body <- getBody
-    let coursesOptions :: CourseGraphOptions = fromJust $ decode body
-    liftIO $ generateAndSavePrereqResponse coursesOptions
-
 generateAndSavePrereqResponse :: CourseGraphOptions -> IO Response
 generateAndSavePrereqResponse coursesOptions = do
   cached <- getGraph graphHash

app/Response.hs

@@ -5,7 +5,6 @@ import Response.Calendar as X
 import Response.Draw as X
 import Response.Export as X
 import Response.Generate as X
-import Response.Graph as X
 import Response.Grid as X
 import Response.Image as X
 import Response.Loading as X

app/Routes.hs

@@ -3,13 +3,41 @@ module Routes
 
 import Control.Monad (MonadPlus (mplus), msum)
 import Control.Monad.IO.Class (liftIO)
+import Controllers.Course as CourseControllers (retrieveCourse, index, courseInfo, depts)
+import Controllers.Graph as GraphControllers
 import Data.Text.Lazy (Text)
 import Database.CourseInsertion (saveGraphJSON)
-import Database.CourseQueries (allCourses, courseInfo, deptList, getGraphJSON, queryGraphs,
-                               retrieveCourse, retrievePost)
-import DynamicGraphs.WriteRunDot (findAndSavePrereqsResponse)
-import Happstack.Server hiding (host)
+import Database.CourseQueries (getGraphJSON, retrievePost)
+import Happstack.Server
+    ( serveDirectory,
+      seeOther,
+      dir,
+      method,
+      noTrailingSlash,
+      nullDir,
+      look,
+      lookBS,
+      lookText',
+      Browsing(DisableBrowsing),
+      ServerPart,
+      ServerPartT,
+      Method(PUT),
+      Response,
+      ToMessage(toResponse) )
 import Response
+    ( drawResponse,
+      aboutResponse,
+      privacyResponse,
+      notFoundResponse,
+      searchResponse,
+      generateResponse,
+      postResponse,
+      loadingResponse,
+      gridResponse,
+      calendarResponse,
+      graphImageResponse,
+      exportTimetableImageResponse,
+      exportTimetablePDFResponse )
 
 routeResponses :: String -> Text -> Text -> ServerPartT IO Response
 routeResponses staticDir aboutContents privacyContents =
@@ -18,29 +46,30 @@ routeResponses staticDir aboutContents privacyContents =
           nullDir >> seeOther ("graph" :: String) (toResponse ("Redirecting to /graph" :: String)),
           notFoundResponse])
 
-strictRoutes :: Text -> Text -> [ (String, ServerPart Response)]
+strictRoutes :: Text -> Text -> [ (String, ServerPart Response)] 
 strictRoutes aboutContents privacyContents = [
     ("grid", gridResponse),
-    ("graph", graphResponse),
+    ("graph", GraphControllers.graphResponse),
     ("graph-generate", do method PUT
-                          findAndSavePrereqsResponse),
+                          GraphControllers.findAndSavePrereqsResponse),
     ("image", look "JsonLocalStorageObj" >>= graphImageResponse),
     ("timetable-image", lookText' "session" >>= \session -> look "courses" >>= exportTimetableImageResponse session),
-    ("timetable-pdf", look "courses" >>= \courses -> look "JsonLocalStorageObj" >>= exportTimetablePDFResponse courses),
+    ("timetable-pdf", look "courses" >>= \coursesList -> look "JsonLocalStorageObj" >>= exportTimetablePDFResponse coursesList),
     ("post", retrievePost),
     ("post-progress", postResponse),
     ("draw", drawResponse),
     ("about", aboutResponse aboutContents),
     ("privacy", privacyResponse privacyContents),
-    ("course", lookText' "name" >>= retrieveCourse),
-    ("all-courses", liftIO allCourses),
-    ("graphs", liftIO queryGraphs),
-    ("course-info", lookText' "dept" >>= courseInfo),
-    ("depts", liftIO deptList),
+    ("graphs", GraphControllers.index),
     ("timesearch", searchResponse),
     ("generate", generateResponse),
-    ("calendar", look "courses" >>= calendarResponse),
     ("get-json-data", lookText' "graphName" >>= \graphName -> liftIO $ getGraphJSON graphName),
+
+    ("course", lookText' "name" >>= CourseControllers.retrieveCourse),
+    ("courses", CourseControllers.index),
+    ("course-info", lookText' "dept" >>= CourseControllers.courseInfo),
+    ("depts", CourseControllers.depts),
+    ("calendar", look "courses" >>= calendarResponse),
     ("loading", lookText' "size" >>= loadingResponse),
     ("save-json", lookBS "jsonData" >>= \jsonStr -> lookText' "nameData" >>= \nameStr -> liftIO $ saveGraphJSON jsonStr nameStr)
     ]

courseography.cabal

@@ -65,6 +65,8 @@ executable courseography
   other-modules:
     Config,
     Css.Constants,
+    Controllers.Course,
+    Controllers.Graph,
     Database.CourseInsertion,
     Database.CourseQueries,
     Database.CourseVideoSeed,
@@ -88,7 +90,6 @@ executable courseography
     Response.Calendar,
     Response.Draw,
     Response.Export,
-    Response.Graph,
     Response.Grid,
     Response.Image,
     Response.Loading,