From a8e5200adf0972627aa8ee93a551ba925811e35c Mon Sep 17 00:00:00 2001 From: Alan Su Date: Fri, 27 Feb 2026 12:17:38 -0500 Subject: [PATCH 1/3] Refactor graphImageResponse to use temporary files --- CHANGELOG.md | 1 + app/Controllers/Graph.hs | 14 ++++++++++---- app/Export/GetImages.hs | 37 +++++++++++++++++++------------------ app/Util/Helpers.hs | 14 ++++++++++---- courseography.cabal | 2 ++ 5 files changed, 42 insertions(+), 26 deletions(-) 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, From d4df9bcd3c4d130af5ec8bc48a18b41b05fc7233 Mon Sep 17 00:00:00 2001 From: Alan Su Date: Wed, 4 Mar 2026 00:42:41 -0500 Subject: [PATCH 2/3] Modify graphImageResponse to use SVG handler --- app/Controllers/Graph.hs | 3 +-- app/Export/GetImages.hs | 17 ++++++++++------- app/Svg/Generator.hs | 13 +++++++------ 3 files changed, 18 insertions(+), 15 deletions(-) diff --git a/app/Controllers/Graph.hs b/app/Controllers/Graph.hs index f0cd8d606..61225d72f 100644 --- a/app/Controllers/Graph.hs +++ b/app/Controllers/Graph.hs @@ -54,10 +54,9 @@ graphImageResponse :: ServerPart Response graphImageResponse = do graphInfo <- look "JsonLocalStorageObj" liftIO $ withSystemTempFile "graph.svg" $ \svgPath svgHandle -> do - hClose svgHandle withSystemTempFile "graph.png" $ \pngPath pngHandle -> do hClose pngHandle - writeActiveGraphImage graphInfo svgPath pngPath + writeActiveGraphImage graphInfo svgPath svgHandle pngPath readImageData pngPath -- | Inserts SVG graph data into Texts, Shapes, and Paths tables diff --git a/app/Export/GetImages.hs b/app/Export/GetImages.hs index cd13f2cf1..c1b97a4dc 100644 --- a/app/Export/GetImages.hs +++ b/app/Export/GetImages.hs @@ -22,15 +22,16 @@ import Export.ImageConversion import Export.TimetableImageCreator (renderTable, renderTableHelper, times) import Models.Meeting (getMeetingTime) import Svg.Generator +import System.IO (Handle, IOMode (WriteMode), hClose, withFile) import System.Random (genWord32, newStdGen) -- | 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 +writeActiveGraphImage :: String -> FilePath -> Handle -> FilePath -> IO () +writeActiveGraphImage graphInfo svgPath svgHandle 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 svgPath pngPath + getGraphImage graphName graphInfoMap svgPath svgHandle pngPath -- | Creates an image of the graph given info and returns resulting graph's .svg and .png names. getActiveGraphImage :: String -> IO (String, String) @@ -38,7 +39,8 @@ getActiveGraphImage graphInfo = do rand <- randomName let svgFilename = rand ++ ".svg" imageFilename = rand ++ ".png" - writeActiveGraphImage graphInfo svgFilename imageFilename + withFile svgFilename WriteMode $ \svgHandle -> + writeActiveGraphImage graphInfo svgFilename svgHandle imageFilename return (svgFilename, imageFilename) -- | If there are selected lectures available, an timetable image of @@ -114,9 +116,10 @@ generateTimetableImg schedule courseSession = do 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 +getGraphImage :: T.Text -> M.Map T.Text T.Text -> FilePath -> Handle -> FilePath -> IO () +getGraphImage graphName courseMap svgPath svgHandle pngPath = do + buildSVG graphName courseMap svgHandle True + hClose svgHandle createImageFile svgPath pngPath -- | Creates an image, and returns the name of the svg used to create the diff --git a/app/Svg/Generator.hs b/app/Svg/Generator.hs index 502d80546..ffd69c94f 100644 --- a/app/Svg/Generator.hs +++ b/app/Svg/Generator.hs @@ -23,6 +23,7 @@ import Database.DataType import Database.Persist.Sqlite import Database.Tables hiding (paths, texts) import Svg.Builder +import System.IO (Handle, hPutStrLn) import Text.Blaze (toMarkup) import Text.Blaze.Internal (stringValue, textValue) import Text.Blaze.Svg.Renderer.String (renderSvg) @@ -41,16 +42,16 @@ buildSVG :: T.Text -- ^ The name of the graph that is being built. -- The data-active attribute is used in the -- interactive graph to indicate which -- courses the user has selected. - -> String -- ^ The filename that this graph will be + -> Handle -- ^ The file handler that this graph will be -- written to. -> Bool -- ^ Whether to include inline styles. -> IO () -buildSVG graphName courseMap filename styled = runDb $ do +buildSVG graphName courseMap fileHandle styled = runDb $ do maybeGraph :: Maybe (Entity Graph) <- selectFirst [GraphTitle ==. graphName] [] case maybeGraph of Nothing -> return () Just val -> do - liftIO $ buildSVGHelper courseMap filename styled (entityVal val) (entityKey val) + liftIO $ buildSVGHelper courseMap fileHandle styled (entityVal val) (entityKey val) buildSVGHelper :: M.Map T.Text T.Text -- ^ A map of courses that holds the course -- ID as a key, and the data-active @@ -58,13 +59,13 @@ buildSVGHelper :: M.Map T.Text T.Text -- ^ A map of courses that holds the cou -- The data-active attribute is used in the -- interactive graph to indicate which -- courses the user has selected. - -> String -- ^ The filename that this graph will be + -> Handle -- ^ The file handler that this graph will be -- written to. -> Bool -- ^ Whether to include inline styles. -> Graph -> Key Graph -> IO () -buildSVGHelper courseMap filename styled sqlGraph gId = runDb $ do +buildSVGHelper courseMap fileHandle styled sqlGraph gId = runDb $ do sqlRects :: [Entity Shape] <- selectList [ShapeType_ <-. [Node, Hybrid], ShapeGraph ==. gId] [] @@ -102,7 +103,7 @@ buildSVGHelper courseMap filename styled sqlGraph gId = runDb $ do styled width height - liftIO $ writeFile filename stringSVG :: SqlPersistM () + liftIO $ hPutStrLn fileHandle stringSVG :: SqlPersistM () where keyAsInt :: PersistEntity a => Entity a -> Integer keyAsInt = fromIntegral . (\(PersistInt64 x) -> x) . safeHead (PersistInt64 0) . keyToValues . entityKey From 13fddeb9c9df939300ef2a828997f4130eea330d Mon Sep 17 00:00:00 2001 From: Alan Su Date: Fri, 6 Mar 2026 02:44:44 -0500 Subject: [PATCH 3/3] Refactor Controllers/Timetable.hs to use temporary files --- CHANGELOG.md | 3 +- app/Controllers/Graph.hs | 5 ++- app/Controllers/Timetable.hs | 57 ++++++++++++++++++--------- app/Export/GetImages.hs | 74 +++++++++--------------------------- app/Util/Helpers.hs | 12 +----- 5 files changed, 63 insertions(+), 88 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 88c4a99bc..e9463fab3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,7 +18,8 @@ - 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 +- Refactor `Controllers/Graph.hs` and `Controllers/Timetable.hs` to use temporary files +- Remove unused `getTimetableImage` function in `Export/GetImages.hs` ## [0.7.2] - 2025-12-10 diff --git a/app/Controllers/Graph.hs b/app/Controllers/Graph.hs index 61225d72f..95673e93d 100644 --- a/app/Controllers/Graph.hs +++ b/app/Controllers/Graph.hs @@ -3,6 +3,7 @@ module Controllers.Graph (graphResponse, index, getGraphJSON, graphImageResponse import Control.Monad.IO.Class (liftIO) import Data.Aeson (decode, object, (.=)) import Data.Maybe (fromMaybe) +import Export.ImageConversion import Happstack.Server (Response, ServerPart, look, lookBS, lookText', ok, toResponse) import MasterTemplate (masterTemplate) import Scripts (graphScripts) @@ -56,7 +57,9 @@ graphImageResponse = do liftIO $ withSystemTempFile "graph.svg" $ \svgPath svgHandle -> do withSystemTempFile "graph.png" $ \pngPath pngHandle -> do hClose pngHandle - writeActiveGraphImage graphInfo svgPath svgHandle pngPath + writeActiveGraphImage graphInfo svgHandle + hClose svgHandle + createImageFile svgPath pngPath readImageData pngPath -- | Inserts SVG graph data into Texts, Shapes, and Paths tables diff --git a/app/Controllers/Timetable.hs b/app/Controllers/Timetable.hs index 2ab198724..c530ba7cf 100644 --- a/app/Controllers/Timetable.hs +++ b/app/Controllers/Timetable.hs @@ -15,18 +15,21 @@ import Data.Time.Calendar.OrdinalDate (fromMondayStartWeek, mondayStartWeek) import Database.Persist.Sqlite (entityKey, entityVal, selectList, (==.)) import Database.Tables import Export.GetImages +import Export.ImageConversion import Export.LatexGenerator import Export.PdfGenerator import Happstack.Server import MasterTemplate import Models.Meeting (returnMeeting) import Scripts -import System.Directory (removeFile) +import System.FilePath (()) +import System.IO (IOMode (WriteMode), hClose, withFile) +import System.IO.Temp (withSystemTempDirectory, withSystemTempFile) import Text.Blaze ((!)) import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A import Text.Read (readMaybe) -import Util.Helpers (returnImageData, safeHead) +import Util.Helpers (readImageData, safeHead) gridResponse :: ServerPart Response gridResponse = @@ -45,37 +48,53 @@ exportTimetableImageResponse :: ServerPart Response exportTimetableImageResponse = do session <- lookText' "session" selectedCourses <- lookText' "courses" - (svgFilename, imageFilename) <- liftIO $ getActiveTimetable selectedCourses session - liftIO $ returnImageData svgFilename imageFilename + + liftIO $ withSystemTempFile "timetable.svg" $ \svgPath svgHandle -> do + withSystemTempFile "timetable.png" $ \pngPath pngHandle -> do + hClose svgHandle + hClose pngHandle + getActiveTimetable selectedCourses session svgPath pngPath + readImageData pngPath -- | Returns a PDF containing graph and timetable requested by the user. exportTimetablePDFResponse :: ServerPart Response exportTimetablePDFResponse = do selectedCourses <- lookText' "courses" graphInfo <- look "JsonLocalStorageObj" - (graphSvg, graphImg) <- liftIO $ getActiveGraphImage graphInfo - (fallsvgFilename, fallimageFilename) <- liftIO $ getActiveTimetable selectedCourses "Fall" - (springsvgFilename, springimageFilename) <- liftIO $ getActiveTimetable selectedCourses "Spring" - pdfName <- liftIO $ returnPDF graphSvg graphImg fallsvgFilename fallimageFilename springsvgFilename springimageFilename - liftIO $ returnPdfBS pdfName --- | Returns 64base bytestring of PDF for given name, then deletes PDF from local. + liftIO $ withSystemTempDirectory "timetable-pdf" $ \tempDir -> do + let graphSvgPath = tempDir "graph.svg" + graphPngPath = tempDir "graph.png" + fallSvgPath = tempDir "fall.svg" + fallPngPath = tempDir "fall.png" + springSvgPath = tempDir "spring.svg" + springPngPath = tempDir "spring.png" + + withFile graphSvgPath WriteMode $ \graphSvgHandle -> + writeActiveGraphImage graphInfo graphSvgHandle + createImageFile graphSvgPath graphPngPath + + getActiveTimetable selectedCourses "Fall" fallSvgPath fallPngPath + + getActiveTimetable selectedCourses "Spring" springSvgPath springPngPath + + pdfName <- returnPDF graphPngPath fallPngPath springPngPath tempDir + returnPdfBS pdfName + +-- | Returns 64base bytestring of PDF for given name. returnPdfBS :: String -> IO Response returnPdfBS pdfFilename = do pdfData <- BS.readFile pdfFilename - _ <- removeFile pdfFilename return $ toResponseBS "application/pdf" $ BEnc.encode $ L.fromStrict pdfData --- | Returns the name of a generated pdf that contains graphImg and timetableImg --- and deletes all of the img and svg files passed as arguments -returnPDF :: String -> String -> String -> String -> String -> String -> IO String -returnPDF graphSvg graphImg fallTimetableSvg fallTimetableImg springTimetableSvg springTimetableImg = do - rand <- randomName - let texName = rand ++ ".tex" - pdfName = rand ++ ".pdf" +-- | Returns the name of a generated pdf that contains graphImg, fallTimetableImg, +-- and springTimetableImg generated in tempDir. +returnPDF :: String -> String -> String -> FilePath -> IO String +returnPDF graphImg fallTimetableImg springTimetableImg tempDir = do + let texName = tempDir "timetable.tex" + pdfName = tempDir "timetable.pdf" generateTex [graphImg, fallTimetableImg, springTimetableImg] texName -- generate a temporary TEX file createPDF texName -- create PDF using TEX and delete the TEX file afterwards - mapM_ removeFile [graphSvg, graphImg, fallTimetableSvg, fallTimetableImg, springTimetableSvg, springTimetableImg] return pdfName diff --git a/app/Export/GetImages.hs b/app/Export/GetImages.hs index c1b97a4dc..19f7e7067 100644 --- a/app/Export/GetImages.hs +++ b/app/Export/GetImages.hs @@ -4,10 +4,10 @@ timetables. Defines functions for creating images from graphs and timetables, most -functions return the name of the created svg and png files after creation. +functions write to the svg and png files given their paths. -} module Export.GetImages - (getActiveGraphImage, getTimetableImage, randomName, getActiveTimetable, writeActiveGraphImage) where + (getActiveTimetable, writeActiveGraphImage) where import Config (runDb) import Data.Aeson (decode) @@ -19,40 +19,28 @@ import Data.Maybe (fromMaybe) import qualified Data.Text as T import Database.Tables as Tables import Export.ImageConversion -import Export.TimetableImageCreator (renderTable, renderTableHelper, times) +import Export.TimetableImageCreator (renderTableHelper, times) import Models.Meeting (getMeetingTime) import Svg.Generator -import System.IO (Handle, IOMode (WriteMode), hClose, withFile) -import System.Random (genWord32, newStdGen) +import System.IO (Handle) -- | 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 -> Handle -> FilePath -> IO () -writeActiveGraphImage graphInfo svgPath svgHandle pngPath = do +writeActiveGraphImage :: String -> Handle -> IO () +writeActiveGraphImage graphInfo svgHandle = 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 svgPath svgHandle 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" - withFile svgFilename WriteMode $ \svgHandle -> - writeActiveGraphImage graphInfo svgFilename svgHandle imageFilename - return (svgFilename, imageFilename) + getGraphImage graphName graphInfoMap svgHandle -- | If there are selected lectures available, an timetable image of -- those lectures in specified session is created. -- Otherwise an empty timetable image is created as default. --- Either way, the resulting image's .svg and .png names are returned. -getActiveTimetable :: T.Text -> T.Text -> IO (String, String) -getActiveTimetable selectedCourses termSession = do +getActiveTimetable :: T.Text -> T.Text -> FilePath -> FilePath -> IO () +getActiveTimetable selectedCourses termSession svgPath pngPath = do let selectedMeetings = parseSelectedCourses selectedCourses termSession mTimes <- getTimes selectedMeetings let schedule = getScheduleByTime selectedMeetings mTimes - generateTimetableImg schedule termSession + generateTimetableImg schedule termSession svgPath pngPath -- | Parses selected courses local storage and returns two lists of information about courses -- in the format of (code, section, session). @@ -104,39 +92,13 @@ addCourseHelper (courseCode, courseSection, courseSession) currentSchedule (day, timeSchedule' = take day timeSchedule ++ [newDaySchedule] ++ drop (day + 1) timeSchedule in take courseTime currentSchedule ++ [timeSchedule'] ++ drop (courseTime + 1) currentSchedule --- | Creates an timetable image based on schedule, and returns the name of the svg --- used to create the image and the name of the image -generateTimetableImg :: [[[T.Text]]] -> T.Text -> IO (String, String) -generateTimetableImg schedule courseSession = do - rand <- randomName - let svgFilename = rand ++ ".svg" - imageFilename = rand ++ ".png" - renderTableHelper svgFilename (zipWith (:) times schedule) courseSession - 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 -> Handle -> FilePath -> IO () -getGraphImage graphName courseMap svgPath svgHandle pngPath = do - buildSVG graphName courseMap svgHandle True - hClose svgHandle +-- | Creates a timetable image based on schedule. +generateTimetableImg :: [[[T.Text]]] -> T.Text -> FilePath -> FilePath -> IO () +generateTimetableImg schedule courseSession svgPath pngPath = do + renderTableHelper svgPath (zipWith (:) times schedule) courseSession createImageFile svgPath pngPath --- | Creates an image, and returns the name of the svg used to create the --- image and the name of the image -getTimetableImage :: T.Text -> T.Text -> IO (String, String) -getTimetableImage courses termSession = do - -- generate 2 random names - rand <- randomName - let svgFilename = rand ++ ".svg" - imageFilename = rand ++ ".png" - renderTable svgFilename courses termSession - createImageFile svgFilename imageFilename - return (svgFilename, imageFilename) - --- | Generate a string containing random integers -randomName :: IO String -randomName = do - gen <- newStdGen - let (rand, _) = genWord32 gen - return (show rand) +-- | Builds the graph svg, given file handler of the svg +getGraphImage :: T.Text -> M.Map T.Text T.Text -> Handle -> IO () +getGraphImage graphName courseMap svgHandle = do + buildSVG graphName courseMap svgHandle True diff --git a/app/Util/Helpers.hs b/app/Util/Helpers.hs index 48397b955..4d4d7a67a 100644 --- a/app/Util/Helpers.hs +++ b/app/Util/Helpers.hs @@ -3,12 +3,11 @@ Description : Contains general-use helper functions. -} module Util.Helpers - (safeHead, readImageData, returnImageData) where + (safeHead, readImageData) where import qualified Data.ByteString as BS (readFile) import qualified Data.ByteString.Base64 as BEnc (encode) import Happstack.Server (Response, toResponse) -import System.Directory (removeFile) -- | Given a list and a default value, returns the head of the list, or the default value -- if the list is empty. @@ -22,12 +21,3 @@ 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 - response <- readImageData imageFilename - _ <- removeFile imageFilename - _ <- removeFile svgFilename - return response