From 34481860a3de50a7d1d42510442778120c4f84a7 Mon Sep 17 00:00:00 2001 From: angelsanddevslol Date: Sat, 16 May 2026 15:49:54 -0400 Subject: [PATCH 1/4] Add tests and update changelog for Database.Tables FromJSON Meeting datatype --- CHANGELOG.md | 1 + README.md | 1 + app/Database/Tables.hs | 2 +- backend-test/Database/TablesTests.hs | 51 ++++++++++++++++++++++++++++ courseography.cabal | 1 + 5 files changed, 55 insertions(+), 1 deletion(-) create mode 100644 backend-test/Database/TablesTests.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index 6a52361be..5232c61d0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -28,6 +28,7 @@ - Removed `Location` datatype in favour of `Building` - Refactor tests to run directly on tuple input to prevent unnecessary unpacking and repacking - 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 `Database/TablesTests.hs` ## [0.7.2] - 2025-12-10 diff --git a/README.md b/README.md index 404f4d141..abe9969a3 100644 --- a/README.md +++ b/README.md @@ -120,6 +120,7 @@ Nazanin Ghazitabatabai, Sidharth Gupta, Parker Hutcheson, Yoonie Jang, +Angelina Jiang, Jai Joshi, Aayush Karki, Japleen Kaur, diff --git a/app/Database/Tables.hs b/app/Database/Tables.hs index edc6366c4..5bac05f37 100644 --- a/app/Database/Tables.hs +++ b/app/Database/Tables.hs @@ -67,7 +67,7 @@ Meeting enrol Int wait Int extra Int - deriving Generic Show + deriving Generic Show Eq UniqueMeeting code session section Times diff --git a/backend-test/Database/TablesTests.hs b/backend-test/Database/TablesTests.hs new file mode 100644 index 000000000..f47b3847e --- /dev/null +++ b/backend-test/Database/TablesTests.hs @@ -0,0 +1,51 @@ +{- HLINT ignore "Use forM_" -} +{-| +Description: Tables module tests. + +Module that contains the tests for the functions in the Tables module. + +-} + +module Database.TablesTests +( test_tableQueries +) where + +import Config (runDb) +import Data.Aeson (decode) +import qualified Data.ByteString.Lazy.Char8 as BL +import Database.Persist.Sqlite (insert_) +import Database.Tables (Meeting (..)) +import Test.Tasty (TestTree) +import Test.Tasty.HUnit (assertEqual, testCase) +import TestHelpers (clearDatabase, withDatabase) + +-- | List of test cases as (label, input JSON payload, expected output) +fromJSONToMeetingTestCases :: [(String, BL.ByteString, Maybe Meeting)] +fromJSONToMeetingTestCases = + [ ("Invalid meeting returns Nothing", "{}", Nothing) + , ("Valid meeting", "{\"teachMethod\":\"LEC\"}", Just (Meeting "" "" "LEC" (-1) "" 0 0 0)) + , ("Valid meeting with all fields", "{\"teachMethod\":\"LEC\",\"sectionNumber\":\"0101\",\"maxEnrolment\":100,\"currentEnrolment\":77,\"currentWaitlist\":0,\"instructors\":[{\"firstName\":\"Brinda\",\"lastName\":\"Venkataramani\"}]}", Just (Meeting "" "" "LEC0101" 100 "Brinda. Venkataramani" 77 0 0)) + ] + +-- | Run a test case (case, input, expected output) on the FromJSON instance of Meeting. +runFromJSONToMeetingTest :: (String, BL.ByteString, Maybe Meeting) -> TestTree +runFromJSONToMeetingTest (label, meetingJSON, expected) = + testCase label $ do + let actual = decode meetingJSON :: Maybe Meeting + + runDb $ do + clearDatabase + case actual of + Just meeting -> insert_ meeting + Nothing -> return () + + assertEqual ("Unexpected response body for " ++ label) expected actual + +-- | Run all the test cases on the FromJSON instance of Meeting +runFromJSONToMeetingTests :: [TestTree] +runFromJSONToMeetingTests = map runFromJSONToMeetingTest fromJSONToMeetingTestCases + +-- | Test suite for Tables Module +test_tableQueries :: TestTree +test_tableQueries = + withDatabase "Parsing from JSON to Meeting tests" runFromJSONToMeetingTests diff --git a/courseography.cabal b/courseography.cabal index 653527376..0d4179fdd 100644 --- a/courseography.cabal +++ b/courseography.cabal @@ -120,6 +120,7 @@ test-suite Tests Controllers.GraphControllerTests, Controllers.ProgramControllerTests, Database.CourseQueriesTests, + Database.TablesTests, RequirementTests.ModifierTests, RequirementTests.PostParserTests, RequirementTests.PreProcessingTests, From 76b45b5cf40cfe61c6d9a98494207fe6bebf0857 Mon Sep 17 00:00:00 2001 From: angelsanddevslol Date: Tue, 19 May 2026 02:56:41 -0400 Subject: [PATCH 2/4] Update code style; clean code --- backend-test/Database/TablesTests.hs | 34 ++++++++++------------------ 1 file changed, 12 insertions(+), 22 deletions(-) diff --git a/backend-test/Database/TablesTests.hs b/backend-test/Database/TablesTests.hs index f47b3847e..89dcc7a72 100644 --- a/backend-test/Database/TablesTests.hs +++ b/backend-test/Database/TablesTests.hs @@ -7,45 +7,35 @@ Module that contains the tests for the functions in the Tables module. -} module Database.TablesTests -( test_tableQueries +( test_tables ) where -import Config (runDb) import Data.Aeson (decode) import qualified Data.ByteString.Lazy.Char8 as BL -import Database.Persist.Sqlite (insert_) import Database.Tables (Meeting (..)) -import Test.Tasty (TestTree) +import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertEqual, testCase) -import TestHelpers (clearDatabase, withDatabase) -- | List of test cases as (label, input JSON payload, expected output) -fromJSONToMeetingTestCases :: [(String, BL.ByteString, Maybe Meeting)] -fromJSONToMeetingTestCases = +meetingFromJSONTestCases :: [(String, BL.ByteString, Maybe Meeting)] +meetingFromJSONTestCases = [ ("Invalid meeting returns Nothing", "{}", Nothing) , ("Valid meeting", "{\"teachMethod\":\"LEC\"}", Just (Meeting "" "" "LEC" (-1) "" 0 0 0)) , ("Valid meeting with all fields", "{\"teachMethod\":\"LEC\",\"sectionNumber\":\"0101\",\"maxEnrolment\":100,\"currentEnrolment\":77,\"currentWaitlist\":0,\"instructors\":[{\"firstName\":\"Brinda\",\"lastName\":\"Venkataramani\"}]}", Just (Meeting "" "" "LEC0101" 100 "Brinda. Venkataramani" 77 0 0)) ] -- | Run a test case (case, input, expected output) on the FromJSON instance of Meeting. -runFromJSONToMeetingTest :: (String, BL.ByteString, Maybe Meeting) -> TestTree -runFromJSONToMeetingTest (label, meetingJSON, expected) = +runMeetingFromJSONTest :: (String, BL.ByteString, Maybe Meeting) -> TestTree +runMeetingFromJSONTest (label, meetingJSON, expected) = testCase label $ do let actual = decode meetingJSON :: Maybe Meeting - - runDb $ do - clearDatabase - case actual of - Just meeting -> insert_ meeting - Nothing -> return () - - assertEqual ("Unexpected response body for " ++ label) expected actual + assertEqual ("Unexpected parsing result for " ++ label) expected actual -- | Run all the test cases on the FromJSON instance of Meeting -runFromJSONToMeetingTests :: [TestTree] -runFromJSONToMeetingTests = map runFromJSONToMeetingTest fromJSONToMeetingTestCases +runMeetingFromJSONTests :: [TestTree] +runMeetingFromJSONTests = map runMeetingFromJSONTest meetingFromJSONTestCases -- | Test suite for Tables Module -test_tableQueries :: TestTree -test_tableQueries = - withDatabase "Parsing from JSON to Meeting tests" runFromJSONToMeetingTests +test_tables :: TestTree +test_tables = + testGroup "Parsing from JSON to Meeting tests" runMeetingFromJSONTests From 682ef724a20c297019aea4c1189349afa37b4514 Mon Sep 17 00:00:00 2001 From: angelsanddevslol Date: Tue, 19 May 2026 03:47:05 -0400 Subject: [PATCH 3/4] add test cases for FromJSON Meeting instance --- backend-test/Database/TablesTests.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/backend-test/Database/TablesTests.hs b/backend-test/Database/TablesTests.hs index 89dcc7a72..ad6083157 100644 --- a/backend-test/Database/TablesTests.hs +++ b/backend-test/Database/TablesTests.hs @@ -19,9 +19,15 @@ import Test.Tasty.HUnit (assertEqual, testCase) -- | List of test cases as (label, input JSON payload, expected output) meetingFromJSONTestCases :: [(String, BL.ByteString, Maybe Meeting)] meetingFromJSONTestCases = - [ ("Invalid meeting returns Nothing", "{}", Nothing) - , ("Valid meeting", "{\"teachMethod\":\"LEC\"}", Just (Meeting "" "" "LEC" (-1) "" 0 0 0)) + [ ("Invalid meeting (empty JSON), Nothing returned", "{}", Nothing) + , ("Valid meeting with valid teachMethod", "{\"teachMethod\":\"LEC\"}", Just (Meeting "" "" "LEC" (-1) "" 0 0 0)) , ("Valid meeting with all fields", "{\"teachMethod\":\"LEC\",\"sectionNumber\":\"0101\",\"maxEnrolment\":100,\"currentEnrolment\":77,\"currentWaitlist\":0,\"instructors\":[{\"firstName\":\"Brinda\",\"lastName\":\"Venkataramani\"}]}", Just (Meeting "" "" "LEC0101" 100 "Brinda. Venkataramani" 77 0 0)) + , ("Valid meeting with no maxEnrolment, default cap returned", "{\"teachMethod\":\"LEC\",\"sectionNumber\":\"0101\"}", Just (Meeting "" "" "LEC0101" (-1) "" 0 0 0)) + , ("Valid meeting with no currentEnrolment, default enrol returned", "{\"teachMethod\":\"LEC\",\"sectionNumber\":\"0101\",\"maxEnrolment\":100}", Just (Meeting "" "" "LEC0101" 100 "" 0 0 0)) + , ("Valid meeting with no currentWaitlist, default wait returned", "{\"teachMethod\":\"LEC\",\"sectionNumber\":\"0101\",\"maxEnrolment\":100,\"currentEnrolment\":50}", Just (Meeting "" "" "LEC0101" 100 "" 50 0 0)) + , ("Valid meeting with multiple instructors", "{\"teachMethod\":\"LEC\",\"sectionNumber\":\"0101\",\"instructors\":[{\"firstName\":\"A\",\"lastName\":\"B\"},{\"firstName\":\"C\",\"lastName\":\"D\"}]}", Just (Meeting "" "" "LEC0101" (-1) "A. B; C. D" 0 0 0)) + , ("Invalid meeting with no teachMethod, Nothing returned", "{\"sectionNumber\":\"0101\",\"maxEnrolment\":100}", Nothing) + , ("Invalid meeting with unknown teachMethod, Nothing returned", "{\"teachMethod\":\"LAB\",\"sectionNumber\":\"0101\"}", Nothing) ] -- | Run a test case (case, input, expected output) on the FromJSON instance of Meeting. @@ -31,7 +37,7 @@ runMeetingFromJSONTest (label, meetingJSON, expected) = let actual = decode meetingJSON :: Maybe Meeting assertEqual ("Unexpected parsing result for " ++ label) expected actual --- | Run all the test cases on the FromJSON instance of Meeting +-- | Run all the meetingFromJSON test cases runMeetingFromJSONTests :: [TestTree] runMeetingFromJSONTests = map runMeetingFromJSONTest meetingFromJSONTestCases From 310e93a32a08ad44a80d6216b46628a7392acba5 Mon Sep 17 00:00:00 2001 From: angelsanddevslol Date: Tue, 19 May 2026 13:18:19 -0400 Subject: [PATCH 4/4] delete unnecessary comment --- backend-test/Database/TablesTests.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/backend-test/Database/TablesTests.hs b/backend-test/Database/TablesTests.hs index ad6083157..9d777271a 100644 --- a/backend-test/Database/TablesTests.hs +++ b/backend-test/Database/TablesTests.hs @@ -1,4 +1,3 @@ -{- HLINT ignore "Use forM_" -} {-| Description: Tables module tests.