diff --git a/CHANGELOG.md b/CHANGELOG.md index 9d72e2d77..88c4a99bc 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,6 +18,7 @@ - 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 +- Refactor `graphImageResponse` in `Controllers/Graph` to use temporary files ## [0.7.2] - 2025-12-10 diff --git a/app/Controllers/Graph.hs b/app/Controllers/Graph.hs index cc62cf9fd..f0cd8d606 100644 --- a/app/Controllers/Graph.hs +++ b/app/Controllers/Graph.hs @@ -6,6 +6,8 @@ import Data.Maybe (fromMaybe) import Happstack.Server (Response, ServerPart, look, lookBS, lookText', ok, toResponse) import MasterTemplate (masterTemplate) import Scripts (graphScripts) +import System.IO (hClose) +import System.IO.Temp (withSystemTempFile) import Text.Blaze ((!)) import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A @@ -13,10 +15,10 @@ 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 Export.GetImages (getActiveGraphImage) +import Export.GetImages (writeActiveGraphImage) import Models.Graph (getGraph, insertGraph) import Util.Happstack (createJSONResponse) -import Util.Helpers (returnImageData) +import Util.Helpers (readImageData) graphResponse :: ServerPart Response graphResponse = @@ -51,8 +53,12 @@ getGraphJSON = do graphImageResponse :: ServerPart Response graphImageResponse = do graphInfo <- look "JsonLocalStorageObj" - (svgFilename, imageFilename) <- liftIO $ getActiveGraphImage graphInfo - liftIO $ returnImageData svgFilename imageFilename + liftIO $ withSystemTempFile "graph.svg" $ \svgPath svgHandle -> do + hClose svgHandle + withSystemTempFile "graph.png" $ \pngPath pngHandle -> do + hClose pngHandle + writeActiveGraphImage graphInfo svgPath pngPath + readImageData pngPath -- | Inserts SVG graph data into Texts, Shapes, and Paths tables saveGraphJSON :: ServerPart Response diff --git a/app/Export/GetImages.hs b/app/Export/GetImages.hs index e0b4bdcec..cd13f2cf1 100644 --- a/app/Export/GetImages.hs +++ b/app/Export/GetImages.hs @@ -7,7 +7,7 @@ Defines functions for creating images from graphs and timetables, most functions return the name of the created svg and png files after creation. -} module Export.GetImages - (getActiveGraphImage, getTimetableImage, randomName, getActiveTimetable) where + (getActiveGraphImage, getTimetableImage, randomName, getActiveTimetable, writeActiveGraphImage) where import Config (runDb) import Data.Aeson (decode) @@ -24,16 +24,22 @@ import Models.Meeting (getMeetingTime) import Svg.Generator import System.Random (genWord32, newStdGen) - --- | If there is an active graph available, an image of that graph is created, --- otherwise the Computer Science graph is created as a default. --- Either way, the resulting graph's .svg and .png names are returned. -getActiveGraphImage :: String -> IO (String, String) -getActiveGraphImage graphInfo = do +-- | If there is an active graph available, an image of the active graph is written, +-- otherwise the Computer Science graph is written as a default. +writeActiveGraphImage :: String -> FilePath -> FilePath -> IO () +writeActiveGraphImage graphInfo svgPath pngPath = do let graphInfoMap = fromMaybe M.empty $ decode $ fromStrict $ BC.pack graphInfo :: M.Map T.Text T.Text graphName = fromMaybe "Computer-Science" $ M.lookup "active-graph" graphInfoMap - getGraphImage graphName graphInfoMap + getGraphImage graphName graphInfoMap svgPath pngPath +-- | Creates an image of the graph given info and returns resulting graph's .svg and .png names. +getActiveGraphImage :: String -> IO (String, String) +getActiveGraphImage graphInfo = do + rand <- randomName + let svgFilename = rand ++ ".svg" + imageFilename = rand ++ ".png" + writeActiveGraphImage graphInfo svgFilename imageFilename + return (svgFilename, imageFilename) -- | If there are selected lectures available, an timetable image of -- those lectures in specified session is created. @@ -107,16 +113,11 @@ generateTimetableImg schedule courseSession = do createImageFile svgFilename imageFilename return (svgFilename, imageFilename) --- | Creates an image, and returns the name of the svg used to create the --- image and the name of the image -getGraphImage :: T.Text -> M.Map T.Text T.Text -> IO (String, String) -getGraphImage graphName courseMap = do - rand <- randomName - let svgFilename = rand ++ ".svg" - imageFilename = rand ++ ".png" - buildSVG graphName courseMap svgFilename True - createImageFile svgFilename imageFilename - return (svgFilename, imageFilename) +-- | Creates an image, given file paths to the svg and image to write to +getGraphImage :: T.Text -> M.Map T.Text T.Text -> FilePath -> FilePath -> IO () +getGraphImage graphName courseMap svgPath pngPath = do + buildSVG graphName courseMap svgPath True + createImageFile svgPath pngPath -- | Creates an image, and returns the name of the svg used to create the -- image and the name of the image diff --git a/app/Util/Helpers.hs b/app/Util/Helpers.hs index 685e6210c..48397b955 100644 --- a/app/Util/Helpers.hs +++ b/app/Util/Helpers.hs @@ -3,7 +3,7 @@ Description : Contains general-use helper functions. -} module Util.Helpers - (safeHead, returnImageData) where + (safeHead, readImageData, returnImageData) where import qualified Data.ByteString as BS (readFile) import qualified Data.ByteString.Base64 as BEnc (encode) @@ -16,12 +16,18 @@ safeHead :: a -> [a] -> a safeHead listHead [] = listHead safeHead _ (listHead:_) = listHead +-- | Reads the data in an image file and returns the data as a response. +readImageData :: String -> IO Response +readImageData imageFileName = do + imageData <- BS.readFile imageFileName + let encodedData = BEnc.encode imageData + return $ toResponse encodedData + -- | Creates and converts an SVG file to an image file, deletes them both and -- returns the image data as a response. returnImageData :: String -> String -> IO Response returnImageData svgFilename imageFilename = do - imageData <- BS.readFile imageFilename + response <- readImageData imageFilename _ <- removeFile imageFilename _ <- removeFile svgFilename - let encodedData = BEnc.encode imageData - return $ toResponse encodedData + return response diff --git a/courseography.cabal b/courseography.cabal index ceed8adc8..67f6bdee9 100644 --- a/courseography.cabal +++ b/courseography.cabal @@ -94,6 +94,7 @@ library split, system-filepath, tagsoup, + temporary, text, time, tls, @@ -271,6 +272,7 @@ executable courseography stylish-haskell, system-filepath, tagsoup, + temporary, text, time, tls,