Refactor Building and Time functions into Models

CHANGELOG.md

@@ -30,6 +30,7 @@
 - Renamed usages of the word "room" to "location" in the codebase to better reflect the data represented
 - Added test cases for JSON parsing of Meeting data type in `backend-test/Database/TablesTests.hs`
 - Added test cases for JSON parsing of Time' data type in `backend-test/Database/TablesTests.hs`
+- Refactored functions relating to `Building` and `Time` into `Models/Building` and `Models/Time` respectively
 
 ## [0.7.2] - 2025-12-10
 

app/Controllers/Timetable.hs

@@ -21,6 +21,7 @@ import Export.PdfGenerator
 import Happstack.Server
 import MasterTemplate
 import Models.Meeting (returnMeeting)
+import Models.Time (buildTime)
 import Scripts
 import System.FilePath ((</>))
 import System.IO.Temp (withSystemTempDirectory)

app/Database/Tables.hs

@@ -26,7 +26,6 @@ import Data.Char (toLower)
 import qualified Data.Text as T
 import Data.Time.Clock (UTCTime)
 import Database.DataType
-import Database.Persist.Sqlite (Key, SqlPersistM, entityVal, selectFirst, (==.))
 import Database.Persist.TH
 import GHC.Generics
 
@@ -308,36 +307,3 @@ convertTimeVals (Just day) (Just start) (Just end) =
         endDbl = getHourVal end
     in (dayDbl, startDbl, endDbl)
 convertTimeVals _ _ _ = (5.0, 25.0, 25.0)
