{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Run a 'Tasty.TestTree' and produce an HTML file summarising the test results.
module Test.Tasty.Runners.Html
  ( HtmlPath(..)
  , htmlRunner
  ) where

import Control.Applicative (Const(..))
import Control.Monad ((>=>), unless, when)
import Control.Monad.Trans.Class (lift)
import Control.Concurrent.STM (atomically, readTVar)
import qualified Control.Concurrent.STM as STM(retry)
import Data.Maybe (fromMaybe)
import Data.Monoid (Sum(Sum,getSum))
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import qualified Data.Text.Lazy.IO as TIO
import qualified Data.ByteString as B
import Control.Monad.State (StateT, evalStateT, liftIO)
import qualified Control.Monad.State as State (get, modify)
import Data.Functor.Compose (Compose(Compose,getCompose))
import qualified Data.IntMap as IntMap
import Data.Proxy (Proxy(..))
import Data.Tagged (Tagged(..))
import Generics.Deriving.Monoid (memptydefault, mappenddefault)
import Test.Tasty.Runners
  ( Ingredient(TestReporter)
  , Status(Done)
  , StatusMap
  , Traversal(Traversal,getTraversal)
  )
import Test.Tasty.Providers (IsTest, TestName)
import qualified Test.Tasty.Runners as Tasty
import qualified Test.Tasty.Ingredients as Tasty
import Test.Tasty.Options as Tasty
import Text.Blaze.Html5 (Markup, (!))
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Text.Blaze.Html.Renderer.Text (renderHtml)
import Text.Printf (printf)

import Paths_tasty_html (getDataFileName)

-- * Exported

-- | Path where the HTML will be rendered.
newtype HtmlPath = HtmlPath FilePath deriving (Typeable)

-- | HTML 'Option' for the HTML 'Ingredient'.
instance IsOption (Maybe HtmlPath) where
  defaultValue :: Maybe HtmlPath
defaultValue = forall a. Maybe a
Nothing
  parseValue :: String -> Maybe (Maybe HtmlPath)
parseValue = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HtmlPath
HtmlPath
  optionName :: Tagged (Maybe HtmlPath) String
optionName = forall {k} (s :: k) b. b -> Tagged s b
Tagged String
"html"
  optionHelp :: Tagged (Maybe HtmlPath) String
optionHelp = forall {k} (s :: k) b. b -> Tagged s b
Tagged String
"A file path to store the test results in HTML"

-- | Path where external assets will be looked up
newtype AssetsPath = AssetsPath FilePath deriving (Typeable)

-- | Assets 'Option' for the HTML 'Ingredient'.
instance IsOption (Maybe AssetsPath) where
    defaultValue :: Maybe AssetsPath
defaultValue = forall a. Maybe a
Nothing
    parseValue :: String -> Maybe (Maybe AssetsPath)
parseValue = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> AssetsPath
AssetsPath
    optionName :: Tagged (Maybe AssetsPath) String
optionName = forall {k} (s :: k) b. b -> Tagged s b
Tagged String
"assets"
    optionHelp :: Tagged (Maybe AssetsPath) String
optionHelp = forall {k} (s :: k) b. b -> Tagged s b
Tagged String
"Directory where HTML assets will be looked up. \
                        \If not given the assets will be inlined within the \
                        \HTML file."

{-| To run tests using this ingredient, use 'Tasty.defaultMainWithIngredients',
    passing 'htmlRunner' as one possible ingredient. This ingredient will run
    tests if you pass the @--html@ command line option. For example,
    @--html=results.html@ will run all the tests and generate @results.html@ as
    output.

    Note enabling @--html@ will ignore all ingredients following 'htmlRunner'.
    If you want to produce the HTML report /in addition/ to other outputs, you can
    use 'Tasty.composeReporters', as in

    > main = defaultMainWithIngredients ingredients tests
    >   where ingredients = [ listingTests, htmlRunner `composeReporters` consoleTestReporter ]

-}
htmlRunner :: Ingredient
htmlRunner :: Ingredient
htmlRunner = [OptionDescription]
-> (OptionSet
    -> TestTree -> Maybe (StatusMap -> IO (Time -> IO Bool)))
-> Ingredient
TestReporter [OptionDescription]
optionDescription forall a b. (a -> b) -> a -> b
$ \OptionSet
options TestTree
testTree -> do
  HtmlPath String
htmlPath <- forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
options
  let mAssetsPath :: Maybe AssetsPath
mAssetsPath = forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
options
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \StatusMap
statusMap -> do
    Const Summary
summary <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Int
0 forall a b. (a -> b) -> a -> b
$ forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Traversal f -> f ()
getTraversal forall a b. (a -> b) -> a -> b
$
      forall b. Monoid b => TreeFold b -> OptionSet -> TestTree -> b
Tasty.foldTestTree
        forall b. Monoid b => TreeFold b
Tasty.trivialFold { foldSingle :: forall t.
IsTest t =>
OptionSet
-> String
-> t
-> Traversal (Compose (StateT Int IO) (Const Summary))
Tasty.foldSingle = forall t.
IsTest t =>
StatusMap
-> OptionSet
-> String
-> t
-> Traversal (Compose (StateT Int IO) (Const Summary))
runTest StatusMap
statusMap
                          , foldGroup :: OptionSet
-> String
-> Traversal (Compose (StateT Int IO) (Const Summary))
-> Traversal (Compose (StateT Int IO) (Const Summary))
Tasty.foldGroup  = OptionSet
-> String
-> Traversal (Compose (StateT Int IO) (Const Summary))
-> Traversal (Compose (StateT Int IO) (Const Summary))
runGroup
                          }
        OptionSet
options
        TestTree
testTree

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \Time
time -> do
      Summary -> Time -> String -> Maybe AssetsPath -> IO ()
generateHtml Summary
summary Time
time String
htmlPath Maybe AssetsPath
mAssetsPath
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Sum a -> a
getSum (Summary -> Sum Int
summaryFailures Summary
summary) forall a. Eq a => a -> a -> Bool
== Int
0

 where
  optionDescription :: [OptionDescription]
optionDescription = [ forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Maybe HtmlPath))
                      , forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Maybe AssetsPath))
                      ]

