Added test cases for saveGraphJSON (#1653)

Author: a1-su

CHANGELOG.md

@@ -8,9 +8,12 @@
 
 ### 🐛 Bug fixes
 
+- Fixed a bug where duplicate graph components were being added
+
 ### 🔧 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`
 
 ## [0.7.2] - 2025-12-10
 

README.md

@@ -139,6 +139,7 @@ Harsh Patel,
 Eleonora Scognamiglio,
 Sam Shaftoe,
 Ian Stewart-Binks,
+Alan Su,
 Maryam Taj,
 Betty Wang,
 Fullchee Zhang,

app/Models/Graph.hs

@@ -4,14 +4,13 @@ module Models.Graph
 
 import Config (runDb)
 import Data.Aeson (Value, object, toJSON)
-import Data.List (partition)
 import qualified Data.Text as T (Text)
 import Database.DataType (ShapeType (BoolNode, Hybrid, Node))
 import Database.Persist.Sqlite (Entity, PersistEntity, PersistValue (PersistInt64), SqlPersistM,
                                 entityKey, entityVal, insert, insertMany_, keyToValues, selectFirst,
                                 selectList, (<-.), (==.))
 import Database.Tables hiding (paths, shapes, texts)
-import Svg.Builder (buildEllipses, buildPath, buildRect, intersectsWithShape)
+import Svg.Builder (buildEllipses, buildPath, buildRect)
 import Util.Helpers
 
 getGraph :: T.Text -> IO (Maybe Value)
@@ -44,15 +43,11 @@ getGraph graphName = runDb $ do
                 graphpaths     = zipWith (buildPath rects ellipses)
                                          (map entityVal sqlPaths)
                                          (map keyAsInt sqlPaths)
-                (regions, _)   = partition pathIsRegion graphpaths
-                regionTexts    = filter (not .
-                                         intersectsWithShape (rects ++ ellipses))
-                                        graphtexts
 
                 response = object [
-                        ("texts", toJSON $ graphtexts ++ regionTexts),
+                        ("texts", toJSON graphtexts),
                         ("shapes", toJSON $ rects ++ ellipses),
-                        ("paths", toJSON $ graphpaths ++ regions),
+                        ("paths", toJSON graphpaths),
                         ("width", toJSON $ graphWidth $ entityVal graph),
                         ("height", toJSON $ graphHeight $ entityVal graph)
                     ]

backend-test/Controllers/GraphControllerTests.hs

@@ -10,15 +10,20 @@ module Controllers.GraphControllerTests
 ) where
 
 import Config (runDb)
-import Controllers.Graph (index)
+import Control.Monad.IO.Class (liftIO)
+import Controllers.Graph (index, saveGraphJSON)
+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 Happstack.Server (rsBody)
+import Models.Graph (getGraph)
 import Test.Tasty (TestTree)
 import Test.Tasty.HUnit (assertEqual, testCase)
-import TestHelpers (clearDatabase, runServerPart, withDatabase)
+import TestHelpers (clearDatabase, mockPutRequest, runServerPart, runServerPartWith, withDatabase)
 
 -- | List of test cases as (label, input graphs, expected output)
 indexTestCases :: [(String, [T.Text], String)]
@@ -59,6 +64,44 @@ runIndexTest label graphs expected =
 runIndexTests :: [TestTree]
 runIndexTests = map (\(label, graphs, expected) -> runIndexTest label graphs expected) indexTestCases
 
