5c00948b-e964-4355-a92e-635ceece6223

Committed 18 Jul 2026 02:16AM UTC coverage: 58.657% (-0.6%) from 59.228%

Build # 5c00948b-e964-4355-a92e-635ceece6223

Build Type

push

circleci

Committed by

web-flow

Commit Message

Switched Haskell formatter to fourmolu and ran on all files (#1763)

Coverage Stats

517 of 966 branches covered (53.52%)

Branch coverage included in aggregate %.

851 of 1590 new or added lines in 34 files covered. (53.52%)

84 existing lines in 13 files now uncovered.

2522 of 4215 relevant lines covered (59.83%)

154.42 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

47.37

/app/Controllers/Graph.hs

module Controllers.Graph (graphResponse, index, getGraphJSON, graphImageResponse, saveGraphJSON) where

import Control.Monad.IO.Class (liftIO)
import Data.Aeson (object, (.=))
import Data.Maybe (fromMaybe)
import Export.ImageConversion (withImageFile)
import Happstack.Server (Response, ServerPart, lookBS, lookText', ok, toResponse)
import MasterTemplate (masterTemplate)
import Scripts (graphScripts)
import System.FilePath ((</>))
import System.IO.Temp (withSystemTempDirectory)
import Text.Blaze ((!))
import qualified Text.Blaze.Html5 as H
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, Text)
import Export.GetImages (writeActiveGraphImage)
import Models.Graph (getGraph, insertGraph, parseGraphComponentsJSON)
import Util.Happstack (createJSONResponse)
import Util.Helpers (readImageData)

graphResponse :: ServerPart Response
graphResponse =
    ok $
        toResponse $
            masterTemplate
                "Courseography - Graph"
                []
                ( do
                    H.div ! A.id "navbar" $ ""
                    H.div ! A.id "container" $ ""
                )
                graphScripts

index :: ServerPart Response
index = liftIO $ runDb $ do
    graphsList :: [Entity Graph] <- selectList [GraphDynamic ==. False] [Asc GraphTitle]
    return $ createJSONResponse graphsList :: SqlPersistM Response

-- | Looks up a graph using its title then gets the Shape, Text and Path elements
-- for rendering graph (returned as JSON).
getGraphJSON :: ServerPart Response
getGraphJSON = do
    graphName <- lookText' "graphName"
    response <- liftIO $ getGraph graphName
    return $
        createJSONResponse $
            fromMaybe
                ( object
                    [ "texts" .= ([] :: [Text])
                    , "shapes" .= ([] :: [Text])
                    , "paths" .= ([] :: [Text])
                    ]
                )
                response

-- | Returns an image of the graph requested by the user, given graphInfo stored in local storage.
graphImageResponse :: ServerPart Response
graphImageResponse = do
    graphInfo <- lookText' "JsonLocalStorageObj"
    liftIO $ withSystemTempDirectory "graph-image" $ \tempDir -> do
        let pngPath = tempDir </> "graph.png"
        withImageFile pngPath (writeActiveGraphImage graphInfo)
        readImageData pngPath

-- | Inserts SVG graph data into Texts, Shapes, and Paths tables
saveGraphJSON :: ServerPart Response
saveGraphJSON = do
    jsonStr <- lookBS "jsonData"
    nameStr <- lookText' "nameData"
    let jsonObj = parseGraphComponentsJSON jsonStr
    case jsonObj of
        Nothing -> return $ toResponse ("Error" :: String)
        Just components -> do
            _ <- liftIO $ runDb $ insertGraph nameStr components
            return $ toResponse ("Success" :: String)

1	module Controllers.Graph (graphResponse, index, getGraphJSON, graphImageResponse, saveGraphJSON) where
2
3	import Control.Monad.IO.Class (liftIO)
4	import Data.Aeson (object, (.=))
5	import Data.Maybe (fromMaybe)
6	import Export.ImageConversion (withImageFile)
7	import Happstack.Server (Response, ServerPart, lookBS, lookText', ok, toResponse)
8	import MasterTemplate (masterTemplate)
9	import Scripts (graphScripts)
10	import System.FilePath ((</>))
11	import System.IO.Temp (withSystemTempDirectory)
12	import Text.Blaze ((!))
13	import qualified Text.Blaze.Html5 as H
14	import qualified Text.Blaze.Html5.Attributes as A
15
16	import Config (runDb)
17	import Database.Persist.Sqlite (Entity, SelectOpt (Asc), SqlPersistM, selectList, (==.))
18	import Database.Tables as Tables (EntityField (GraphDynamic, GraphTitle), Graph, Text)
19	import Export.GetImages (writeActiveGraphImage)
20	import Models.Graph (getGraph, insertGraph, parseGraphComponentsJSON)
21	import Util.Happstack (createJSONResponse)
22	import Util.Helpers (readImageData)
23
24	graphResponse :: ServerPart Response
25	graphResponse =
NEW 26	ok $	×
NEW 27	toResponse $	×
NEW 28	masterTemplate	×
NEW 29	"Courseography - Graph"	×
30	[]	×
NEW 31	( do	×
32	H.div ! A.id "navbar" $ ""	×
33	H.div ! A.id "container" $ ""	×
34	)
35	graphScripts	×
36
37	index :: ServerPart Response
38	index = liftIO $ runDb $ do	3✔
39	graphsList :: [Entity Graph] <- selectList [GraphDynamic ==. False] [Asc GraphTitle]	1✔
40	return $ createJSONResponse graphsList :: SqlPersistM Response	3✔
41
42	-- \| Looks up a graph using its title then gets the Shape, Text and Path elements
43	-- for rendering graph (returned as JSON).
44	getGraphJSON :: ServerPart Response
45	getGraphJSON = do	1✔
46	graphName <- lookText' "graphName"	1✔
47	response <- liftIO $ getGraph graphName	4✔
48	return $	4✔
49	createJSONResponse $	4✔
50	fromMaybe	4✔
NEW 51	( object	×
NEW 52	[ "texts" .= ([] :: [Text])	×
NEW 53	, "shapes" .= ([] :: [Text])	×
NEW 54	, "paths" .= ([] :: [Text])	×
55	]
56	)
57	response	4✔
58
59	-- \| Returns an image of the graph requested by the user, given graphInfo stored in local storage.
60	graphImageResponse :: ServerPart Response
61	graphImageResponse = do	×
62	graphInfo <- lookText' "JsonLocalStorageObj"	×
63	liftIO $ withSystemTempDirectory "graph-image" $ \tempDir -> do	×
64	let pngPath = tempDir </> "graph.png"	×
65	withImageFile pngPath (writeActiveGraphImage graphInfo)	×
66	readImageData pngPath	×
67
68	-- \| Inserts SVG graph data into Texts, Shapes, and Paths tables
69	saveGraphJSON :: ServerPart Response
70	saveGraphJSON = do	1✔
71	jsonStr <- lookBS "jsonData"	1✔
72	nameStr <- lookText' "nameData"	3✔
73	let jsonObj = parseGraphComponentsJSON jsonStr	3✔
74	case jsonObj of	3✔
75	Nothing -> return $ toResponse ("Error" :: String)	×
76	Just components -> do	3✔
77	_ <- liftIO $ runDb $ insertGraph nameStr components	3✔
78	return $ toResponse ("Success" :: String)	3✔

Courseography / courseography / 5c00948b-e964-4355-a92e-635ceece6223

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous