From 185a8e332a5d7e2ef7cc4db949172e1bf611ca0d Mon Sep 17 00:00:00 2001 From: angelsanddevslol Date: Sun, 24 May 2026 02:50:43 -0400 Subject: [PATCH 1/4] 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/4] 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/4] 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/4] 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)