{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

#if HAVE_QUANTIFIED_CONSTRAINTS
{-# LANGUAGE QuantifiedConstraints #-}
#endif

-- | Reverse-engineered hedgehog internals that don't print out source locations.
module Hedgehog.Classes.Common.PP
  ( ppResult
  , renderResult
  ) where

import Control.Monad.IO.Class (MonadIO(..))
import Hedgehog.Internal.Report hiding (ppResult, renderResult)
import Text.PrettyPrint.Annotated.WL (Doc)
import qualified Hedgehog.Internal.Report as R
import Hedgehog.Internal.Config (UseColor(..))

renderResult :: MonadIO m
  => Report Result
  -> m String
renderResult :: Report Result -> m String
renderResult Report Result
x = UseColor -> Doc Markup -> m String
forall (m :: * -> *).
MonadIO m =>
UseColor -> Doc Markup -> m String
renderDoc UseColor
u (Doc Markup -> m String) -> m (Doc Markup) -> m String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Report Result -> m (Doc Markup)
forall (m :: * -> *). MonadIO m => Report Result -> m (Doc Markup)
ppResult Report Result
x
  where
#if MIN_VERSION_hedgehog(1,0,2)
    u :: UseColor
u = UseColor
EnableColor
#else
    u = Just EnableColor
#endif

ppResult :: MonadIO m
  => Report Result
  -> m (Doc Markup)
ppResult :: Report Result -> m (Doc Markup)
ppResult r :: Report Result
r@(Report TestCount
tests DiscardCount
discards Coverage CoverCount
coverage Result
status) = case Result
status of
  Failed (FailureReport Size
size Seed
seed ShrinkCount
shrinks Maybe (Coverage CoverCount)
_mcoverage [FailedAnnotation]
annots Maybe Span
_mspan String
msg Maybe Diff
_mdiff [String]
footnotes) ->
    let failure :: Result
failure = FailureReport -> Result
Failed (FailureReport -> Result) -> FailureReport -> Result
forall a b. (a -> b) -> a -> b
$ Size
-> Seed
-> ShrinkCount
-> Maybe (Coverage CoverCount)
-> [FailedAnnotation]
-> Maybe Span
-> String
-> Maybe Diff
-> [String]
-> FailureReport
FailureReport Size
size Seed
seed ShrinkCount
shrinks Maybe (Coverage CoverCount)
forall a. Maybe a
Nothing [FailedAnnotation]
annots Maybe Span
forall a. Maybe a
Nothing String
msg Maybe Diff
forall a. Maybe a
Nothing [String]
footnotes
    in Maybe PropertyName -> Report Result -> m (Doc Markup)
forall (m :: * -> *).
MonadIO m =>
Maybe PropertyName -> Report Result -> m (Doc Markup)
R.ppResult Maybe PropertyName
forall a. Maybe a
Nothing (TestCount
-> DiscardCount -> Coverage CoverCount -> Result -> Report Result
forall a.
TestCount -> DiscardCount -> Coverage CoverCount -> a -> Report a
Report TestCount
tests DiscardCount
discards Coverage CoverCount
coverage Result
failure)
  Result
_ -> Maybe PropertyName -> Report Result -> m (Doc Markup)
forall (m :: * -> *).
MonadIO m =>
Maybe PropertyName -> Report Result -> m (Doc Markup)
R.ppResult Maybe PropertyName
forall a. Maybe a
Nothing Report Result
r