{-# 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)
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)
import Data.Aeson.Text (encodeToLazyText)
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 System.IO (hPutStrLn, stderr)
import Text.Microstache (Key (..), Node (..), Template (..),
                compileMustacheText, displayMustacheWarning, renderMustacheW)
import Prelude ()
import Prelude.Compat
import qualified Control.Exception as E
import qualified Data.Text as T
#if defined(EMBED)
import qualified Data.Text.Lazy.Encoding as TLE
#endif
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, chartContents)
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text.Encoding as TE
#else
import qualified Language.Javascript.Chart as Chart
#endif

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as Key
#endif

-- | Trim long flat tails from a KDE plot.
tidyTails :: KDE -> KDE
tidyTails :: KDE -> KDE
tidyTails KDE{[Char]
Vector Double
kdePDF :: KDE -> Vector Double
kdeValues :: KDE -> Vector Double
kdeType :: KDE -> [Char]
kdePDF :: Vector Double
kdeValues :: Vector Double
kdeType :: [Char]
..} = KDE { kdeType :: [Char]
kdeType   = [Char]
kdeType
                        , kdeValues :: Vector Double
kdeValues = forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
Int -> Int -> v a -> v a
G.slice Int
front Int
winSize Vector Double
kdeValues
                        , kdePDF :: Vector Double
kdePDF    = forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
Int -> Int -> v a -> v a
G.slice Int
front Int
winSize Vector Double
kdePDF
                        }
  where tiny :: Double
tiny     = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Num a => a -> a -> a
subtract (forall (v :: * -> *).
Vector v Double =>
v Double -> (Double, Double)
minMax Vector Double
kdePDF) forall a. Num a => a -> a -> a
* Double
0.005
        omitTiny :: Vector Double -> Int
omitTiny = forall (v :: * -> *) a. Vector v a => v a -> Int
G.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a. Vector v a => (a -> Bool) -> v a -> v a
G.takeWhile ((forall a. Ord a => a -> a -> Bool
<= Double
tiny) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
abs)
        front :: Int
front    = Vector Double -> Int
omitTiny Vector Double
kdePDF
        back :: Int
back     = Vector Double -> Int
omitTiny forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a. Vector v a => v a -> v a
G.reverse forall a b. (a -> b) -> a -> b
$ Vector Double
kdePDF
        winSize :: Int
winSize  = forall (v :: * -> *) a. Vector v a => v a -> Int
G.length Vector Double
kdePDF forall a. Num a => a -> a -> a
- Int
front 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 [Char]
getTemplateDir = [Char] -> IO [Char]
getDataFileName [Char]
"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 [Report]
reports = do
  Config{Double
Int
[Char]
[([[Char]], [Char])]
Maybe [Char]
CL Double
Verbosity
template :: Config -> [Char]
verbosity :: Config -> Verbosity
junitFile :: Config -> Maybe [Char]
jsonFile :: Config -> Maybe [Char]
csvFile :: Config -> Maybe [Char]
reportFile :: Config -> Maybe [Char]
rawDataFile :: Config -> Maybe [Char]
regressions :: Config -> [([[Char]], [Char])]
resamples :: Config -> Int
timeLimit :: Config -> Double
confInterval :: Config -> CL Double
template :: [Char]
verbosity :: Verbosity
junitFile :: Maybe [Char]
jsonFile :: Maybe [Char]
csvFile :: Maybe [Char]
reportFile :: Maybe [Char]
rawDataFile :: Maybe [Char]
regressions :: [([[Char]], [Char])]
resamples :: Int
timeLimit :: Double
confInterval :: CL Double
..} <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe [Char]
reportFile forall a b. (a -> b) -> a -> b
$ \[Char]
name -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    [Char]
td <- IO [Char]
getTemplateDir
    Text
tpl <- [[Char]] -> [Char] -> IO Text
loadTemplate [[Char]
td,[Char]
"."] [Char]
template
    [Char] -> Text -> IO ()
TL.writeFile [Char]
name forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Report] -> Text -> IO Text
formatReport [Report]
reports Text
tpl

