Renamed post to program in database schema and implement migration action (#1607)

akarki2005 · web-flow · commit 77b9721cc3c8 · 2025-11-13T11:19:04.000-05:00
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -13,6 +13,7 @@
 - Added a route to access all POST codes stored in the database with test coverage
 - Added the `js/components/generate/AutocompleteDropdown.js` component to the program field of Generate
 - Updated the colour of the rendered options for the AutocompleteDropdown component
+- Added a `database-migrate` CLI option that runs SQL migrations
 - Updated the course info modal timetable styling and layout
 
 ### 🐛 Bug fixes
@@ -37,6 +38,7 @@
 - Added test cases for the `ExportModal` component in `js/components/common`
 - Updated backend tests to use `tasty-discover`
 - Added documentation for running a subset of the backend tests
+- Renamed `Post` and `PostCategory` database tables to `Program` and `ProgramCategory` respectively through a database migration
 - Deleted `app/Response/Image` file and refactored `app/Util/Helpers` to include `returnImageData`
 - Added test cases for the retrieveProgram function in `Controllers/Program`
 - Removed duplicate code from `mockRequest` and `runServerPartWith` in `backend-test/TestHelpers.hs`
diff --git a/app/Controllers/Generate.hs b/app/Controllers/Generate.hs
@@ -42,13 +42,13 @@ findAndSavePrereqsResponse = do
     requestBody <- getBody
     let coursesOptions :: CourseGraphOptions = fromJust $ decode requestBody
 
-    postResults <- liftIO $ mapM (\code -> do
-                        post <- returnProgram (TL.toStrict code)
-                        return (TL.toStrict code, post))
+    programResults <- liftIO $ mapM (\code -> do
+                        program <- returnProgram (TL.toStrict code)
+                        return (TL.toStrict code, program))
                    (programs coursesOptions)
 
-    let invalidPrograms = map fst $ filter (isNothing . snd) postResults
-        validPrograms = mapMaybe snd postResults
+    let invalidPrograms = map fst $ filter (isNothing . snd) programResults
+        validPrograms = mapMaybe snd programResults
 
     allCourses <- liftIO $ nub <$>
         if all (== TL.empty) (courses coursesOptions)
diff --git a/app/Controllers/Program.hs b/app/Controllers/Program.hs
@@ -6,7 +6,7 @@ import qualified Data.Set as S
 import qualified Data.Text as T (Text, null, strip, unlines)
 import Database.Persist (Entity)
 import Database.Persist.Sqlite (SqlPersistM, entityVal, selectList)
-import Database.Tables as Tables (Post, postCode, postModified)
+import Database.Tables as Tables (Program, programCode, programModified)
 import Happstack.Server (Request, Response, ServerPart, askRq, ifModifiedSince, lookText',
                          toResponse)
 import Models.Program (returnProgram)
@@ -16,8 +16,8 @@ import Util.Happstack (createJSONResponse)
 index :: ServerPart Response
 index = do
     response <- liftIO $ runDb $ do
-        programsList :: [Entity Post] <- selectList [] []
-        let codes = map (postCode . entityVal) programsList
+        programsList :: [Entity Program] <- selectList [] []
+        let codes = map (programCode . entityVal) programsList
             rmEmpty = filter (not . T.null . T.strip) codes
             rmDups = S.toList (S.fromList rmEmpty)
         return $ T.unlines rmDups :: SqlPersistM T.Text
@@ -39,5 +39,5 @@ queryProgram :: Request -> T.Text -> IO Response
 queryProgram req code = do
     programMaybe <- returnProgram code
     case programMaybe of
-        Nothing -> return $ createJSONResponse (Nothing :: Maybe Post)
-        Just program -> return $ ifModifiedSince (postModified program) req (createJSONResponse program)
+        Nothing -> return $ createJSONResponse (Nothing :: Maybe Program)
+        Just program -> return $ ifModifiedSince (programModified program) req (createJSONResponse program)
diff --git a/app/Database/DataType.hs b/app/Database/DataType.hs
@@ -31,9 +31,9 @@ instance ToJSON ShapeType
 -- .
 instance FromJSON ShapeType
 
-data PostType = Specialist | Major | Minor | Focus | Certificate | Other
+data ProgramType = Specialist | Major | Minor | Focus | Certificate | Other
  deriving (Show, Read, Eq, Generic)
-derivePersistField "PostType"
+derivePersistField "ProgramType"
 
-instance ToJSON PostType
-instance FromJSON PostType
+instance ToJSON ProgramType
+instance FromJSON ProgramType
diff --git a/app/Database/Database.hs b/app/Database/Database.hs
@@ -11,12 +11,12 @@ module Database.Database
 
 import Config (databasePath, runDb)
 import Control.Monad (void)
-import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.IO.Class (liftIO)
 import Data.Maybe (fromMaybe)
 import Data.Text as T (findIndex, length, reverse, take, unpack)
 import Database.CourseVideoSeed (seedVideos)
-import Database.Persist.Sqlite (SqlPersistT, entityVal, insert_, runMigration, runMigrationQuiet,
-                                selectFirst)
+import Database.Migrations (getDatabaseVersion)
+import Database.Persist.Sqlite (insert_, runMigration, runMigrationQuiet)
 import Database.Tables
 import System.Directory (createDirectoryIfMissing)
 import WebParsing.ArtSciParser (parseCalendar)
@@ -41,19 +41,6 @@ setupDatabase quiet = do
     let migrateFunction = if quiet then void . runMigrationQuiet else runMigration
     runDb $ void $ migrateFunction migrateAll >> getDatabaseVersion
 
--- | Gets the current version of the database.
--- If no version is defined, initialize the
--- version to 1 and return that.
-getDatabaseVersion :: MonadIO m => SqlPersistT m Int
-getDatabaseVersion = do
-    result <- selectFirst [] []
-    case result of
-        Just entity -> pure $ schemaVersionVersion $ entityVal entity
-        Nothing -> do
-            let initialVersion = 1
-            insert_ $ SchemaVersion initialVersion
-            pure initialVersion
-
 -- | Sets up the course information from Artsci Calendar
 populateCalendar :: IO ()
 populateCalendar = do
diff --git a/app/Database/Migrations.hs b/app/Database/Migrations.hs
@@ -0,0 +1,62 @@
+module Database.Migrations
+    (migrateDatabase, getDatabaseVersion, setDatabaseVersion, migrationList) where
+
+import Control.Monad.Reader (MonadIO)
+import Data.List (sortOn)
+import Database.Persist.Sql (Entity (..), Migration, SqlPersistT, addMigration, insert_,
+                             runMigrationUnsafe, selectFirst, update, (=.))
+import Database.Tables
+
+data MigrationWrapper = MigrationWrapper {
+    version :: Int,
+    script :: Migration
+}
+
+-- | Migrates the database
+migrateDatabase :: MonadIO m => SqlPersistT m ()
+migrateDatabase = do
+    currVersion <- getDatabaseVersion
+    applyMigrations currVersion migrationList
+
+-- | Migrates the database by applying only migrations newer than the current version number
+applyMigrations :: MonadIO m => Int -> [MigrationWrapper] -> SqlPersistT m ()
+applyMigrations currVersion migrations = do
+    mapM_ (runMigrationUnsafe . script)
+        $ sortOn version
+        $ filter (\migration -> version migration > currVersion) migrations
+
+    case migrations of
+        [] -> return ()
+        _ -> setDatabaseVersion $ maximum $ map version migrations
+
+-- | List of migrations
+migrationList :: [MigrationWrapper]
+migrationList = [MigrationWrapper {version=2, script=renamePostTables}]
+
+-- | Migration script which renames the Post tables to Program
+renamePostTables :: Migration
+renamePostTables = do
+    addMigration True "ALTER TABLE post RENAME TO program;"
+    addMigration True "ALTER TABLE post_category RENAME TO program_category;"
+    addMigration True "ALTER TABLE program_category RENAME COLUMN post TO program;"
+
+-- | Gets the current version of the database.
+-- If no version is defined, initialize the
+-- version to the latest version and return that.
+getDatabaseVersion :: MonadIO m => SqlPersistT m Int
+getDatabaseVersion = do
+    result <- selectFirst [] []
+    case result of
+        Just entity -> pure $ schemaVersionVersion $ entityVal entity
+        Nothing -> do
+            let latestVersion = maximum $ map version migrationList
+            setDatabaseVersion latestVersion
+            pure latestVersion
+
+-- | Sets the database version number to newVersion
+setDatabaseVersion :: MonadIO m => Int -> SqlPersistT m ()
+setDatabaseVersion newVersion = do
+    result <- selectFirst [] []
+    case result of
+        Just (Entity key _) -> update key [SchemaVersionVersion =. newVersion]
+        Nothing -> insert_ $ SchemaVersion newVersion
diff --git a/app/Database/Tables.hs b/app/Database/Tables.hs
@@ -128,20 +128,20 @@ Path json
     deriving Show
     transform [Double] default=[1,0,0,1,0,0]
 
-Post
-    name PostType
+Program
+    name ProgramType
     department T.Text
     code T.Text
-    --UniquePostCode code
+    --UniqueProgramCode code
     --Primary code
     description T.Text
     requirements T.Text
     created UTCTime
     modified UTCTime
     deriving Show Eq Generic
 
-PostCategory
-    post PostId
+ProgramCategory
+    program ProgramId
     name T.Text
     deriving Show
 
@@ -216,7 +216,7 @@ data Course =
            } deriving (Show, Generic)
 
 instance ToJSON Course
