{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}

-- |
-- Module      : Criterion.Report
-- Copyright   : (c) 2009-2014 Bryan O'Sullivan
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- Reporting functions.

module Criterion.Report
    (
      formatReport
    , report
    , tidyTails
    -- * Rendering helper functions
    , TemplateException(..)
    , loadTemplate
    , includeFile
    , getTemplateDir
    , vector
    , vector2
    ) where

import Control.Exception (Exception, IOException, throwIO)
import Control.Monad (mplus, unless)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Reader (ask)
import Criterion.Monad (Criterion)
import Criterion.Types
import Data.Aeson (ToJSON (..), Value(..), object, (.=), Value, encode)
import Data.Data (Data, Typeable)
import Data.Foldable (forM_)
import GHC.Generics (Generic)
import Paths_criterion (getDataFileName)
import Statistics.Function (minMax)
import Statistics.Types (confidenceInterval, confidenceLevel, confIntCL, estError)
import System.Directory (doesFileExist)
import System.FilePath ((</>), (<.>), isPathSeparator)
import System.IO (hPutStrLn, stderr)
import Text.Microstache (Key (..), MustacheWarning (..), Node (..), Template (..),
                         compileMustacheText, displayMustacheWarning, renderMustacheW)
import Prelude ()
import Prelude.Compat
import qualified Control.Exception as E
import qualified Data.Text as T
import qualified Data.Text.Lazy.Encoding as TLE
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy as TL
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, jQueryContents, flotContents,
                               flotErrorbarsContents, flotNavigateContents)
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
tidyTails :: KDE -> KDE
tidyTails KDE{..} = KDE :: String -> Vector Double -> Vector Double -> KDE
KDE { kdeType :: String
kdeType   = String
kdeType
                        , kdeValues :: Vector Double
kdeValues = Int -> Int -> Vector Double -> Vector Double
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
G.slice Int
front Int
winSize Vector Double
kdeValues
                        , kdePDF :: Vector Double
kdePDF    = Int -> Int -> Vector Double -> Vector Double
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
G.slice Int
front Int
winSize Vector Double
kdePDF
                        }
  where tiny :: Double
tiny     = (Double -> Double -> Double) -> (Double, Double) -> Double
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Double -> Double
forall a. Num a => a -> a -> a
subtract (Vector Double -> (Double, Double)
forall (v :: * -> *).
Vector v Double =>
v Double -> (Double, Double)
minMax Vector Double
kdePDF) Double -> Double -> Double
forall a. Num a => a -> a -> a
* 0.005
        omitTiny :: Vector Double -> Int
omitTiny = Vector Double -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.length (Vector Double -> Int)
-> (Vector Double -> Vector Double) -> Vector Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Bool) -> Vector Double -> Vector Double
forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> v a
G.takeWhile ((Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
tiny) (Double -> Bool) -> (Double -> Double) -> Double -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Num a => a -> a
abs)
        front :: Int
front    = Vector Double -> Int
omitTiny Vector Double
kdePDF
        back :: Int
back     = Vector Double -> Int
omitTiny (Vector Double -> Int)
-> (Vector Double -> Vector Double) -> Vector Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Double -> Vector Double
forall (v :: * -> *) a. Vector v a => v a -> v a
G.reverse (Vector Double -> Int) -> Vector Double -> Int
forall a b. (a -> b) -> a -> b
$ Vector Double
kdePDF
        winSize :: Int
winSize  = Vector Double -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.length Vector Double
kdePDF Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
front Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
back

-- | 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 :: IO String
getTemplateDir = String -> IO String
getDataFileName "templates"
#endif

-- | Write out a series of 'Report' values to a single file, if
-- configured to do so.
report :: [Report] -> Criterion ()
report :: [Report] -> Criterion ()
report reports :: [Report]
reports = do
  Config{..} <- Criterion Config
forall r (m :: * -> *). MonadReader r m => m r
ask
  Maybe String -> (String -> Criterion ()) -> Criterion ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe String
reportFile ((String -> Criterion ()) -> Criterion ())
-> (String -> Criterion ()) -> Criterion ()
forall a b. (a -> b) -> a -> b
$ \name :: String
name -> IO () -> Criterion ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Criterion ()) -> IO () -> Criterion ()
forall a b. (a -> b) -> a -> b
$ do
    String
td <- IO String
getTemplateDir
    Text
