• Home
  • Features
  • Pricing
  • Docs
  • Announcements
  • Sign In

Courseography / courseography / 0db00a0f-6300-48f5-afbc-6c830d1ade7e

27 Mar 2026 03:38PM UTC coverage: 57.384% (-0.02%) from 57.408%
0db00a0f-6300-48f5-afbc-6c830d1ade7e

push

circleci

web-flow
Refactored TEX and SVG temporary files to use stdin (#1682)

501 of 964 branches covered (51.97%)

Branch coverage included in aggregate %.

0 of 18 new or added lines in 4 files covered. (0.0%)

1 existing line in 1 file now uncovered.

2316 of 3945 relevant lines covered (58.71%)

163.35 hits per line

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

51.61
/app/Controllers/Graph.hs
1
module Controllers.Graph (graphResponse, index, getGraphJSON, graphImageResponse, saveGraphJSON) where
2

3
import Control.Monad.IO.Class (liftIO)
4
import Data.Aeson (decode, 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, SvgJSON, Text)
19
import Export.GetImages (writeActiveGraphImage)
20
import Models.Graph (getGraph, insertGraph)
21
import Util.Happstack (createJSONResponse)
22
import Util.Helpers (readImageData)
23

24
graphResponse :: ServerPart Response
25
graphResponse =
26
   ok $ toResponse $
×
27
    masterTemplate "Courseography - Graph"
×
28
                []
×
29
                (do
×
30
                    H.div ! A.id "navbar" $ ""
×
31
                    H.div ! A.id "container" $ ""
×
32
                )
33
                graphScripts
×
34

35

36
index :: ServerPart Response
37
index = liftIO $ runDb $ do
3✔
38
    graphsList :: [Entity Graph] <- selectList [GraphDynamic ==. False] [Asc GraphTitle]
1✔
39
    return $ createJSONResponse graphsList :: SqlPersistM Response
3✔
40

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 $ createJSONResponse $ fromMaybe (object ["texts" .= ([] :: [Text]),
4✔
49
                                                    "shapes" .= ([] :: [Text]),
×
50
                                                    "paths" .= ([] :: [Text])]) response
4✔
51

52

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

62
-- | Inserts SVG graph data into Texts, Shapes, and Paths tables
63
saveGraphJSON :: ServerPart Response
64
saveGraphJSON = do
1✔
65
    jsonStr <- lookBS "jsonData"
1✔
66
    nameStr <- lookText' "nameData"
3✔
67
    let jsonObj = decode jsonStr :: Maybe SvgJSON
3✔
68
    case jsonObj of
3✔
69
        Nothing -> return $ toResponse ("Error" :: String)
×
70
        Just svg -> do
3✔
71
            _ <- liftIO $ runDb $ insertGraph nameStr svg
3✔
72
            return $ toResponse ("Success" :: String)
3✔
STATUS · Troubleshooting · Open an Issue · Sales · Support · CAREERS · ENTERPRISE · START FREE · SCHEDULE DEMO
ANNOUNCEMENTS · TWITTER · TOS & SLA · Supported CI Services · What's a CI service? · Automated Testing

© 2026 Coveralls, Inc