From f4078f762415e173204a31bafa725ed470900a2c Mon Sep 17 00:00:00 2001 From: Jason De Lanerolle Date: Fri, 30 Jan 2026 09:30:35 -0500 Subject: [PATCH 1/5] Add getGraphJSON test template --- README.md | 1 + .../Controllers/GraphControllerTests.hs | 41 +++++++++++++++---- 2 files changed, 35 insertions(+), 7 deletions(-) diff --git a/README.md b/README.md index f122193c1..404f4d141 100644 --- a/README.md +++ b/README.md @@ -108,6 +108,7 @@ Christina Chen, Eugene Cheung, Mimis Chlympatsos, Matthew Dahlgren, +Jason De Lanerolle, Kael Deverell, Spencer Elliott, Lana El Sanyoura, diff --git a/backend-test/Controllers/GraphControllerTests.hs b/backend-test/Controllers/GraphControllerTests.hs index ea1565537..a69f31fbd 100644 --- a/backend-test/Controllers/GraphControllerTests.hs +++ b/backend-test/Controllers/GraphControllerTests.hs @@ -11,19 +11,19 @@ module Controllers.GraphControllerTests import Config (runDb) import Control.Monad.IO.Class (liftIO) -import Controllers.Graph (index, saveGraphJSON) +import Controllers.Graph (index, saveGraphJSON, getGraphJSON) import Data.Aeson (Value (Number, Object), decode) import qualified Data.Aeson.Key as Key import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.Text as T import Database.Persist.Sqlite (SqlPersistM, insert_) -import Database.Tables (Graph (..)) +import Database.Tables (Graph (..), Path, Shape, Text, SvgJSON (SvgJSON)) import Happstack.Server (rsBody) -import Models.Graph (getGraph) +import Models.Graph (getGraph, insertGraph) import Test.Tasty (TestTree) import Test.Tasty.HUnit (assertEqual, testCase) -import TestHelpers (clearDatabase, mockPutRequest, runServerPart, runServerPartWith, withDatabase) +import TestHelpers (clearDatabase, mockPutRequest, runServerPart, runServerPartWith, withDatabase, mockGetRequest) -- | List of test cases as (label, input graphs, expected output) indexTestCases :: [(String, [T.Text], String)] @@ -45,9 +45,9 @@ indexTestCases = -- | Helper function to insert graphs into the database insertGraphs :: [T.Text] -> SqlPersistM () -insertGraphs = mapM_ insertGraph +insertGraphs = mapM_ insertGraph' where - insertGraph title = insert_ (Graph title 0 0 False ) + insertGraph' title = insert_ (Graph title 0 0 False ) -- | Run a test case (case, input, expected output) on the index function. runIndexTest :: String -> [T.Text] -> String -> TestTree @@ -102,6 +102,33 @@ runSaveGraphJSONTest label payload = runSaveGraphJSONTests :: [TestTree] runSaveGraphJSONTests = map (uncurry runSaveGraphJSONTest) saveGraphJSONTestCases +-- | List of test cases for getGraphJSON as (label, (texts, shapes, paths), expected) +-- | TODO: Build texts/shapes/paths into test cases +getGraphJSONTestCases :: [(String, ([Text], [Shape], [Path]), String)] +getGraphJSONTestCases = + [ ("Empty attributes", + ([], [], []), + "{\"height\":256,\"paths\":[],\"shapes\":[],\"texts\":[],\"width\":256}" + ) + ] + +-- | Run a test case (case, (texts, shapes, paths), expected output) on getGraphJSON. +runGetGraphJSONTest :: String -> ([Text], [Shape], [Path]) -> String -> TestTree +runGetGraphJSONTest label (texts, shapes, paths) expected = + testCase label $ do + let graphName = "Test Graph Name" + runDb $ do + clearDatabase + insertGraph graphName (SvgJSON texts shapes paths) + response <- runServerPartWith Controllers.Graph.getGraphJSON $ mockGetRequest "/get-json-data" [("graphName", T.unpack graphName)] "" + let actual = BL.unpack $ rsBody response + assertEqual ("Unexpected response body for " ++ label) expected actual + +-- | Run all getGraphJSON tests +runGetGraphJSONTests :: [TestTree] +runGetGraphJSONTests = map (\(label, (texts, shapes, paths), expected) -> runGetGraphJSONTest label (texts, shapes, paths) expected) getGraphJSONTestCases + + -- | Test suite for Graph Controller Module test_graphController :: TestTree -test_graphController = withDatabase "Graph Controller tests" (runIndexTests ++ runSaveGraphJSONTests) +test_graphController = withDatabase "Graph Controller tests" (runIndexTests ++ runSaveGraphJSONTests ++ runGetGraphJSONTests) From 2872b35af33c30a082a3f9dd47be902709d56ef7 Mon Sep 17 00:00:00 2001 From: Jason De Lanerolle Date: Fri, 13 Feb 2026 12:13:40 -0500 Subject: [PATCH 2/5] Populate getGraphJSON test cases --- .../Controllers/GraphControllerTests.hs | 106 +++++++++++++++--- 1 file changed, 89 insertions(+), 17 deletions(-) diff --git a/backend-test/Controllers/GraphControllerTests.hs b/backend-test/Controllers/GraphControllerTests.hs index a69f31fbd..1c52a5a0c 100644 --- a/backend-test/Controllers/GraphControllerTests.hs +++ b/backend-test/Controllers/GraphControllerTests.hs @@ -17,13 +17,14 @@ import qualified Data.Aeson.Key as Key import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.Text as T -import Database.Persist.Sqlite (SqlPersistM, insert_) -import Database.Tables (Graph (..), Path, Shape, Text, SvgJSON (SvgJSON)) +import Database.Persist.Sqlite (SqlPersistM, insert_, toSqlKey) +import Database.Tables (Graph (..), Path (..), Shape (..), Text (..), SvgJSON (..)) import Happstack.Server (rsBody) import Models.Graph (getGraph, insertGraph) import Test.Tasty (TestTree) -import Test.Tasty.HUnit (assertEqual, testCase) +import Test.Tasty.HUnit (assertEqual, assertFailure, testCase) import TestHelpers (clearDatabase, mockPutRequest, runServerPart, runServerPartWith, withDatabase, mockGetRequest) +import Database.DataType (ShapeType(..)) -- | List of test cases as (label, input graphs, expected output) indexTestCases :: [(String, [T.Text], String)] @@ -102,31 +103,102 @@ runSaveGraphJSONTest label payload = runSaveGraphJSONTests :: [TestTree] runSaveGraphJSONTests = map (uncurry runSaveGraphJSONTest) saveGraphJSONTestCases --- | List of test cases for getGraphJSON as (label, (texts, shapes, paths), expected) --- | TODO: Build texts/shapes/paths into test cases -getGraphJSONTestCases :: [(String, ([Text], [Shape], [Path]), String)] + +-- | List of test cases for getGraphJSON as (label, (texts, shapes, paths)) +getGraphJSONTestCases :: [(String, ([Text], [Shape], [Path]))] getGraphJSONTestCases = - [ ("Empty attributes", - ([], [], []), - "{\"height\":256,\"paths\":[],\"shapes\":[],\"texts\":[],\"width\":256}" - ) + let testWords1 = Text { + textGraph = toSqlKey 1, + textRId = T.pack "t1", + textPos = (20.0, 30.0), + textText = T.pack "Sample Text 1", + textAlign = T.pack "center", + textFill = T.pack "red", + textTransform = [1,0,0,1,0,0] + } + testWords2 = Text { + textGraph = toSqlKey 1, + textRId = T.pack "t2", + textPos = (100.0, 60.0), + textText = T.pack "Sample Text 2", + textAlign = T.pack "left", + textFill = T.pack "green", + textTransform = [1,0,0,1,0,0] + } + testShape1 = Shape { + shapeGraph = toSqlKey 1, + shapeId_ = T.pack "s1", + shapePos = (0.0, 0.0), + shapeWidth = 40.0, + shapeHeight = 60.0, + shapeFill = T.pack "black", + shapeStroke = T.pack "white", + shapeText = [testWords1], + shapeType_ = Node, + shapeTransform = [1,0,0,1,0,0] + } + testShape2 = Shape { + shapeGraph = toSqlKey 1, + shapeId_ = T.pack "s2", + shapePos = (100.0, 45.0), + shapeWidth = 50.0, + shapeHeight = 30.0, + shapeFill = T.pack "black", + shapeStroke = T.pack "white", + shapeText = [testWords2], + shapeType_ = Node, + shapeTransform = [1,0,0,1,0,0] + } + testPath = Path { + pathGraph = toSqlKey 1, + pathId_ = T.pack "p1", + pathPoints = [(20.0, 30.0), (125.0, 60.0)], + pathFill = T.pack "red", + pathStroke = T.pack "blue", + pathIsRegion = False, + pathSource = T.pack "s1", + pathTarget = T.pack "s2", + pathTransform = [1,0,0,1,0,0] + } + in [ + ("Empty graph", + ([], [], []) + ), + + ("Single-text-element graph", + ([testWords1], [], []) + ), + + ("Single-shape graph", + ([testWords2], [testShape2], []) + ), + + ("Two-shape connected graph", + ([testWords1, testWords2], [testShape1, testShape2], [testPath]) + ) ] --- | Run a test case (case, (texts, shapes, paths), expected output) on getGraphJSON. -runGetGraphJSONTest :: String -> ([Text], [Shape], [Path]) -> String -> TestTree -runGetGraphJSONTest label (texts, shapes, paths) expected = +-- | Run a test case (case, (texts, shapes, paths)) on getGraphJSON. +runGetGraphJSONTest :: String -> ([Text], [Shape], [Path]) -> TestTree +runGetGraphJSONTest label (textlist, shapelist, pathlist) = testCase label $ do let graphName = "Test Graph Name" runDb $ do clearDatabase - insertGraph graphName (SvgJSON texts shapes paths) + insertGraph graphName (SvgJSON textlist shapelist pathlist) response <- runServerPartWith Controllers.Graph.getGraphJSON $ mockGetRequest "/get-json-data" [("graphName", T.unpack graphName)] "" - let actual = BL.unpack $ rsBody response - assertEqual ("Unexpected response body for " ++ label) expected actual + let body = rsBody response + let jsonObj = decode body :: Maybe SvgJSON + case jsonObj of + Nothing -> assertFailure ("Maybe SvgJSON returned as Nothing for " ++ label) + Just svg -> do + assertEqual ("Texts differ for " ++ label) (show (map (\text -> text {textGraph = toSqlKey 1}) textlist)) (show (map (\text -> text {textGraph = toSqlKey 1}) (texts svg))) + assertEqual ("Shapes differ for " ++ label) (show (map (\shape -> shape {shapeGraph = toSqlKey 1}) shapelist)) (show (map (\shape -> shape {shapeGraph = toSqlKey 1}) (shapes svg))) + assertEqual ("Paths differ for " ++ label) (show (map (\path -> path {pathGraph = toSqlKey 1}) pathlist)) (show (map (\path -> path {pathGraph = toSqlKey 1}) (paths svg))) -- | Run all getGraphJSON tests runGetGraphJSONTests :: [TestTree] -runGetGraphJSONTests = map (\(label, (texts, shapes, paths), expected) -> runGetGraphJSONTest label (texts, shapes, paths) expected) getGraphJSONTestCases +runGetGraphJSONTests = map (\(label, (textlist, shapelist, pathlist)) -> runGetGraphJSONTest label (textlist, shapelist, pathlist)) getGraphJSONTestCases -- | Test suite for Graph Controller Module From 88832f12774729f11e594ba79f6a3bb15997b35b Mon Sep 17 00:00:00 2001 From: Jason De Lanerolle Date: Fri, 13 Feb 2026 12:16:45 -0500 Subject: [PATCH 3/5] update changelog --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 68f4a400e..959395e8c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,7 +15,7 @@ ### 🔧 Internal changes - Refactor GraphDropdown component from being a child of Graph to being a child of NavBar -- Added test cases for the saveGraphJSON function in `Controllers/Graph` +- Added test cases for the saveGraphJSON and getGraphJSON functions in `Controllers/Graph` - Fix unused variable from `Graph.js`, formatting in `Container.js` and `GraphDropdown.js`, and eslint config ## [0.7.2] - 2025-12-10 From 3f3d0d2fc2cda64634cec85f226865b29f096236 Mon Sep 17 00:00:00 2001 From: Jason De Lanerolle Date: Sat, 14 Feb 2026 11:50:40 -0500 Subject: [PATCH 4/5] derive Eq for Text, Shape, Path datatypes --- app/Database/Tables.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/app/Database/Tables.hs b/app/Database/Tables.hs index aa628dae6..44026c8c2 100644 --- a/app/Database/Tables.hs +++ b/app/Database/Tables.hs @@ -100,7 +100,7 @@ Text json text T.Text align T.Text fill T.Text - deriving Show + deriving Show Eq transform [Double] default=[1,0,0,1,0,0] Shape json @@ -113,7 +113,7 @@ Shape json stroke T.Text text [Text] type_ ShapeType - deriving Show + deriving Show Eq transform [Double] default=[1,0,0,1,0,0] Path json @@ -125,7 +125,7 @@ Path json isRegion Bool source T.Text target T.Text - deriving Show + deriving Show Eq transform [Double] default=[1,0,0,1,0,0] Program From e8ed546f2cdbda2d978c49df92a093f9d5f58f73 Mon Sep 17 00:00:00 2001 From: Jason De Lanerolle Date: Sat, 14 Feb 2026 11:51:59 -0500 Subject: [PATCH 5/5] review cleanup --- CHANGELOG.md | 3 +- .../Controllers/GraphControllerTests.hs | 56 ++++++++++--------- 2 files changed, 31 insertions(+), 28 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 959395e8c..9d72e2d77 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,7 +15,8 @@ ### 🔧 Internal changes - Refactor GraphDropdown component from being a child of Graph to being a child of NavBar -- Added test cases for the saveGraphJSON and getGraphJSON functions in `Controllers/Graph` +- Added test cases for the saveGraphJSON function in `Controllers/Graph` +- Added test cases for the getGraphJSON function in `Controllers/Graph` - Fix unused variable from `Graph.js`, formatting in `Container.js` and `GraphDropdown.js`, and eslint config ## [0.7.2] - 2025-12-10 diff --git a/backend-test/Controllers/GraphControllerTests.hs b/backend-test/Controllers/GraphControllerTests.hs index 1c52a5a0c..347c6d023 100644 --- a/backend-test/Controllers/GraphControllerTests.hs +++ b/backend-test/Controllers/GraphControllerTests.hs @@ -105,64 +105,65 @@ runSaveGraphJSONTests = map (uncurry runSaveGraphJSONTest) saveGraphJSONTestCase -- | List of test cases for getGraphJSON as (label, (texts, shapes, paths)) +-- | Invariant: Expected Graph IDs are all set to 1 getGraphJSONTestCases :: [(String, ([Text], [Shape], [Path]))] getGraphJSONTestCases = let testWords1 = Text { textGraph = toSqlKey 1, - textRId = T.pack "t1", + textRId = "t1", textPos = (20.0, 30.0), - textText = T.pack "Sample Text 1", - textAlign = T.pack "center", - textFill = T.pack "red", + textText = "Sample Text 1", + textAlign = "center", + textFill = "red", textTransform = [1,0,0,1,0,0] } testWords2 = Text { textGraph = toSqlKey 1, - textRId = T.pack "t2", + textRId = "t2", textPos = (100.0, 60.0), - textText = T.pack "Sample Text 2", - textAlign = T.pack "left", - textFill = T.pack "green", + textText = "Sample Text 2", + textAlign = "left", + textFill = "green", textTransform = [1,0,0,1,0,0] } testShape1 = Shape { shapeGraph = toSqlKey 1, - shapeId_ = T.pack "s1", + shapeId_ = "s1", shapePos = (0.0, 0.0), shapeWidth = 40.0, shapeHeight = 60.0, - shapeFill = T.pack "black", - shapeStroke = T.pack "white", + shapeFill = "black", + shapeStroke = "white", shapeText = [testWords1], shapeType_ = Node, shapeTransform = [1,0,0,1,0,0] } testShape2 = Shape { shapeGraph = toSqlKey 1, - shapeId_ = T.pack "s2", + shapeId_ = "s2", shapePos = (100.0, 45.0), shapeWidth = 50.0, shapeHeight = 30.0, - shapeFill = T.pack "black", - shapeStroke = T.pack "white", + shapeFill = "black", + shapeStroke = "white", shapeText = [testWords2], shapeType_ = Node, shapeTransform = [1,0,0,1,0,0] } testPath = Path { pathGraph = toSqlKey 1, - pathId_ = T.pack "p1", + pathId_ = "p1", pathPoints = [(20.0, 30.0), (125.0, 60.0)], - pathFill = T.pack "red", - pathStroke = T.pack "blue", + pathFill = "red", + pathStroke = "blue", pathIsRegion = False, - pathSource = T.pack "s1", - pathTarget = T.pack "s2", + pathSource = "s1", + pathTarget = "s2", pathTransform = [1,0,0,1,0,0] } in [ ("Empty graph", - ([], [], []) + ([], [], []) ), ("Single-text-element graph", @@ -178,27 +179,28 @@ getGraphJSONTestCases = ) ] --- | Run a test case (case, (texts, shapes, paths)) on getGraphJSON. +-- | Run a test case (case, (texts', shapes', paths')) on getGraphJSON. +-- | Map GraphID to 1 in the assertions to account for insertGraph overriding the field. runGetGraphJSONTest :: String -> ([Text], [Shape], [Path]) -> TestTree -runGetGraphJSONTest label (textlist, shapelist, pathlist) = +runGetGraphJSONTest label (texts', shapes', paths') = testCase label $ do let graphName = "Test Graph Name" runDb $ do clearDatabase - insertGraph graphName (SvgJSON textlist shapelist pathlist) + insertGraph graphName (SvgJSON texts' shapes' paths') response <- runServerPartWith Controllers.Graph.getGraphJSON $ mockGetRequest "/get-json-data" [("graphName", T.unpack graphName)] "" let body = rsBody response let jsonObj = decode body :: Maybe SvgJSON case jsonObj of Nothing -> assertFailure ("Maybe SvgJSON returned as Nothing for " ++ label) Just svg -> do - assertEqual ("Texts differ for " ++ label) (show (map (\text -> text {textGraph = toSqlKey 1}) textlist)) (show (map (\text -> text {textGraph = toSqlKey 1}) (texts svg))) - assertEqual ("Shapes differ for " ++ label) (show (map (\shape -> shape {shapeGraph = toSqlKey 1}) shapelist)) (show (map (\shape -> shape {shapeGraph = toSqlKey 1}) (shapes svg))) - assertEqual ("Paths differ for " ++ label) (show (map (\path -> path {pathGraph = toSqlKey 1}) pathlist)) (show (map (\path -> path {pathGraph = toSqlKey 1}) (paths svg))) + assertEqual ("Texts differ for " ++ label) texts' (map (\text -> text {textGraph = toSqlKey 1}) (texts svg)) + assertEqual ("Shapes differ for " ++ label) shapes' (map (\shape -> shape {shapeGraph = toSqlKey 1}) (shapes svg)) + assertEqual ("Paths differ for " ++ label) paths' (map (\path -> path {pathGraph = toSqlKey 1}) (paths svg)) -- | Run all getGraphJSON tests runGetGraphJSONTests :: [TestTree] -runGetGraphJSONTests = map (\(label, (textlist, shapelist, pathlist)) -> runGetGraphJSONTest label (textlist, shapelist, pathlist)) getGraphJSONTestCases +runGetGraphJSONTests = map (\(label, (texts', shapes', paths')) -> runGetGraphJSONTest label (texts', shapes', paths')) getGraphJSONTestCases -- | Test suite for Graph Controller Module