tpl <- [String] -> String -> IO Text
loadTemplate [String
td,"."] String
template
    String -> Text -> IO ()
TL.writeFile String
name (Text -> IO ()) -> IO Text -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Report] -> Text -> IO Text
formatReport [Report]
reports Text
tpl

-- | Format a series of 'Report' values using the given Mustache template.
formatReport :: [Report]
             -> TL.Text    -- ^ Mustache template.
             -> IO TL.Text
formatReport :: [Report] -> Text -> IO Text
formatReport reports :: [Report]
reports templateName :: Text
templateName = do
    Template
template0 <- case PName -> Text -> Either ParseError Template
compileMustacheText "tpl" Text
templateName of
        Left err :: ParseError
err -> String -> IO Template
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ParseError -> String
forall a. Show a => a -> String
show ParseError
err) -- TODO: throw a template exception?
        Right x :: Template
x -> Template -> IO Template
forall (m :: * -> *) a. Monad m => a -> m a
return Template
x

    Text
jQuery            <- IO Text
jQueryFileContents
    Text
flot              <- IO Text
flotFileContents
    Text
flotErrorbars     <- IO Text
flotErrorbarsFileContents
    Text
flotNavigate      <- IO Text
flotNavigateFileContents
    Text
jQueryCriterionJS <- String -> IO Text
readDataFile ("js" String -> String -> String
</> "jquery.criterion.js")
    Text
criterionCSS      <- String -> IO Text
readDataFile "criterion.css"

    -- includes, only top level
    String
templates <- IO String
getTemplateDir
    Template
template <- (String -> IO Text) -> Template -> IO Template
includeTemplate ([String] -> String -> IO Text
forall (m :: * -> *). MonadIO m => [String] -> String -> m Text
includeFile [String
templates]) Template
template0

    let context :: Value
context = [Pair] -> Value
object
            [ "json"                Text -> [Report] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Report]
reports
            , "report"              Text -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Report -> Value) -> [Report] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Report -> Value
inner [Report]
reports
            , "js-jquery"           Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
jQuery
            , "js-flot"             Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
flot
            , "js-flot-errorbars"   Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
flotErrorbars
            , "js-flot-navigate"    Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
flotNavigate
            , "jquery-criterion-js" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
jQueryCriterionJS
            , "criterion-css"       Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
criterionCSS
            ]

    let (warnings :: [MustacheWarning]
warnings, formatted :: Text
formatted) = Template -> Value -> ([MustacheWarning], Text)
renderMustacheW Template
template Value
context
    -- If there were any issues during mustache template rendering, make sure
    -- to inform the user. See #127.
    [MustacheWarning] -> (MustacheWarning -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [MustacheWarning]
warnings ((MustacheWarning -> IO ()) -> IO ())
-> (MustacheWarning -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \warning :: MustacheWarning
warning -> do
      -- The one thing we choose not to warn about is substituting in the `json`
      -- key. The reason is that `json` is used in:
      --
      --   var reports = {{{json}}};
      --
      -- So `json` represents a raw JavaScript array. This is a bit skeevy by
      -- mustache conventions, but redesigning the template to avoid this
      -- warning would be more work than just substituting the array directly.
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (MustacheWarning
warning MustacheWarning -> MustacheWarning -> Bool
forall a. Eq a => a -> a -> Bool
== Key -> MustacheWarning
MustacheDirectlyRenderedValue ([Text] -> Key
Key ["json"])) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStrLn Handle
stderr)
         [ "criterion: warning:"
         , "  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ MustacheWarning -> String
displayMustacheWarning MustacheWarning
warning
         , ""
         ]
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
formatted
  where
    jQueryFileContents, flotFileContents :: IO T.Text
#if defined(EMBED)
    jQueryFileContents        = pure $ TE.decodeUtf8 jQueryContents
    flotFileContents          = pure $ TE.decodeUtf8 flotContents
    flotErrorbarsFileContents = pure $ TE.decodeUtf8 flotErrorbarsContents
    flotNavigateFileContents  = pure $ TE.decodeUtf8 flotNavigateContents
#else
    jQueryFileContents :: IO Text
jQueryFileContents        = String -> IO Text
T.readFile (String -> IO Text) -> IO String -> IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String
JQuery.file
    flotFileContents :: IO Text
flotFileContents          = String -> IO Text
T.readFile (String -> IO Text) -> IO String -> IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Flot -> IO String
Flot.file Flot
Flot.Flot
    flotErrorbarsFileContents :: IO Text
flotErrorbarsFileContents = String -> IO Text
T.readFile (String -> IO Text) -> IO String -> IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Flot -> IO String
Flot.file Flot
Flot.FlotErrorbars
    flotNavigateFileContents :: IO Text
flotNavigateFileContents  = String -> IO Text
T.readFile (String -> IO Text) -> IO String -> IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Flot -> IO String
Flot.file Flot
Flot.FlotNavigate
#endif

    readDataFile :: FilePath -> IO T.Text
    readDataFile :: String -> IO Text
readDataFile fp :: String
fp =
      (String -> IO Text
T.readFile (String -> IO Text) -> IO String -> IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO String
getDataFileName ("templates" String -> String -> String
</> String
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 :: (String -> IO Text) -> Template -> IO Template
includeTemplate f :: String -> IO Text
f Template {..} = (Map PName [Node] -> Template)
-> IO (Map PName [Node]) -> IO Template
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        (PName -> Map PName [Node] -> Template
Template PName
templateActual)
        (([Node] -> IO [Node]) -> Map PName [Node] -> IO (Map PName [Node])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Node -> IO Node) -> [Node] -> IO [Node]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> IO Text) -> Node -> IO Node
includeNode String -> IO Text
f)) Map PName [Node]
templateCache)

    includeNode :: (FilePath -> IO T.Text) -> Node -> IO Node
    includeNode :: (String -> IO Text) -> Node -> IO Node