-- | Escape JSON string aimed to be embedded in an HTML <script> tag.  Notably
-- < and > are replaced with their unicode escape sequences such that closing
-- the <script> tag from within the JSON data is disallowed, i.e, the character
-- sequence "</" is made impossible.
--
-- Moreover, & is escaped to avoid HTML character references (&<code>;), + is
-- escaped to avoid UTF-7 attacks (should only affect old versions of IE), and
-- \0 is escaped to allow it to be represented in JSON, as the NUL character is
-- disallowed in JSON but valid in Haskell characters.
--
-- The following characters are replaced with their unicode escape sequences
-- (\uXXXX):
-- <, >, &, +, \x2028 (line separator), \x2029 (paragraph separator), and \0
-- (null terminator)
--
-- Other characters are such as \\ (backslash) and \n (newline) are not escaped
-- as the JSON serializer @encodeToLazyText@ already escapes them when they
-- occur inside JSON strings and they cause no issues with respect to HTML
-- safety when used outside of strings in the JSON-encoded payload.
--
-- If the resulting JSON-encoded Text is embedded in an HTML attribute, extra
-- care is required to also escape quotes with character references in the
-- final JSON payload.
-- See <https://html.spec.whatwg.org/multipage/syntax.html#syntax-attributes>
-- for details on how to escape attribute values.
escapeJSON :: Char -> TL.Text
escapeJSON :: Char -> Text
escapeJSON Char
'<'      = Text
"\\u003c" -- ban closing of the script tag by making </ impossible
escapeJSON Char
'>'      = Text
"\\u003e" -- encode tags with unicode escape sequences
escapeJSON Char
'\x2028' = Text
"\\u2028" -- line separator
escapeJSON Char
'\x2029' = Text
"\\u2029" -- paragraph separator
escapeJSON Char
'&'      = Text
"\\u0026" -- avoid HTML entities
escapeJSON Char
'+'      = Text
"\\u002b" -- + can be used in UTF-7 escape sequences
escapeJSON Char
'\0'     = Text
"\\u0000" -- make null characters explicit
escapeJSON Char
c        = Char -> Text
TL.singleton Char
c

-- | 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 [Report]
reports Text
templateName = do
    Template
template0 <- case PName -> Text -> Either ParseError Template
compileMustacheText PName
"tpl" Text
templateName of
        Left ParseError
err -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (forall a. Show a => a -> [Char]
show ParseError
err) -- TODO: throw a template exception?
        Right Template
x -> forall (m :: * -> *) a. Monad m => a -> m a
return Template
x

    Text
criterionJS <- [Char] -> IO Text
readDataFile [Char]
"criterion.js"
    Text
criterionCSS <- [Char] -> IO Text
readDataFile [Char]
"criterion.css"
    Text
chartJS <- IO Text
chartFileContents

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

    let context :: Value
context = [Pair] -> Value
object
            [ Key
"json"                forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Report] -> Text
reportsJSON [Report]
reports
            , Key
"js-criterion"        forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
criterionJS
            , Key
"js-chart"            forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
chartJS
            , Key
"criterion-css"       forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
criterionCSS
            ]

    let ([MustacheWarning]
warnings, 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.
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [MustacheWarning]
warnings forall a b. (a -> b) -> a -> b
$ \MustacheWarning
warning -> do
        [Char] -> IO ()
criterionWarning forall a b. (a -> b) -> a -> b
$ MustacheWarning -> [Char]
displayMustacheWarning MustacheWarning
warning
    forall (m :: * -> *) a. Monad m => a -> m a
return Text
formatted
  where
    reportsJSON :: [Report] -> T.Text
    reportsJSON :: [Report] -> Text
reportsJSON = Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Text) -> Text -> Text
TL.concatMap Char -> Text
escapeJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Text
encodeToLazyText

    chartFileContents :: IO T.Text
#if defined(EMBED)
    chartFileContents        = pure $ TE.decodeUtf8 chartContents
#else
    chartFileContents :: IO Text
chartFileContents        = [Char] -> IO Text
T.readFile forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Chart -> IO [Char]
Chart.file Chart
Chart.Chart
#endif

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

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

criterionWarning :: String -> IO ()
criterionWarning :: [Char] -> IO ()
criterionWarning [Char]
msg =
  Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines
    [ [Char]
"criterion: warning:"
    , [Char]
"  " forall a. [a] -> [a] -> [a]
++ [Char]
msg
    ]

-- | 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 :: forall (v :: * -> *) a.
(Vector v a, ToJSON a) =>
Text -> v a -> Value
vector Text
name v a
v = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. ToJSON a => a -> Value
val forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a. Vector v a => v a -> [a]
G.toList forall a b. (a -> b) -> a -> b
$ v a
v where
    val :: v -> Value
