{-# 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 :: forall (m :: * -> *). MonadIO m => Report Result -> m String
renderResult Report Result
x = forall (m :: * -> *).
MonadIO m =>
UseColor -> Doc Markup -> m String
renderDoc UseColor
u forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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)
#if MIN_VERSION_hedgehog(1,2,0)
ppResult :: forall (m :: * -> *). MonadIO m => Report Result -> m (Doc Markup)
ppResult r :: Report Result
r@(Report TestCount
tests DiscardCount
discards Coverage CoverCount
coverage Seed
seed Result
status) = case Result
status of
  Failed (FailureReport ShrinkCount
shrinks ShrinkPath
shrinkPath Maybe (Coverage CoverCount)
_mcoverage [FailedAnnotation]
annots Maybe Span
_mspan String
msg Maybe Diff
_mdiff [String]
footnotes) ->
    let failure :: Result
failure = FailureReport -> Result
Failed forall a b. (a -> b) -> a -> b
$ ShrinkCount
-> ShrinkPath
-> Maybe (Coverage CoverCount)
-> [FailedAnnotation]
-> Maybe Span
-> String
-> Maybe Diff
-> [String]
-> FailureReport
FailureReport ShrinkCount
shrinks ShrinkPath
shrinkPath forall a. Maybe a
Nothing [FailedAnnotation]
annots forall a. Maybe a
Nothing String
msg forall a. Maybe a
Nothing [String]
footnotes
    in forall (m :: * -> *).
MonadIO m =>
Maybe PropertyName -> Report Result -> m (Doc Markup)
R.ppResult forall a. Maybe a
Nothing (forall a.
TestCount
-> DiscardCount -> Coverage CoverCount -> Seed -> a -> Report a
Report TestCount
tests DiscardCount
discards Coverage CoverCount
coverage Seed
seed Result
failure)
  Result
_ -> forall (m :: * -> *).
MonadIO m =>
Maybe PropertyName -> Report Result -> m (Doc Markup)
R.ppResult forall a. Maybe a
Nothing Report Result
r
#else
ppResult r@(Report tests discards coverage status) = case status of
  Failed (FailureReport size seed shrinks _mcoverage annots _mspan msg _mdiff footnotes) ->
    let failure = Failed $ FailureReport size seed shrinks Nothing annots Nothing msg Nothing footnotes
    in R.ppResult Nothing (Report tests discards coverage failure)
  _ -> R.ppResult Nothing r
#endif