+-- | Helper function to add the default width and height to graph JSON
+addDefaults :: Value -> Value
+addDefaults (Object obj) = Object $
+    KeyMap.insert (Key.fromString "width") (Number 256) $
+    KeyMap.insert (Key.fromString "height") (Number 256) obj
+addDefaults v = v
+
+-- | List of test cases as (label, graph JSON payload)
+saveGraphJSONTestCases :: [(String, BL.ByteString)]
+saveGraphJSONTestCases =
+    [ ("Empty graph",
+        "{\"texts\":[],\"shapes\":[],\"paths\":[]}"
+    ),
+
+    ("Single shape graph",
+        "{\"texts\":[],\"shapes\":[{\"graph\": 1, \"id_\": \"s1\", \"pos\": [100.0, 100.0], \"width\": 50.0, \"height\": 50.0, \"fill\": \"white\", \"stroke\": \"black\", \"text\": [], \"type_\": \"Node\", \"transform\": [1.0, 0.0, 0.0, 1.0, 0.0, 0.0]}],\"paths\":[]}"
+    ),
+
+    ("Multi-node graph",
+        "{\"texts\":[{\"graph\":1,\"rId\":\"t1\",\"pos\":[10.0,10.0],\"text\":\"Graph text 1\",\"align\":\"left\",\"fill\":\"black\",\"transform\":[1.0,0.0,0.0,1.0,0.0,0.0]},{\"graph\":1,\"rId\":\"t2\",\"pos\":[20.0,20.0],\"text\":\"Graph text 2\",\"align\":\"center\",\"fill\":\"blue\",\"transform\":[1.0,0.0,0.0,1.0,0.0,0.0]}],\"shapes\":[{\"graph\":1,\"id_\":\"s1\",\"pos\":[100.0,100.0],\"width\":100.0,\"height\":50.0,\"fill\":\"white\",\"stroke\":\"black\",\"text\":[],\"type_\":\"Node\",\"transform\":[1.0,0.0,0.0,1.0,0.0,0.0]},{\"graph\":1,\"id_\":\"h2\",\"pos\":[200.0,200.0],\"width\":50.0,\"height\":10.0,\"fill\":\"green\",\"stroke\":\"blue\",\"text\":[],\"type_\":\"Hybrid\",\"transform\":[1.0,0.0,0.0,1.0,0.0,0.0]},{\"graph\":1,\"id_\":\"s3\",\"pos\":[300.0,300.0],\"width\":30.0,\"height\":30.0,\"fill\":\"red\",\"stroke\":\"purple\",\"text\":[],\"type_\":\"BoolNode\",\"transform\":[1.0,0.0,0.0,1.0,0.0,0.0]}],\"paths\":[{\"graph\":1,\"id_\":\"p1\",\"points\":[[50.0,50.0],[150.0,50.0]],\"fill\":\"white\",\"stroke\":\"black\",\"isRegion\":false,\"source\":\"s1\",\"target\":\"h2\",\"transform\":[1.0,0.0,0.0,1.0,0.0,0.0]},{\"graph\":1,\"id_\":\"p2\",\"points\":[[100.0,20.0],[30.0,40.0]],\"fill\":\"yellow\",\"stroke\":\"orange\",\"isRegion\":false,\"source\":\"h2\",\"target\":\"s3\",\"transform\":[1.0,0.0,0.0,1.0,0.0,0.0]}]}"
+    )
+    ]
+
+-- | Run a test case (case, graph JSON payload)
+runSaveGraphJSONTest :: String -> BL.ByteString -> TestTree
+runSaveGraphJSONTest label payload =
+    testCase label $ do
+        runDb clearDatabase
+        let graphName = "Test Graph Name"
+        _ <- runServerPartWith Controllers.Graph.saveGraphJSON $ mockPutRequest "/graph-save" [("nameData", T.unpack graphName), ("jsonData", BL.unpack payload)] ""
+        retrievedResult <- liftIO $ Models.Graph.getGraph graphName
+        let expectedValue = fmap addDefaults (decode payload :: Maybe Value)
+        assertEqual ("Unexpected response for " ++ label) expectedValue retrievedResult
+
+-- | Run all save graph test cases
+runSaveGraphJSONTests :: [TestTree]
+runSaveGraphJSONTests = map (uncurry runSaveGraphJSONTest) saveGraphJSONTestCases
+
 -- | Test suite for Graph Controller Module
 test_graphController :: TestTree
-test_graphController = withDatabase "Graph Controller tests" runIndexTests
+test_graphController = withDatabase "Graph Controller tests" (runIndexTests ++ runSaveGraphJSONTests)