-instance ToJSON Post
+instance ToJSON Program
 instance ToJSON Time
 instance ToJSON MeetTime'
 instance ToJSON Building
diff --git a/app/Main.hs b/app/Main.hs
@@ -16,7 +16,9 @@ import System.Environment (getArgs)
 import System.IO (hPutStrLn, stderr)
 
 -- internal dependencies
+import Config (runDb)
 import Database.Database (populateCalendar, setupDatabase)
+import Database.Migrations (migrateDatabase)
 import Server (runServer)
 import Svg.Parser (parsePrebuiltSvgs)
 import Util.Documentation (generateDocs)
@@ -34,7 +36,8 @@ taskMap = Map.fromList [
     ("database-graphs", const parsePrebuiltSvgs),
     ("docs", const generateDocs),
     ("generate", generate),
-    ("database-setup", const (setupDatabase False))]
+    ("database-setup", const (setupDatabase False)),
+    ("database-migrate", const (runDb migrateDatabase))]
 
 -- | Courseography entry point.
 main :: IO ()
diff --git a/app/Models/Program.hs b/app/Models/Program.hs
@@ -8,18 +8,18 @@ import qualified Data.Text as T (Text, unpack)
 import Database.Persist.Sqlite (entityVal, selectFirst, (==.))
 import Database.Tables
 