includeNode f :: String -> IO Text
f (Section (Key ["include"]) [TextBlock fp :: Text
fp]) =
        (Text -> Node) -> IO Text -> IO Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Node
TextBlock (String -> IO Text
f (Text -> String
T.unpack Text
fp))
    includeNode _ n :: Node
n = Node -> IO Node
forall (m :: * -> *) a. Monad m => a -> m a
return Node
n

    -- Merge Report with it's analysis and outliers
    merge :: ToJSON a => a -> Value -> Value
    merge :: a -> Value -> Value
merge x :: a
x y :: Value
y = case a -> Value
forall a. ToJSON a => a -> Value
toJSON a
x of
        Object x' :: Object
x' -> case Value
y of
            Object y' :: Object
y' -> Object -> Value
Object (Object
x' Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
y')
            _         -> Value
y
        _         -> Value
y

    inner :: Report -> Value
inner r :: Report
r@Report {..} = SampleAnalysis -> Value -> Value
forall a. ToJSON a => a -> Value -> Value
merge SampleAnalysis
reportAnalysis (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ Outliers -> Value -> Value
forall a. ToJSON a => a -> Value -> Value
merge Outliers
reportOutliers (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
        [ "name"                  Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
reportName
        , "json"                  Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
TLE.decodeUtf8 (Report -> ByteString
forall a. ToJSON a => a -> ByteString
encode Report
r)
        , "number"                Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
reportNumber
        , "iters"                 Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Vector Int64 -> Value
forall (v :: * -> *) a.
(Vector v a, ToJSON a) =>
Text -> v a -> Value
vector "x" Vector Int64
iters
        , "times"                 Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Vector Double -> Value
forall (v :: * -> *) a.
(Vector v a, ToJSON a) =>
Text -> v a -> Value
vector "x" Vector Double
times
        , "cycles"                Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Vector Int64 -> Value
forall (v :: * -> *) a.
(Vector v a, ToJSON a) =>
Text -> v a -> Value
vector "x" Vector Int64
cycles
        , "kdetimes"              Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Vector Double -> Value
forall (v :: * -> *) a.
(Vector v a, ToJSON a) =>
Text -> v a -> Value
vector "x" Vector Double
kdeValues
        , "kdepdf"                Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Vector Double -> Value
forall (v :: * -> *) a.
(Vector v a, ToJSON a) =>
Text -> v a -> Value
vector "x" Vector Double
kdePDF
        , "kde"                   Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Text -> Vector Double -> Vector Double -> Value
forall (v :: * -> *) a b.
(Vector v a, Vector v b, ToJSON a, ToJSON b) =>
Text -> Text -> v a -> v b -> Value
vector2 "time" "pdf" Vector Double
kdeValues Vector Double
kdePDF
        , "anMeanConfidenceLevel" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
anMeanConfidenceLevel
        , "anMeanLowerBound"      Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
anMeanLowerBound
        , "anMeanUpperBound"      Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
anMeanUpperBound
        , "anStdDevLowerBound"    Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
anStdDevLowerBound
        , "anStdDevUpperBound"    Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
anStdDevUpperBound
        ]
      where
        [KDE{..}]          = [KDE]
reportKDEs
        SampleAnalysis{..} = SampleAnalysis
reportAnalysis

        iters :: Vector Int64
iters  = (Measured -> Int64) -> Vector Measured -> Vector Int64
forall a. Unbox a => (Measured -> a) -> Vector Measured -> Vector a
measure Measured -> Int64
measIters Vector Measured
reportMeasured
        times :: Vector Double
times  = (Measured -> Double) -> Vector Measured -> Vector Double
forall a. Unbox a => (Measured -> a) -> Vector Measured -> Vector a
measure Measured -> Double
measTime Vector Measured
reportMeasured
        cycles :: Vector Int64
cycles = (Measured -> Int64) -> Vector Measured -> Vector Int64
forall a. Unbox a => (Measured -> a) -> Vector Measured -> Vector a
measure Measured -> Int64
measCycles Vector Measured
reportMeasured
        anMeanConfidenceLevel :: Double
anMeanConfidenceLevel
               = CL Double -> Double
forall a. Num a => CL a -> a
confidenceLevel (CL Double -> Double) -> CL Double -> Double
forall a b. (a -> b) -> a -> b
$ ConfInt Double -> CL Double
forall a. ConfInt a -> CL Double
confIntCL (ConfInt Double -> CL Double) -> ConfInt Double -> CL Double
forall a b. (a -> b) -> a -> b
$ Estimate ConfInt Double -> ConfInt Double
forall (e :: * -> *) a. Estimate e a -> e a
estError Estimate ConfInt Double
anMean
        (anMeanLowerBound :: Double
anMeanLowerBound, anMeanUpperBound :: Double
anMeanUpperBound)
               = Estimate ConfInt Double -> (Double, Double)
forall a. Num a => Estimate ConfInt a -> (a, a)
confidenceInterval Estimate ConfInt Double
anMean
        (anStdDevLowerBound :: Double
anStdDevLowerBound, anStdDevUpperBound :: Double
anStdDevUpperBound)
               = Estimate ConfInt Double -> (Double, Double)
forall a. Num a => Estimate ConfInt a -> (a, a)
confidenceInterval Estimate ConfInt Double
anStdDev

-- | Render the elements of a vector.
--
-- It will substitute each value in the vector for @x@ in the
-- following Mustache template:
--
-- > {{#foo}}
-- >  {{x}}
-- > {{/foo}}
vector :: (G.Vector v a, ToJSON a) =>
          T.Text                -- ^ Name to use when substituting.
       -> v a
       -> Value
{-# SPECIALIZE vector :: T.Text -> U.Vector Double -> Value #-}
vector :: Text -> v a -> Value
vector name :: Text
name v :: v a
v = [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Value] -> Value) -> (v a -> [Value]) -> v a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> [a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map a -> Value
forall a. ToJSON a => a -> Value
val ([a] -> [Value]) -> (v a -> [a]) -> v a -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v a -> [a]
forall (v :: * -> *) a. Vector v a => v a -> [a]
G.toList (v a -> Value) -> v a -> Value
forall a b. (a -> b) -> a -> b
$ v a
v where
    val :: v -> Value
val i :: v
i = [Pair] -> Value
object [ Text
name Text -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= v
i ]

-- | Render the elements of two vectors.
vector2 :: (G.Vector v a, G.Vector v b, ToJSON a, ToJSON b) =>
           T.Text               -- ^ Name for elements from the first vector.
        -> T.Text               -- ^ Name for elements from the second vector.
        -> v a                  -- ^ First vector.
        -> v b                  -- ^ Second vector.
        -> Value
{-# SPECIALIZE vector2 :: T.Text -> T.Text -> U.Vector Double -> U.Vector Double
                       -> Value #-}
vector2 :: Text -> Text -> v a -> v b -> Value
vector2 name1 :: Text
name1 name2 :: Text
name2 v1 :: v a
v1 v2 :: v b
v2 = [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ (a -> b -> Value) -> [a] -> [b] -> [Value]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> b -> Value
forall v v. (ToJSON v, ToJSON v) => v -> v -> Value
val (v a -> [a]
forall (v :: * -> *) a. Vector v a => v a -> [a]
G.toList v a
v1) (v b -> [b]
forall (v :: * -> *) a. Vector v a => v a -> [a]
G.toList v b
v2) where
    val :: v -> v -> Value
val i :: v
i j :: v
j = [Pair] -> Value
object
        [ Text
name1 Text -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= v
i
        , Text
name2 Text -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= v
j
        ]

-- | Attempt to include the contents of a file based on a search path.
-- Returns 'B.empty' if the search fails or the file could not be read.
--
-- Intended for preprocessing Mustache files, e.g. replacing sections
--
-- @
-- {{#include}}file.txt{{/include}
-- @
--
-- with file contents.
includeFile :: (MonadIO m) =>
               [FilePath]       -- ^ Directories to search.
            -> FilePath         -- ^ Name of the file to search for.
            -> m T.Text
{-# SPECIALIZE includeFile :: [FilePath] -> FilePath -> IO T.Text #-}
includeFile :: [String] -> String -> m Text
includeFile searchPath :: [String]
searchPath name :: String
name = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ (String -> IO Text -> IO Text) -> IO Text -> [String] -> IO Text
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> IO Text -> IO Text
go (Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
T.empty) [String]
searchPath
    where go :: String -> IO Text -> IO Text
go dir :: String
dir next :: IO Text
next = do
            let path :: String
path = String
dir String -> String -> String
</> String
name
            String -> IO Text
T.readFile String
path IO Text -> (IOException -> IO Text) -> IO Text
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(IOException
_::IOException) -> IO Text
next

-- | A problem arose with a template.
data TemplateException =
    TemplateNotFound FilePath   -- ^ The template could not be found.
    deriving (TemplateException -> TemplateException -> Bool
(TemplateException -> TemplateException -> Bool)
-> (TemplateException -> TemplateException -> Bool)
-> Eq TemplateException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TemplateException -> TemplateException -> Bool
$c/= :: TemplateException -> TemplateException -> Bool
== :: TemplateException -> TemplateException -> Bool
$c== :: TemplateException -> TemplateException -> Bool
Eq, ReadPrec [TemplateException]
ReadPrec TemplateException
Int -> ReadS TemplateException
ReadS [TemplateException]
(Int -> ReadS TemplateException)
-> ReadS [TemplateException]
-> ReadPrec TemplateException
-> ReadPrec [TemplateException]
-> Read TemplateException
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TemplateException]
$creadListPrec :: ReadPrec [TemplateException]
readPrec :: ReadPrec TemplateException
$creadPrec :: ReadPrec TemplateException
readList :: ReadS [TemplateException]
$creadList :: ReadS [TemplateException]
readsPrec :: Int -> ReadS TemplateException
$creadsPrec :: Int -> ReadS TemplateException
Read, Int -> TemplateException -> String -> String
[TemplateException] -> String -> String
TemplateException -> String
(Int -> TemplateException -> String -> String)
-> (TemplateException -> String)
-> ([TemplateException] -> String -> String)
-> Show TemplateException
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TemplateException] -> String -> String
$cshowList :: [TemplateException] -> String -> String
show :: TemplateException -> String
$cshow :: TemplateException -> String
showsPrec :: Int -> TemplateException -> String -> String
$cshowsPrec :: Int -> TemplateException -> String -> String
Show, Typeable, Typeable TemplateException
Constr
DataType
Typeable TemplateException =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> TemplateException
 -> c TemplateException)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TemplateException)
-> (TemplateException -> Constr)
-> (TemplateException -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TemplateException))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c TemplateException))
-> ((forall b. Data b => b -> b)
    -> TemplateException -> TemplateException)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TemplateException -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TemplateException -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> TemplateException -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TemplateException -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> TemplateException -> m TemplateException)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TemplateException -> m TemplateException)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TemplateException -> m TemplateException)
-> Data TemplateException
TemplateException -> Constr
TemplateException -> DataType
(forall b. Data b => b -> b)
-> TemplateException -> TemplateException
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TemplateException -> c TemplateException
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TemplateException
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> TemplateException -> u
forall u. (forall d. Data d => d -> u) -> TemplateException -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TemplateException -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TemplateException -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TemplateException -> m TemplateException
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TemplateException -> m TemplateException
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TemplateException
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TemplateException -> c TemplateException
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TemplateException)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TemplateException)
$cTemplateNotFound :: Constr
$tTemplateException :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> TemplateException -> m TemplateException
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TemplateException -> m TemplateException
gmapMp :: (forall d. Data d => d -> m d)
-> TemplateException -> m TemplateException
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TemplateException -> m TemplateException
gmapM :: (forall d. Data d => d -> m d)
-> TemplateException -> m TemplateException
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TemplateException -> m TemplateException
gmapQi :: Int -> (forall d. Data d => d -> u) -> TemplateException -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TemplateException -> u
gmapQ :: (forall d. Data d => d -> u) -> TemplateException -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TemplateException -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TemplateException -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TemplateException -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TemplateException -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TemplateException -> r
gmapT :: (forall b. Data b => b -> b)
-> TemplateException -> TemplateException
$cgmapT :: (forall b. Data b => b -> b)
-> TemplateException -> TemplateException
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TemplateException)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TemplateException)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c TemplateException)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TemplateException)
dataTypeOf :: TemplateException -> DataType
$cdataTypeOf :: TemplateException -> DataType
toConstr :: TemplateException -> Constr
$ctoConstr :: TemplateException -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TemplateException
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TemplateException
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TemplateException -> c TemplateException
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TemplateException -> c TemplateException
$cp1Data :: Typeable TemplateException
Data, (forall x. TemplateException -> Rep TemplateException x)
-> (forall x. Rep TemplateException x -> TemplateException)
-> Generic TemplateException
forall x. Rep TemplateException x -> TemplateException
forall x. TemplateException -> Rep TemplateException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TemplateException x -> TemplateException
$cfrom :: forall x. TemplateException -> Rep TemplateException x
Generic)

