Refactor courses to course

CHANGELOG.md

@@ -10,6 +10,8 @@
 
 ### 🔧 Internal changes
 
+- Refactored the `Courses` table to `Course` with a database migration
+
 ## [0.8.0] - 2026-06-09
 
 ### ✨ New features/enhancements

app/Controllers/Course.hs

@@ -6,7 +6,7 @@ import Control.Monad.IO.Class (liftIO)
 import qualified Data.Text as T (Text, unlines)
 import Database.Persist (Entity)
 import Database.Persist.Sqlite (SqlPersistM, entityVal, selectList)
-import Database.Tables as Tables (Courses, coursesCode)
+import Database.Tables as Tables (Course, courseCode)
 import Happstack.Server (Response, ServerPart, lookText', notFound, ok, toResponse)
 import Models.Course (getDeptCourses, returnCourse)
 import Util.Happstack (createJSONResponse)
@@ -25,8 +25,8 @@ retrieveCourse = do
 index :: ServerPart Response
 index = do
   response <- liftIO $ runDb $ do
-      coursesList :: [Entity Courses] <- selectList [] []
-      let codes = map (coursesCode . entityVal) coursesList
+      coursesList :: [Entity Course] <- selectList [] []
+      let codes = map (courseCode . entityVal) coursesList
       return $ T.unlines codes :: SqlPersistM T.Text
   return $ toResponse response
 

app/Database/CourseVideoSeed.hs

@@ -24,7 +24,7 @@ courseVideos = [
 
 seedVideo :: (Text, [Text]) -> SqlPersistM ()
 seedVideo (code, videos) =
-    updateWhere [CoursesCode ==. code] [CoursesVideoUrls =. videos]
+    updateWhere [CourseCode ==. code] [CourseVideoUrls =. videos]
 
 -- | Sets the video routes of all course rows.
 seedVideos :: IO ()

app/Database/Migrations.hs

@@ -31,7 +31,9 @@ applyMigrations currVersion migrations = do
 
 -- | List of migrations
 migrationList :: [MigrationWrapper]
-migrationList = [MigrationWrapper {version=2, script=renamePostTables}]
+migrationList = [ MigrationWrapper {version=2, script=renamePostTables}
+                , MigrationWrapper {version=3, script=renameCoursesTable}
+                ]
 
 -- | Migration script which renames the Post tables to Program
 renamePostTables :: Migration
@@ -40,6 +42,11 @@ renamePostTables = do
     addMigration True "ALTER TABLE post_category RENAME TO program_category;"
     addMigration True "ALTER TABLE program_category RENAME COLUMN post TO program;"
 
+-- | Migration script which renames the Courses table to Course
+renameCoursesTable :: Migration
+renameCoursesTable =
+    addMigration True "ALTER TABLE courses RENAME TO course;"
+
 -- | Gets the current version of the database.
 -- If no version is defined, initialize the
 -- version to the latest version and return that.

app/Database/Tables.hs

@@ -19,8 +19,8 @@ straightforward.
 
 module Database.Tables where
 
-import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), genericToJSON, withObject,
-                   (.!=), (.:), (.:?))
+import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), genericToJSON, withObject, (.!=), (.:),
+                   (.:?))
 import Data.Aeson.Types (Options (..), Parser, Value (Object), defaultOptions)
 import Data.Char (toLower)
 import qualified Data.Text as T
@@ -43,7 +43,7 @@ Department json
     Primary name
     UniqueName name
 
-Courses
+Course
     code T.Text
     Primary code
     title T.Text Maybe

app/Export/GetImages.hs

@@ -17,7 +17,7 @@ import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
 import qualified Data.Text.Lazy.IO as LTIO
-import Database.Tables as Tables
+import Database.Tables (Time (..))
 import Export.ImageConversion (withImageFile)
 import Export.TimetableImageCreator (renderTableHelper, times)
 import Models.Meeting (getMeetingTime)

app/Models/Course.hs

