diff --git a/Criterion/EmbeddedData.hs b/Criterion/EmbeddedData.hs
new file mode 100644
--- /dev/null
+++ b/Criterion/EmbeddedData.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- |
+-- Module : Criterion.EmbeddedData
+-- Copyright : (c) 2017 Ryan Scott
+--
+-- License : BSD-style
+-- Maintainer : bos@serpentine.com
+-- Stability : experimental
+-- Portability : GHC
+--
+-- When the @embed-data-files@ @Cabal@ flag is enabled, this module exports
+-- the contents of various files (the @data-files@ from @criterion.cabal@, as
+-- well as minimized versions of jQuery and Flot) embedded as 'ByteString's.
+module Criterion.EmbeddedData (dataFiles, jQueryContents, flotContents) where
+
+import Data.ByteString (ByteString)
+import Data.FileEmbed (embedDir, embedFile)
+import Language.Haskell.TH.Syntax (runIO)
+import qualified Language.Javascript.Flot as Flot
+import qualified Language.Javascript.JQuery as JQuery
+
+dataFiles :: [(FilePath, ByteString)]
+dataFiles = $(embedDir "templates")
+
+jQueryContents, flotContents :: ByteString
+jQueryContents = $(embedFile =<< runIO JQuery.file)
+flotContents = $(embedFile =<< runIO (Flot.file Flot.Flot))
diff --git a/Criterion/Report.hs b/Criterion/Report.hs
--- a/Criterion/Report.hs
+++ b/Criterion/Report.hs
@@ -1,6 +1,10 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, OverloadedStrings,
- RecordWildCards, ScopedTypeVariables #-}
-- |
-- Module : Criterion.Report
@@ -56,8 +60,15 @@
import qualified Data.Text.Lazy.IO as TL
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Unboxed as U
+
+#if defined(EMBED)
+import Criterion.EmbeddedData (dataFiles, flotContents, jQueryContents)
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Text.Encoding as TE
+#else
import qualified Language.Javascript.Flot as Flot
import qualified Language.Javascript.JQuery as JQuery
+#endif
-- | Trim long flat tails from a KDE plot.
tidyTails :: KDE -> KDE
@@ -73,8 +84,15 @@
-- | Return the path to the template and other files used for
-- generating reports.
+--
+-- When the @-fembed-data-files@ @Cabal@ flag is enabled, this simply
+-- returns the empty path.
getTemplateDir :: IO FilePath
+#if defined(EMBED)
+getTemplateDir = pure ""
+#else
getTemplateDir = getDataFileName "templates"
+#endif
-- | Write out a series of 'Report' values to a single file, if
-- configured to do so.
@@ -95,18 +113,22 @@
Left err -> fail (show err) -- TODO: throw a template exception?
Right x -> return x
- jQuery <- T.readFile =<< JQuery.file
- flot <- T.readFile =<< Flot.file Flot.Flot
+ jQuery <- jQueryFileContents
+ flot <- flotFileContents
+ jQueryCriterionJS <- readDataFile ("js" "jquery.criterion.js")
+ criterionCSS <- readDataFile "criterion.css"
-- includes, only top level
templates <- getTemplateDir
template <- includeTemplate (includeFile [templates]) template0
let context = object
- [ "json" .= reports
- , "report" .= map inner reports
- , "js-jquery" .= jQuery
- , "js-flot" .= flot
+ [ "json" .= reports
+ , "report" .= map inner reports
+ , "js-jquery" .= jQuery
+ , "js-flot" .= flot
+ , "jquery-criterion-js" .= jQueryCriterionJS
+ , "criterion-css" .= criterionCSS
]
let (warnings, formatted) = renderMustacheW template context
@@ -129,6 +151,25 @@
]
return formatted
where
+ jQueryFileContents, flotFileContents :: IO T.Text
+#if defined(EMBED)
+ jQueryFileContents = pure $ TE.decodeUtf8 jQueryContents
+ flotFileContents = pure $ TE.decodeUtf8 flotContents
+#else
+ jQueryFileContents = T.readFile =<< JQuery.file
+ flotFileContents = T.readFile =<< Flot.file Flot.Flot
+#endif
+
+ readDataFile :: FilePath -> IO T.Text
+ readDataFile fp =
+ (T.readFile =<< getDataFileName ("templates" fp))
+#if defined(EMBED)
+ `E.catch` \(e :: IOException) ->
+ maybe (throwIO e)
+ (pure . TE.decodeUtf8)
+ (lookup fp dataFiles)
+#endif
+
includeTemplate :: (FilePath -> IO T.Text) -> Template -> IO Template
includeTemplate f Template {..} = fmap
(Template templateActual)
@@ -240,19 +281,42 @@
-- If the name is an absolute or relative path, the search path is
-- /not/ used, and the name is treated as a literal path.
--
+-- If the @-fembed-data-files@ @Cabal@ flag is enabled, this also checks
+-- the embedded @data-files@ from @criterion.cabal@.
+--
-- This function throws a 'TemplateException' if the template could
-- not be found, or an 'IOException' if no template could be loaded.
loadTemplate :: [FilePath] -- ^ Search path.
-> FilePath -- ^ Name of template file.
-> IO TL.Text
loadTemplate paths name
- | any isPathSeparator name = TL.readFile name
+ | any isPathSeparator name = readFileCheckEmbedded name
| otherwise = go Nothing paths
where go me (p:ps) = do
let cur = p name <.> "tpl"
- x <- doesFileExist cur
+ x <- doesFileExist' cur
if x
- then TL.readFile cur `E.catch` \e -> go (me `mplus` Just e) ps
+ then readFileCheckEmbedded cur `E.catch` \e -> go (me `mplus` Just e) ps
else go me ps
go (Just e) _ = throwIO (e::IOException)
go _ _ = throwIO . TemplateNotFound $ name
+
+ doesFileExist' :: FilePath -> IO Bool
+ doesFileExist' fp = do
+ e <- doesFileExist fp
+ pure $ e
+#if defined(EMBED)
+ || (fp `elem` map fst dataFiles)
+#endif
+
+-- A version of 'readFile' that falls back on the embedded 'dataFiles'
+-- from @criterion.cabal@.
+readFileCheckEmbedded :: FilePath -> IO TL.Text
+readFileCheckEmbedded fp =
+ TL.readFile fp
+#if defined(EMBED)
+ `E.catch` \(e :: IOException) ->
+ maybe (throwIO e)
+ (pure . TLE.decodeUtf8 . BL.fromStrict)
+ (lookup fp dataFiles)
+#endif
diff --git a/changelog.md b/changelog.md
--- a/changelog.md
+++ b/changelog.md
@@ -1,10 +1,17 @@
+1.2.5.0
+
+* Add an `-fembed-data-files` flag. Enabling this option will embed the
+ `data-files` from `criterion.cabal` directly into the binary, producing
+ a relocatable executable. (This has the downside of increasing the binary
+ size significantly, so be warned.)
+
1.2.4.0
-* Fix issue where `--help` would display duplicate options
+* Fix issue where `--help` would display duplicate options.
1.2.3.0
-* Add a `Semigroup` instance for `Outliers`
+* Add a `Semigroup` instance for `Outliers`.
* Improve the error messages that are thrown when forcing nonexistent
benchmark environments.
diff --git a/criterion.cabal b/criterion.cabal
--- a/criterion.cabal
+++ b/criterion.cabal
@@ -1,5 +1,5 @@
name: criterion
-version: 1.2.4.0
+version: 1.2.5.0
synopsis: Robust, reliable performance measurement and analysis
license: BSD3
license-file: LICENSE
@@ -49,6 +49,12 @@
default: False
manual: True
+flag embed-data-files
+ description: Embed the data files in the binary for a relocatable executable.
+ (Warning: This will increase the executable size significantly.)
+ default: False
+ manual: True
+
library
exposed-modules:
Criterion
@@ -122,6 +128,12 @@
ghc-options: -O0
else
ghc-options: -O2
+
+ if flag(embed-data-files)
+ other-modules: Criterion.EmbeddedData
+ build-depends: file-embed < 0.1,
+ template-haskell
+ cpp-options: "-DEMBED"
Executable criterion-report
Default-Language: Haskell2010
diff --git a/templates/default.tpl b/templates/default.tpl
--- a/templates/default.tpl
+++ b/templates/default.tpl
@@ -10,10 +10,10 @@
{{{js-flot}}}