-
--- | Convert Times into Time
-buildTime :: Times -> SqlPersistM Time
-buildTime t = do
-  room1 <- getBuilding (timesFirstRoom t)
-  room2 <- getBuilding (timesSecondRoom t)
-  return $ Time (timesWeekDay t)
-    (timesStartHour t)
-    (timesEndHour t)
-    room1
-    room2
-
-buildTimes :: Key Meeting -> Time' -> Times
-buildTimes meetingKey t =
-  Times (weekDay' t)
-    (startHour' t)
-    (endHour' t)
-    meetingKey
-    (firstLocation' t)
-    (secondLocation' t)
-
--- | Given a building code, get the persistent Building associated with it
-getBuilding :: Maybe T.Text -> SqlPersistM (Maybe Building)
-getBuilding rm = do
-  case rm of
-    Nothing -> return Nothing
-    Just r -> do
-      maybeEntityBuilding <- selectFirst [BuildingCode ==. T.take 2 r] []
-      case maybeEntityBuilding of
-        Nothing -> return Nothing
-        Just entBuilding -> do
-          let building = entityVal entBuilding
-          return $ Just building

app/Models/Building.hs

@@ -0,0 +1,55 @@
+module Models.Building
+    (buildingsCSV,
+    parseBuildings,
+    getBuildingsFromCSV,
+    getBuilding) where
+
+import Config (runDb)
+import Control.Monad.IO.Class (liftIO)
+import Data.CSV (csvFile)
+import qualified Data.Text as T
+import Database.Persist.Sqlite (Filter, SqlPersistM, deleteWhere, entityVal, insertMany_,
+                                selectFirst, (==.))
+import Database.Tables (Building (Building), EntityField (BuildingCode))
+import Filesystem.Path.CurrentOS as Path (append, decodeString, encodeString)
+import System.Directory (getCurrentDirectory)
+import Text.ParserCombinators.Parsec (parseFromFile)
+import Util.Helpers (safeHead)
+
+buildingsCSV :: IO Prelude.FilePath
+buildingsCSV = do
+    curDir <- getCurrentDirectory
+    return $ Path.encodeString $ Path.append (Path.decodeString curDir) $ Path.append (Path.decodeString "db") (Path.decodeString "building.csv")
+
+parseBuildings :: IO ()
+parseBuildings = do
+    buildingInfo <- getBuildingsFromCSV =<< buildingsCSV
+    runDb $ do
+        liftIO $ putStrLn "Inserting buildings"
+        deleteWhere ([] :: [Filter Building]) :: SqlPersistM ()
+        insertMany_ buildingInfo :: SqlPersistM ()
+
+-- | Extract building names, codes, addresses, postal codes, latitude and longitude from csv file
+getBuildingsFromCSV :: String -> IO [Building]
+getBuildingsFromCSV buildingCSVFile = do
+    buildingCSVData <- parseFromFile csvFile buildingCSVFile
+    case buildingCSVData of
+        Left _ -> error "csv parse error"
+        Right buildingData ->
+            return $ map (\b -> Building (T.pack $ safeHead "" b)
+                                        (T.pack (b !! 1))
+                                        (T.pack (b !! 2))
+                                        (T.pack (b !! 3))
+                                        (read (b !! 4) :: Double)
+                                        (read (b !! 5) :: Double)) $ drop 1 buildingData
+
+-- | Given a building code, get the persistent Building associated with it
+getBuilding :: Maybe T.Text -> SqlPersistM (Maybe Building)
+getBuilding rm =
+    case rm of
+        Nothing -> return Nothing
+        Just r -> do
+            maybeEntityBuilding <- selectFirst [BuildingCode ==. T.take 2 r] []
+            case maybeEntityBuilding of
+                Nothing -> return Nothing
+                Just entBuilding -> return $ Just (entityVal entBuilding)

app/Models/Meeting.hs

@@ -10,6 +10,7 @@ import qualified Data.Text as T (Text, append, isPrefixOf, tail, take, toUpper)
 import Database.Persist.Sqlite (Entity, SqlPersistM, entityKey, entityVal, selectFirst, selectList,
                                 (<-.), (==.))
 import Database.Tables as Tables
+import Models.Time (buildTime)
 
 -- | Queries the database for all matching lectures, tutorials,
 meetingQuery :: [T.Text] -> SqlPersistM [MeetTime']

app/Models/Time.hs

@@ -0,0 +1,26 @@
+module Models.Time
+    (buildTime,
+    buildTimes) where
+import Database.Persist.Sqlite (SqlPersistM)
+import Database.Tables (MeetingId, Time (..), Time' (..), Times (..))
+import Models.Building (getBuilding)
+
+-- | Convert a Times record into a Time by resolving room codes to Buildings
+buildTime :: Times -> SqlPersistM Time
+buildTime t = do
+    room1 <- getBuilding (timesFirstRoom t)
+    room2 <- getBuilding (timesSecondRoom t)
+    return $ Time (timesWeekDay t)
+        (timesStartHour t)
+        (timesEndHour t)
+        room1
+        room2
+
+buildTimes :: MeetingId -> Time' -> Times
+buildTimes meetingKey t =
+    Times (weekDay' t)
+        (startHour' t)
+        (endHour' t)
+        meetingKey
+        (firstLocation' t)
+        (secondLocation' t)

app/WebParsing/ArtSciParser.hs

@@ -3,27 +3,23 @@ module WebParsing.ArtSciParser
 
 import Config (fasCalendarUrl, programsUrl, runDb)
 import Control.Monad.IO.Class (liftIO)
-import Data.CSV
 import Data.List (findIndex, nubBy)
 import Data.Maybe (fromMaybe, mapMaybe)
 import qualified Data.Text as T
 import Data.Text.Lazy (toStrict)
 import Data.Text.Lazy.Encoding (decodeUtf8)
 import Database.Persist (insertUnique)
-import Database.Persist.Sqlite (Filter, SqlPersistM, deleteWhere, insertMany_)
-import Database.Tables (Building (..), Courses (..), Department (..))
-import Filesystem.Path.CurrentOS as Path
+import Database.Persist.Sqlite (SqlPersistM)
+import Database.Tables (Courses (..), Department (..))
+import Models.Building (parseBuildings)
 import Models.Course (insertCourse)
 import Network.HTTP.Simple (getResponseBody, httpLBS, parseRequest)
-import System.Directory (getCurrentDirectory)
 import qualified Text.HTML.TagSoup as TS
 import Text.HTML.TagSoup (Tag)
 import Text.HTML.TagSoup.Match (anyAttrValue, tagOpen, tagOpenAttrLit, tagOpenAttrNameLit)
 import Text.Parsec (count, many, parse)
 import qualified Text.Parsec.Char as P
 import Text.Parsec.Text (Parser)
-import Text.ParserCombinators.Parsec (parseFromFile)
-import Util.Helpers
 import WebParsing.ParsecCombinators (text)
 import WebParsing.PostParser (addPostToDatabase)
 import WebParsing.ReqParser (parseReqs)
@@ -33,34 +29,6 @@ parseCalendar = do
     parseArtSci
     parseBuildings
 
--- The file name is building.csv and it is in the courseography/db folder
-buildingsCSV :: IO Prelude.FilePath
-buildingsCSV = do
-    curDir <- getCurrentDirectory
-    return $ Path.encodeString $ Path.append (Path.decodeString curDir) $ Path.append (Path.decodeString "db") (Path.decodeString "building.csv")
-
-parseBuildings :: IO ()
-parseBuildings = do
-    buildingInfo <- getBuildingsFromCSV =<< buildingsCSV
-    runDb $ do
-        liftIO $ putStrLn "Inserting buildings"
-        deleteWhere ([] :: [Filter Building])  :: SqlPersistM ()
-        insertMany_ buildingInfo :: SqlPersistM ()
-
--- | Extract building names, codes, addresses, postal codes, latitude and longitude from csv file
-getBuildingsFromCSV :: String -> IO [Building]
-getBuildingsFromCSV buildingCSVFile = do
-    buildingCSVData <- parseFromFile csvFile buildingCSVFile
-    case buildingCSVData of
-        Left _ -> error "csv parse error"
-        Right buildingData -> do
-            return $ map (\b -> Building (T.pack $ safeHead "" b)
-                                        (T.pack (b !! 1))
-                                        (T.pack (b !! 2))
-                                        (T.pack (b !! 3))
-                                        (read (b !! 4) :: Double)
-                                        (read (b !! 5) :: Double)) $ drop 1 buildingData
-
 -- | Parses the entire Arts & Science Course Calendar and inserts courses
 -- into the database.
 parseArtSci :: IO ()

app/WebParsing/UtsgJsonParser.hs

@@ -10,7 +10,8 @@ import Data.Default.Class (def)
 import qualified Data.Text as T
 import Database.Persist.Sqlite (SqlPersistM, Update, deleteWhere, entityKey, insert, insertMany_,
                                 selectFirst, upsert, (=.), (==.))
-import Database.Tables (EntityField (..), MeetTime (..), Meeting (..), buildTimes)
+import Database.Tables (EntityField (..), MeetTime (..), Meeting (..))
+import Models.Time (buildTimes)
 import Network.Connection (TLSSettings (TLSSettingsSimple))
 import Network.HTTP.Conduit (RequestBody (RequestBodyLBS), httpLbs, method, mkManagerSettings,
                              newManager, parseRequest, requestBody, requestHeaders, responseBody)

backend-test/Controllers/CourseControllerTests.hs

@@ -18,9 +18,9 @@ import qualified Data.Map as Map
 import Data.Maybe (fromMaybe, mapMaybe)
 import qualified Data.Text as T
 import Database.Persist.Sqlite (SqlPersistM, insert, insertMany_, insert_)
-import Database.Tables (Building (..), Courses (..), MeetTime (..), Meeting (..), Time' (..),
-                        buildTimes)
+import Database.Tables (Building (..), Courses (..), MeetTime (..), Meeting (..), Time' (..))
 import Happstack.Server (rsBody, rsCode)
+import Models.Time (buildTimes)
 import Test.Tasty (TestTree)
 import Test.Tasty.HUnit (assertEqual, testCase)
 import TestHelpers (clearDatabase, mockGetRequest, runServerPart, runServerPartWith, withDatabase)

backend-test/Database/BuildingTests.hs

@@ -0,0 +1,51 @@
+{-|
+Description: Building module tests.
+
+Module that contains the tests for the functions in the Building module.
+
+-}
+
+module Database.BuildingTests
+( test_buildings
+) where
+
+import Config (runDb)
+import Database.Persist.Sqlite (Filter, selectList)
+import Database.Tables (Building)
+import Models.Building (parseBuildings)
+import Test.Tasty (TestTree)
+import Test.Tasty.HUnit (assertBool, assertEqual, testCase)
+import TestHelpers (clearDatabase, withDatabase)
+
+-- | Count the number of buildings currently in the database.
+countBuildings :: IO Int
+countBuildings = do
+    buildings <- runDb $ selectList ([] :: [Filter Building]) []
+    return $ length buildings
+
+-- | Run test on parseBuildings to check for a non-zero number of buildings
+testParseBuildingsInserts :: TestTree
+testParseBuildingsInserts =
+    testCase "parseBuildings inserts buildings from the CSV" $ do
+        runDb clearDatabase
+        parseBuildings
+        count <- countBuildings
+        assertBool "Expected parseBuildings to insert at least one building" (count > 0)
+
+-- | Run test on parseBuildings to check that calling multiple times does not duplicate entries in the database
+testParseBuildingsIdempotent :: TestTree
+testParseBuildingsIdempotent =
+    testCase "parseBuildings is called multiple times and does not duplicate entries" $ do
+        runDb clearDatabase
+        parseBuildings
+        countAfterFirst <- countBuildings
+        parseBuildings
+        countAfterSecond <- countBuildings
+        assertBool "Expected parseBuildings to insert at least one building" (countAfterFirst > 0)
+        assertEqual "Expected building count to be the same after multiple calls"
+            countAfterFirst countAfterSecond
+
+-- | Test suite for Building module
+test_buildings :: TestTree
+test_buildings =
+    withDatabase "Building tests" [testParseBuildingsInserts, testParseBuildingsIdempotent]

courseography.cabal

@@ -43,10 +43,12 @@ library
     Export.ImageConversion,
     Export.TimetableImageCreator,
     MasterTemplate,
+    Models.Building,
     Models.Course,
     Models.Graph,
     Models.Meeting,
     Models.Program,
+    Models.Time,
     Scripts,
     Svg.Builder,
     Svg.Database,
@@ -119,6 +121,7 @@ test-suite Tests
     Controllers.GenerateControllerTests,
     Controllers.GraphControllerTests,
     Controllers.ProgramControllerTests,
+    Database.BuildingTests,
     Database.CourseQueriesTests,
     Database.TablesTests,
     RequirementTests.ModifierTests,
@@ -188,10 +191,12 @@ executable courseography
     Export.PdfGenerator,
     Export.TimetableImageCreator,
     MasterTemplate,
+    Models.Building,
     Models.Course,
     Models.Graph,
     Models.Meeting,
     Models.Program,
+    Models.Time,
     Response,
     Response.About,
     Response.Draw,