From 185a8e332a5d7e2ef7cc4db949172e1bf611ca0d Mon Sep 17 00:00:00 2001 From: angelsanddevslol Date: Sun, 24 May 2026 02:50:43 -0400 Subject: [PATCH 1/7] Refactor building-related functions into Models/Building --- app/Controllers/Timetable.hs | 1 + app/Database/Tables.hs | 34 -------------- app/Models/Building.hs | 77 ++++++++++++++++++++++++++++++++ app/Models/Meeting.hs | 1 + app/WebParsing/ArtSciParser.hs | 38 ++-------------- app/WebParsing/UtsgJsonParser.hs | 3 +- 6 files changed, 84 insertions(+), 70 deletions(-) create mode 100644 app/Models/Building.hs diff --git a/app/Controllers/Timetable.hs b/app/Controllers/Timetable.hs index 9763698f4..9d98b9e24 100644 --- a/app/Controllers/Timetable.hs +++ b/app/Controllers/Timetable.hs @@ -20,6 +20,7 @@ import Export.LatexGenerator import Export.PdfGenerator import Happstack.Server import MasterTemplate +import Models.Building (buildTime) import Models.Meeting (returnMeeting) import Scripts import System.FilePath (()) diff --git a/app/Database/Tables.hs b/app/Database/Tables.hs index fe5c631e6..ef7061472 100644 --- a/app/Database/Tables.hs +++ b/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 diff --git a/app/Models/Building.hs b/app/Models/Building.hs new file mode 100644 index 000000000..d52f17ed8 --- /dev/null +++ b/app/Models/Building.hs @@ -0,0 +1,77 @@ +module Models.Building + (buildingsCSV, + parseBuildings, + getBuildingsFromCSV, + getBuilding, + buildTime, + buildTimes) where + +import Config (runDb) +import Control.Monad.IO.Class (liftIO) +import Data.CSV +import qualified Data.Text as T +import Database.Persist.Sqlite (Filter, SqlPersistM, deleteWhere, entityVal, insertMany_, + selectFirst, (==.)) +import Database.Tables +import Filesystem.Path.CurrentOS as Path +import System.Directory (getCurrentDirectory) +import Text.ParserCombinators.Parsec (parseFromFile) +import Util.Helpers + +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) + +-- | 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 :: Key Meeting -> Time' -> Times +buildTimes meetingKey t = + Times (weekDay' t) + (startHour' t) + (endHour' t) + meetingKey + (firstLocation' t) + (secondLocation' t) diff --git a/app/Models/Meeting.hs b/app/Models/Meeting.hs index 05678018b..bcc567078 100644 --- a/app/Models/Meeting.hs +++ b/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.Building (buildTime) -- | Queries the database for all matching lectures, tutorials, meetingQuery :: [T.Text] -> SqlPersistM [MeetTime'] diff --git a/app/WebParsing/ArtSciParser.hs b/app/WebParsing/ArtSciParser.hs index 806a220b8..74f5b36ab 100644 --- a/app/WebParsing/ArtSciParser.hs +++ b/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 () diff --git a/app/WebParsing/UtsgJsonParser.hs b/app/WebParsing/UtsgJsonParser.hs index 860f13876..1b7e76e35 100644 --- a/app/WebParsing/UtsgJsonParser.hs +++ b/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.Building (buildTimes) import Network.Connection (TLSSettings (TLSSettingsSimple)) import Network.HTTP.Conduit (RequestBody (RequestBodyLBS), httpLbs, method, mkManagerSettings, newManager, parseRequest, requestBody, requestHeaders, responseBody) From 7e109cc70d19ef95ffe3ee49eaadf5341f461bd4 Mon Sep 17 00:00:00 2001 From: angelsanddevslol Date: Sun, 24 May 2026 02:53:30 -0400 Subject: [PATCH 2/7] Update changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 44894175e..51aeab147 100644 --- a/CHANGELOG.md +++ b/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` into `Models/Building` ## [0.7.2] - 2025-12-10 From 6fbc319f2fb22b505f6fe7e68d164313e5403dbd Mon Sep 17 00:00:00 2001 From: angelsanddevslol Date: Sun, 24 May 2026 12:15:59 -0400 Subject: [PATCH 3/7] Update cabal to include Models.Building --- courseography.cabal | 2 ++ 1 file changed, 2 insertions(+) diff --git a/courseography.cabal b/courseography.cabal index 0d4179fdd..3b54a031b 100644 --- a/courseography.cabal +++ b/courseography.cabal @@ -43,6 +43,7 @@ library Export.ImageConversion, Export.TimetableImageCreator, MasterTemplate, + Models.Building, Models.Course, Models.Graph, Models.Meeting, @@ -188,6 +189,7 @@ executable courseography Export.PdfGenerator, Export.TimetableImageCreator, MasterTemplate, + Models.Building, Models.Course, Models.Graph, Models.Meeting, From 77c4fb75121e92dbdcf010d01d30fea7767f004c Mon Sep 17 00:00:00 2001 From: angelsanddevslol Date: Sun, 24 May 2026 12:39:10 -0400 Subject: [PATCH 4/7] refactor imports for backend tests involving buildTimes and Building --- backend-test/Controllers/CourseControllerTests.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/backend-test/Controllers/CourseControllerTests.hs b/backend-test/Controllers/CourseControllerTests.hs index 7237dad2b..739c338dd 100644 --- a/backend-test/Controllers/CourseControllerTests.hs +++ b/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.Building (buildTimes) import Test.Tasty (TestTree) import Test.Tasty.HUnit (assertEqual, testCase) import TestHelpers (clearDatabase, mockGetRequest, runServerPart, runServerPartWith, withDatabase) From 2e35d96e44c373662f6bf7997e6014bfe62f87ca Mon Sep 17 00:00:00 2001 From: angelsanddevslol Date: Fri, 29 May 2026 12:35:52 -0400 Subject: [PATCH 5/7] create Models.Time and refactor buildTime/buildTimes --- app/Controllers/Timetable.hs | 2 +- app/Models/Building.hs | 32 +++---------------- app/Models/Meeting.hs | 2 +- app/Models/Time.hs | 26 +++++++++++++++ app/WebParsing/UtsgJsonParser.hs | 2 +- .../Controllers/CourseControllerTests.hs | 2 +- courseography.cabal | 2 ++ 7 files changed, 37 insertions(+), 31 deletions(-) create mode 100644 app/Models/Time.hs diff --git a/app/Controllers/Timetable.hs b/app/Controllers/Timetable.hs index 9d98b9e24..670338d80 100644 --- a/app/Controllers/Timetable.hs +++ b/app/Controllers/Timetable.hs @@ -20,8 +20,8 @@ import Export.LatexGenerator import Export.PdfGenerator import Happstack.Server import MasterTemplate -import Models.Building (buildTime) import Models.Meeting (returnMeeting) +import Models.Time (buildTime) import Scripts import System.FilePath (()) import System.IO.Temp (withSystemTempDirectory) diff --git a/app/Models/Building.hs b/app/Models/Building.hs index d52f17ed8..0c2557178 100644 --- a/app/Models/Building.hs +++ b/app/Models/Building.hs @@ -2,21 +2,19 @@ module Models.Building (buildingsCSV, parseBuildings, getBuildingsFromCSV, - getBuilding, - buildTime, - buildTimes) where + getBuilding) where import Config (runDb) import Control.Monad.IO.Class (liftIO) -import Data.CSV +import Data.CSV (csvFile) import qualified Data.Text as T import Database.Persist.Sqlite (Filter, SqlPersistM, deleteWhere, entityVal, insertMany_, selectFirst, (==.)) -import Database.Tables -import Filesystem.Path.CurrentOS as Path +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 +import Util.Helpers (safeHead) buildingsCSV :: IO Prelude.FilePath buildingsCSV = do @@ -55,23 +53,3 @@ getBuilding rm = case maybeEntityBuilding of Nothing -> return Nothing Just entBuilding -> return $ Just (entityVal entBuilding) - --- | 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 :: Key Meeting -> Time' -> Times -buildTimes meetingKey t = - Times (weekDay' t) - (startHour' t) - (endHour' t) - meetingKey - (firstLocation' t) - (secondLocation' t) diff --git a/app/Models/Meeting.hs b/app/Models/Meeting.hs index bcc567078..86f536214 100644 --- a/app/Models/Meeting.hs +++ b/app/Models/Meeting.hs @@ -10,7 +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.Building (buildTime) +import Models.Time (buildTime) -- | Queries the database for all matching lectures, tutorials, meetingQuery :: [T.Text] -> SqlPersistM [MeetTime'] diff --git a/app/Models/Time.hs b/app/Models/Time.hs new file mode 100644 index 000000000..9be774f5e --- /dev/null +++ b/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) diff --git a/app/WebParsing/UtsgJsonParser.hs b/app/WebParsing/UtsgJsonParser.hs index 1b7e76e35..c1b3899d3 100644 --- a/app/WebParsing/UtsgJsonParser.hs +++ b/app/WebParsing/UtsgJsonParser.hs @@ -11,7 +11,7 @@ import qualified Data.Text as T import Database.Persist.Sqlite (SqlPersistM, Update, deleteWhere, entityKey, insert, insertMany_, selectFirst, upsert, (=.), (==.)) import Database.Tables (EntityField (..), MeetTime (..), Meeting (..)) -import Models.Building (buildTimes) +import Models.Time (buildTimes) import Network.Connection (TLSSettings (TLSSettingsSimple)) import Network.HTTP.Conduit (RequestBody (RequestBodyLBS), httpLbs, method, mkManagerSettings, newManager, parseRequest, requestBody, requestHeaders, responseBody) diff --git a/backend-test/Controllers/CourseControllerTests.hs b/backend-test/Controllers/CourseControllerTests.hs index 739c338dd..8e904165f 100644 --- a/backend-test/Controllers/CourseControllerTests.hs +++ b/backend-test/Controllers/CourseControllerTests.hs @@ -20,7 +20,7 @@ import qualified Data.Text as T import Database.Persist.Sqlite (SqlPersistM, insert, insertMany_, insert_) import Database.Tables (Building (..), Courses (..), MeetTime (..), Meeting (..), Time' (..)) import Happstack.Server (rsBody, rsCode) -import Models.Building (buildTimes) +import Models.Time (buildTimes) import Test.Tasty (TestTree) import Test.Tasty.HUnit (assertEqual, testCase) import TestHelpers (clearDatabase, mockGetRequest, runServerPart, runServerPartWith, withDatabase) diff --git a/courseography.cabal b/courseography.cabal index 3b54a031b..01cfdee8d 100644 --- a/courseography.cabal +++ b/courseography.cabal @@ -48,6 +48,7 @@ library Models.Graph, Models.Meeting, Models.Program, + Models.Time, Scripts, Svg.Builder, Svg.Database, @@ -194,6 +195,7 @@ executable courseography Models.Graph, Models.Meeting, Models.Program, + Models.Time, Response, Response.About, Response.Draw, From 6a90de5769700719455e134e5680239ea24801b3 Mon Sep 17 00:00:00 2001 From: angelsanddevslol Date: Sat, 30 May 2026 00:02:05 -0400 Subject: [PATCH 6/7] add tests for parseBuilding --- backend-test/Database/BuildingTests.hs | 51 ++++++++++++++++++++++++++ courseography.cabal | 1 + 2 files changed, 52 insertions(+) create mode 100644 backend-test/Database/BuildingTests.hs diff --git a/backend-test/Database/BuildingTests.hs b/backend-test/Database/BuildingTests.hs new file mode 100644 index 000000000..613a8e1c2 --- /dev/null +++ b/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] diff --git a/courseography.cabal b/courseography.cabal index 01cfdee8d..dd1f3789a 100644 --- a/courseography.cabal +++ b/courseography.cabal @@ -121,6 +121,7 @@ test-suite Tests Controllers.GenerateControllerTests, Controllers.GraphControllerTests, Controllers.ProgramControllerTests, + Database.BuildingTests, Database.CourseQueriesTests, Database.TablesTests, RequirementTests.ModifierTests, From 9a837617413e1313c835a9a469d7d49d4b16965f Mon Sep 17 00:00:00 2001 From: angelsanddevslol Date: Sat, 30 May 2026 00:41:17 -0400 Subject: [PATCH 7/7] update changelog to include Time module --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 51aeab147..ef4ad537d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -30,7 +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` into `Models/Building` +- Refactored functions relating to `Building` and `Time` into `Models/Building` and `Models/Time` respectively ## [0.7.2] - 2025-12-10