-- -- Grapher.hs -- -- Convert a cost center profile generated by the -px flag -- into the directed graph in the Dot format of GraphViz -- -- Gregory Wright, 28 July 2007 -- -- Copyright (c) 2007, 2008 Antiope Associates LLC, all rights reserved. -- module Grapher ( ColorCoord (..), GraphOptions (..), NodeStyle (..), profToDot ) where import Data.IntMap as IM import Data.List as L import Data.Maybe import TreeToGraph import ParseProfile -- | How to color a graph. -- data ColorCoord = NoColor | ColorCalls | ColorTicks | ColorAllocs deriving Show data NodeStyle = Brief | Verbose deriving Show -- | The GraphOptions record tells us how to color the graph, whether -- to do call tree -> call graph conversion, whether nodes should be displayed -- in a brief format (just the node name) and if modules should be shown by -- a labelled box. -- data GraphOptions = GraphOptions { graphColorCoord :: ColorCoord, graphConvertTree :: Bool, graphNodeStyle :: NodeStyle, graphShowModules :: Bool } deriving Show -- | Our data types are nodes and edges. A Node is a collection of all -- of the profiling information for a cost center. An edge is simply -- a pair of Ints identifying the connected Nodes. -- data Node = Node { nodeNum :: Int, nodeName :: String, moduleName :: String, nodeCost :: CostCenterReport } deriving Show type Edge = (Int, Int) -- | extractEdges extracts the edges of the call graph from a Profile. -- The return value is a lists of all the edges in the graph connecting -- cost centers that have a nonzero cost attributed to them. -- extractEdges :: Profile -> [ Edge ] extractEdges p = let edgePairs :: Int -> CostCenterStack -> [ (Int, Int) ] edgePairs s st = if (parentStack st) /= [] then L.map (\n -> (n, s)) (parentStack st) else [] in concatMap (\(s, st) -> edgePairs s st) (toList (nonzeroStacks p)) -- | extractNodes take the list of edges in the graph and make a list -- of the unique nodes. It then looks up the node information associated -- with each. -- extractNodes :: Profile -> [ Edge ] -> [ Node ] extractNodes p es = let ns = unzip es ns' = nub (fst ns ++ snd ns) in L.map (getNodeInfo p) ns' -- | The maxCost function computes the maximum resource usage of all the -- nodes. It is used when attributing fractional costs to particular -- nodes in the graph. -- maxCost :: [ Node ] -> CostCenterReport maxCost ns = foldl' maxCosts CostCenterReport {reportCount = 0, reportTicks = 0, reportAlloc = 0} ns where maxCosts :: CostCenterReport -> Node -> CostCenterReport maxCosts c n = CostCenterReport { reportCount = maxOf (reportCount c) (reportCount (nodeCost n)), reportTicks = maxOf (reportTicks c) (reportTicks (nodeCost n)), reportAlloc = maxOf (reportAlloc c) (reportAlloc (nodeCost n))} maxOf a b = if a >= b then a else b -- | extractModules return a list of pairs containing the module name and -- all of the cost centers associated with it. -- extractModules :: Profile -> [ (String, [ Int ]) ] extractModules p = let modulesAndCenters = L.map (\(s, st) -> (ccModule ((centers p) IM.! (stackCCID st)), s)) (toList (nonzeroStacks p)) groupModules :: (String, Int) -> (String, Int) -> Bool groupModules (s1, _) (s2, _) = s1 == s2 sortModules :: (String, Int) -> (String, Int) -> Ordering sortModules (s1, _) (s2, _) = if s1 == s2 then EQ else if s1 > s2 then GT else LT sortedModules = sortBy sortModules modulesAndCenters moduleList = L.map unzip (groupBy groupModules sortedModules) in L.map (\(mods, ccs) -> (head mods, ccs)) moduleList -- | Get the name, associated module name and the cost for a given node in -- the call graph. -- getNodeInfo :: Profile -> Int -> Node getNodeInfo p n = Node { nodeNum = n, nodeName = ccName cc, moduleName = ccModule cc, nodeCost = (reports p) IM.! n } where cc = ((centers p) IM.! (stackCCID ((stacks p) IM.! n))) -- | Apply a color map. The colorize function takes the total resource -- usage (count, ticks or allocs) and a selector function for the same -- field in the nodeCost record, returning a function which determines -- the color of the node based on its resource usage. -- colorize :: Integer -> (CostCenterReport -> Integer) -> Node -> String colorize costBasis selector node = let fractionalCost = fromInteger(selector (nodeCost node)) / (fromInteger costBasis) maxhue = 0.6 minsat = 0.1 hue = maxhue * (1.0 - fractionalCost) sat = minsat + (3.0 - minsat) * fractionalCost val = 1.0 :: Double sat' = if sat <= 1.0 then sat else 1.0 :: Double in "color = \"" ++ show hue ++ ", " ++ show sat' ++ ", " ++ show val ++ "\" " -- | The pieces of a dot file: the foreword, the edge descriptions, the -- node descriptions, possibly subgraphs grouping the modules and the afterword: -- foreword :: String -> String foreword name = "digraph " ++ name ++ " {\n" nodeColorStyle :: ColorCoord -> String nodeColorStyle NoColor = "" nodeColorStyle _ = "node [style = filled];\n" afterword :: String afterword = "}\n" showEdge :: Edge -> String showEdge e = show (fst e) ++ " -> " ++ show (snd e) ++ ";\n" showNode :: NodeStyle -> Maybe (Node -> String) -> Node -> String showNode style cm n = let color = if isJust cm then (fromJust cm) n else "" in show (nodeNum n) ++ " [ shape=box, " ++ color ++ "label=\"" ++ showNodeInfo style n ++ "\"];\n" showNodeInfo :: NodeStyle -> Node -> String showNodeInfo Brief n = nodeName n showNodeInfo Verbose n = let calls = reportCount (nodeCost n) ticks = reportTicks (nodeCost n) allocs = reportAlloc (nodeCost n) in nodeName n ++ "\\ncount = " ++ show calls ++ "\\lticks = " ++ show ticks ++ "\\lallocs = " ++ show allocs ++ "\\l" showModule :: (String, [ Int ]) -> String showModule (m, ccs) = "subgraph \"cluster_" ++ m ++ "\" { label = \"" ++ m ++ "\"; " ++ "style=filled; color=lightgrey; " ++ concatMap (\n -> show n ++ "; ") ccs ++ " }\n" profToDot :: GraphOptions -> String -> Profile -> String profToDot options name p = let p' = if graphConvertTree options then treeToGraph p else p es = extractEdges p' ns = extractNodes p' es colorMap = let m = maxCost ns in case graphColorCoord options of NoColor -> Nothing ColorCalls -> Just (colorize (reportCount m) reportCount) ColorTicks -> Just (colorize (reportTicks m) reportTicks) ColorAllocs -> Just (colorize (reportAlloc m) reportAlloc) edges = concatMap showEdge es nodes = concatMap (showNode (graphNodeStyle options) colorMap) ns mods = if graphShowModules options then concatMap showModule (extractModules p') else "" style = nodeColorStyle (graphColorCoord options) in foreword name ++ style ++ edges ++ nodes ++ mods ++ afterword