profiteur 0.2.0.2 → 0.3.0.0
raw patch · 12 files changed
+201/−232 lines, 12 filesdep ~base
Dependency ranges changed: base
Files
- CHANGELOG +5/−1
- data/js/cost-centre-node.js +0/−40
- data/js/details.js +21/−22
- data/js/individual-node.js +0/−24
- data/js/main.js +1/−2
- data/js/node.js +50/−19
- data/js/tree-browser.js +1/−2
- data/js/tree-map.js +1/−2
- profiteur.cabal +1/−3
- src/Main.hs +16/−19
- src/Profiteur/Core.hs +88/−76
- src/Profiteur/Parser.hs +17/−22
CHANGELOG view
@@ -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
− data/js/cost-centre-node.js
@@ -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;-};
data/js/details.js view
@@ -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() {
− data/js/individual-node.js
@@ -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;-};
data/js/main.js view
@@ -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);
data/js/node.js view
@@ -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() {
data/js/tree-browser.js view
@@ -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?
data/js/tree-map.js view
@@ -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);
profiteur.cabal view
@@ -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
src/Main.hs view
@@ -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 $ "<!DOCTYPE html>\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
src/Profiteur/Core.hs view
@@ -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)
src/Profiteur/Parser.hs view
@@ -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 }