-- Silence unused import warning
_onlyUsedByHaddock :: ()
_onlyUsedByHaddock :: ()
_onlyUsedByHaddock = ()
  where Ingredient -> Ingredient -> Ingredient
_ = Ingredient -> Ingredient -> Ingredient
Tasty.composeReporters


-- * Internal

-- ** Types
--
{-| Includes the number of successful and failed tests and the 'Markup' to
    render the results of a test run.
-}
data Summary = Summary { Summary -> Sum Int
summaryFailures :: Sum Int
                       , Summary -> Sum Int
summarySuccesses :: Sum Int
                       , Summary -> Html
htmlRenderer :: Markup
                       } deriving (forall x. Rep Summary x -> Summary
forall x. Summary -> Rep Summary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Summary x -> Summary
$cfrom :: forall x. Summary -> Rep Summary x
Generic)

instance Semigroup Summary where
  <> :: Summary -> Summary -> Summary
(<>) = forall a. (Generic a, Monoid' (Rep a)) => a -> a -> a
mappenddefault

instance Monoid Summary where
  mempty :: Summary
mempty = forall a. (Generic a, Monoid' (Rep a)) => a
memptydefault
  mappend :: Summary -> Summary -> Summary
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | A 'Traversal' composed of a 'Summary' and a test count.
type SummaryTraversal = Traversal (Compose (StateT Int IO) (Const Summary))

-- ** Test folding

-- | To be used for an individual test when when folding the final 'TestTree'.
runTest :: IsTest t
        => StatusMap -> OptionSet -> TestName -> t -> SummaryTraversal
runTest :: forall t.
IsTest t =>
StatusMap
-> OptionSet
-> String
-> t
-> Traversal (Compose (StateT Int IO) (Const Summary))
runTest StatusMap
statusMap OptionSet
_ String
testName t
_ = forall (f :: * -> *). f () -> Traversal f
Traversal forall a b. (a -> b) -> a -> b
$ forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ do
  Int
ix <- forall s (m :: * -> *). MonadState s m => m s
State.get

  Result
result <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
    Status
status <- forall a. TVar a -> STM a
readTVar forall a b. (a -> b) -> a -> b
$
      forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"Attempted to lookup test by index outside bounds") forall a b. (a -> b) -> a -> b
$
      forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
ix StatusMap
statusMap

    case Status
status of
      -- If the test is done, return the result
      Done Result
result -> forall (m :: * -> *) a. Monad m => a -> m a
return Result
result
      -- Otherwise the test has either not been started or is currently
      -- executing
      Status
_ -> forall a. STM a
STM.retry

  -- Generate HTML for the test
  String
msg <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
Tasty.formatMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result -> String
Tasty.resultDescription forall a b. (a -> b) -> a -> b
$ Result
result
  let time :: Time
time = Result -> Time
Tasty.resultTime Result
result
      summary :: Summary
summary = if Result -> Bool
Tasty.resultSuccessful Result
result
                then String -> Time -> String -> Summary
mkSuccess String
testName Time
time String
msg
                else String -> Time -> String -> Summary
mkFailure String
testName Time
time String
msg

  forall {k} a (b :: k). a -> Const a b
Const Summary
summary forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (forall a. Num a => a -> a -> a
+Int
1)

-- | To be used for a 'TestGroup' when folding the final 'TestTree'.
runGroup :: OptionSet -> TestName -> SummaryTraversal -> SummaryTraversal
runGroup :: OptionSet
-> String
-> Traversal (Compose (StateT Int IO) (Const Summary))
-> Traversal (Compose (StateT Int IO) (Const Summary))
runGroup OptionSet
_opts String
groupName Traversal (Compose (StateT Int IO) (Const Summary))
children = forall (f :: * -> *). f () -> Traversal f
Traversal forall a b. (a -> b) -> a -> b
$ forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ do
  Const Summary
soFar <- forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Traversal f -> f ()
getTraversal Traversal (Compose (StateT Int IO) (Const Summary))
children

  let successful :: Bool
successful = Summary -> Sum Int
summaryFailures Summary
soFar forall a. Eq a => a -> a -> Bool
== forall a. a -> Sum a
Sum Int
0
  let grouped :: Html
grouped = String -> Bool -> Html -> Html
testGroupMarkup String
groupName Bool
successful forall a b. (a -> b) -> a -> b
$ Html -> Html
treeMarkup forall a b. (a -> b) -> a -> b
$ Summary -> Html
htmlRenderer Summary
soFar

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {k} a (b :: k). a -> Const a b
Const Summary
soFar { htmlRenderer :: Html
htmlRenderer = Html
grouped }

-- ** HTML

-- | Generates the final HTML report.
generateHtml :: Summary  -- ^ Test summary.
             -> Tasty.Time -- ^ Total run time.
             -> FilePath -- ^ Where to write.
             -> Maybe AssetsPath
             -> IO ()
generateHtml :: Summary -> Time -> String -> Maybe AssetsPath -> IO ()
generateHtml Summary
summary Time
time String
htmlPath Maybe AssetsPath
mAssetsPath = do

  Html
prologue <- case Maybe AssetsPath
mAssetsPath of
    Maybe AssetsPath
Nothing -> String -> IO Html
includeStyle String
"data/tasty.css"
    Just (AssetsPath String
path) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html
H.link forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.rel AttributeValue
"stylesheet" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (forall a. ToValue a => a -> AttributeValue
H.toValue forall a b. (a -> b) -> a -> b
$ String
path forall a. Semigroup a => a -> a -> a
<> String
"/" forall a. Semigroup a => a -> a -> a
<> String
"tasty.css")
  Html
epilogue <- case Maybe AssetsPath
mAssetsPath of
    Maybe AssetsPath
Nothing -> String -> IO Html
includeScript String
"data/tasty.js"
    Just (AssetsPath String
path) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html -> Html
H.script forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.src (forall a. ToValue a => a -> AttributeValue
H.toValue forall a b. (a -> b) -> a -> b
$ String
path forall a. Semigroup a => a -> a -> a
<> String
"/" forall a. Semigroup a => a -> a -> a
<> String
"tasty.js") forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty

  String -> Text -> IO ()
TIO.writeFile String
htmlPath forall a b. (a -> b) -> a -> b
$
    Html -> Text
renderHtml forall a b. (a -> b) -> a -> b
$
      Html -> Html
H.docTypeHtml forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.lang AttributeValue
"en" forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
H.head forall a b. (a -> b) -> a -> b
$ do
          Html
H.meta forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.charset AttributeValue
"utf-8"
          Html
H.meta forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.name AttributeValue
"viewport"
                 forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.content AttributeValue
"width=device-width, initial-scale=1.0"
          Html -> Html
H.title Html
"Tasty Test Results"
          Html
prologue

          case Maybe AssetsPath
mAssetsPath of
            Maybe AssetsPath
Nothing -> forall a. Monoid a => a
mempty
            Just (AssetsPath String
_) -> forall a. Monoid a => a
mempty

        Html -> Html
H.body forall a b. (a -> b) -> a -> b
$ do
          Html -> Html
H.h1 Html
"Tasty Test Results"
          if Summary -> Sum Int
summaryFailures Summary
summary forall a. Ord a => a -> a -> Bool
> forall a. a -> Sum a
Sum Int
0
            then Html
failureBanner
            else Html
successBanner
          Html -> Html
H.button forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"expand-all" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"hidden" forall a b. (a -> b) -> a -> b
$ Html
"Expand all"

          forall a. ToMarkup a => a -> Html
H.toMarkup forall a b. (a -> b) -> a -> b
$ Html -> Html
treeMarkup forall a b. (a -> b) -> a -> b
$ Summary -> Html
htmlRenderer Summary
summary
          Html
epilogue
  where
    getRead :: String -> IO ByteString
getRead = String -> IO String
getDataFileName forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> IO ByteString
B.readFile

    includeScript :: String -> IO Html
includeScript = String -> IO ByteString
getRead forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \ByteString
bs ->
      forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Html
H.unsafeByteString forall a b. (a -> b) -> a -> b
$ ByteString
"<script>" forall a. Semigroup a => a -> a -> a
<> ByteString
bs forall a. Semigroup a => a -> a -> a
<> ByteString
"</script>"

    includeStyle :: String -> IO Html
includeStyle String
path = do
      ByteString
bs <- String -> IO ByteString
getRead String
path
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Html -> Html
H.style forall a b. (a -> b) -> a -> b
$ ByteString -> Html
H.unsafeByteString ByteString
bs

    failureBanner :: Html
failureBanner = Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"status-banner" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"fail" forall a b. (a -> b) -> a -> b
$ do
      forall a. ToMarkup a => a -> Html
H.toMarkup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Sum a -> a
getSum forall a b. (a -> b) -> a -> b
$ Summary -> Sum Int
summaryFailures Summary
summary
      Html
" out of " :: Markup
      forall a. ToMarkup a => a -> Html
H.toMarkup Int
tests
      Html
" tests failed" :: Markup
      Html -> Html
H.span forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
H.toMarkup forall a b. (a -> b) -> a -> b
$ Time -> String
formatTime Time
time

    successBanner :: Html
successBanner = Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"status-banner" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"pass" forall a b. (a -> b) -> a -> b
$ do
      Html
"All " :: Markup
      forall a. ToMarkup a => a -> Html
H.toMarkup Int
tests
      Html
" tests passed" :: Markup
      Html -> Html
H.span forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
H.toMarkup forall a b. (a -> b) -> a -> b
$ Time -> String
formatTime Time
time

    tests :: Int
tests = forall a. Sum a -> a
getSum forall a b. (a -> b) -> a -> b
$ Summary -> Sum Int
summaryFailures Summary
summary forall a. Semigroup a => a -> a -> a
<> Summary -> Sum Int
summarySuccesses Summary
summary

-- | Set the 'htmlRenderer' of a 'Summary' with the given 'Markup'.
mkSummary :: Markup -> Summary
mkSummary :: Html -> Summary
mkSummary Html
contents = forall a. Monoid a => a
mempty { htmlRenderer :: Html
htmlRenderer = Html
contents }

-- | Create an HTML 'Summary' with a test success.
mkSuccess :: TestName
          -> Tasty.Time
          -> String -- ^ Description for the test.
          -> Summary
mkSuccess :: String -> Time -> String -> Summary
mkSuccess String
name Time
time String
desc = Summary
summary { summarySuccesses :: Sum Int
summarySuccesses = forall a. a -> Sum a
Sum Int
1 }
  where
    summary :: Summary
summary = Html -> Summary
mkSummary forall a b. (a -> b) -> a -> b
$ String -> Bool -> Time -> String -> Html
testItemMarkup String
name Bool
True Time
time String
desc

-- | Create an HTML 'Summary' with a test failure.
mkFailure :: TestName
          -> Tasty.Time
          -> String -- ^ Description for the test.
          -> Summary
mkFailure :: String -> Time -> String -> Summary
mkFailure String
name Time
time String
desc = Summary
summary { summaryFailures :: Sum Int
summaryFailures = forall a. a -> Sum a
Sum Int
1 }
  where
    summary :: Summary
summary = Html -> Summary
mkSummary forall a b. (a -> b) -> a -> b
$ String -> Bool -> Time -> String -> Html
testItemMarkup String
name Bool
False Time
time String
desc

-- | Markup representing the branching of a /tree/.
treeMarkup :: Markup -> Markup
treeMarkup :: Html -> Html
treeMarkup = Html -> Html
H.ul

-- | Markup for a test group.
testGroupMarkup :: TestName -> Bool -> Markup -> Markup
testGroupMarkup :: String -> Bool -> Html -> Html
testGroupMarkup String
groupName Bool
successful Html
body =
  Html -> Html
H.li forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
H.h4 forall h. Attributable h => h -> Attribute -> h
! Attribute
className forall a b. (a -> b) -> a -> b
$ do
      forall a. ToMarkup a => a -> Html
H.toMarkup String
groupName
      Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"expand" forall a b. (a -> b) -> a -> b
$ Html
" (click to expand)"
    Html
body
    Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"ellipsis" forall a b. (a -> b) -> a -> b
$ Text -> Html
H.preEscapedText Text
"&#x2026;" -- "…"

  where
    className :: H.Attribute
    className :: Attribute
className = [String] -> Attribute
classNames forall a b. (a -> b) -> a -> b
$ [String
"group"] forall a. Semigroup a => a -> a -> a
<> [String
"fail" | Bool -> Bool
not Bool
successful]

classNames :: [String] -> H.Attribute
classNames :: [String] -> Attribute
classNames = AttributeValue -> Attribute
A.class_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToValue a => a -> AttributeValue
H.toValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords

-- | Markup for a single test.
testItemMarkup :: TestName
               -> Bool
               -> Tasty.Time
               -> String
               -> Markup
testItemMarkup :: String -> Bool -> Time -> String -> Html
testItemMarkup String
testName Bool
successful Time
time String
desc = do
  Html -> Html
H.li forall h. Attributable h => h -> Attribute -> h
! Attribute
className forall a b. (a -> b) -> a -> b
$ do
    -- for check mark / cross
    Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"mark" forall a b. (a -> b) -> a -> b
$ Text -> Html
H.preEscapedText forall a b. (a -> b) -> a -> b
$
      if Bool
successful
      then Text
"&#x2713;" -- "✓"
      else Text
"&#x2715;" -- "✕"
    Html -> Html
H.div forall a b. (a -> b) -> a -> b
$ do
      Html -> Html
H.h5 forall a b. (a -> b) -> a -> b
$ do
        forall a. ToMarkup a => a -> Html
H.toMarkup String
testName
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Time
time forall a. Ord a => a -> a -> Bool
>= Time
0.01) forall a b. (a -> b) -> a -> b
$
          Html -> Html
H.span forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
H.toMarkup (Time -> String
formatTime Time
time)

      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
desc) forall a b. (a -> b) -> a -> b
$
        Html -> Html
H.pre forall a b. (a -> b) -> a -> b
$ Html -> Html
H.small forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
H.toMarkup String
desc

  where
    className :: H.Attribute
    className :: Attribute
className = [String] -> Attribute
classNames forall a b. (a -> b) -> a -> b
$ [String
"item"] forall a. Semigroup a => a -> a -> a
<> [String
"fail" | Bool -> Bool
not Bool
successful]

formatTime :: Tasty.Time -> String
formatTime :: Time -> String
formatTime = forall r. PrintfType r => String -> r
printf String
" (%.2fs)"

-- vim: textwidth=79 shiftwidth=2