138a8cdc-7016-4918-a15c-5fc6d24156f3

Committed 10 Dec 2025 02:50PM UTC coverage: 55.338% (+0.2%) from 55.14%

Build # 138a8cdc-7016-4918-a15c-5fc6d24156f3

Build Type

push

circleci

Committed by

web-flow

Commit Message

Refactored prerequisite filtering in dynamic graph generation (#1628)

Run Details

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

{-# LANGUAGE OverloadedStrings #-}

module DynamicGraphs.GraphGenerator
  ( sampleGraph
  , coursesToPrereqGraph
  , coursesToPrereqGraphExcluding
  , graphProfileHash
  , filterReq
  )
  where

import Control.Monad.State (State)
import qualified Control.Monad.State as State
import Css.Constants (nodeFontSize)
import Data.Containers.ListUtils (nubOrd)
import Data.Foldable (toList)
import Data.Graph (Tree (Node))
import Data.GraphViz.Attributes as A
import Data.GraphViz.Attributes.Complete as AC
import Data.GraphViz.Types.Generalised (DotEdge (..), DotGraph (..), DotNode (..),
                                        DotStatement (..), GlobalAttributes (..))
import Data.Hash.MD5 (Str (Str), md5s)
import Data.List (elemIndex)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Sequence as Seq
import Data.Text.Lazy (Text, concat, isInfixOf, isPrefixOf, last, pack, take, unpack)
import Database.Requirement (Modifier (..), Req (..))
import DynamicGraphs.CourseFinder (lookupCourses)
import DynamicGraphs.GraphNodeUtils (formatModOr, maybeHead, paddingSpaces, stringifyModAnd)
import DynamicGraphs.GraphOptions (GraphOptions (..), defaultGraphOptions)
import Prelude hiding (last)

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

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

sampleGraph :: DotGraph Text
sampleGraph = fst $ State.runState (reqsToGraph
    defaultGraphOptions
    [("MAT237H1", J "MAT137H1" ""),
    ("MAT133H1", None),
    ("CSC148H1", ReqAnd [J "CSC108H1" "", J "CSC104H1" ""]),
    ("CSC265H1", ReqAnd [J "CSC148H1" "", J "CSC236H1" ""])
    ])
    (GeneratorState 0 Map.empty)

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

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

        includeName (n, _) =
            pickCourse options n &&
            n `notElem`taken options

-- | Recurse through the Req Tree to remove any nodes specified in GraphOptions
filterReq :: GraphOptions -> Req -> Req
filterReq _ None = None
filterReq options (J course info)
    | not (pickCourse options (pack course)) = None
    | pack course `elem` taken options = None
    | otherwise = J course info
filterReq options (ReqAnd reqs) =
    case Prelude.filter (/= None) (map (filterReq options) reqs) of
        [] -> None
        [r] -> r
        reqs' -> ReqAnd reqs'
filterReq options (ReqOr reqs) =
    case Prelude.filter (/= None) (map (filterReq options) reqs) of
        [] -> None
        [r] -> r
        reqs' -> ReqOr reqs'
filterReq _ (Fces fl modifier) = Fces fl modifier
filterReq options  (Grade str req) = Grade str (filterReq options req)
filterReq _ (Gpa fl str) = Gpa fl str
filterReq _ (Program pro) = Program pro
filterReq _ (Raw s) = Raw s

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

pickCourse :: GraphOptions -> Text -> Bool
pickCourse options name =
    pickCourseByDepartment options name &&
    pickCourseByLocation options name

pickCourseByDepartment :: GraphOptions -> Text -> Bool
pickCourseByDepartment options name =
    Prelude.null (departments options) ||
    prefixedByOneOf name (departments options)

pickCourseByLocation :: GraphOptions -> Text -> Bool
pickCourseByLocation options name =
    Prelude.null (location options) ||
    courseLocation `elem` mapMaybe locationNum (location options)
    where
        courseLocation = last name
        locationNum l = case l of
            "utsg" -> Just '1'
            "utsc" -> Just '3'
            "utm" -> Just '5'
            _ -> Nothing

nodeColor :: GraphOptions -> Text -> Color
nodeColor options name = colors !! depIndex
    where colors :: [Color]
          colors = cycle $ map toColor
            [Orchid, Orange, CornFlowerBlue, Salmon, Aquamarine, Yellow, OliveDrab]
          depIndex :: Int
          depIndex = fromMaybe 0 (elemIndex courseDep (departments options))
          courseDep :: Text
          courseDep = Data.Text.Lazy.take 3 name

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

reqToStmtsTree :: GraphOptions -- ^ Options to toggle dynamic graph
               -> Text -- ^ Name of parent course
               -> Req  -- ^ Requirement to generate dep tree for
               -> State GeneratorState (Tree [DotStatement Text])
reqToStmtsTree _ _ None = return (Node [] [])
reqToStmtsTree options parentID (J name2 _) = do
    let name = pack name2
    prereq <- makeNode name $ Just (nodeColor options name)
    edge <- makeEdge (nodeID prereq) parentID Nothing
    return (Node [DN prereq, DE edge] [])
-- Two or more required prerequisites.
reqToStmtsTree options parentID (ReqAnd reqs) = do
    (andNode, _) <- makeBool "and" reqs
    edge <- makeEdge (nodeID andNode) parentID Nothing
    prereqStmts <- mapM (reqToStmtsTree options (nodeID andNode)) reqs
    let filteredStmts = Prelude.filter (Node [] [] /=) prereqStmts
    case filteredStmts of
        [] -> return $ Node [] []
        [Node (DN node:_) xs] -> do
            -- make new edge with parent id and single child id
            newEdge <- makeEdge (nodeID node) parentID Nothing
            return $ Node [DN node, DE newEdge] xs
        _ -> return $ Node [DN andNode, DE edge] filteredStmts
-- A choice from two or more prerequisites.
reqToStmtsTree options parentID (ReqOr reqs) = do
    (orNode, _) <- makeBool "or" reqs
    edge <- makeEdge (nodeID orNode) parentID Nothing
    prereqStmts <- mapM (reqToStmtsTree options (nodeID orNode)) reqs
    let filteredStmts = Prelude.filter (Node [] [] /=) prereqStmts
    case filteredStmts of
        [] -> return $ Node [] []
        [Node (DN node:_) xs] -> do
            -- make new edge with parent id and single child id
            newEdge <- makeEdge (nodeID node) parentID Nothing
            return $ Node [DN node, DE newEdge] xs
        _  -> return $ Node [DN orNode, DE edge] filteredStmts

-- A prerequisite with a grade requirement.
reqToStmtsTree options parentID (Grade description req) = do
    if includeGrades options then do
        Node root rest <- reqToStmtsTree options parentID req
        case root of
            DN gradeNode:_ -> do
                -- make an annotated edge
                gradeEdge <- makeEdge (nodeID gradeNode)
                                      parentID
                                      (Just $ pack $ description ++ "%")
                -- swap out top edge of prereqStmt tree with annotated edge
                return $ Node [DN gradeNode, DE gradeEdge] rest
            _ -> return $ Node [] [] -- ERROR
    else reqToStmtsTree options parentID req

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

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

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

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

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

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

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

    case maybeHead [req | Requirement req <- modifiers] of
        Nothing -> return $ Node [DN fceNode, DE edge] []
        Just req -> do
            prereqStmts <- reqToStmtsTree options (nodeID fceNode) req
            return $ Node [DN fceNode, DE edge] [prereqStmts]

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

    case maybeHead [req | Requirement req <- modifiers] of
        Nothing -> return $ Node [DN fceNode, DE edge] []
        Just req -> do
            prereqStmts <- reqToStmtsTree options (nodeID fceNode) req
            return $ Node [DN fceNode, DE edge] [prereqStmts]

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

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

prefixedByOneOf :: Text -> [Text] -> Bool
prefixedByOneOf name = any (`isPrefixOf` name)

makeNode :: Text -> Maybe Color -> State GeneratorState (DotNode Text)
makeNode name nodeCol = do
    GeneratorState i nodesMap <- State.get
    case Map.lookup name nodesMap of
        Nothing -> do
            let nodeId = mappendTextWithCounter name i
                actualColor = case nodeCol of
                    Nothing -> toColor Gray
                    Just c -> c
                node = DotNode nodeId
                               [AC.Label $ toLabelValue name,
                                ID nodeId,
                                AC.FixedSize AC.GrowAsNeeded,
                                AC.FontSize nodeFontSize,
                                FillColor $ toColorList [actualColor]]
                nodesMap' = Map.insert name node nodesMap
            State.put (GeneratorState (i + 1) nodesMap')
            return node
        Just node -> return node

makeBool :: Text -> [Req] -> State GeneratorState (DotNode Text, Text)
makeBool text1 reqs = do
    GeneratorState i boolsMap <- State.get
    reqsList <- mapM generateBoolKey reqs
    let sortedList = toList (sort $ fromList reqsList)
    let boolKey = Data.Text.Lazy.concat $ text1 : sortedList
    case Map.lookup boolKey boolsMap of
        Nothing -> do
            let nodeId = mappendTextWithCounter text1 i
            let boolNode = DotNode nodeId
                                    ([AC.Label (toLabelValue text1), ID nodeId] ++ ellipseAttrs)
                boolsMap' = Map.insert boolKey boolNode boolsMap
            State.put (GeneratorState (i + 1) boolsMap')

            return (boolNode, boolKey)
        Just node -> do
            return (node, boolKey)

-- | Create edge from two node ids. Also allow for potential edge label
makeEdge :: Text -> Text -> Maybe Text -> State GeneratorState (DotEdge Text)
makeEdge id1 id2 description =
    return $ DotEdge id1 id2
                     (ID (id1 `mappend` "|" `mappend` id2) : textLabelList)
    where
        textLabelList = case description of
            Nothing -> []
            Just a -> [textLabel a]

mappendTextWithCounter :: Text -> Integer -> Text
mappendTextWithCounter text1 counter = text1 `mappend` "_counter_" `mappend` pack (show counter)

-- | Generates a unique key for each boolean node
-- May generate lower level nodes that make up the boolean node
generateBoolKey :: Req -> State GeneratorState Text
generateBoolKey (J s1 _) = return $ pack ("_" ++ s1)
generateBoolKey (Grade _ req) = do
    generateBoolKey req
generateBoolKey (ReqAnd reqs) = do
    (_, boolKey)<- makeBool "and" reqs
    return $ pack ("_[" ++ unpack boolKey ++ "]")
generateBoolKey (ReqOr reqs) = do
    (_, boolKey) <- makeBool "or" reqs
    return $ pack ("_[" ++ unpack boolKey ++ "]")
generateBoolKey _ = return ""

-- ** Graphviz configuration

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

graphProfileHash :: String
graphProfileHash = md5s . Str . show $ (buildGraph [], ellipseAttrs)

-- | Means the layout of the full graph is from left to right.
graphAttrs :: GlobalAttributes
graphAttrs = GraphAttrs
    [ AC.RankDir AC.FromTop
    , AC.Splines AC.Ortho
    , AC.Concentrate False
    ]

nodeAttrs :: GlobalAttributes
nodeAttrs = NodeAttrs
    [ A.shape A.BoxShape
    , AC.FixedSize GrowAsNeeded
    , A.style A.filled
    ]

ellipseAttrs :: A.Attributes
ellipseAttrs =
    [ A.shape A.Ellipse
    , AC.Width 0.20     -- min 0.01
    , AC.Height 0.15    -- min 0.01
    , AC.FixedSize SetNodeSize
    , A.fillColor White
    , AC.FontSize 6.0  -- min 1.0
    ]

edgeAttrs :: GlobalAttributes
edgeAttrs = EdgeAttrs [
    ArrowHead (AType [(ArrMod FilledArrow BothSides, Normal)])
    ]

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	]

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

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