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

60.0

/app/DynamicGraphs/WriteRunDot.hs

module DynamicGraphs.WriteRunDot where

import Control.Monad (forM_)
import Control.Monad.IO.Class (liftIO)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.GraphViz hiding (Str)
import Data.Hash.MD5 (Str (Str), md5s)
import Data.List (sort)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
import DynamicGraphs.GraphGenerator (
    coursesToPrereqGraph,
    coursesToPrereqGraphExcluding,
    graphProfileHash,
 )
import DynamicGraphs.GraphOptions (CourseGraphOptions (..), GraphOptions (..))
import Happstack.Server (ServerPart, askRq)
import Happstack.Server.SimpleHTTP (Response)
import Happstack.Server.Types (takeRequestBody, unBody)
import Models.Graph (getGraph)
import Svg.Parser (parseDynamicSvg)
import System.Directory (createDirectoryIfMissing)
import System.FilePath (combine, normalise)
import Util.Happstack (createJSONResponse)

doDots :: PrintDotRepr dg n => [(FilePath, dg n)] -> IO ()
doDots cases = do
    forM_ cases createImage
    putStrLn "Look in graphs/gen to see the created graphs"

generatePrereqsForCourses :: (FilePath, [String]) -> IO ()
generatePrereqsForCourses (output, rootCourses) = do
    graph <- coursesToPrereqGraph rootCourses
    _ <- createImage (output, graph)
    putStrLn $
        "Generated prerequisite graph for "
            ++ show rootCourses
            ++ " in graphs/gen"

getBody :: ServerPart L.ByteString
getBody = do
    req <- askRq
    body <- liftIO $ takeRequestBody req
    case body of
        Just rqbody -> return . unBody $ rqbody
        Nothing -> return ""

generateAndSavePrereqResponse :: CourseGraphOptions -> IO Response
generateAndSavePrereqResponse coursesOptions = do
    cached <- getGraph graphHash
    case cached of
        Just cachedGraph -> return $ createJSONResponse cachedGraph
        Nothing -> do
            graph <- coursesToPrereqGraphExcluding (courses coursesOptions) (graphOptions coursesOptions)
            bString <- graphToByteString graph
            -- Parse the generated SVG and store it in the database.
            parseDynamicSvg graphHash $ decodeUtf8 bString
            storedGraph <- getGraph graphHash
            return $ createJSONResponse $ fromMaybe graphNotFound storedGraph
  where
    graphHash :: T.Text
    graphHash = hash coursesOptions
    graphNotFound = error "Graph should have been generated but was not found"

-- | Hash function to uniquely identify the graph layout.
hash :: CourseGraphOptions -> T.Text
hash coursesOptions = hashFunction (key, graphProfileHash)
  where
    key =
        coursesOptions
            { courses = sort $ courses coursesOptions
            , graphOptions =
                options
                    { taken = sort $ taken options
                    , departments = sort $ departments options
                    , distribution = sort $ distribution options
                    , location = sort $ location options
                    , courseNumPrefix = sort $ courseNumPrefix options
                    }
            }
      where
        options = graphOptions coursesOptions
    hashFunction :: (CourseGraphOptions, String) -> T.Text
    hashFunction = T.pack . ("graph_" ++) . md5s . Str . show

graphToByteString :: PrintDotRepr dg n => dg n -> IO B.ByteString
graphToByteString graph = graphvizWithHandle Dot graph Svg B.hGetContents

createImage :: PrintDotRepr dg n => (FilePath, dg n) -> IO FilePath
createImage (n, g) = do
    _ <- createDirectoryIfMissing False filepath
    createImageInDir filepath n Svg g
  where
    filepath = normalise "graphs/gen"

-- | Here runGraphvizCommand Dot creates the final graph given the input DotGraph object g and connects it
-- with the file path(by combining directory d and filename n) to make the final graph in the required directory.
createImageInDir ::
    PrintDotRepr dg n =>
    -- | directory to write in
    FilePath ->
    -- | filename
    FilePath ->
    -- | filetype to write in
    GraphvizOutput ->
    -- | graph to draw
    dg n ->
    IO FilePath
createImageInDir d n o g = Data.GraphViz.addExtension (runGraphvizCommand Dot g) o (combine d n)

