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

Courseography / courseography / 138a8cdc-7016-4918-a15c-5fc6d24156f3

10 Dec 2025 02:50PM UTC coverage: 55.338% (+0.2%) from 55.14%
138a8cdc-7016-4918-a15c-5fc6d24156f3

push

circleci

web-flow
Refactored prerequisite filtering in dynamic graph generation (#1628)

498 of 967 branches covered (51.5%)

Branch coverage included in aggregate %.

23 of 29 new or added lines in 2 files covered. (79.31%)

39 existing lines in 1 file now uncovered.

2244 of 3988 relevant lines covered (56.27%)

164.41 hits per line

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

51.49
/app/DynamicGraphs/GraphGenerator.hs
1
{-# LANGUAGE OverloadedStrings #-}
2

3
module DynamicGraphs.GraphGenerator
4
  ( sampleGraph
5
  , coursesToPrereqGraph
6
  , coursesToPrereqGraphExcluding
7
  , graphProfileHash
8
  , filterReq
9
  )
10
  where
11

12
import Control.Monad.State (State)
13
import qualified Control.Monad.State as State
14
import Css.Constants (nodeFontSize)
15
import Data.Containers.ListUtils (nubOrd)
16
import Data.Foldable (toList)
17
import Data.Graph (Tree (Node))
18
import Data.GraphViz.Attributes as A
19
import Data.GraphViz.Attributes.Complete as AC
20
import Data.GraphViz.Types.Generalised (DotEdge (..), DotGraph (..), DotNode (..),
21
                                        DotStatement (..), GlobalAttributes (..))
22
import Data.Hash.MD5 (Str (Str), md5s)
23
import Data.List (elemIndex)
24
import qualified Data.Map.Strict as Map
25
import Data.Maybe (fromMaybe, mapMaybe)
26
import Data.Sequence as Seq
27
import Data.Text.Lazy (Text, concat, isInfixOf, isPrefixOf, last, pack, take, unpack)
28
import Database.Requirement (Modifier (..), Req (..))
29
import DynamicGraphs.CourseFinder (lookupCourses)
30
import DynamicGraphs.GraphNodeUtils (formatModOr, maybeHead, paddingSpaces, stringifyModAnd)
31
import DynamicGraphs.GraphOptions (GraphOptions (..), defaultGraphOptions)
32
import Prelude hiding (last)
33

34
-- | Generates a DotGraph dependency graph including all the given courses and their recursive dependecies
35
coursesToPrereqGraph :: [String] -- ^ courses to generate
36
                        -> IO (DotGraph Text)
37
coursesToPrereqGraph rootCourses = coursesToPrereqGraphExcluding (map pack rootCourses) defaultGraphOptions
×
38

39
-- | Takes a list of courses we wish to generate a dependency graph for, along with graph options
40
-- for the courses we want to include. The generated graph will not contain the dependencies of the courses
41
-- from excluded departments. In addition, it will neither include any of the taken courses,
42
-- nor the dependencies of taken courses (unless they are depended on by other courses)
43
coursesToPrereqGraphExcluding :: [Text] -> GraphOptions -> IO (DotGraph Text)
44
coursesToPrereqGraphExcluding rootCourses options = do
7✔
45
    reqs <- lookupCourses options rootCourses
7✔
46
    let reqs' = Map.toList reqs
7✔
47
    return $ fst $ State.runState (reqsToGraph options reqs') initialState
7✔
48
    where
49
        initialState = GeneratorState 0 Map.empty
7✔
50

51
sampleGraph :: DotGraph Text
52
sampleGraph = fst $ State.runState (reqsToGraph
×
53
    defaultGraphOptions
×
54
    [("MAT237H1", J "MAT137H1" ""),
×
55
    ("MAT133H1", None),
×
56
    ("CSC148H1", ReqAnd [J "CSC108H1" "", J "CSC104H1" ""]),
×
57
    ("CSC265H1", ReqAnd [J "CSC148H1" "", J "CSC236H1" ""])
×
58
    ])
59
    (GeneratorState 0 Map.empty)
×
60

61
-- ** Main algorithm for converting requirements into a DotGraph
62

63
-- | Convert a list of coursenames and requirements to a DotGraph object for
64
-- drawing using Dot. Also prunes any repeated edges that arise from
65
-- multiple Reqs using the same Grade requirement
66
reqsToGraph :: GraphOptions -> [(Text, Req)] -> State GeneratorState (DotGraph Text)
67
reqsToGraph options reqs = do
7✔
68
    allStmts <- concatUnique <$> mapM (reqToStmts options) reqs'
7✔
69
    return $ buildGraph allStmts
7✔
70
    where
71
        concatUnique = nubOrd . Prelude.concat
1✔
72
        filteredReqs = [(n, filterReq options req) | (n, req) <- reqs]
23✔
73
        reqs' =  Prelude.filter includeName filteredReqs
7✔
74

75
        includeName (n, _) =
76
            pickCourse options n &&
23✔
77
            n `notElem`taken options
22✔
78

79
-- | Recurse through the Req Tree to remove any nodes specified in GraphOptions
80
filterReq :: GraphOptions -> Req -> Req
81
filterReq _ None = None
11✔
82
filterReq options (J course info)
83
    | not (pickCourse options (pack course)) = None
47✔
84
    | pack course `elem` taken options = None
42✔
85
    | otherwise = J course info
36!
86
filterReq options (ReqAnd reqs) =
87
    case Prelude.filter (/= None) (map (filterReq options) reqs) of
17✔
NEW
88
        [] -> None
×
89
        [r] -> r
2✔
90
        reqs' -> ReqAnd reqs'
15✔
91
filterReq options (ReqOr reqs) =
92
    case Prelude.filter (/= None) (map (filterReq options) reqs) of
3✔
93
        [] -> None
1✔
94
        [r] -> r
1✔
95
        reqs' -> ReqOr reqs'
1✔
NEW
96
filterReq _ (Fces fl modifier) = Fces fl modifier
×
NEW
97
filterReq options  (Grade str req) = Grade str (filterReq options req)
×
NEW
98
filterReq _ (Gpa fl str) = Gpa fl str
×
NEW
99
filterReq _ (Program pro) = Program pro
×
NEW
100
filterReq _ (Raw s) = Raw s
×
101

102
data GeneratorState = GeneratorState Integer (Map.Map Text (DotNode Text))
103

104
pickCourse :: GraphOptions -> Text -> Bool
105
pickCourse options name =
106
    pickCourseByDepartment options name &&
70✔
107
    pickCourseByLocation options name
64✔
108

109
pickCourseByDepartment :: GraphOptions -> Text -> Bool
110
pickCourseByDepartment options name =
111
    Prelude.null (departments options) ||
70✔
112
    prefixedByOneOf name (departments options)
48✔
113

114
pickCourseByLocation :: GraphOptions -> Text -> Bool
115
pickCourseByLocation options name =
116
    Prelude.null (location options) ||
64✔
UNCOV
117
    courseLocation `elem` mapMaybe locationNum (location options)
×
118
    where
119
        courseLocation = last name
×
UNCOV
120
        locationNum l = case l of
×
121
            "utsg" -> Just '1'
×
122
            "utsc" -> Just '3'
×
123
            "utm" -> Just '5'
×
124
            _ -> Nothing
×
125

126
nodeColor :: GraphOptions -> Text -> Color
127
nodeColor options name = colors !! depIndex
20✔
128
    where colors :: [Color]
129
          colors = cycle $ map toColor
20✔
130
            [Orchid, Orange, CornFlowerBlue, Salmon, Aquamarine, Yellow, OliveDrab]
1✔
131
          depIndex :: Int
132
          depIndex = fromMaybe 0 (elemIndex courseDep (departments options))
20✔
133
          courseDep :: Text
134
          courseDep = Data.Text.Lazy.take 3 name
16✔
135

136
-- | Convert the original requirement data into dot statements that can be used by buildGraph to create the
137
-- corresponding DotGraph objects.
138
reqToStmts :: GraphOptions -> (Text, Req) -> State GeneratorState [DotStatement Text]
139
reqToStmts options (name, req) = do
20✔
140
    node <- makeNode name $ Just (nodeColor options name)
20✔
141
    stmts <- reqToStmtsTree options (nodeID node) req
20✔
142
    return $ DN node:Prelude.concat (toList stmts)
20✔
143

144
reqToStmtsTree :: GraphOptions -- ^ Options to toggle dynamic graph
145
               -> Text -- ^ Name of parent course
146
               -> Req  -- ^ Requirement to generate dep tree for
147
               -> State GeneratorState (Tree [DotStatement Text])
148
reqToStmtsTree _ _ None = return (Node [] [])
1✔
149
reqToStmtsTree options parentID (J name2 _) = do
14✔
150
    let name = pack name2
14✔
151
    prereq <- makeNode name $ Just (nodeColor options name)
14✔
152
    edge <- makeEdge (nodeID prereq) parentID Nothing
14✔
153
    return (Node [DN prereq, DE edge] [])
14✔
154
-- Two or more required prerequisites.
155
reqToStmtsTree options parentID (ReqAnd reqs) = do
5✔
156
    (andNode, _) <- makeBool "and" reqs
5✔
157
    edge <- makeEdge (nodeID andNode) parentID Nothing
5✔
158
    prereqStmts <- mapM (reqToStmtsTree options (nodeID andNode)) reqs
5✔
159
    let filteredStmts = Prelude.filter (Node [] [] /=) prereqStmts
5✔
160
    case filteredStmts of
5✔
UNCOV
161
        [] -> return $ Node [] []
×
UNCOV
162
        [Node (DN node:_) xs] -> do
×
163
            -- make new edge with parent id and single child id
164
            newEdge <- makeEdge (nodeID node) parentID Nothing
×
UNCOV
165
            return $ Node [DN node, DE newEdge] xs
×
166
        _ -> return $ Node [DN andNode, DE edge] filteredStmts
5✔
167
-- A choice from two or more prerequisites.
UNCOV
168
reqToStmtsTree options parentID (ReqOr reqs) = do
×
UNCOV
169
    (orNode, _) <- makeBool "or" reqs
×
170
    edge <- makeEdge (nodeID orNode) parentID Nothing
×
171
    prereqStmts <- mapM (reqToStmtsTree options (nodeID orNode)) reqs
×
172
    let filteredStmts = Prelude.filter (Node [] [] /=) prereqStmts
×
173
    case filteredStmts of
×
174
        [] -> return $ Node [] []
×
175
        [Node (DN node:_) xs] -> do
×
176
            -- make new edge with parent id and single child id
177
            newEdge <- makeEdge (nodeID node) parentID Nothing
×
UNCOV
178
            return $ Node [DN node, DE newEdge] xs
×
179
        _  -> return $ Node [DN orNode, DE edge] filteredStmts
×
180

181
-- A prerequisite with a grade requirement.
UNCOV
182
reqToStmtsTree options parentID (Grade description req) = do
×
UNCOV
183
    if includeGrades options then do
×
184
        Node root rest <- reqToStmtsTree options parentID req
×
185
        case root of
×
186
            DN gradeNode:_ -> do
×
187
                -- make an annotated edge
188
                gradeEdge <- makeEdge (nodeID gradeNode)
×
UNCOV
189
                                      parentID
×
190
                                      (Just $ pack $ description ++ "%")
×
191
                -- swap out top edge of prereqStmt tree with annotated edge
192
                return $ Node [DN gradeNode, DE gradeEdge] rest
×
UNCOV
193
            _ -> return $ Node [] [] -- ERROR
×
194
    else reqToStmtsTree options parentID req
×
195

196
-- A raw string description of a prerequisite.
197
reqToStmtsTree options parentID (Raw rawText) =
UNCOV
198
    if not (includeRaws options) || "High school" `isInfixOf` pack rawText || rawText == ""
×
UNCOV
199
        then return $ Node [] []
×
200
        else do
×
201
            prereq <- makeNode (pack rawText) Nothing
×
202
            edge <- makeEdge (nodeID prereq) parentID Nothing
×
203
            return $ Node [DN prereq, DE edge] []
×
204

205
--A prerequisite concerning a given number of earned credits
UNCOV
206
reqToStmtsTree _ parentID (Fces creds (Requirement (Raw ""))) = do
×
UNCOV
207
    fceNode <- makeNode (pack $ show creds ++ " FCEs") Nothing
×
208
    edge <- makeEdge (nodeID fceNode) parentID Nothing
×
209
    return $ Node [DN fceNode, DE edge] []
×
210

211
--A prerequisite concerning a given number of earned credits in some raw string
UNCOV
212
reqToStmtsTree _ parentID (Fces creds (Requirement (Raw text))) = do
×
UNCOV
213
    fceNode <- makeNode (pack $ show creds ++ " FCEs from " ++ text ++ paddingSpaces 18) Nothing
×
214
    edge <- makeEdge (nodeID fceNode) parentID Nothing
×
215
    return $ Node [DN fceNode, DE edge] []
×
216

217
--A prerequisite concerning a given number of earned credits in some course(s)
UNCOV
218
reqToStmtsTree options parentID (Fces creds (Requirement req)) = do
×
UNCOV
219
    fceNode <- makeNode (pack $ show creds ++ " FCEs") Nothing
×
220
    edge <- makeEdge (nodeID fceNode) parentID Nothing
×
221
    prereqStmts <- reqToStmtsTree options (nodeID fceNode) req
×
222
    return $ Node [DN fceNode, DE edge] [prereqStmts]
×
223

224
--A prerequisite concerning a given number of earned credits in a department
UNCOV
225
reqToStmtsTree _ parentID (Fces creds (Department dept)) = do
×
UNCOV
226
    fceNode <- makeNode (pack $ show creds ++ " " ++ dept ++ " FCEs") Nothing
×
227
    edge <- makeEdge (nodeID fceNode) parentID Nothing
×
228
    return $ Node [DN fceNode, DE edge] []
×
229

230
--A prerequisite concerning a given number of earned credits at a given level
UNCOV
231
reqToStmtsTree _ parentID (Fces creds (Level level)) = do
×
UNCOV
232
    fceNode <- makeNode (pack $ show creds ++ " FCEs at the " ++ level ++ " level" ++ paddingSpaces 18) Nothing
×
233
    edge <- makeEdge (nodeID fceNode) parentID Nothing
×
234
    return $ Node [DN fceNode, DE edge] []
×
235

236
-- | A prerequisite concerning a given number of earned credits with a combination
237
-- | of some modifiers related through ModAnds
238
-- | Assumes each modifier constructor appears in modifiers at most once
239
-- | The ModOr constructor may appear more than once, but each occurrence
240
-- | of ModOr contains exactly one constructor for all its elements
241
-- | and such constructor does not appear anywhere else in ModAnd
UNCOV
242
reqToStmtsTree options parentID (Fces creds (ModAnd modifiers)) = do
×
UNCOV
243
    fceNode <- makeNode (pack $ stringifyModAnd creds modifiers ++ paddingSpaces 10) Nothing
×
244
    edge <- makeEdge (nodeID fceNode) parentID Nothing
×
245

246
    case maybeHead [req | Requirement req <- modifiers] of
×
UNCOV
247
        Nothing -> return $ Node [DN fceNode, DE edge] []
×
248
        Just req -> do
×
249
            prereqStmts <- reqToStmtsTree options (nodeID fceNode) req
×
250
            return $ Node [DN fceNode, DE edge] [prereqStmts]
×
251

252
-- | A prerequisite concerning a given number of earned credits with a combination
253
-- | of some modifiers related through a ModOr
254
-- | Assumes all modifiers in the list have the same constructor
UNCOV
255
reqToStmtsTree options parentID (Fces creds (ModOr modifiers)) = do
×
UNCOV
256
    fceNode <- makeNode (pack $ formatModOr creds modifiers) Nothing
×
257
    edge <- makeEdge (nodeID fceNode) parentID Nothing
×
258

259
    case maybeHead [req | Requirement req <- modifiers] of
×
UNCOV
260
        Nothing -> return $ Node [DN fceNode, DE edge] []
×
261
        Just req -> do
×
262
            prereqStmts <- reqToStmtsTree options (nodeID fceNode) req
×
263
            return $ Node [DN fceNode, DE edge] [prereqStmts]
×
264

265
-- A program requirement
UNCOV
266
reqToStmtsTree _ parentID (Program prog) = do
×
267
    -- FIXME: weird width calculation from the library with the prog
268
    -- so we padded the string with prog again to work around it
UNCOV
269
    progNode <- makeNode (pack $ "Enrolled in " ++ prog ++ Prelude.replicate (Prelude.length prog) ' ') Nothing
×
UNCOV
270
    edge <- makeEdge (nodeID progNode) parentID Nothing
×
271
    return $ Node [DN progNode, DE edge] []
×
272

273
-- a cGPA requirement
UNCOV
274
reqToStmtsTree _ parentID (Gpa float string) = do
×
UNCOV
275
    gpaNode <- makeNode (pack $ "Minimum cGPA of " ++ show float ++ string) Nothing
×
276
    edge <-  makeEdge (nodeID gpaNode) parentID Nothing
×
277
    return $ Node [DN gpaNode, DE edge] []
×
278

279
prefixedByOneOf :: Text -> [Text] -> Bool
280
prefixedByOneOf name = any (`isPrefixOf` name)
48✔
281

282
makeNode :: Text -> Maybe Color -> State GeneratorState (DotNode Text)
283
makeNode name nodeCol = do
34✔
284
    GeneratorState i nodesMap <- State.get
1✔
285
    case Map.lookup name nodesMap of
34✔
286
        Nothing -> do
20✔
287
            let nodeId = mappendTextWithCounter name i
20✔
288
                actualColor = case nodeCol of
20✔
UNCOV
289
                    Nothing -> toColor Gray
×
290
                    Just c -> c
20✔
291
                node = DotNode nodeId
20✔
292
                               [AC.Label $ toLabelValue name,
20✔
293
                                ID nodeId,
20✔
294
                                AC.FixedSize AC.GrowAsNeeded,
20✔
295
                                AC.FontSize nodeFontSize,
20✔
296
                                FillColor $ toColorList [actualColor]]
20✔
297
                nodesMap' = Map.insert name node nodesMap
19✔
298
            State.put (GeneratorState (i + 1) nodesMap')
19✔
299
            return node
20✔
300
        Just node -> return node
14✔
301

302
makeBool :: Text -> [Req] -> State GeneratorState (DotNode Text, Text)
303
makeBool text1 reqs = do
5✔
304
    GeneratorState i boolsMap <- State.get
1✔
305
    reqsList <- mapM generateBoolKey reqs
2✔
306
    let sortedList = toList (sort $ fromList reqsList)
2✔
307
    let boolKey = Data.Text.Lazy.concat $ text1 : sortedList
5✔
308
    case Map.lookup boolKey boolsMap of
5✔
309
        Nothing -> do
4✔
310
            let nodeId = mappendTextWithCounter text1 i
4✔
311
            let boolNode = DotNode nodeId
4✔
312
                                    ([AC.Label (toLabelValue text1), ID nodeId] ++ ellipseAttrs)
4✔
313
                boolsMap' = Map.insert boolKey boolNode boolsMap
4✔
314
            State.put (GeneratorState (i + 1) boolsMap')
4✔
315

316
            return (boolNode, boolKey)
4✔
317
        Just node -> do
1✔
318
            return (node, boolKey)
1✔
319

320
-- | Create edge from two node ids. Also allow for potential edge label
321
makeEdge :: Text -> Text -> Maybe Text -> State GeneratorState (DotEdge Text)
322
makeEdge id1 id2 description =
323
    return $ DotEdge id1 id2
19✔
324
                     (ID (id1 `mappend` "|" `mappend` id2) : textLabelList)
19✔
325
    where
326
        textLabelList = case description of
19✔
327
            Nothing -> []
1✔
UNCOV
328
            Just a -> [textLabel a]
×
329

330
mappendTextWithCounter :: Text -> Integer -> Text
331
mappendTextWithCounter text1 counter = text1 `mappend` "_counter_" `mappend` pack (show counter)
24✔
332

333
-- | Generates a unique key for each boolean node
334
-- May generate lower level nodes that make up the boolean node
335
generateBoolKey :: Req -> State GeneratorState Text
336
generateBoolKey (J s1 _) = return $ pack ("_" ++ s1)
4✔
UNCOV
337
generateBoolKey (Grade _ req) = do
×
UNCOV
338
    generateBoolKey req
×
339
generateBoolKey (ReqAnd reqs) = do
×
340
    (_, boolKey)<- makeBool "and" reqs
×
341
    return $ pack ("_[" ++ unpack boolKey ++ "]")
×
342
generateBoolKey (ReqOr reqs) = do
×
343
    (_, boolKey) <- makeBool "or" reqs
×
344
    return $ pack ("_[" ++ unpack boolKey ++ "]")
×
345
generateBoolKey _ = return ""
×
346

347
-- ** Graphviz configuration
348

349
-- | With the dot statements converted from original requirement data as input, create the corresponding DotGraph
350
-- object with predefined hyperparameters (here, the hyperparameters defines that 1.graph can have multi-edges
351
-- 2.graph edges have directions 3.graphID not defined(not so clear) 4.the graph layout, node shape, edge shape
352
-- are defined by the attributes as below)
353
buildGraph :: [DotStatement Text] -> DotGraph Text
354
buildGraph statements = DotGraph {
8✔
355
    strictGraph = False,
8✔
356
    directedGraph = True,
8✔
357
    graphID = Nothing,
1✔
358
    graphStatements = Seq.fromList $ [
8✔
359
        GA graphAttrs,
1✔
360
        GA nodeAttrs,
1✔
361
        GA edgeAttrs
1✔
362
        ] ++ statements
8✔
363
    }
364

365
graphProfileHash :: String
366
graphProfileHash = md5s . Str . show $ (buildGraph [], ellipseAttrs)
1✔
367

368
-- | Means the layout of the full graph is from left to right.
369
graphAttrs :: GlobalAttributes
370
graphAttrs = GraphAttrs
1✔
371
    [ AC.RankDir AC.FromTop
1✔
372
    , AC.Splines AC.Ortho
1✔
373
    , AC.Concentrate False
1✔
374
    ]
375

376
nodeAttrs :: GlobalAttributes
377
nodeAttrs = NodeAttrs
1✔
378
    [ A.shape A.BoxShape
1✔
379
    , AC.FixedSize GrowAsNeeded
1✔
380
    , A.style A.filled
1✔
381
    ]
382

383
ellipseAttrs :: A.Attributes
384
ellipseAttrs =
385
    [ A.shape A.Ellipse
1✔
386
    , AC.Width 0.20     -- min 0.01
1✔
387
    , AC.Height 0.15    -- min 0.01
1✔
388
    , AC.FixedSize SetNodeSize
1✔
389
    , A.fillColor White
1✔
390
    , AC.FontSize 6.0  -- min 1.0
1✔
391
    ]
392

393
edgeAttrs :: GlobalAttributes
394
edgeAttrs = EdgeAttrs [
1✔
395
    ArrowHead (AType [(ArrMod FilledArrow BothSides, Normal)])
1✔
396
    ]
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

© 2025 Coveralls, Inc