val v
i = [Pair] -> Value
object [ Text -> Key
toKey Text
name forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 :: forall (v :: * -> *) a b.
(Vector v a, Vector v b, ToJSON a, ToJSON b) =>
Text -> Text -> v a -> v b -> Value
vector2 Text
name1 Text
name2 v a
v1 v b
v2 = forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {v} {v}. (ToJSON v, ToJSON v) => v -> v -> Value
val (forall (v :: * -> *) a. Vector v a => v a -> [a]
G.toList v a
v1) (forall (v :: * -> *) a. Vector v a => v a -> [a]
G.toList v b
v2) where
    val :: v -> v -> Value
val v
i v
j = [Pair] -> Value
object
        [ Text -> Key
toKey Text
name1 forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
i
        , Text -> Key
toKey Text
name2 forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
j
        ]

#if MIN_VERSION_aeson(2,0,0)
toKey :: T.Text -> Key.Key
toKey :: Text -> Key
toKey = Text -> Key
Key.fromText
#else
toKey :: T.Text -> T.Text
toKey = id
#endif


-- | 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 :: forall (m :: * -> *). MonadIO m => [[Char]] -> [Char] -> m Text
includeFile [[Char]]
searchPath [Char]
name = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Char] -> IO Text -> IO Text
go (forall (m :: * -> *) a. Monad m => a -> m a
return Text
T.empty) [[Char]]
searchPath
    where go :: [Char] -> IO Text -> IO Text
go [Char]
dir IO Text
next = do
            let path :: [Char]
path = [Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
name
            [Char] -> IO Text
T.readFile [Char]
path 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
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]
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 -> [Char] -> [Char]
[TemplateException] -> [Char] -> [Char]
TemplateException -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [TemplateException] -> [Char] -> [Char]
$cshowList :: [TemplateException] -> [Char] -> [Char]
show :: TemplateException -> [Char]
$cshow :: TemplateException -> [Char]
showsPrec :: Int -> TemplateException -> [Char] -> [Char]
$cshowsPrec :: Int -> TemplateException -> [Char] -> [Char]
Show, Typeable, Typeable TemplateException
TemplateException -> DataType
TemplateException -> Constr
(forall b. Data b => b -> b)
-> TemplateException -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u.
Int -> (forall d. Data d => d -> u) -> TemplateException -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TemplateException -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TemplateException -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TemplateException -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, 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 :: [[Char]] -> [Char] -> IO Text
loadTemplate [[Char]]
paths [Char]
name
    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isPathSeparator [Char]
name = [Char] -> IO Text
readFileCheckEmbedded [Char]
name
    | Bool
otherwise                = Maybe IOException -> [[Char]] -> IO Text
go forall a. Maybe a
Nothing [[Char]]
paths
  where go :: Maybe IOException -> [[Char]] -> IO Text
go Maybe IOException
me ([Char]
p:[[Char]]
ps) = do
          let cur :: [Char]
cur = [Char]
p [Char] -> [Char] -> [Char]
</> [Char]
name [Char] -> [Char] -> [Char]
<.> [Char]
"tpl"
          Bool
x <- [Char] -> IO Bool
doesFileExist' [Char]
cur
          if Bool
x
            then [Char] -> IO Text
readFileCheckEmbedded [Char]
cur forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \IOException
e -> Maybe IOException -> [[Char]] -> IO Text
go (Maybe IOException
me forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall a. a -> Maybe a
Just IOException
e) [[Char]]
ps
            else Maybe IOException -> [[Char]] -> IO Text
go Maybe IOException
me [[Char]]
ps
        go (Just IOException
e) [[Char]]
_ = forall e a. Exception e => e -> IO a
throwIO (IOException
e::IOException)
        go Maybe IOException
_        [[Char]]
_ = forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TemplateException
TemplateNotFound forall a b. (a -> b) -> a -> b
$ [Char]
name

        doesFileExist' :: FilePath -> IO Bool
        doesFileExist' :: [Char] -> IO Bool
doesFileExist' [Char]
fp = do
          Bool
e <- [Char] -> IO Bool
doesFileExist [Char]
fp
          forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 :: [Char] -> IO Text
readFileCheckEmbedded [Char]
fp =
  [Char] -> IO Text
TL.readFile [Char]
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