--- | Queries the database for information about the program then returns the post value
-returnProgram :: T.Text -> IO (Maybe Post)
+-- | Queries the database for information about the program then returns the program value
+returnProgram :: T.Text -> IO (Maybe Program)
 returnProgram code = runDb $ do
-    sqlProgram <- selectFirst [PostCode ==. code] []
+    sqlProgram <- selectFirst [ProgramCode ==. code] []
     case sqlProgram of
         Nothing -> return Nothing
         Just program -> return $ Just $ entityVal program
 
--- | Retrieves the course requirements for a Post (program) as a list of course codes
-reqsForProgram :: Post -> [String]
+-- | Retrieves the course requirements for a Program as a list of course codes
+reqsForProgram :: Program -> [String]
 reqsForProgram program = do
-    let requirementsText = T.unpack $ postRequirements program
+    let requirementsText = T.unpack $ programRequirements program
         cleaned = filter (`notElem` ("<>" :: String)) $ filter (not . isPunctuation) requirementsText
         potentialCodes = words cleaned
     filter isCourseCode potentialCodes
diff --git a/app/WebParsing/PostParser.hs b/app/WebParsing/PostParser.hs
@@ -13,7 +13,7 @@ import Data.List.Split (keepDelimsL, split, splitWhen, whenElt)
 import Data.Text (strip)
 import qualified Data.Text as T
 import Data.Time.Clock (getCurrentTime)
