{-# 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{String
Vector Double
kdePDF :: KDE -> Vector Double
kdeValues :: KDE -> Vector Double
kdeType :: KDE -> String
kdePDF :: Vector Double
kdeValues :: Vector Double
kdeType :: String
..} = 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.
(HasCallStack, 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.
(HasCallStack, 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
* Double
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 String
"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
String
[([String], String)]
Maybe String
CL Double
Verbosity
template :: Config -> String
verbosity :: Config -> Verbosity
junitFile :: Config -> Maybe String
jsonFile :: Config -> Maybe String
csvFile :: Config -> Maybe String
reportFile :: Config -> Maybe String
rawDataFile :: Config -> Maybe String
regressions :: Config -> [([String], String)]
resamples :: Config -> Int
timeLimit :: Config -> Double
confInterval :: Config -> CL Double
template :: String
verbosity :: Verbosity
junitFile :: Maybe String
jsonFile :: Maybe String
csvFile :: Maybe String
reportFile :: Maybe String
rawDataFile :: Maybe String
regressions :: [([String], String)]
resamples :: Int
timeLimit :: Double
confInterval :: CL Double
..} <- 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
$ \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
"."] 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

-- | 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 -> 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 Template
x -> Template -> IO Template
forall (m :: * -> *) a. Monad m => a -> m a
return Template
x

    Text
criterionJS <- String -> IO Text
readDataFile String
"criterion.js"
    Text
criterionCSS <- String -> IO Text
readDataFile String
"criterion.css"
    Text
chartJS <- IO Text
chartFileContents

    -- 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
            [ Key
"json"                Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Report] -> Text
reportsJSON [Report]
reports
            , Key
"js-criterion"        Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
criterionJS
            , Key
"js-chart"            Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
chartJS
            , Key
"criterion-css"       Key -> Text -> Pair
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.
    [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
$ \MustacheWarning
warning -> do
        String -> IO ()
criterionWarning (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ MustacheWarning -> String
displayMustacheWarning MustacheWarning
warning
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
formatted
  where
    reportsJSON :: [Report] -> T.Text
    reportsJSON :: [Report] -> Text
reportsJSON = Text -> Text
TL.toStrict (Text -> Text) -> ([Report] -> Text) -> [Report] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Text) -> Text -> Text
TL.concatMap Char -> Text
escapeJSON (Text -> Text) -> ([Report] -> Text) -> [Report] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Report] -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText

    chartFileContents :: IO T.Text
#if defined(EMBED)
    chartFileContents        = pure $ TE.decodeUtf8 chartContents
#else
    chartFileContents :: IO Text
chartFileContents        = 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
=<< Chart -> IO String
Chart.file Chart
Chart.Chart
#endif

    readDataFile :: FilePath -> IO T.Text
    readDataFile :: String -> IO Text
readDataFile 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 (String
"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 String -> IO Text
f Template {Map PName [Node]
PName
templateActual :: Template -> PName
templateCache :: Template -> Map PName [Node]
templateCache :: Map PName [Node]
templateActual :: PName
..} = (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 String -> IO Text
f (Section (Key [Text
"include"]) [TextBlock 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 String -> IO Text
_ Node
n = Node -> IO Node
forall (m :: * -> *) a. Monad m => a -> m a
return Node
n

criterionWarning :: String -> IO ()
criterionWarning :: String -> IO ()
criterionWarning String
msg =
  Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
    [ String
"criterion: warning:"
    , String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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 :: Text -> v a -> Value
vector Text
name 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 v
i = [Pair] -> Value
object [ Text -> Key
toKey Text
name Key -> v -> Pair
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 :: Text -> Text -> v a -> v b -> Value
vector2 Text
name1 Text
name2 v a
v1 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 v
i v
j = [Pair] -> Value
object
        [ Text -> Key
toKey Text
name1 Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
i
        , Text -> Key
toKey Text
name2 Key -> v -> Pair
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 :: [String] -> String -> m Text
includeFile [String]
searchPath 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 String
dir 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
DataType
Constr
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 -> DataType
TemplateException -> Constr
(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 [String]
paths 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 Maybe IOException
me (String
p:[String]
ps) = do
          let cur :: String
cur = String
p String -> String -> String
</> String
name String -> 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` \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 IOException
e) [String]
_ = IOException -> IO Text
forall e a. Exception e => e -> IO a
throwIO (IOException
e::IOException)
        go Maybe IOException
_        [String]
_ = 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' 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 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