1	module DynamicGraphs.WriteRunDot where
2
3	import Control.Monad (forM_)
4	import Control.Monad.IO.Class (liftIO)
5	import qualified Data.ByteString as B
6	import qualified Data.ByteString.Lazy as L
7	import Data.GraphViz hiding (Str)
8	import Data.Hash.MD5 (Str (Str), md5s)
9	import Data.List (sort)
10	import Data.Maybe (fromMaybe)
11	import qualified Data.Text as T
12	import Data.Text.Encoding (decodeUtf8)
13	import DynamicGraphs.GraphGenerator (
14	coursesToPrereqGraph,
15	coursesToPrereqGraphExcluding,
16	graphProfileHash,
17	)
18	import DynamicGraphs.GraphOptions (CourseGraphOptions (..), GraphOptions (..))
19	import Happstack.Server (ServerPart, askRq)
20	import Happstack.Server.SimpleHTTP (Response)
21	import Happstack.Server.Types (takeRequestBody, unBody)
22	import Models.Graph (getGraph)
23	import Svg.Parser (parseDynamicSvg)
24	import System.Directory (createDirectoryIfMissing)
25	import System.FilePath (combine, normalise)
26	import Util.Happstack (createJSONResponse)
27
28	doDots :: PrintDotRepr dg n => [(FilePath, dg n)] -> IO ()
29	doDots cases = do	×
NEW 30	forM_ cases createImage	×
NEW 31	putStrLn "Look in graphs/gen to see the created graphs"	×
32
33	generatePrereqsForCourses :: (FilePath, [String]) -> IO ()
34	generatePrereqsForCourses (output, rootCourses) = do	×
NEW 35	graph <- coursesToPrereqGraph rootCourses	×
NEW 36	_ <- createImage (output, graph)	×
NEW 37	putStrLn $	×
NEW 38	"Generated prerequisite graph for "	×
NEW 39	++ show rootCourses	×
NEW 40	++ " in graphs/gen"	×
41
42	getBody :: ServerPart L.ByteString
43	getBody = do	1✔
44	req <- askRq	1✔
45	body <- liftIO $ takeRequestBody req	7✔
46	case body of	7✔
47	Just rqbody -> return . unBody $ rqbody	7✔
NEW 48	Nothing -> return ""	×
49
50	generateAndSavePrereqResponse :: CourseGraphOptions -> IO Response
51	generateAndSavePrereqResponse coursesOptions = do	7✔
52	cached <- getGraph graphHash	7✔
53	case cached of	7✔
NEW 54	Just cachedGraph -> return $ createJSONResponse cachedGraph	×
55	Nothing -> do	7✔
56	graph <- coursesToPrereqGraphExcluding (courses coursesOptions) (graphOptions coursesOptions)	7✔
57	bString <- graphToByteString graph	7✔
58	-- Parse the generated SVG and store it in the database.
59	parseDynamicSvg graphHash $ decodeUtf8 bString	7✔
60	storedGraph <- getGraph graphHash	7✔
61	return $ createJSONResponse $ fromMaybe graphNotFound storedGraph	7✔
62	where
63	graphHash :: T.Text
64	graphHash = hash coursesOptions	7✔
65	graphNotFound = error "Graph should have been generated but was not found"	×
66
67	-- \| Hash function to uniquely identify the graph layout.
68	hash :: CourseGraphOptions -> T.Text
69	hash coursesOptions = hashFunction (key, graphProfileHash)	7✔
70	where
71	key =
72	coursesOptions	7✔
73	{ courses = sort $ courses coursesOptions	7✔
74	, graphOptions =
75	options	7✔
76	{ taken = sort $ taken options	7✔
77	, departments = sort $ departments options	7✔
78	, distribution = sort $ distribution options	7✔
79	, location = sort $ location options	7✔
80	, courseNumPrefix = sort $ courseNumPrefix options	7✔
81	}
82	}
83	where
84	options = graphOptions coursesOptions	7✔
85	hashFunction :: (CourseGraphOptions, String) -> T.Text
86	hashFunction = T.pack . ("graph_" ++) . md5s . Str . show	7✔
87
88	graphToByteString :: PrintDotRepr dg n => dg n -> IO B.ByteString
89	graphToByteString graph = graphvizWithHandle Dot graph Svg B.hGetContents	7✔
90
91	createImage :: PrintDotRepr dg n => (FilePath, dg n) -> IO FilePath
92	createImage (n, g) = do	×
NEW 93	_ <- createDirectoryIfMissing False filepath	×
NEW 94	createImageInDir filepath n Svg g	×
95	where
96	filepath = normalise "graphs/gen"	×
97
98	-- \| Here runGraphvizCommand Dot creates the final graph given the input DotGraph object g and connects it
99	-- with the file path(by combining directory d and filename n) to make the final graph in the required directory.
100	createImageInDir ::
101	PrintDotRepr dg n =>
102	-- \| directory to write in
103	FilePath ->
104	-- \| filename
105	FilePath ->
106	-- \| filetype to write in
107	GraphvizOutput ->
108	-- \| graph to draw
109	dg n ->
110	IO FilePath
UNCOV 111	createImageInDir d n o g = Data.GraphViz.addExtension (runGraphvizCommand Dot g) o (combine d n)	×

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