Remove SvgJSON data type

CHANGELOG.md

@@ -33,6 +33,7 @@
 - Refactor graph helper functions from `app/Svg/Database.hs` to `app/Models/Graph.hs`
 - Refactor functions for performing matrix operations from `app/Svg/Parser.hs` to `app/Util/Matrix.hs`
 - Updated documentation in `app/Util/Blaze.hs`
+- Removed `SvgJSON` data type in favour of `([Text], [Shape], [Path])`
 
 ## [0.7.2] - 2025-12-10
 

app/Controllers/Graph.hs

@@ -1,7 +1,7 @@
 module Controllers.Graph (graphResponse, index, getGraphJSON, graphImageResponse, saveGraphJSON) where
 
 import Control.Monad.IO.Class (liftIO)
-import Data.Aeson (decode, object, (.=))
+import Data.Aeson (object, (.=))
 import Data.Maybe (fromMaybe)
 import Export.ImageConversion (withImageFile)
 import Happstack.Server (Response, ServerPart, lookBS, lookText', ok, toResponse)
@@ -15,9 +15,9 @@ import qualified Text.Blaze.Html5.Attributes as A
 
 import Config (runDb)
 import Database.Persist.Sqlite (Entity, SelectOpt (Asc), SqlPersistM, selectList, (==.))
-import Database.Tables as Tables (EntityField (GraphDynamic, GraphTitle), Graph, SvgJSON, Text)
+import Database.Tables as Tables (EntityField(GraphTitle, GraphDynamic), Text, Graph)
 import Export.GetImages (writeActiveGraphImage)
-import Models.Graph (getGraph, insertGraph)
+import Models.Graph (getGraph, insertGraph, parseGraphComponentsJSON)
 import Util.Happstack (createJSONResponse)
 import Util.Helpers (readImageData)
 
@@ -64,9 +64,9 @@ saveGraphJSON :: ServerPart Response
 saveGraphJSON = do
     jsonStr <- lookBS "jsonData"
     nameStr <- lookText' "nameData"
-    let jsonObj = decode jsonStr :: Maybe SvgJSON
+    let jsonObj = parseGraphComponentsJSON jsonStr
     case jsonObj of
         Nothing -> return $ toResponse ("Error" :: String)
-        Just svg -> do
-            _ <- liftIO $ runDb $ insertGraph nameStr svg
+        Just components -> do
+            _ <- liftIO $ runDb $ insertGraph nameStr components
             return $ toResponse ("Success" :: String)

app/Database/Tables.hs

@@ -19,8 +19,8 @@ straightforward.
 
 module Database.Tables where
 
-import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), genericToJSON, withObject, (.!=), (.:),
-                   (.:?))
+import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), genericToJSON, withObject,
+                   (.!=), (.:), (.:?))
 import Data.Aeson.Types (Options (..), Parser, Value (Object), defaultOptions)
 import Data.Char (toLower)
 import qualified Data.Text as T
@@ -161,13 +161,6 @@ SchemaVersion
 
 -- ** TODO: Remove these extra types and class instances
 
--- | JSON SVG data
-data SvgJSON =
-    SvgJSON { texts :: [Text],
-              shapes :: [Shape],
-              paths :: [Path]
-            } deriving (Show, Generic)
-
 data Time' =
   Time' { weekDay' :: Double,
           startHour' :: Double,
@@ -211,10 +204,6 @@ instance ToJSON Time
 instance ToJSON MeetTime'
 instance ToJSON Building
 
