diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,4 +1,8 @@ -* 0.2.0.2 +- 0.3.0.0 + * Simplify the tree, creating actual (indiv) nodes where necessary from the + Haskell code + +- 0.2.0.2 * Bump `aeson` and `vector` dependencies - 0.2.0.1 diff --git a/data/js/cost-centre-node.js b/data/js/cost-centre-node.js deleted file mode 100644 --- a/data/js/cost-centre-node.js +++ /dev/null @@ -1,40 +0,0 @@ -CostCentreNode.prototype = new Node(); -CostCentreNode.prototype.constructor = CostCentreNode; - -function CostCentreNode(prof, selection, sorting, parent, id) { - Node.call(this, prof, selection, sorting, parent, id); -} - -CostCentreNode.prototype.isExpandable = function() { - return true; -}; - -CostCentreNode.prototype.computeChildren = function() { - var _this = this; - - if (_this.expanded && _this.children.length <= 0) { - _this.children.push(new IndividualNode( - _this.prof, _this.selection, _this.sorting, - _this.parent, _this.id)); - - for (var i = 0; i < _this.data.children.length; i++) { - _this.children.push(new CostCentreNode( - _this.prof, _this.selection, _this.sorting, - _this, _this.data.children[i])); - } - } else if (!_this.expanded && _this.children.length > 0) { - _this.children = []; - } - - _this.children.sort(function(a, b) { - return b.getCost() - a.getCost(); - }); -}; - -CostCentreNode.prototype.getTime = function() { - return this.data.info.inheritedTime; -}; - -CostCentreNode.prototype.getAlloc = function() { - return this.data.info.inheritedAlloc; -}; diff --git a/data/js/details.js b/data/js/details.js --- a/data/js/details.js +++ b/data/js/details.js @@ -21,6 +21,7 @@ this.mkElement(); selection.addChangeListener(this); + zoom.addChangeListener(this); } Details.prototype.mkElement = function() { @@ -66,20 +67,12 @@ .append(mk('td').addClass('entries'))); table.append(mk('tr') - .append(mk('td').text('Individual time')) - .append(mk('td').addClass('individualTime'))); - - table.append(mk('tr') - .append(mk('td').text('Individual alloc')) - .append(mk('td').addClass('individualAlloc'))); - - table.append(mk('tr') - .append(mk('td').text('Inherited time')) - .append(mk('td').addClass('inheritedTime'))); + .append(mk('td').text('Time')) + .append(mk('td').addClass('time'))); table.append(mk('tr') - .append(mk('td').text('Inherited alloc')) - .append(mk('td').addClass('inheritedAlloc'))); + .append(mk('td').text('Alloc')) + .append(mk('td').addClass('alloc'))); this.container.append(canonical); this.container.append(controls); @@ -88,11 +81,8 @@ Details.prototype.render = function(node) { var _this = this; - var data = node.data; - var name = data.name; - var info = data.info; - this.container.children('.canonical').text(name.canonical); + this.container.children('.canonical').text(node.getCanonicalName()); var up = this.container.find('.up'); up.off(); @@ -114,12 +104,21 @@ _this.zoom.setZoom(node); }); - this.container.find('.module').text(name.module); - this.container.find('.entries').text(info.entries); - this.container.find('.individualTime').text(info.individualTime); - this.container.find('.individualAlloc').text(info.individualAlloc); - this.container.find('.inheritedTime').text(info.inheritedTime); - this.container.find('.inheritedAlloc').text(info.inheritedAlloc); + var time = node.getTime(); + var alloc = node.getAlloc(); + + var zoom = _this.zoom.getZoom(); + if (zoom.parent && zoom.getTime() > 0) { + time = time * 100 / zoom.getTime(); + } + if (zoom.parent && zoom.getAlloc() > 0) { + alloc = alloc * 100 / zoom.getAlloc(); + } + + this.container.find('.module').text(node.getModuleName()); + this.container.find('.entries').text(node.getEntries()); + this.container.find('.time').text(time); + this.container.find('.alloc').text(alloc); }; Details.prototype.onChange = function() { diff --git a/data/js/individual-node.js b/data/js/individual-node.js deleted file mode 100644 --- a/data/js/individual-node.js +++ /dev/null @@ -1,24 +0,0 @@ -IndividualNode.prototype = new Node(); -IndividualNode.prototype.constructor = IndividualNode; - -function IndividualNode(prof, selection, sorting, parent, id) { - Node.call(this, prof, selection, sorting, parent, id); - - this.id = id + '.individual'; -} - -IndividualNode.prototype.isExpandable = function() { - return false; -}; - -IndividualNode.prototype.getCanonicalName = function() { - return '(indiv)'; -}; - -IndividualNode.prototype.getTime = function() { - return this.data.info.individualTime; -}; - -IndividualNode.prototype.getAlloc = function() { - return this.data.info.individualAlloc; -}; diff --git a/data/js/main.js b/data/js/main.js --- a/data/js/main.js +++ b/data/js/main.js @@ -5,8 +5,7 @@ function main() { var selection = new Selection(); var sorting = new Sorting(); - var root = new CostCentreNode( - $prof, selection, sorting, undefined, $prof.root); + var root = new Node($prof[0], selection, sorting, undefined, $prof[1]); var zoom = new Zoom(root); var tb = new TreeBrowser($('#tree'), zoom); diff --git a/data/js/node.js b/data/js/node.js --- a/data/js/node.js +++ b/data/js/node.js @@ -3,21 +3,31 @@ function Node(prof, selection, sorting, parent, id) { Model.call(this); + var _this = this; - this.prof = prof; - this.sorting = sorting; - this.parent = parent; - this.id = id; - this.data = prof ? prof.nodes[id] : undefined; - this.expanded = false; - this.children = []; - this.selection = selection; + // Set general properties + _this.prof = prof; + _this.sorting = sorting; + _this.parent = parent; + _this.id = id; + _this.expanded = false; + _this.selection = selection; - if (sorting) sorting.addChangeListener(this); + // Set data + var data = prof[id]; + _this.name = data[0]; + _this.module = data[1]; + _this.entries = data[2]; + _this.time = data[3]; + _this.alloc = data[4]; + _this.childIds = data[5]; + _this.children = []; + + if (sorting) sorting.addChangeListener(_this); } Node.prototype.isExpandable = function() { - return false; + return this.childIds.length > 0; }; Node.prototype.toggleExpanded = function() { @@ -25,31 +35,52 @@ }; Node.prototype.computeChildren = function() { - return; + var _this = this; + + if (_this.expanded && _this.children.length <= 0) { + _this.children = []; + for (var i in _this.childIds) { + var childId = _this.childIds[i]; + _this.children.push(new Node( + _this.prof, _this.selection, _this.sorting, + _this, childId)); + } + } else if (!_this.expanded && _this.children.length > 0) { + _this.children = []; + } + + _this.children.sort(function(a, b) { + return b.getCost() - a.getCost(); + }); }; Node.prototype.setExpanded = function(expanded) { var _this = this; - if (_this.expanded === expanded) return; - _this.expanded = expanded; _this.computeChildren(); - _this.triggerChange(); }; Node.prototype.getCanonicalName = function() { - return this.data.name.canonical; + return this.name; }; +Node.prototype.getModuleName = function() { + return this.module; +}; + Node.prototype.getFullName = function() { - return this.data.name.module + '.' + this.getCanonicalName(); + return this.module + '.' + this.name; }; +Node.prototype.getEntries = function() { + return this.entries; +}; + Node.prototype.getColor = function() { var hash = 5381; - var str = this.data.name.module + '.' + this.data.name.canonical; + var str = this.getFullName(); for (var i = 0; i < str.length; i++) { hash = (hash << 5) + hash + str.charCodeAt(i); } @@ -84,11 +115,11 @@ }; Node.prototype.getTime = function() { - return 0; + return this.time; }; Node.prototype.getAlloc = function() { - return 0; + return this.alloc; }; Node.prototype.isSelected = function() { diff --git a/data/js/tree-browser.js b/data/js/tree-browser.js --- a/data/js/tree-browser.js +++ b/data/js/tree-browser.js @@ -88,8 +88,7 @@ _this.container.append(_this.elements[node.id]); _this.renderNode(_this.elements[node.id], node); node.addChangeListener(_this); - } else if ((source instanceof CostCentreNode) || - (source instanceof IndividualNode)) { + } else if (source instanceof Node) { var element = _this.elements[source.id]; if (!element) return; // Invisible source changed what? diff --git a/data/js/tree-map.js b/data/js/tree-map.js --- a/data/js/tree-map.js +++ b/data/js/tree-map.js @@ -240,8 +240,7 @@ _this.rects[node.id] = _this.mkRootRect(); _this.render(); node.addChangeListener(this); - } else if ((source instanceof CostCentreNode) || - (source instanceof IndividualNode)) { + } else if (source instanceof Node) { _this.render(); for (var i = 0; i < source.children.length; i++) { source.children[i].addChangeListener(this); diff --git a/profiteur.cabal b/profiteur.cabal --- a/profiteur.cabal +++ b/profiteur.cabal @@ -1,5 +1,5 @@ Name: profiteur -Version: 0.2.0.2 +Version: 0.3.0.0 Synopsis: Treemap visualiser for GHC prof files Description: Treemap visualiser for GHC prof files Homepage: http://github.com/jaspervdj/profiteur @@ -18,9 +18,7 @@ Data-files: data/css/main.css data/html/body.html - data/js/cost-centre-node.js data/js/details.js - data/js/individual-node.js data/js/main.js data/js/model.js data/js/node.js diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -6,23 +6,21 @@ -------------------------------------------------------------------------------- -import Control.Applicative ((<$>)) -import qualified Data.Aeson as Aeson -import qualified Data.Attoparsec as AP -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as BC8 -import qualified Data.ByteString.Lazy as BL -import Data.Monoid (mappend) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import System.Environment (getArgs, getProgName) -import System.Exit (exitFailure) -import System.FilePath (takeBaseName) -import qualified System.IO as IO +import qualified Data.Aeson as Aeson +import qualified Data.Attoparsec.ByteString as AP +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC8 +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import System.Environment (getArgs, getProgName) +import System.Exit (exitFailure) +import System.FilePath (takeBaseName) +import qualified System.IO as IO -------------------------------------------------------------------------------- -import Paths_profiteur (getDataFileName) +import Paths_profiteur (getDataFileName) import Profiteur.Core import Profiteur.Parser @@ -35,7 +33,7 @@ -------------------------------------------------------------------------------- -writeReport :: String -> Prof -> IO () +writeReport :: String -> NodeMap -> IO () writeReport profFile prof = IO.withBinaryFile htmlFile IO.WriteMode $ \h -> do BC8.hPutStrLn h $ "\n\ @@ -57,8 +55,6 @@ includeJs h "data/js/model.js" includeJs h "data/js/resizing-canvas.js" includeJs h "data/js/node.js" - includeJs h "data/js/individual-node.js" - includeJs h "data/js/cost-centre-node.js" includeJs h "data/js/selection.js" includeJs h "data/js/zoom.js" includeJs h "data/js/details.js" @@ -93,9 +89,10 @@ args <- getArgs case args of [profFile] -> do - profOrErr <- AP.parseOnly parseProf <$> B.readFile profFile + profOrErr <- AP.parseOnly parseFile <$> B.readFile profFile case profOrErr of - Right prof -> writeReport profFile prof + Right prof -> + writeReport profFile $ nodeMapFromCostCentre prof Left err -> do putStrLn $ profFile ++ ": " ++ err exitFailure diff --git a/src/Profiteur/Core.hs b/src/Profiteur/Core.hs --- a/src/Profiteur/Core.hs +++ b/src/Profiteur/Core.hs @@ -1,117 +1,129 @@ -------------------------------------------------------------------------------- -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE RecordWildCards #-} module Profiteur.Core - ( Prof - , mkProf - - , CostCentreMap - , mkCostCentreMap - - , CostCentreNode (..) - , Name (..) - , CostCentreInfo (..) + ( CostCentre (..) + , Node (..) + , nodesFromCostCentre + , NodeMap (..) + , nodeMapFromNodes + , nodeMapFromCostCentre ) where -------------------------------------------------------------------------------- -import Data.Aeson ((.=)) +import Control.Monad (guard) import qualified Data.Aeson as A -import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HMS -import Data.Text (Text) +import Data.List (foldl') +import Data.Maybe (maybeToList) +import Data.Monoid ((<>)) import qualified Data.Text as T -import Data.Vector (Vector) import qualified Data.Vector as V -------------------------------------------------------------------------------- -data Prof = Prof - { pNodes :: !CostCentreMap - , pRoot :: !T.Text - } deriving (Show) - - --------------------------------------------------------------------------------- -instance A.ToJSON Prof where - toJSON p = A.object - [ "nodes" .= pNodes p - , "root" .= pRoot p - ] +type Id = T.Text -------------------------------------------------------------------------------- -mkProf :: CostCentreNode -> Prof -mkProf ccn = Prof - { pNodes = mkCostCentreMap ccn - , pRoot = ccnId ccn - } +data CostCentre = CostCentre + { ccName :: !T.Text + , ccModule :: !T.Text + , ccId :: !Id + , ccEntries :: !Int + , ccIndividualTime :: !Double + , ccIndividualAlloc :: !Double + , ccInheritedTime :: !Double + , ccInheritedAlloc :: !Double + , ccChildren :: !(V.Vector CostCentre) + } deriving (Show) -------------------------------------------------------------------------------- -type CostCentreMap = HashMap Text CostCentreNode +data Node = Node + { nId :: !Id + , nName :: !T.Text + , nModule :: !T.Text + , nEntries :: !Int + , nTime :: !Double + , nAlloc :: !Double + , nChildren :: !(V.Vector Id) + } deriving (Show) -------------------------------------------------------------------------------- -mkCostCentreMap :: CostCentreNode -> CostCentreMap -mkCostCentreMap = go HMS.empty +nodesFromCostCentre :: CostCentre -> [Node] +nodesFromCostCentre cc + | V.null (ccChildren cc), Just indiv' <- indiv = + [ indiv' {nId = nId self, nName = nName self} + ] + | otherwise = + self : maybeToList indiv ++ + concatMap nodesFromCostCentre (V.toList $ ccChildren cc) where - go :: CostCentreMap -> CostCentreNode -> CostCentreMap - go ccm !ccn = - HMS.insert (ccnId ccn) ccn $ - V.foldl' go ccm (ccnChildren ccn) - + self = Node + { nId = ccId cc + , nName = ccName cc + , nModule = ccModule cc + , nEntries = ccEntries cc + , nTime = ccInheritedTime cc + , nAlloc = ccInheritedAlloc cc + , nChildren = V.fromList $ + maybeToList (nId <$> indiv) ++ map ccId (V.toList $ ccChildren cc) + } --------------------------------------------------------------------------------- -data CostCentreNode = CostCentreNode - { ccnName :: !Name - , ccnId :: !T.Text - , ccnInfo :: !CostCentreInfo - , ccnChildren :: !(Vector CostCentreNode) - } deriving (Show) + indiv = do + guard $ ccIndividualTime cc > 0 || ccIndividualAlloc cc > 0 + return Node + { nId = nId self <> ".indiv" + , nName = ccName cc <> " (indiv)" + , nModule = ccModule cc + , nEntries = ccEntries cc + , nTime = ccIndividualTime cc + , nAlloc = ccIndividualAlloc cc + , nChildren = V.empty + } -------------------------------------------------------------------------------- -instance A.ToJSON CostCentreNode where - toJSON ccn = A.object - [ "name" .= ccnName ccn - , "id" .= ccnId ccn - , "info" .= ccnInfo ccn - , "children" .= V.map ccnId (ccnChildren ccn) +instance A.ToJSON Node where + toJSON Node {..} = A.toJSON + [ A.toJSON nName + , A.toJSON nModule + , A.toJSON nEntries + , A.toJSON nTime + , A.toJSON nAlloc + , A.toJSON nChildren ] -------------------------------------------------------------------------------- -data Name = Name - { nCanonical :: !Text - , nModule :: !Text - } deriving (Show, Eq) +data NodeMap = NodeMap + { nmNodes :: !(HMS.HashMap Id Node) + , nmRoot :: !Id + } deriving (Show) -------------------------------------------------------------------------------- -instance A.ToJSON Name where - toJSON n = A.object - [ "canonical" .= nCanonical n - , "module" .= nModule n +instance A.ToJSON NodeMap where + toJSON NodeMap {..} = A.toJSON + [ A.toJSON nmNodes + , A.toJSON nmRoot ] -------------------------------------------------------------------------------- -data CostCentreInfo = CostCentreInfo - { cciEntries :: !Int - , cciIndividualTime :: !Double - , cciIndividualAlloc :: !Double - , cciInheritedTime :: !Double - , cciInheritedAlloc :: !Double - } deriving (Show) +nodeMapFromNodes :: Id -> [Node] -> NodeMap +nodeMapFromNodes root nodes = NodeMap + { nmNodes = foldl' (\acc n -> HMS.insert (nId n) n acc) HMS.empty nodes + , nmRoot = root + } -------------------------------------------------------------------------------- -instance A.ToJSON CostCentreInfo where - toJSON cci = A.object - [ "entries" .= cciEntries cci - , "individualTime" .= cciIndividualTime cci - , "individualAlloc" .= cciIndividualAlloc cci - , "inheritedTime" .= cciInheritedTime cci - , "inheritedAlloc" .= cciInheritedAlloc cci - ] +nodeMapFromCostCentre :: CostCentre -> NodeMap +nodeMapFromCostCentre root = + nodeMapFromNodes (ccId root) (nodesFromCostCentre root) diff --git a/src/Profiteur/Parser.hs b/src/Profiteur/Parser.hs --- a/src/Profiteur/Parser.hs +++ b/src/Profiteur/Parser.hs @@ -1,12 +1,11 @@ -------------------------------------------------------------------------------- {-# LANGUAGE OverloadedStrings #-} module Profiteur.Parser - ( parseProf + ( parseFile ) where -------------------------------------------------------------------------------- -import Control.Applicative ((<$>)) import Control.Monad (replicateM_) import Data.Attoparsec.ByteString as AP import Data.Attoparsec.ByteString.Char8 as AP8 @@ -21,19 +20,19 @@ -------------------------------------------------------------------------------- -parseProf :: AP.Parser Prof -parseProf = fmap mkProf $ do +parseFile :: AP.Parser CostCentre +parseFile = do -- Hacky stuff. _ <- AP.manyTill AP8.anyChar (AP.try $ AP8.string "COST CENTRE") _ <- AP.manyTill AP8.anyChar (AP.try $ AP8.string "COST CENTRE") _ <- AP.skipWhile (not . AP8.isEndOfLine) _ <- AP8.skipSpace - parseContCentreNode 0 + paresCostCentre 0 -------------------------------------------------------------------------------- -parseContCentreNode :: Int -> AP.Parser CostCentreNode -parseContCentreNode indent = do +paresCostCentre :: Int -> AP.Parser CostCentre +paresCostCentre indent = do replicateM_ indent $ AP8.char8 ' ' canonical <- identifier skipHorizontalSpace @@ -53,22 +52,18 @@ inheritedAlloc <- AP8.double skipToEol - children <- AP.many' $ parseContCentreNode (indent + 1) + children <- AP.many' $ paresCostCentre (indent + 1) - return CostCentreNode - { ccnName = Name - { nCanonical = canonical - , nModule = module' - } - , ccnId = id' - , ccnInfo = CostCentreInfo - { cciEntries = entries - , cciIndividualTime = individualTime - , cciIndividualAlloc = individualAlloc - , cciInheritedTime = inheritedTime - , cciInheritedAlloc = inheritedAlloc - } - , ccnChildren = V.fromList children + return CostCentre + { ccName = canonical + , ccModule = module' + , ccId = id' + , ccEntries = entries + , ccIndividualTime = individualTime + , ccIndividualAlloc = individualAlloc + , ccInheritedTime = inheritedTime + , ccInheritedAlloc = inheritedAlloc + , ccChildren = V.fromList children }