instance Exception TemplateException

-- | Load a Mustache template file.
--
-- 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 :: [String] -> String -> IO Text
loadTemplate paths :: [String]
paths name :: String
name
    | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isPathSeparator String
name = String -> IO Text
readFileCheckEmbedded String
name
    | Bool
otherwise                = Maybe IOException -> [String] -> IO Text
go Maybe IOException
forall a. Maybe a
Nothing [String]
paths
  where go :: Maybe IOException -> [String] -> IO Text
go me :: Maybe IOException
me (p :: String
p:ps :: [String]
ps) = do
          let cur :: String
cur = String
p String -> String -> String
</> String
name String -> String -> String
<.> "tpl"
          Bool
x <- String -> IO Bool
doesFileExist' String
cur
          if Bool
x
            then String -> IO Text
readFileCheckEmbedded String
cur IO Text -> (IOException -> IO Text) -> IO Text
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \e :: IOException
e -> Maybe IOException -> [String] -> IO Text
go (Maybe IOException
me Maybe IOException -> Maybe IOException -> Maybe IOException
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` IOException -> Maybe IOException
forall a. a -> Maybe a
Just IOException
e) [String]
ps
            else Maybe IOException -> [String] -> IO Text
go Maybe IOException
me [String]
ps
        go (Just e :: IOException
e) _ = IOException -> IO Text
forall e a. Exception e => e -> IO a
throwIO (IOException
e::IOException)
        go _        _ = TemplateException -> IO Text
forall e a. Exception e => e -> IO a
throwIO (TemplateException -> IO Text)
-> (String -> TemplateException) -> String -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TemplateException
TemplateNotFound (String -> IO Text) -> String -> IO Text
forall a b. (a -> b) -> a -> b
$ String
name

        doesFileExist' :: FilePath -> IO Bool
        doesFileExist' :: String -> IO Bool
doesFileExist' fp :: String
fp = do
          Bool
e <- String -> IO Bool
doesFileExist String
fp
          Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool
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 :: String -> IO Text
readFileCheckEmbedded fp :: String
fp =
  String -> IO Text
TL.readFile String
fp
#if defined(EMBED)
  `E.catch` \(e :: IOException) ->
    maybe (throwIO e)
          (pure . TLE.decodeUtf8 . fromStrict)
          (lookup fp dataFiles)
  where
# if MIN_VERSION_bytestring(0,10,0)
    fromStrict = BL.fromStrict
# else
    fromStrict x = BL.fromChunks [x]
# endif
#endif