diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +- 0.4.4.0 + * Add a flag to embed the datafiles (by Nikolay Yakimov) + * Allow passing in an output path (by Nikolay Yakimov) + * Use HSL instead of RGB for random color generation (by David + Luposchainsky) + - 0.4.3.0 * Add `--version` flag * Bump `aeson` dependency to 1.2 diff --git a/data/js/node.js b/data/js/node.js --- a/data/js/node.js +++ b/data/js/node.js @@ -85,29 +85,10 @@ hash = (hash << 5) + hash + str.charCodeAt(i); } - hash = hash % 0xffffff; - var r = (hash & 0xff0000) >> 16; - var g = (hash & 0x00ff00) >> 8; - var b = (hash & 0x0000ff); - - r = (r) / 2; - g = (g) / 2; - b = (b) / 2; - - function hex2(x) { - var str = x.toString(16); - if (str.length < 2) { - for (var i = 0; i < 2 - str.length; i++) { - str = '0' + str; - } - } - return str; - } - - return '#' + - hex2(Math.round(r)) + - hex2(Math.round(g)) + - hex2(Math.round(b)); + var h = hash % 360; + var s = "100%"; + var l = "40%"; + return 'hsl(' + h + ', ' + s + ', ' + l + ')'; }; Node.prototype.getCost = function() { 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 @@ -219,6 +219,8 @@ // Fill entire area context.fillStyle = node.getColor(); context.fillRect(rect.x, rect.y, rect.w, rect.h); + context.strokeStyle = 'black'; + context.strokeRect(rect.x, rect.y, rect.w, rect.h); // Draw children on top. if (node.children.length > 0) { diff --git a/profiteur.cabal b/profiteur.cabal --- a/profiteur.cabal +++ b/profiteur.cabal @@ -1,5 +1,5 @@ Name: profiteur -Version: 0.4.3.0 +Version: 0.4.4.0 Synopsis: Treemap visualiser for GHC prof files Description: Treemap visualiser for GHC prof files Homepage: http://github.com/jaspervdj/profiteur @@ -8,7 +8,7 @@ Author: Jasper Van der Jeugt Maintainer: Jasper Van der Jeugt Copyright: 2014 Jasper Van der Jeugt -Category: Development +Category: Development, Profiling Build-type: Simple Cabal-version: >= 1.8 @@ -31,6 +31,11 @@ data/js/unicode.js data/js/zoom.js +Flag embed-data-files + description: Embed data files into the executable (needed for ghcjs packaging) + default: False + manual: True + Source-repository head Type: git Location: git://github.com/jaspervdj/profiteur.git @@ -43,6 +48,9 @@ Other-modules: Profiteur.Core Profiteur.Parser + Profiteur.DataFile + Profiteur.DataFile.Internal + Paths_profiteur Build-depends: aeson >= 0.6 && < 1.3, @@ -56,3 +64,10 @@ text >= 0.11 && < 1.3, unordered-containers >= 0.2 && < 0.3, vector >= 0.10 && < 0.13 + + if flag(embed-data-files) + Build-depends: file-embed >= 0.0.10 && < 0.0.11, + template-haskell >= 2.11 && < 2.12 + Hs-source-dirs: src/embed + else + Hs-source-dirs: src/noembed diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -13,7 +13,6 @@ import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy.IO as TL import Data.Version (showVersion) -import qualified Language.Javascript.JQuery as JQuery import System.Environment (getArgs, getProgName) import System.Exit (exitFailure) import System.FilePath (takeBaseName) @@ -21,20 +20,15 @@ -------------------------------------------------------------------------------- -import Paths_profiteur (getDataFileName, version) +import Paths_profiteur (version) import Profiteur.Core import Profiteur.Parser - - --------------------------------------------------------------------------------- -includeFile :: IO.Handle -> FilePath -> IO () -includeFile h filePath = - BL.hPutStr h =<< BL.readFile filePath +import Profiteur.DataFile -------------------------------------------------------------------------------- -writeReport :: String -> NodeMap -> IO () -writeReport profFile prof = IO.withBinaryFile htmlFile IO.WriteMode $ \h -> do +writeReport :: IO.Handle -> String -> NodeMap -> IO () +writeReport h profFile prof = do BC8.hPutStrLn h $ "\n\ \\n\ @@ -47,57 +41,70 @@ BC8.hPutStrLn h ";" BC8.hPutStrLn h "" - includeJs h =<< JQuery.file - includeJs h =<< getDataFileName "data/js/unicode.js" - includeJs h =<< getDataFileName "data/js/model.js" - includeJs h =<< getDataFileName "data/js/resizing-canvas.js" - includeJs h =<< getDataFileName "data/js/node.js" - includeJs h =<< getDataFileName "data/js/selection.js" - includeJs h =<< getDataFileName "data/js/zoom.js" - includeJs h =<< getDataFileName "data/js/details.js" - includeJs h =<< getDataFileName "data/js/sorting.js" - includeJs h =<< getDataFileName "data/js/tree-map.js" - includeJs h =<< getDataFileName "data/js/tree-browser.js" - includeJs h =<< getDataFileName "data/js/main.js" + includeJs JQueryFile + includeJs "data/js/unicode.js" + includeJs "data/js/model.js" + includeJs "data/js/resizing-canvas.js" + includeJs "data/js/node.js" + includeJs "data/js/selection.js" + includeJs "data/js/zoom.js" + includeJs "data/js/details.js" + includeJs "data/js/sorting.js" + includeJs "data/js/tree-map.js" + includeJs "data/js/tree-browser.js" + includeJs "data/js/main.js" BC8.hPutStrLn h " \n\ \ " - includeFile h =<< getDataFileName "data/html/body.html" + includeFile h "data/html/body.html" BC8.hPutStrLn h " \ \" - - putStrLn $ "Wrote " ++ htmlFile where - htmlFile = profFile ++ ".html" title = T.pack $ takeBaseName profFile - includeJs h file = do + includeJs file = do BC8.hPutStrLn h "" +-------------------------------------------------------------------------------- +makeReport :: IO.Handle -> FilePath -> IO () +makeReport h profFile = do + profOrErr <- decode <$> TL.readFile profFile + case profOrErr of + Right prof -> + writeReport h profFile $ nodeMapFromCostCentre prof + Left err -> do + putStrLnErr $ profFile ++ ": " ++ err + exitFailure -------------------------------------------------------------------------------- +putStrLnErr :: String -> IO () +putStrLnErr = IO.hPutStrLn IO.stderr + +-------------------------------------------------------------------------------- main :: IO () main = do progName <- getProgName args <- getArgs case args of _ | "--version" `elem` args -> - putStrLn (showVersion version) - [profFile] -> do - profOrErr <- decode <$> TL.readFile profFile - case profOrErr of - Right prof -> - writeReport profFile $ nodeMapFromCostCentre prof - Left err -> do - putStrLn $ profFile ++ ": " ++ err - exitFailure + putStrLnErr (showVersion version) + [profFile] -> + let htmlFile = profFile ++ ".html" + in IO.withBinaryFile htmlFile IO.WriteMode $ \h -> + makeReport h profFile + [profFile, "-"] -> + makeReport IO.stdout profFile + [profFile, htmlFile] -> + IO.withBinaryFile htmlFile IO.WriteMode $ \h -> + makeReport h profFile _ -> do - putStrLn $ "Usage: " ++ progName ++ " " + putStrLnErr $ "Usage: " ++ progName ++ " []" + putStrLnErr " \"-\" means STDOUT" exitFailure diff --git a/src/Profiteur/DataFile/Internal.hs b/src/Profiteur/DataFile/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Profiteur/DataFile/Internal.hs @@ -0,0 +1,8 @@ +module Profiteur.DataFile.Internal where + +import Data.String + +data DataType = JQueryFile | DataFile FilePath deriving (Show) + +instance IsString DataType where + fromString = DataFile diff --git a/src/embed/Profiteur/DataFile.hs b/src/embed/Profiteur/DataFile.hs new file mode 100644 --- /dev/null +++ b/src/embed/Profiteur/DataFile.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE TemplateHaskell #-} +module Profiteur.DataFile ( + includeFile, + module Profiteur.DataFile.Internal + ) where + +import Profiteur.DataFile.Internal +import System.IO (Handle) +import qualified Data.ByteString as B +import Data.FileEmbed +import Control.Arrow +import qualified Language.Javascript.JQuery as JQuery +import Language.Haskell.TH (runIO) +import Data.Maybe + +includeFile :: Handle -> DataType -> IO () +includeFile h filePath = B.hPutStr h $ data' filePath + where + data' JQueryFile = $(embedFile =<< runIO JQuery.file) + data' (DataFile fp) = + fromMaybe (error $ "No such datafile: " ++ fp) $ lookup fp dataDirContents + dataDirContents = map (first ("data/" ++)) $(embedDir "data") diff --git a/src/noembed/Profiteur/DataFile.hs b/src/noembed/Profiteur/DataFile.hs new file mode 100644 --- /dev/null +++ b/src/noembed/Profiteur/DataFile.hs @@ -0,0 +1,16 @@ +module Profiteur.DataFile ( + includeFile, + module Profiteur.DataFile.Internal + ) where + +import Paths_profiteur (getDataFileName) +import System.IO (Handle) +import qualified Data.ByteString.Lazy as BL +import qualified Language.Javascript.JQuery as JQuery +import Profiteur.DataFile.Internal + +includeFile :: Handle -> DataType -> IO () +includeFile h JQueryFile = + BL.hPutStr h =<< BL.readFile =<< JQuery.file +includeFile h (DataFile filePath) = + BL.hPutStr h =<< BL.readFile =<< getDataFileName filePath