module Criterion.Report
(
formatReport
, report
, tidyTails
, TemplateException(..)
, loadTemplate
, includeFile
, getTemplateDir
, vector
, vector2
) where
import Control.Exception (Exception, IOException, throwIO)
import Control.Monad (mplus)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Reader (ask)
import Criterion.Monad (Criterion)
import Criterion.Types
import Data.Aeson.Encode (encodeToTextBuilder)
import Data.Aeson.Types (toJSON)
import Data.Data (Data, Typeable)
import Data.Foldable (forM_)
import GHC.Generics (Generic)
import Paths_criterion (getDataFileName)
import Statistics.Function (minMax)
import System.Directory (doesFileExist)
import System.FilePath ((</>), (<.>), isPathSeparator)
import Text.Hastache (MuType(..))
import Text.Hastache.Context (mkGenericContext, mkStrContext, mkStrContextM)
import qualified Control.Exception as E
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TL
import qualified Data.Text.Lazy.IO as TL
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Unboxed as U
import qualified Language.Javascript.Flot as Flot
import qualified Language.Javascript.JQuery as JQuery
import qualified Text.Hastache as H
tidyTails :: KDE -> KDE
tidyTails KDE{..} = KDE { kdeType = kdeType
, kdeValues = G.slice front winSize kdeValues
, kdePDF = G.slice front winSize kdePDF
}
where tiny = uncurry subtract (minMax kdePDF) * 0.005
omitTiny = G.length . G.takeWhile ((<= tiny) . abs)
front = omitTiny kdePDF
back = omitTiny . G.reverse $ kdePDF
winSize = G.length kdePDF front back
getTemplateDir :: IO FilePath
getTemplateDir = getDataFileName "templates"
report :: [Report] -> Criterion ()
report reports = do
Config{..} <- ask
forM_ reportFile $ \name -> liftIO $ do
td <- getTemplateDir
tpl <- loadTemplate [td,"."] template
TL.writeFile name =<< formatReport reports tpl
formatReport :: [Report]
-> T.Text
-> IO TL.Text
formatReport reports template = do
templates <- getTemplateDir
let context "report" = return $ MuList $ map inner reports
context "json" = return $ MuVariable (encode reports)
context "include" = return $ MuLambdaM $ includeFile [templates]
context "js-jquery" = fmap MuVariable $ TL.readFile =<< JQuery.file
context "js-flot" = fmap MuVariable $ TL.readFile =<< Flot.file Flot.Flot
context _ = return $ MuNothing
encode v = TL.toLazyText . encodeToTextBuilder . toJSON $ v
inner r@Report{..} = mkStrContextM $ \nym ->
case nym of
"name" -> return . MuVariable . H.htmlEscape .
TL.pack $ reportName
"json" -> return $ MuVariable (encode r)
"number" -> return $ MuVariable reportNumber
"iters" -> return $ vector "x" iters
"times" -> return $ vector "x" times
"cycles" -> return $ vector "x" cycles
"kdetimes" -> return $ vector "x" kdeValues
"kdepdf" -> return $ vector "x" kdePDF
"kde" -> return $ vector2 "time" "pdf" kdeValues kdePDF
('a':'n':_)-> mkGenericContext reportAnalysis $
H.encodeStr nym
_ -> mkGenericContext reportOutliers $
H.encodeStr nym
where [KDE{..}] = reportKDEs
iters = measure measIters reportMeasured
times = measure measTime reportMeasured
cycles = measure measCycles reportMeasured
config = H.defaultConfig {
H.muEscapeFunc = H.emptyEscape
, H.muTemplateFileDir = Just templates
, H.muTemplateFileExt = Just ".tpl"
}
H.hastacheStr config template context
vector :: (Monad m, G.Vector v a, H.MuVar a) =>
String
-> v a
-> MuType m
vector name v = MuList . map val . G.toList $ v
where val i = mkStrContext $ \nym ->
if nym == name
then MuVariable i
else MuNothing
vector2 :: (Monad m, G.Vector v a, G.Vector v b, H.MuVar a, H.MuVar b) =>
String
-> String
-> v a
-> v b
-> MuType m
vector2 name1 name2 v1 v2 = MuList $ zipWith val (G.toList v1) (G.toList v2)
where val i j = mkStrContext $ \nym ->
case undefined of
_| nym == name1 -> MuVariable i
| nym == name2 -> MuVariable j
| otherwise -> MuNothing
includeFile :: (MonadIO m) =>
[FilePath]
-> T.Text
-> m T.Text
includeFile searchPath name = liftIO $ foldr go (return T.empty) searchPath
where go dir next = do
let path = dir </> H.decodeStr name
T.readFile path `E.catch` \(_::IOException) -> next
data TemplateException =
TemplateNotFound FilePath
deriving (Eq, Read, Show, Typeable, Data, Generic)
instance Exception TemplateException
loadTemplate :: [FilePath]
-> FilePath
-> IO T.Text
loadTemplate paths name
| any isPathSeparator name = T.readFile name
| otherwise = go Nothing paths
where go me (p:ps) = do
let cur = p </> name <.> "tpl"
x <- doesFileExist cur
if x
then T.readFile cur `E.catch` \e -> go (me `mplus` Just e) ps
else go me ps
go (Just e) _ = throwIO (e::IOException)
go _ _ = throwIO . TemplateNotFound $ name