-import Database.DataType (PostType (..))
+import Database.DataType (ProgramType (..))
 import Database.Persist (insertUnique)
 import Database.Persist.Sqlite (SqlPersistM, insert_)
 import Database.Tables
@@ -41,18 +41,18 @@ addPostToDatabase programElements = do
         Left _ -> return ()
         Right (department, code) -> do
             currTime <- liftIO getCurrentTime
-            postExists <- insertUnique Post {
-                postName = getPostType code department,
-                postDepartment = department,
-                postCode = code,
-                postDescription = descriptionText,
-                postRequirements = renderTags requirementLines,
-                postCreated = currTime,
-                postModified = currTime
+            programExists <- insertUnique Program {
+                programName = getPostType code department,
+                programDepartment = department,
+                programCode = code,
+                programDescription = descriptionText,
+                programRequirements = renderTags requirementLines,
+                programCreated = currTime,
+                programModified = currTime
                 }
-            case postExists of
+            case programExists of
                 Just key ->
-                    mapM_ (insert_ . PostCategory key) requirements
+                    mapM_ (insert_ . ProgramCategory key) requirements
                 Nothing -> return ()
     where
         isDescriptionSection tag = tagOpenAttrNameLit "div" "class" (T.isInfixOf "views-field-body") tag || isRequirementSection tag
@@ -73,12 +73,12 @@ postInfoParser = do
 
 -- | Extracts the post type (eg. major) from a post code if it is non-empty,
 -- | or from a dept name otherwise
-getPostType :: T.Text -> T.Text -> PostType
+getPostType :: T.Text -> T.Text -> ProgramType
 getPostType "" deptName = getPostTypeFromName deptName
 getPostType code _ = getPostTypeFromCode code
 
 -- | Extracts the post type (eg. major) from a post name (eg. "Biology Specialist")
-getPostTypeFromName :: T.Text -> PostType
+getPostTypeFromName :: T.Text -> ProgramType
 getPostTypeFromName deptName
     | T.isInfixOf "Specialist" deptName = Specialist
     | T.isInfixOf "Major" deptName = Major
@@ -87,12 +87,12 @@ getPostTypeFromName deptName
     | T.isInfixOf "Certificate" deptName = Certificate
     | otherwise = Other
 
--- | Extracts the post type (eg. major) from a post code (eg. ASMAJ1689)
-getPostTypeFromCode :: T.Text -> PostType
+-- | Extracts the program type (eg. major) from a program code (eg. ASMAJ1689)
+getPostTypeFromCode :: T.Text -> ProgramType
 getPostTypeFromCode = abbrevToPost . T.take 3 . T.drop 2
 
--- | Maps the post type abbreviations to their corresponding PostType
-abbrevToPost :: T.Text -> PostType
+-- | Maps the post type abbreviations to their corresponding ProgramType
+abbrevToPost :: T.Text -> ProgramType
 abbrevToPost "SPE" = Specialist
 abbrevToPost "MAJ" = Major
 abbrevToPost "MIN" = Minor
diff --git a/backend-test/Controllers/ProgramControllerTests.hs b/backend-test/Controllers/ProgramControllerTests.hs
diff --git a/backend-test/Database/CourseQueriesTests.hs b/backend-test/Database/CourseQueriesTests.hs
diff --git a/backend-test/RequirementTests/PostParserTests.hs b/backend-test/RequirementTests/PostParserTests.hs
diff --git a/backend-test/TestHelpers.hs b/backend-test/TestHelpers.hs
diff --git a/courseography.cabal b/courseography.cabal
