module Criterion.Report
(
Report(..)
, formatReport
, report
, TemplateException(..)
, loadTemplate
, includeFile
, templateDir
, vector
, vector2
) where
import Control.Exception (Exception, IOException, throwIO)
import Control.Monad (mplus)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Criterion.Analysis (Outliers(..), SampleAnalysis(..))
import Criterion.Config (cfgReport, cfgTemplate, fromLJ)
import Criterion.Monad (Criterion, getConfig)
import Data.Data (Data, Typeable)
import Data.Monoid (Last(..))
import Paths_criterion (getDataFileName)
import Statistics.Sample.KernelDensity (kde)
import Statistics.Types (Sample)
import System.Directory (doesFileExist)
import System.FilePath ((</>), isPathSeparator)
import System.IO.Unsafe (unsafePerformIO)
import Text.Hastache (MuType(..))
import Text.Hastache.Context (mkGenericContext, mkStrContext, mkStrContextM)
import qualified Control.Exception as E
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as L
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Unboxed as U
import qualified Text.Hastache as H
data Report = Report {
reportNumber :: Int
, reportName :: String
, reportTimes :: Sample
, reportAnalysis :: SampleAnalysis
, reportOutliers :: Outliers
} deriving (Eq, Show, Typeable, Data)
templateDir :: FilePath
templateDir = unsafePerformIO $ getDataFileName "templates"
report :: [Report] -> Criterion ()
report reports = do
cfg <- getConfig
case cfgReport cfg of
Last Nothing -> return ()
Last (Just name) -> liftIO $ do
tpl <- loadTemplate [".",templateDir] (fromLJ cfgTemplate cfg)
L.writeFile name =<< formatReport reports tpl
formatReport :: [Report]
-> B.ByteString
-> IO L.ByteString
formatReport reports template = do
let context "report" = return $ MuList $ map inner reports
context "include" = return $ MuLambdaM $ includeFile [templateDir]
context _ = return $ MuNothing
inner Report{..} = mkStrContextM $ \nym ->
case nym of
"name" -> return $ MuVariable reportName
"number" -> return $ MuVariable reportNumber
"times" -> return $ vector "x" reportTimes
"kdetimes" -> return $ vector "x" kdeTimes
"kdepdf" -> return $ vector "x" kdePDF
"kde" -> return $ vector2 "time" "pdf" kdeTimes kdePDF
('a':'n':_)-> mkGenericContext reportAnalysis $
H.encodeStr nym
_ -> mkGenericContext reportOutliers $
H.encodeStr nym
where (kdeTimes,kdePDF) = kde 128 reportTimes
H.hastacheStr H.defaultConfig 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]
-> B.ByteString
-> m B.ByteString
includeFile searchPath name = liftIO $ foldr go (return B.empty) searchPath
where go dir next = do
let path = dir </> H.decodeStr name
B.readFile path `E.catch` \(_::IOException) -> next
data TemplateException =
TemplateNotFound FilePath
deriving (Eq, Show, Typeable, Data)
instance Exception TemplateException
loadTemplate :: [FilePath]
-> FilePath
-> IO B.ByteString
loadTemplate paths name
| any isPathSeparator name = B.readFile name
| otherwise = go Nothing paths
where go me (p:ps) = do
let cur = p </> name
x <- doesFileExist cur
if x
then B.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