--- instance FromJSON required so that tables can be parsed into JSON,
--- not necessary otherwise.
-instance FromJSON SvgJSON
-
 instance ToJSON Meeting where
   toJSON = genericToJSON defaultOptions {
       fieldLabelModifier =

app/Models/Graph.hs

@@ -1,14 +1,17 @@
 module Models.Graph
-    (getGraph, insertGraph, insertElements, deleteExistingGraph) where
+    (getGraph, insertGraph, insertElements, deleteExistingGraph, parseGraphComponentsJSON) where
 
 import Config (runDb)
-import Data.Aeson (Value, object, toJSON)
+import Data.Aeson (Value, decode, object, toJSON, (.:))
+import Data.Aeson.Types (parseMaybe)
 import qualified Data.Text as T (Text)
+import qualified Data.ByteString.Lazy as L
 import Database.DataType (ShapeType (BoolNode, Hybrid, Node))
 import Database.Persist.Sqlite (Entity, PersistEntity, PersistValue (PersistInt64), SqlPersistM,
                                 deleteWhere, entityKey, entityVal, insert, insert_, insertMany_, keyToValues, 
                                 selectFirst, selectList, (<-.), (==.))
-import Database.Tables hiding (paths, shapes, texts)
+import Database.Tables (EntityField(GraphId, ShapeType_, GraphTitle, TextGraph, ShapeGraph, PathGraph),
+                        Key, Path(pathGraph), Shape(shapeGraph), Text(textGraph), Graph(graphWidth, graphHeight, Graph))   
 import Svg.Builder (buildEllipses, buildPath, buildRect)
 import Util.Helpers
 
@@ -55,10 +58,10 @@ getGraph graphName = runDb $ do
 
 -- | Insert a new graph into the database, given its SVG JSON.
 -- | Return Nothing.
-insertGraph :: T.Text         -- ^ The title of the graph being inserted.
-            -> SvgJSON        -- ^ The SVG JSON data of the inserted graph (texts, shapes, paths).
-            -> SqlPersistM () -- ^ Return Nothing.
-insertGraph nameStr_ (SvgJSON texts shapes paths) = do
+insertGraph :: T.Text                    -- ^ The title of the graph being inserted.
+            -> ([Text], [Shape], [Path]) -- ^ The parsed JSON data of the inserted graph.
+            -> SqlPersistM ()            -- ^ Return Nothing.
+insertGraph nameStr_ (texts, shapes, paths) = do
     gId <- insert $ Graph nameStr_ 256 256 False
     insertMany_ $ map (\text -> text {textGraph = gId}) texts
     insertMany_ $ map (\shape -> shape {shapeGraph = gId}) shapes
@@ -88,3 +91,14 @@ deleteGraph gId = do
     deleteWhere [ShapeGraph ==. gId]
     deleteWhere [PathGraph ==. gId]
     deleteWhere [GraphId ==. gId]
+
+-- | Parse the JSON representation of a graph into its texts, shapes, and paths components.
+parseGraphComponentsJSON :: L.ByteString -> Maybe ([Text], [Shape], [Path])
+parseGraphComponentsJSON jsonStr = do
+  obj <- decode jsonStr
+  parseMaybe (\o -> do
+    texts <- o .: "texts"
+    shapes <- o .: "shapes"
+    paths <- o .: "paths"
+    return (texts, shapes, paths)
+    ) obj

app/Svg/Builder.hs

@@ -21,7 +21,10 @@ import Data.Char (toLower)
 import Data.List (find)
 import qualified Data.Text as T
 import Database.DataType
-import Database.Tables hiding (shapes, texts)
+import Database.Tables (Matrix, Point, 
+                        Path(pathTarget, pathIsRegion, pathPoints, pathTransform, pathId_, pathSource),
+                        Shape(shapeText, shapeWidth, shapeHeight, shapePos, shapeTransform, shapeType_, shapeId_),
+                        Text(textPos, textText, textTransform))
 import Util.Matrix (matrixPointMultiply)
 import TextShow (showt)
 import Util.Helpers

app/Svg/Generator.hs

@@ -21,7 +21,11 @@ import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
 import Database.DataType
 import Database.Persist.Sqlite
-import Database.Tables hiding (paths, texts)
+import Database.Tables (EntityField(ShapeGraph, GraphTitle, TextGraph, PathGraph, ShapeType_),
+                        Path(pathFill, pathIsRegion, pathSource, pathTarget, pathId_, pathPoints, pathTransform),
+                        Shape(shapeText, shapeFill, shapeType_, shapeId_, shapeTransform, shapeWidth, shapeHeight, shapePos),
+                        Text(textText, textPos, textAlign, textFill, textTransform),
+                        Graph(graphHeight, graphWidth))
 import Svg.Builder
 import System.IO (Handle, hPutStrLn)
 import Text.Blaze (toMarkup)

app/Svg/Parser.hs

@@ -25,7 +25,9 @@ import qualified Data.Text as T
 import Data.Text.IO as T (readFile)
 import Database.DataType
 import Database.Persist.Sqlite
-import Database.Tables hiding (graphHeight, graphWidth, paths, shapes, texts)
+import Database.Tables (Matrix, Point, 
+                        Path(pathFill, Path), Shape(shapeType_, shapeWidth, shapePos, Shape, shapeFill),
+                        Text(Text), Graph(Graph), GraphId)
 import Models.Graph (deleteExistingGraph, insertElements)
 import qualified Text.HTML.TagSoup as TS hiding (fromAttrib)
 import Text.HTML.TagSoup (Tag)

backend-test/Controllers/GraphControllerTests.hs

@@ -18,9 +18,9 @@ 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_, toSqlKey)
-import Database.Tables (Graph (..), Path (..), Shape (..), Text (..), SvgJSON (..))
+import Database.Tables (Graph(Graph), Path(..), Shape(..), Text(..))
 import Happstack.Server (rsBody)
-import Models.Graph (getGraph, insertGraph)
+import Models.Graph (getGraph, insertGraph, parseGraphComponentsJSON)
 import Test.Tasty (TestTree)
 import Test.Tasty.HUnit (assertEqual, assertFailure, testCase)
 import TestHelpers (clearDatabase, mockPutRequest, runServerPart, runServerPartWith, withDatabase, mockGetRequest)
@@ -187,16 +187,16 @@ runGetGraphJSONTest (label, (texts', shapes', paths')) =
         let graphName = "Test Graph Name"
         runDb $ do
             clearDatabase
-            insertGraph graphName (SvgJSON texts' shapes' paths')
+            insertGraph graphName (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
+        let jsonObj = parseGraphComponentsJSON body
         case jsonObj of
-            Nothing -> assertFailure ("Maybe SvgJSON returned as Nothing for " ++ label)
-            Just svg -> do
-                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))
+            Nothing -> assertFailure ("Maybe ([Text], [Shape], [Path]) returned as Nothing for " ++ label)
+            Just (parsedTexts, parsedShapes, parsedPaths) -> do
+                assertEqual ("Texts differ for " ++ label) texts' (map (\text -> text {textGraph = toSqlKey 1}) parsedTexts)
+                assertEqual ("Shapes differ for " ++ label) shapes' (map (\shape -> shape {shapeGraph = toSqlKey 1}) parsedShapes)
+                assertEqual ("Paths differ for " ++ label) paths' (map (\path -> path {pathGraph = toSqlKey 1}) parsedPaths)
 
 -- | Run all getGraphJSON tests
 runGetGraphJSONTests :: [TestTree]