Rename post table to program

CHANGELOG.md

@@ -12,6 +12,7 @@
 - Added an autocomplete feature to the search bar `js/components/generate/GenerateForm`, also rewrote tests related to this feature
 - 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
+- Added a `database-migrate` CLI option that runs safe & unsafe SQL migrations (safe migration logic was extracted out of `database-setup` script)
 
 ### 🐛 Bug fixes
 
@@ -34,6 +35,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
 
 ## [0.7.1] - 2025-06-16
 

README.md

@@ -49,9 +49,10 @@ $ stack build   # Compile Courseography and all Haskell dependencies (this will
 #### Parsing and Generation
 
 1. Create the database file `$ stack run database-setup`
-2. Parse prerequisite graphs `$ stack run database-graphs`
-3. Parse course information from Arts and Science Calendar `$ stack run database-calendar`
-4. Parse course information from Arts and Science Timetable `$ stack run database-timetable`
+2. Run necessary database migrations `$ stack run database-migrate`
+3. Parse prerequisite graphs `$ stack run database-graphs`
+4. Parse course information from Arts and Science Calendar `$ stack run database-calendar`
+5. Parse course information from Arts and Science Timetable `$ stack run database-timetable`
 
 #### Running
 

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)

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)

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

app/Database/Migrations.hs

@@ -0,0 +1,21 @@
+module Database.Migrations
+    (migrateDatabase) where
+
+import Control.Monad.Reader (MonadIO, ReaderT)
+import Database.Persist.Sql (Migration, SqlBackend, addMigration, runMigration, runMigrationUnsafe)
+import Database.Tables (migrateAll)
+
+-- | Runs a migration 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;"
+
+-- | Migrates the database
+migrateDatabase :: MonadIO m => ReaderT SqlBackend m ()
+migrateDatabase = do
+    -- Run unsafe migrations
+    runMigrationUnsafe renamePostTables
+    -- Run safe migrations
+    runMigration migrateAll

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
 
@@ -212,7 +212,7 @@ data Course =
            } deriving (Show, Generic)
 
 instance ToJSON Course
-instance ToJSON Post
+instance ToJSON Program
 instance ToJSON Time
 instance ToJSON MeetTime'
 instance ToJSON Building

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 ()

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

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

backend-test/Controllers/ProgramControllerTests.hs

@@ -8,9 +8,9 @@ import Controllers.Program (index)
 import qualified Data.ByteString.Lazy.Char8 as BL
 import qualified Data.Text as T
 import Data.Time (getCurrentTime)
-import Database.DataType (PostType (..))
+import Database.DataType (ProgramType (..))
 import Database.Persist.Sqlite (SqlPersistM, insert_)
-import Database.Tables (Post (..))
+import Database.Tables (Program (..))
 import Happstack.Server (rsBody)
 import Test.Tasty (TestTree)
 import Test.Tasty.HUnit (assertEqual, testCase)
@@ -43,7 +43,7 @@ insertPrograms = mapM_ insertProgram
         insertProgram :: T.Text -> SqlPersistM ()
         insertProgram code = do
             curr <- liftIO getCurrentTime
-            insert_ (Post Other "test" code "test" "test" curr curr)
+            insert_ (Program Other "test" code "test" "test" curr curr)
 
 -- | Run all the index test cases
 runIndexTests :: [TestTree]

backend-test/Database/CourseQueriesTests.hs

@@ -13,9 +13,9 @@ import Config (runDb)
 import Control.Monad.IO.Class (liftIO)
 import qualified Data.Text as T
 import Data.Time (getCurrentTime)
-import Database.DataType (PostType (..))
+import Database.DataType (ProgramType (..))
 import Database.Persist.Sqlite (insert_)
-import Database.Tables (Post (..))
+import Database.Tables (Program (..))
 import Models.Program (reqsForProgram)
 import Test.Tasty (TestTree)
 import Test.Tasty.HUnit (assertEqual, testCase)
@@ -34,7 +34,7 @@ runReqsForProgramTest :: String -> T.Text -> T.Text -> String -> TestTree
 runReqsForProgramTest label reqsToInsert program expected =
     testCase label $ do
         currentTime <- liftIO getCurrentTime
-        let testProgram = Post Major "Computer Science" program "Sample post description" reqsToInsert currentTime currentTime
+        let testProgram = Program Major "Computer Science" program "Sample post description" reqsToInsert currentTime currentTime
 
         runDb $ do
             clearDatabase

backend-test/RequirementTests/PostParserTests.hs

@@ -10,7 +10,7 @@ module RequirementTests.PostParserTests
 
 import Data.Bifunctor (second)
 import qualified Data.Text as T
-import Database.DataType (PostType (..))
+import Database.DataType (ProgramType (..))
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (assertEqual, testCase)
 import qualified Text.Parsec as Parsec
@@ -56,7 +56,7 @@ postInfoInputs = [
         ("Biological Physics Specialist", ""))
     ]
 
-getPostTypeInputs :: [((T.Text, T.Text), PostType)]
+getPostTypeInputs :: [((T.Text, T.Text), ProgramType)]
 getPostTypeInputs = [
       (("ASSPE1958", "Psychology Specialist"), Specialist)
     , (("ASMAJ2276", "Music Major"), Major)

backend-test/TestHelpers.hs

@@ -167,8 +167,8 @@ clearDatabase = do
     deleteWhere ([] :: [Filter Database.Tables.Text])
     deleteWhere ([] :: [Filter Shape])
     deleteWhere ([] :: [Filter Path])
-    deleteWhere ([] :: [Filter Post])
-    deleteWhere ([] :: [Filter PostCategory])
+    deleteWhere ([] :: [Filter Program])
+    deleteWhere ([] :: [Filter ProgramCategory])
     deleteWhere ([] :: [Filter Building])
     deleteWhere ([] :: [Filter Graph])
 

courseography.cabal

@@ -33,6 +33,7 @@ library
     Database.DataType,
     Database.Requirement,
     Database.Tables,
+    Database.Migrations,
     DynamicGraphs.CourseFinder,
     DynamicGraphs.GraphGenerator,
     DynamicGraphs.GraphNodeUtils,
@@ -170,6 +171,7 @@ executable courseography
     Database.DataType,
     Database.Requirement,
     Database.Tables,
+    Database.Migrations,
     DynamicGraphs.CourseFinder,
     DynamicGraphs.GraphGenerator,
     DynamicGraphs.GraphNodeUtils,