@@ -17,16 +17,16 @@ import Database.Persist.Class (selectKeysList)
 import Database.Persist.Sqlite (Entity, PersistValue (PersistText), SqlPersistM, entityVal, get,
                                 insert_, rawSql, selectFirst, selectList, (<-.), (==.))
 import Database.Tables (Breadth (breadthDescription),
-                        Courses (coursesBreadth, coursesCode, coursesCoreqs, coursesDescription, coursesDistribution, coursesExclusions, coursesPrereqString, coursesTitle, coursesVideoUrls),
+                        Course (courseBreadth, courseCode, courseCoreqs, courseDescription, courseDistribution, courseExclusions, coursePrereqString, courseTitle, courseVideoUrls),
                         Distribution (distributionDescription),
-                        EntityField (BreadthDescription, CoursesCode, DistributionDescription, MeetingCode),
+                        EntityField (BreadthDescription, CourseCode, DistributionDescription, MeetingCode),
                         Key, MeetTime', Meeting (meetingCode))
 import GHC.Generics (Generic)
 import Models.Meeting (buildMeetTimes, meetingQuery)
 
 -- | The data for a single course, as returned by the back-end to the front-end.
--- This is different from the schema-defined 'Courses' type (in "Database.Tables")
--- 'Courses' describes how a course is stored in the database, whereas
+-- This is different from the schema-defined 'Course' type (in "Database.Tables")
+-- 'Course' describes how a course is stored in the database, whereas
 -- 'CourseData' describes the shape of the information sent to the client
 -- when a course is requested.
 data CourseData =
@@ -51,7 +51,7 @@ returnCourse lowerStr = runDb $ do
     let courseStr = T.toUpper lowerStr
     -- TODO: require the client to pass the full course code
     let fullCodes = [courseStr, T.append courseStr "H1", T.append courseStr "Y1"]
-    sqlCourse :: (Maybe (Entity Courses)) <- selectFirst [CoursesCode <-. fullCodes] []
+    sqlCourse :: (Maybe (Entity Course)) <- selectFirst [CourseCode <-. fullCodes] []
     case sqlCourse of
       Nothing -> return Nothing
       Just course -> do
@@ -73,48 +73,48 @@ getDescriptionD (Just key) = do
     maybeDistribution <- get key
     return $ fmap distributionDescription maybeDistribution
 
--- | Builds a 'CourseData' structure from a tuple from the Courses table.
+-- | Builds a 'CourseData' structure from a tuple from the Course table.
 -- Some fields still need to be added in.
-buildCourse :: [MeetTime'] -> Courses -> SqlPersistM CourseData
+buildCourse :: [MeetTime'] -> Course -> SqlPersistM CourseData
 buildCourse allMeetings course = do
-    cBreadth <- getDescriptionB (coursesBreadth course)
-    cDistribution <- getDescriptionD (coursesDistribution course)
+    cBreadth <- getDescriptionB (courseBreadth course)
+    cDistribution <- getDescriptionD (courseDistribution course)
     return $ CourseData cBreadth
            -- TODO: Remove the filter and allow double-quotes
-           (fmap (T.filter (/='\"')) (coursesDescription course))
-           (fmap (T.filter (/='\"')) (coursesTitle course))
-           (coursesPrereqString course)
+           (fmap (T.filter (/='\"')) (courseDescription course))
+           (fmap (T.filter (/='\"')) (courseTitle course))
+           (coursePrereqString course)
            (Just allMeetings)
-           (coursesCode course)
-           (coursesExclusions course)
+           (courseCode course)
+           (courseExclusions course)
            cDistribution
-           (coursesCoreqs course)
-           (coursesVideoUrls course)
+           (courseCoreqs course)
+           (courseVideoUrls course)
 
 -- | Retrieves the prerequisites for a course (code) as a string.
 -- Also retrieves the actual course code in the database in case
 -- the one the user inputs doesn't match it exactly
 prereqsForCourse :: T.Text -> IO (Either String (T.Text, T.Text))
-prereqsForCourse courseCode = runDb $ do
-    let upperCaseCourseCode = T.toUpper courseCode
-    course <- selectFirst [CoursesCode <-. [upperCaseCourseCode, upperCaseCourseCode `T.append` "H1", upperCaseCourseCode `T.append` "Y1"]] []
+prereqsForCourse code = runDb $ do
+    let upperCaseCourseCode = T.toUpper code
+    course <- selectFirst [CourseCode <-. [upperCaseCourseCode, upperCaseCourseCode `T.append` "H1", upperCaseCourseCode `T.append` "Y1"]] []
     case course of
         Nothing -> return (Left "Course not found")
         Just courseEntity ->
             return (Right
-                     (coursesCode $ entityVal courseEntity,
-                      fromMaybe "" $ coursesPrereqString $ entityVal courseEntity)
+                     (courseCode $ entityVal courseEntity,
+                      fromMaybe "" $ coursePrereqString $ entityVal courseEntity)
                     ) :: SqlPersistM (Either String (T.Text, T.Text))
 
 getDeptCourses :: MonadIO m => T.Text -> m [CourseData]
 getDeptCourses dept = liftIO $ runDb $ do
-        courses :: [Entity Courses] <- rawSql "SELECT ?? FROM courses WHERE code LIKE ?" [PersistText $ T.snoc dept '%']
+        courses :: [Entity Course] <- rawSql "SELECT ?? FROM course WHERE code LIKE ?" [PersistText $ T.snoc dept '%']
         let deptCourses = map entityVal courses
-        meetings :: [Entity Meeting] <- selectList [MeetingCode <-. map coursesCode deptCourses] []
+        meetings :: [Entity Meeting] <- selectList [MeetingCode <-. map courseCode deptCourses] []
         mapM (processCourse meetings) deptCourses
     where
         processCourse allMeetings course = do
-            let courseMeetings = filter (\m -> meetingCode (entityVal m) == coursesCode course) allMeetings
+            let courseMeetings = filter (\m -> meetingCode (entityVal m) == courseCode course) allMeetings
             allTimes <- mapM buildMeetTimes courseMeetings
             buildCourse allTimes course
 
@@ -138,13 +138,13 @@ getBreadthKey description_ = do
         [] -> Nothing
         (x:_) -> Just x
 
--- | Inserts course into the Courses table.
-insertCourse :: (Courses, T.Text, T.Text) -> SqlPersistM ()
+-- | Inserts course into the Course table.
+insertCourse :: (Course, T.Text, T.Text) -> SqlPersistM ()
 insertCourse (course, breadthDesc, distributionDesc) = do
-    maybeCourse <- selectFirst [CoursesCode ==. coursesCode course] []
+    maybeCourse <- selectFirst [CourseCode ==. courseCode course] []
     breadthKey <- getBreadthKey breadthDesc
     distributionKey <- getDistributionKey distributionDesc
     case maybeCourse of
-        Nothing -> insert_ $ course {coursesBreadth = breadthKey,
-                                     coursesDistribution = distributionKey}
+        Nothing -> insert_ $ course {courseBreadth = breadthKey,
+                                     courseDistribution = distributionKey}
         Just _ -> return ()

app/WebParsing/ArtSciParser.hs

@@ -10,7 +10,7 @@ import Data.Text.Lazy (toStrict)
 import Data.Text.Lazy.Encoding (decodeUtf8)
 import Database.Persist (insertUnique)
 import Database.Persist.Sqlite (SqlPersistM)
-import Database.Tables (Courses (..), Department (..))
+import Database.Tables (Course (..), Department (..))
 import Models.Building (parseBuildings)
 import Models.Course (insertCourse)
 import Network.HTTP.Simple (getResponseBody, httpLBS, parseRequest)
@@ -89,7 +89,7 @@ parsePrograms programs = mapM_ addPostToDatabase $ TS.partitions isAccordionHead
         isAccordionHeader = tagOpenAttrNameLit "h3" "class" (T.isInfixOf "js-views-accordion-group-header")
 
 -- | Parse the section of the course calendar listing the courses offered by a department.
-parseCourses :: [Tag T.Text] -> [(Courses, T.Text, T.Text)]
+parseCourses :: [Tag T.Text] -> [(Course, T.Text, T.Text)]
 parseCourses tags =
     let elems = TS.partitions isAccordion tags
         courses = map parseCourse elems
@@ -98,7 +98,7 @@ parseCourses tags =
     where
         isAccordion = tagOpenAttrNameLit "h3" "class" (T.isInfixOf "js-views-accordion-group-header")
 
-        parseCourse :: [Tag T.Text] -> (Courses, T.Text, T.Text)
+        parseCourse :: [Tag T.Text] -> (Course, T.Text, T.Text)
         parseCourse courseTags =
             let courseHeader = T.strip . TS.innerText $ takeWhile (not . TS.isTagCloseName "h3") courseTags
                 (code, title) = either (error . show) id $ parse parseCourseTitle "course title" courseHeader
@@ -116,17 +116,17 @@ parseCourses tags =
                 distribution = fromMaybe "" $ getValue "Distribution Requirements:" courseContents
                 breadth = fromMaybe "" $ getValue "Breadth Requirements:" courseContents
             in
-                (Courses code
-                         (Just title)
-                         (Just description)
-                         (fmap (T.pack . show . parseReqs . T.unpack) prereqString)
-                         exclusion
-                         Nothing
-                         Nothing
-                         prereqString
-                         coreq
-                         [],
-                 breadth, distribution)
+                (Course code
+                    (Just title)
+                    (Just description)
+                    (fmap (T.pack . show . parseReqs . T.unpack) prereqString)
+                    exclusion
+                    Nothing
+                    Nothing
+                    prereqString
+                    coreq
+                    [],
+                breadth, distribution)
 
         getValue label texts = do
             i <- findIndex (T.isPrefixOf label) texts