    {-# OPTIONS_HADDOCK not-home #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveFoldable #-}
    {-# LANGUAGE DeriveFunctor #-}
    {-# LANGUAGE DeriveTraversable #-}
    {-# LANGUAGE DoAndIfThenElse #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE NoImplicitPrelude #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TupleSections #-}

    module Hedgehog.Internal.Report (
      -- * Report
        Summary(..)
      , Report(..)
      , Progress(..)
      , Result(..)
      , FailureReport(..)
      , FailedAnnotation(..)

      , Style(..)
      , Markup(..)

      , Config(..)
      , defaultConfig
      , Context(..)
      , Lines
      , PrintPrefixIcons(..)

      , renderProgress
      , renderResult
      , renderResultWith
      , renderSummary
      , renderDoc

      , ppProgress
      , ppResult
      , ppResultWith
      , ppSummary

      , fromResult
      , mkFailure
      ) where

    import           Control.Monad (zipWithM)
    import           Control.Monad.IO.Class (MonadIO(..))
    import           Control.Monad.Trans.Maybe (MaybeT(..))

    import           Data.Bifunctor (bimap, first, second)
    import qualified Data.Char as Char
    import           Data.Either (partitionEithers)
    import qualified Data.List as List
    import           Data.Map (Map)
    import qualified Data.Map as Map
    import           Data.Maybe (mapMaybe, catMaybes)
    #if !MIN_VERSION_base(4,11,0)
    import qualified Data.Semigroup as Semigroup
    #endif
    import           Data.Traversable (for)

    import           Hedgehog.Internal.Config
    import           Hedgehog.Internal.Discovery (Pos(..), Position(..))
    import qualified Hedgehog.Internal.Discovery as Discovery
    import           Hedgehog.Internal.Prelude
    import           Hedgehog.Internal.Property (CoverCount(..), CoverPercentage(..))
    import           Hedgehog.Internal.Property (Coverage(..), Label(..), LabelName(..))
    import           Hedgehog.Internal.Property (PropertyName(..), Log(..), Diff(..))
    import           Hedgehog.Internal.Property (ShrinkCount(..), PropertyCount(..))
    import           Hedgehog.Internal.Property (TestCount(..), DiscardCount(..))
    import           Hedgehog.Internal.Property (coverPercentage, coverageFailures)
    import           Hedgehog.Internal.Property (labelCovered)
    import           Hedgehog.Internal.Property (ShrinkPath(..), skipCompress)

    import           Hedgehog.Internal.Show
    import           Hedgehog.Internal.Source

    import           System.Console.ANSI (ColorIntensity(..), Color(..))
    import           System.Console.ANSI (ConsoleLayer(..), ConsoleIntensity(..))
    import           System.Console.ANSI (SGR(..), setSGRCode)
    import           System.Directory (makeRelativeToCurrentDirectory)

    #if mingw32_HOST_OS
    import           System.IO (hSetEncoding, stdout, stderr, utf8)
    #endif

    import           Text.PrettyPrint.Annotated.WL (Doc, (<#>), (<+>))
    import qualified Text.PrettyPrint.Annotated.WL as WL
    import           Text.Printf (printf)

    ------------------------------------------------------------------------
    -- Data

    data FailedAnnotation =
      FailedAnnotation {
          FailedAnnotation -> Maybe Span
    failedSpan :: !(Maybe Span)
        , FailedAnnotation -> String
    failedValue :: !String
        } deriving (FailedAnnotation -> FailedAnnotation -> Bool
    (FailedAnnotation -> FailedAnnotation -> Bool)
    -> (FailedAnnotation -> FailedAnnotation -> Bool)
    -> Eq FailedAnnotation
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FailedAnnotation -> FailedAnnotation -> Bool
    == :: FailedAnnotation -> FailedAnnotation -> Bool
    $c/= :: FailedAnnotation -> FailedAnnotation -> Bool
    /= :: FailedAnnotation -> FailedAnnotation -> Bool
    Eq, Int -> FailedAnnotation -> ShowS
    [FailedAnnotation] -> ShowS
    FailedAnnotation -> String
    (Int -> FailedAnnotation -> ShowS)
    -> (FailedAnnotation -> String)
    -> ([FailedAnnotation] -> ShowS)
    -> Show FailedAnnotation
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FailedAnnotation -> ShowS
    showsPrec :: Int -> FailedAnnotation -> ShowS
    $cshow :: FailedAnnotation -> String
    show :: FailedAnnotation -> String
    $cshowList :: [FailedAnnotation] -> ShowS
    showList :: [FailedAnnotation] -> ShowS
    Show)

    data FailureReport =
      FailureReport {
          FailureReport -> ShrinkCount
    failureShrinks :: !ShrinkCount
        , FailureReport -> ShrinkPath
    failureShrinkPath :: !ShrinkPath
        , FailureReport -> Maybe (Coverage CoverCount)
    failureCoverage :: !(Maybe (Coverage CoverCount))
        , FailureReport -> [FailedAnnotation]
    failureAnnotations :: ![FailedAnnotation]
        , FailureReport -> Maybe Span
    failureLocation :: !(Maybe Span)
        , FailureReport -> String
    failureMessage :: !String
        , FailureReport -> Maybe Diff
    failureDiff :: !(Maybe Diff)
        , FailureReport -> [String]
    failureFootnotes :: ![String]
        } deriving (FailureReport -> FailureReport -> Bool
    (FailureReport -> FailureReport -> Bool)
    -> (FailureReport -> FailureReport -> Bool) -> Eq FailureReport
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FailureReport -> FailureReport -> Bool
    == :: FailureReport -> FailureReport -> Bool
    $c/= :: FailureReport -> FailureReport -> Bool
    /= :: FailureReport -> FailureReport -> Bool
    Eq, Int -> FailureReport -> ShowS
    [FailureReport] -> ShowS
    FailureReport -> String
    (Int -> FailureReport -> ShowS)
    -> (FailureReport -> String)
    -> ([FailureReport] -> ShowS)
    -> Show FailureReport
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FailureReport -> ShowS
    showsPrec :: Int -> FailureReport -> ShowS
    $cshow :: FailureReport -> String
    show :: FailureReport -> String
    $cshowList :: [FailureReport] -> ShowS
    showList :: [FailureReport] -> ShowS
    Show)

    -- | The status of a running property test.
    --
    data Progress =
        Running
      | Shrinking !FailureReport
        deriving (Progress -> Progress -> Bool
    (Progress -> Progress -> Bool)
    -> (Progress -> Progress -> Bool) -> Eq Progress
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Progress -> Progress -> Bool
    == :: Progress -> Progress -> Bool
    $c/= :: Progress -> Progress -> Bool
    /= :: Progress -> Progress -> Bool
    Eq, Int -> Progress -> ShowS
    [Progress] -> ShowS
    Progress -> String
    (Int -> Progress -> ShowS)
    -> (Progress -> String) -> ([Progress] -> ShowS) -> Show Progress
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Progress -> ShowS
    showsPrec :: Int -> Progress -> ShowS
    $cshow :: Progress -> String
    show :: Progress -> String
    $cshowList :: [Progress] -> ShowS
    showList :: [Progress] -> ShowS
    Show)

    -- | The status of a completed property test.
    --
    --   In the case of a failure it provides the seed used for the test, the
    --   number of shrinks, and the execution log.
    --
    data Result =
        Failed !FailureReport
      | GaveUp
      | OK
        deriving (Result -> Result -> Bool
    (Result -> Result -> Bool)
    -> (Result -> Result -> Bool) -> Eq Result
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Result -> Result -> Bool
    == :: Result -> Result -> Bool
    $c/= :: Result -> Result -> Bool
    /= :: Result -> Result -> Bool
    Eq, Int -> Result -> ShowS
    [Result] -> ShowS
    Result -> String
    (Int -> Result -> ShowS)
    -> (Result -> String) -> ([Result] -> ShowS) -> Show Result
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Result -> ShowS
    showsPrec :: Int -> Result -> ShowS
    $cshow :: Result -> String
    show :: Result -> String
    $cshowList :: [Result] -> ShowS
    showList :: [Result] -> ShowS
    Show)

    -- | A report on a running or completed property test.
    --
    data Report a =
      Report {
          forall a. Report a -> TestCount
    reportTests :: !TestCount
        , forall a. Report a -> DiscardCount
    reportDiscards :: !DiscardCount
        , forall a. Report a -> Coverage CoverCount
    reportCoverage :: !(Coverage CoverCount)
        , forall a. Report a -> Seed
    reportSeed :: !Seed
        , forall a. Report a -> a
    reportStatus :: !a
        } deriving (Int -> Report a -> ShowS
    [Report a] -> ShowS
    Report a -> String
    (Int -> Report a -> ShowS)
    -> (Report a -> String) -> ([Report a] -> ShowS) -> Show (Report a)
    forall a. Show a => Int -> Report a -> ShowS
    forall a. Show a => [Report a] -> ShowS
    forall a. Show a => Report a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> Report a -> ShowS
    showsPrec :: Int -> Report a -> ShowS
    $cshow :: forall a. Show a => Report a -> String
    show :: Report a -> String
    $cshowList :: forall a. Show a => [Report a] -> ShowS
    showList :: [Report a] -> ShowS
    Show, (forall a b. (a -> b) -> Report a -> Report b)
    -> (forall a b. a -> Report b -> Report a) -> Functor Report
    forall a b. a -> Report b -> Report a
    forall a b. (a -> b) -> Report a -> Report b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> Report a -> Report b
    fmap :: forall a b. (a -> b) -> Report a -> Report b
    $c<$ :: forall a b. a -> Report b -> Report a
    <$ :: forall a b. a -> Report b -> Report a
    Functor, (forall m. Monoid m => Report m -> m)
    -> (forall m a. Monoid m => (a -> m) -> Report a -> m)
    -> (forall m a. Monoid m => (a -> m) -> Report a -> m)
    -> (forall a b. (a -> b -> b) -> b -> Report a -> b)
    -> (forall a b. (a -> b -> b) -> b -> Report a -> b)
    -> (forall b a. (b -> a -> b) -> b -> Report a -> b)
    -> (forall b a. (b -> a -> b) -> b -> Report a -> b)
    -> (forall a. (a -> a -> a) -> Report a -> a)
    -> (forall a. (a -> a -> a) -> Report a -> a)
    -> (forall a. Report a -> [a])
    -> (forall a. Report a -> Bool)
    -> (forall a. Report a -> Int)
    -> (forall a. Eq a => a -> Report a -> Bool)
    -> (forall a. Ord a => Report a -> a)
    -> (forall a. Ord a => Report a -> a)
    -> (forall a. Num a => Report a -> a)
    -> (forall a. Num a => Report a -> a)
    -> Foldable Report
    forall a. Eq a => a -> Report a -> Bool
    forall a. Num a => Report a -> a
    forall a. Ord a => Report a -> a
    forall m. Monoid m => Report m -> m
    forall a. Report a -> Bool
    forall a. Report a -> Int
    forall a. Report a -> [a]
    forall a. (a -> a -> a) -> Report a -> a
    forall m a. Monoid m => (a -> m) -> Report a -> m
    forall b a. (b -> a -> b) -> b -> Report a -> b
    forall a b. (a -> b -> b) -> b -> Report a -> b
    forall (t :: * -> *).
    (forall m. Monoid m => t m -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. t a -> [a])
    -> (forall a. t a -> Bool)
    -> (forall a. t a -> Int)
    -> (forall a. Eq a => a -> t a -> Bool)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> Foldable t
    $cfold :: forall m. Monoid m => Report m -> m
    fold :: forall m. Monoid m => Report m -> m
    $cfoldMap :: forall m a. Monoid m => (a -> m) -> Report a -> m
    foldMap :: forall m a. Monoid m => (a -> m) -> Report a -> m
    $cfoldMap' :: forall m a. Monoid m => (a -> m) -> Report a -> m
    foldMap' :: forall m a. Monoid m => (a -> m) -> Report a -> m
    $cfoldr :: forall a b. (a -> b -> b) -> b -> Report a -> b
    foldr :: forall a b. (a -> b -> b) -> b -> Report a -> b
    $cfoldr' :: forall a b. (a -> b -> b) -> b -> Report a -> b
    foldr' :: forall a b. (a -> b -> b) -> b -> Report a -> b
    $cfoldl :: forall b a. (b -> a -> b) -> b -> Report a -> b
    foldl :: forall b a. (b -> a -> b) -> b -> Report a -> b
    $cfoldl' :: forall b a. (b -> a -> b) -> b -> Report a -> b
    foldl' :: forall b a. (b -> a -> b) -> b -> Report a -> b
    $cfoldr1 :: forall a. (a -> a -> a) -> Report a -> a
    foldr1 :: forall a. (a -> a -> a) -> Report a -> a
    $cfoldl1 :: forall a. (a -> a -> a) -> Report a -> a
    foldl1 :: forall a. (a -> a -> a) -> Report a -> a
    $ctoList :: forall a. Report a -> [a]
    toList :: forall a. Report a -> [a]
    $cnull :: forall a. Report a -> Bool
    null :: forall a. Report a -> Bool
    $clength :: forall a. Report a -> Int
    length :: forall a. Report a -> Int
    $celem :: forall a. Eq a => a -> Report a -> Bool
    elem :: forall a. Eq a => a -> Report a -> Bool
    $cmaximum :: forall a. Ord a => Report a -> a
    maximum :: forall a. Ord a => Report a -> a
    $cminimum :: forall a. Ord a => Report a -> a
    minimum :: forall a. Ord a => Report a -> a
    $csum :: forall a. Num a => Report a -> a
    sum :: forall a. Num a => Report a -> a
    $cproduct :: forall a. Num a => Report a -> a
    product :: forall a. Num a => Report a -> a
    Foldable, Functor Report
    Foldable Report
    (Functor Report, Foldable Report) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> Report a -> f (Report b))
    -> (forall (f :: * -> *) a.
        Applicative f =>
        Report (f a) -> f (Report a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> Report a -> m (Report b))
    -> (forall (m :: * -> *) a.
        Monad m =>
        Report (m a) -> m (Report a))
    -> Traversable Report
    forall (t :: * -> *).
    (Functor t, Foldable t) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> t a -> f (t b))
    -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> t a -> m (t b))
    -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
    -> Traversable t
    forall (m :: * -> *) a. Monad m => Report (m a) -> m (Report a)
    forall (f :: * -> *) a.
    Applicative f =>
    Report (f a) -> f (Report a)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Report a -> m (Report b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Report a -> f (Report b)
    $ctraverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Report a -> f (Report b)
    traverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Report a -> f (Report b)
    $csequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    Report (f a) -> f (Report a)
    sequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    Report (f a) -> f (Report a)
    $cmapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Report a -> m (Report b)
    mapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Report a -> m (Report b)
    $csequence :: forall (m :: * -> *) a. Monad m => Report (m a) -> m (Report a)
    sequence :: forall (m :: * -> *) a. Monad m => Report (m a) -> m (Report a)
    Traversable)

    -- | A summary of all the properties executed.
    --
    data Summary =
      Summary {
          Summary -> PropertyCount
    summaryWaiting :: !PropertyCount
        , Summary -> PropertyCount
    summaryRunning :: !PropertyCount
        , Summary -> PropertyCount
    summaryFailed :: !PropertyCount
        , Summary -> PropertyCount
    summaryGaveUp :: !PropertyCount
        , Summary -> PropertyCount
    summaryOK :: !PropertyCount
        } deriving (Int -> Summary -> ShowS
    [Summary] -> ShowS
    Summary -> String
    (Int -> Summary -> ShowS)
    -> (Summary -> String) -> ([Summary] -> ShowS) -> Show Summary
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Summary -> ShowS
    showsPrec :: Int -> Summary -> ShowS
    $cshow :: Summary -> String
    show :: Summary -> String
    $cshowList :: [Summary] -> ShowS
    showList :: [Summary] -> ShowS
    Show)

    instance Monoid Summary where
    #if !MIN_VERSION_base(4,11,0)
      mappend = (Semigroup.<>)
    #endif
      mempty :: Summary
    mempty =
        PropertyCount
    -> PropertyCount
    -> PropertyCount
    -> PropertyCount
    -> PropertyCount
    -> Summary
    Summary PropertyCount
    0 PropertyCount
    0 PropertyCount
    0 PropertyCount
    0 PropertyCount
    0

    instance Semigroup Summary where
      Summary PropertyCount
    x1 PropertyCount
    x2 PropertyCount
    x3 PropertyCount
    x4 PropertyCount
    x5 <> :: Summary -> Summary -> Summary
    <> Summary PropertyCount
    y1 PropertyCount
    y2 PropertyCount
    y3 PropertyCount
    y4 PropertyCount
    y5 =
        PropertyCount
    -> PropertyCount
    -> PropertyCount
    -> PropertyCount
    -> PropertyCount
    -> Summary
    Summary
          (PropertyCount
    x1 PropertyCount -> PropertyCount -> PropertyCount
    forall a. Num a => a -> a -> a
    + PropertyCount
    y1)
          (PropertyCount
    x2 PropertyCount -> PropertyCount -> PropertyCount
    forall a. Num a => a -> a -> a
    + PropertyCount
    y2)
          (PropertyCount
    x3 PropertyCount -> PropertyCount -> PropertyCount
    forall a. Num a => a -> a -> a
    + PropertyCount
    y3)
          (PropertyCount
    x4 PropertyCount -> PropertyCount -> PropertyCount
    forall a. Num a => a -> a -> a
    + PropertyCount
    y4)
          (PropertyCount
    x5 PropertyCount -> PropertyCount -> PropertyCount
    forall a. Num a => a -> a -> a
    + PropertyCount
    y5)

    -- | Construct a summary from a single result.
    --
    fromResult :: Result -> Summary
    fromResult :: Result -> Summary
    fromResult = \case
      Failed FailureReport
    _ ->
        Summary
    forall a. Monoid a => a
    mempty { summaryFailed = 1 }
      Result
    GaveUp ->
        Summary
    forall a. Monoid a => a
    mempty { summaryGaveUp = 1 }
      Result
    OK ->
        Summary
    forall a. Monoid a => a
    mempty { summaryOK = 1 }

    summaryCompleted :: Summary -> PropertyCount
    summaryCompleted :: Summary -> PropertyCount
    summaryCompleted (Summary PropertyCount
    _ PropertyCount
    _ PropertyCount
    x3 PropertyCount
    x4 PropertyCount
    x5) =
      PropertyCount
    x3 PropertyCount -> PropertyCount -> PropertyCount
    forall a. Num a => a -> a -> a
    + PropertyCount
    x4 PropertyCount -> PropertyCount -> PropertyCount
    forall a. Num a => a -> a -> a
    + PropertyCount
    x5

    summaryTotal :: Summary -> PropertyCount
    summaryTotal :: Summary -> PropertyCount
    summaryTotal (Summary PropertyCount
    x1 PropertyCount
    x2 PropertyCount
    x3 PropertyCount
    x4 PropertyCount
    x5) =
      PropertyCount
    x1 PropertyCount -> PropertyCount -> PropertyCount
    forall a. Num a => a -> a -> a
    + PropertyCount
    x2 PropertyCount -> PropertyCount -> PropertyCount
    forall a. Num a => a -> a -> a
    + PropertyCount
    x3 PropertyCount -> PropertyCount -> PropertyCount
    forall a. Num a => a -> a -> a
    + PropertyCount
    x4 PropertyCount -> PropertyCount -> PropertyCount
    forall a. Num a => a -> a -> a
    + PropertyCount
    x5

    ------------------------------------------------------------------------
    -- Pretty Printing Helpers

    data Line a =
      Line {
          forall a. Line a -> a
    lineAnnotation :: !a
        , forall a. Line a -> LineNo
    lineNumber :: !LineNo
        , forall a. Line a -> String
    _lineSource :: !String
        } deriving (Line a -> Line a -> Bool
    (Line a -> Line a -> Bool)
    -> (Line a -> Line a -> Bool) -> Eq (Line a)
    forall a. Eq a => Line a -> Line a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. Eq a => Line a -> Line a -> Bool
    == :: Line a -> Line a -> Bool
    $c/= :: forall a. Eq a => Line a -> Line a -> Bool
    /= :: Line a -> Line a -> Bool
    Eq, Eq (Line a)
    Eq (Line a) =>
    (Line a -> Line a -> Ordering)
    -> (Line a -> Line a -> Bool)
    -> (Line a -> Line a -> Bool)
    -> (Line a -> Line a -> Bool)
    -> (Line a -> Line a -> Bool)
    -> (Line a -> Line a -> Line a)
    -> (Line a -> Line a -> Line a)
    -> Ord (Line a)
    Line a -> Line a -> Bool
    Line a -> Line a -> Ordering
    Line a -> Line a -> Line a
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    forall a. Ord a => Eq (Line a)
    forall a. Ord a => Line a -> Line a -> Bool
    forall a. Ord a => Line a -> Line a -> Ordering
    forall a. Ord a => Line a -> Line a -> Line a
    $ccompare :: forall a. Ord a => Line a -> Line a -> Ordering
    compare :: Line a -> Line a -> Ordering
    $c< :: forall a. Ord a => Line a -> Line a -> Bool
    < :: Line a -> Line a -> Bool
    $c<= :: forall a. Ord a => Line a -> Line a -> Bool
    <= :: Line a -> Line a -> Bool
    $c> :: forall a. Ord a => Line a -> Line a -> Bool
    > :: Line a -> Line a -> Bool
    $c>= :: forall a. Ord a => Line a -> Line a -> Bool
    >= :: Line a -> Line a -> Bool
    $cmax :: forall a. Ord a => Line a -> Line a -> Line a
    max :: Line a -> Line a -> Line a
    $cmin :: forall a. Ord a => Line a -> Line a -> Line a
    min :: Line a -> Line a -> Line a
    Ord, Int -> Line a -> ShowS
    [Line a] -> ShowS
    Line a -> String
    (Int -> Line a -> ShowS)
    -> (Line a -> String) -> ([Line a] -> ShowS) -> Show (Line a)
    forall a. Show a => Int -> Line a -> ShowS
    forall a. Show a => [Line a] -> ShowS
    forall a. Show a => Line a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> Line a -> ShowS
    showsPrec :: Int -> Line a -> ShowS
    $cshow :: forall a. Show a => Line a -> String
    show :: Line a -> String
    $cshowList :: forall a. Show a => [Line a] -> ShowS
    showList :: [Line a] -> ShowS
    Show, (forall a b. (a -> b) -> Line a -> Line b)
    -> (forall a b. a -> Line b -> Line a) -> Functor Line
    forall a b. a -> Line b -> Line a
    forall a b. (a -> b) -> Line a -> Line b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> Line a -> Line b
    fmap :: forall a b. (a -> b) -> Line a -> Line b
    $c<$ :: forall a b. a -> Line b -> Line a
    <$ :: forall a b. a -> Line b -> Line a
    Functor)

    data Declaration a =
      Declaration {
          forall a. Declaration a -> String
    declarationFile :: !FilePath
        , forall a. Declaration a -> LineNo
    declarationLine :: !LineNo
        , forall a. Declaration a -> String
    _declarationName :: !String
        , forall a. Declaration a -> Map LineNo (Line a)
    declarationSource :: !(Map LineNo (Line a))
        } deriving (Declaration a -> Declaration a -> Bool
    (Declaration a -> Declaration a -> Bool)
    -> (Declaration a -> Declaration a -> Bool) -> Eq (Declaration a)
    forall a. Eq a => Declaration a -> Declaration a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. Eq a => Declaration a -> Declaration a -> Bool
    == :: Declaration a -> Declaration a -> Bool
    $c/= :: forall a. Eq a => Declaration a -> Declaration a -> Bool
    /= :: Declaration a -> Declaration a -> Bool
    Eq, Eq (Declaration a)
    Eq (Declaration a) =>
    (Declaration a -> Declaration a -> Ordering)
    -> (Declaration a -> Declaration a -> Bool)
    -> (Declaration a -> Declaration a -> Bool)
    -> (Declaration a -> Declaration a -> Bool)
    -> (Declaration a -> Declaration a -> Bool)
    -> (Declaration a -> Declaration a -> Declaration a)
    -> (Declaration a -> Declaration a -> Declaration a)
    -> Ord (Declaration a)
    Declaration a -> Declaration a -> Bool
    Declaration a -> Declaration a -> Ordering
    Declaration a -> Declaration a -> Declaration a
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    forall a. Ord a => Eq (Declaration a)
    forall a. Ord a => Declaration a -> Declaration a -> Bool
    forall a. Ord a => Declaration a -> Declaration a -> Ordering
    forall a. Ord a => Declaration a -> Declaration a -> Declaration a
    $ccompare :: forall a. Ord a => Declaration a -> Declaration a -> Ordering
    compare :: Declaration a -> Declaration a -> Ordering
    $c< :: forall a. Ord a => Declaration a -> Declaration a -> Bool
    < :: Declaration a -> Declaration a -> Bool
    $c<= :: forall a. Ord a => Declaration a -> Declaration a -> Bool
    <= :: Declaration a -> Declaration a -> Bool
    $c> :: forall a. Ord a => Declaration a -> Declaration a -> Bool
    > :: Declaration a -> Declaration a -> Bool
    $c>= :: forall a. Ord a => Declaration a -> Declaration a -> Bool
    >= :: Declaration a -> Declaration a -> Bool
    $cmax :: forall a. Ord a => Declaration a -> Declaration a -> Declaration a
    max :: Declaration a -> Declaration a -> Declaration a
    $cmin :: forall a. Ord a => Declaration a -> Declaration a -> Declaration a
    min :: Declaration a -> Declaration a -> Declaration a
    Ord, Int -> Declaration a -> ShowS
    [Declaration a] -> ShowS
    Declaration a -> String
    (Int -> Declaration a -> ShowS)
    -> (Declaration a -> String)
    -> ([Declaration a] -> ShowS)
    -> Show (Declaration a)
    forall a. Show a => Int -> Declaration a -> ShowS
    forall a. Show a => [Declaration a] -> ShowS
    forall a. Show a => Declaration a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> Declaration a -> ShowS
    showsPrec :: Int -> Declaration a -> ShowS
    $cshow :: forall a. Show a => Declaration a -> String
    show :: Declaration a -> String
    $cshowList :: forall a. Show a => [Declaration a] -> ShowS
    showList :: [Declaration a] -> ShowS
    Show, (forall a b. (a -> b) -> Declaration a -> Declaration b)
    -> (forall a b. a -> Declaration b -> Declaration a)
    -> Functor Declaration
    forall a b. a -> Declaration b -> Declaration a
    forall a b. (a -> b) -> Declaration a -> Declaration b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> Declaration a -> Declaration b
    fmap :: forall a b. (a -> b) -> Declaration a -> Declaration b
    $c<$ :: forall a b. a -> Declaration b -> Declaration a
    <$ :: forall a b. a -> Declaration b -> Declaration a
    Functor)

    data Style =
        StyleDefault
      | StyleAnnotation
      | StyleFailure
        deriving (Style -> Style -> Bool
    (Style -> Style -> Bool) -> (Style -> Style -> Bool) -> Eq Style
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Style -> Style -> Bool
    == :: Style -> Style -> Bool
    $c/= :: Style -> Style -> Bool
    /= :: Style -> Style -> Bool
    Eq, Eq Style
    Eq Style =>
    (Style -> Style -> Ordering)
    -> (Style -> Style -> Bool)
    -> (Style -> Style -> Bool)
    -> (Style -> Style -> Bool)
    -> (Style -> Style -> Bool)
    -> (Style -> Style -> Style)
    -> (Style -> Style -> Style)
    -> Ord Style
    Style -> Style -> Bool
    Style -> Style -> Ordering
    Style -> Style -> Style
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Style -> Style -> Ordering
    compare :: Style -> Style -> Ordering
    $c< :: Style -> Style -> Bool
    < :: Style -> Style -> Bool
    $c<= :: Style -> Style -> Bool
    <= :: Style -> Style -> Bool
    $c> :: Style -> Style -> Bool
    > :: Style -> Style -> Bool
    $c>= :: Style -> Style -> Bool
    >= :: Style -> Style -> Bool
    $cmax :: Style -> Style -> Style
    max :: Style -> Style -> Style
    $cmin :: Style -> Style -> Style
    min :: Style -> Style -> Style
    Ord, Int -> Style -> ShowS
    [Style] -> ShowS
    Style -> String
    (Int -> Style -> ShowS)
    -> (Style -> String) -> ([Style] -> ShowS) -> Show Style
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Style -> ShowS
    showsPrec :: Int -> Style -> ShowS
    $cshow :: Style -> String
    show :: Style -> String
    $cshowList :: [Style] -> ShowS
    showList :: [Style] -> ShowS
    Show)

    data Markup =
        WaitingIcon
      | WaitingHeader
      | RunningIcon
      | RunningHeader
      | ShrinkingIcon
      | ShrinkingHeader
      | FailedIcon
      | FailedText
      | GaveUpIcon
      | GaveUpText
      | SuccessIcon
      | SuccessText
      | CoverageIcon
      | CoverageText
      | CoverageFill
      | DeclarationLocation
      | StyledLineNo !Style
      | StyledBorder !Style
      | StyledSource !Style
      | AnnotationGutter
      | AnnotationValue
      | FailureArrows
      | FailureGutter
      | FailureMessage
      | DiffPrefix
      | DiffInfix
      | DiffSuffix
      | DiffSame
      | DiffRemoved
      | DiffAdded
      | ReproduceHeader
      | ReproduceGutter
      | ReproduceSource
        deriving (Markup -> Markup -> Bool
    (Markup -> Markup -> Bool)
    -> (Markup -> Markup -> Bool) -> Eq Markup
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Markup -> Markup -> Bool
    == :: Markup -> Markup -> Bool
    $c/= :: Markup -> Markup -> Bool
    /= :: Markup -> Markup -> Bool
    Eq, Eq Markup
    Eq Markup =>
    (Markup -> Markup -> Ordering)
    -> (Markup -> Markup -> Bool)
    -> (Markup -> Markup -> Bool)
    -> (Markup -> Markup -> Bool)
    -> (Markup -> Markup -> Bool)
    -> (Markup -> Markup -> Markup)
    -> (Markup -> Markup -> Markup)
    -> Ord Markup
    Markup -> Markup -> Bool
    Markup -> Markup -> Ordering
    Markup -> Markup -> Markup
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Markup -> Markup -> Ordering
    compare :: Markup -> Markup -> Ordering
    $c< :: Markup -> Markup -> Bool
    < :: Markup -> Markup -> Bool
    $c<= :: Markup -> Markup -> Bool
    <= :: Markup -> Markup -> Bool
    $c> :: Markup -> Markup -> Bool
    > :: Markup -> Markup -> Bool
    $c>= :: Markup -> Markup -> Bool
    >= :: Markup -> Markup -> Bool
    $cmax :: Markup -> Markup -> Markup
    max :: Markup -> Markup -> Markup
    $cmin :: Markup -> Markup -> Markup
    min :: Markup -> Markup -> Markup
    Ord, Int -> Markup -> ShowS
    [Markup] -> ShowS
    Markup -> String
    (Int -> Markup -> ShowS)
    -> (Markup -> String) -> ([Markup] -> ShowS) -> Show Markup
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Markup -> ShowS
    showsPrec :: Int -> Markup -> ShowS
    $cshow :: Markup -> String
    show :: Markup -> String
    $cshowList :: [Markup] -> ShowS
    showList :: [Markup] -> ShowS
    Show)

    instance Semigroup Style where
      <> :: Style -> Style -> Style
    (<>) Style
    x Style
    y =
        case (Style
    x, Style
    y) of
          (Style
    StyleFailure, Style
    _) ->
            Style
    StyleFailure
          (Style
    _, Style
    StyleFailure) ->
            Style
    StyleFailure
          (Style
    StyleAnnotation, Style
    _) ->
            Style
    StyleAnnotation
          (Style
    _, Style
    StyleAnnotation) ->
            Style
    StyleAnnotation
          (Style
    StyleDefault, Style
    _) ->
            Style
    StyleDefault

    ------------------------------------------------------------------------

    takeAnnotation :: Log -> Maybe FailedAnnotation
    takeAnnotation :: Log -> Maybe FailedAnnotation
    takeAnnotation = \case
      Annotation Maybe Span
    loc String
    val ->
        FailedAnnotation -> Maybe FailedAnnotation
    forall a. a -> Maybe a
    Just (FailedAnnotation -> Maybe FailedAnnotation)
    -> FailedAnnotation -> Maybe FailedAnnotation
    forall a b. (a -> b) -> a -> b
    $ Maybe Span -> String -> FailedAnnotation
    FailedAnnotation Maybe Span
    loc String
    val
      Log
    _ ->
        Maybe FailedAnnotation
    forall a. Maybe a
    Nothing

    takeFootnote :: Log -> Maybe String
    takeFootnote :: Log -> Maybe String
    takeFootnote = \case
      Footnote String
    x ->
        String -> Maybe String
    forall a. a -> Maybe a
    Just String
    x
      Log
    _ ->
        Maybe String
    forall a. Maybe a
    Nothing

    mkFailure ::
         ShrinkCount
      -> ShrinkPath
      -> Maybe (Coverage CoverCount)
      -> Maybe Span
      -> String
      -> Maybe Diff
      -> [Log]
      -> FailureReport
    mkFailure :: ShrinkCount
    -> ShrinkPath
    -> Maybe (Coverage CoverCount)
    -> Maybe Span
    -> String
    -> Maybe Diff
    -> [Log]
    -> FailureReport
    mkFailure ShrinkCount
    shrinks ShrinkPath
    shrinkPath Maybe (Coverage CoverCount)
    mcoverage Maybe Span
    location String
    message Maybe Diff
    diff [Log]
    logs =
      let
        inputs :: [FailedAnnotation]
    inputs =
          (Log -> Maybe FailedAnnotation) -> [Log] -> [FailedAnnotation]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Log -> Maybe FailedAnnotation
    takeAnnotation [Log]
    logs

        footnotes :: [String]
    footnotes =
          (Log -> Maybe String) -> [Log] -> [String]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Log -> Maybe String
    takeFootnote [Log]
    logs
      in
        ShrinkCount
    -> ShrinkPath
    -> Maybe (Coverage CoverCount)
    -> [FailedAnnotation]
    -> Maybe Span
    -> String
    -> Maybe Diff
    -> [String]
    -> FailureReport
    FailureReport ShrinkCount
    shrinks ShrinkPath
    shrinkPath Maybe (Coverage CoverCount)
    mcoverage [FailedAnnotation]
    inputs Maybe Span
    location String
    message Maybe Diff
    diff [String]
    footnotes

    ------------------------------------------------------------------------
    -- Pretty Printing

    ppShow :: Show x => x -> Doc a
    ppShow :: forall x a. Show x => x -> Doc a
    ppShow = -- unfortunate naming clash
      String -> Doc a
    forall a. String -> Doc a
    WL.text (String -> Doc a) -> (x -> String) -> x -> Doc a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . x -> String
    forall a. Show a => a -> String
    show

    markup :: Markup -> Doc Markup -> Doc Markup
    markup :: Markup -> Doc Markup -> Doc Markup
    markup =
      Markup -> Doc Markup -> Doc Markup
    forall a. a -> Doc a -> Doc a
    WL.annotate

    gutter :: Markup -> Doc Markup -> Doc Markup
    gutter :: Markup -> Doc Markup -> Doc Markup
    gutter Markup
    m Doc Markup
    x =
      Markup -> Doc Markup -> Doc Markup
    markup Markup
    m Doc Markup
    ">" Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+> Doc Markup
    x

    icon :: PrintPrefixIcons -> Markup -> Char -> Doc Markup -> Doc Markup
    icon :: PrintPrefixIcons -> Markup -> Char -> Doc Markup -> Doc Markup
    icon PrintPrefixIcons
    p Markup
    m Char
    i Doc Markup
    x = case PrintPrefixIcons
    p of
      PrintPrefixIcons
    DisablePrefixIcons -> Doc Markup
    x
      PrintPrefixIcons
    EnablePrefixIcons -> Markup -> Doc Markup -> Doc Markup
    markup Markup
    m (Char -> Doc Markup
    forall a. Char -> Doc a
    WL.char Char
    i) Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+> Doc Markup
    x

    ppTestCount :: TestCount -> Doc a
    ppTestCount :: forall a. TestCount -> Doc a
    ppTestCount = \case
      TestCount Int
    1 ->
        Doc a
    "1 test"
      TestCount Int
    n ->
        Int -> Doc a
    forall x a. Show x => x -> Doc a
    ppShow Int
    n Doc a -> Doc a -> Doc a
    forall a. Doc a -> Doc a -> Doc a
    <+> Doc a
    "tests"

    ppDiscardCount :: DiscardCount -> Doc a
    ppDiscardCount :: forall a. DiscardCount -> Doc a
    ppDiscardCount = \case
      DiscardCount Int
    1 ->
        Doc a
    "1 discard"
      DiscardCount Int
    n ->
        Int -> Doc a
    forall x a. Show x => x -> Doc a
    ppShow Int
    n Doc a -> Doc a -> Doc a
    forall a. Doc a -> Doc a -> Doc a
    <+> Doc a
    "discards"

    ppShrinkCount :: ShrinkCount -> Doc a
    ppShrinkCount :: forall a. ShrinkCount -> Doc a
    ppShrinkCount = \case
      ShrinkCount Int
    1 ->
        Doc a
    "1 shrink"
      ShrinkCount Int
    n ->
        Int -> Doc a
    forall x a. Show x => x -> Doc a
    ppShow Int
    n Doc a -> Doc a -> Doc a
    forall a. Doc a -> Doc a -> Doc a
    <+> Doc a
    "shrinks"

    -- | Render a compressed 'Skip'.
    --
    ppSkip :: Skip -> Doc a
    ppSkip :: forall a. Skip -> Doc a
    ppSkip =
      String -> Doc a
    forall a. String -> Doc a
    WL.text (String -> Doc a) -> (Skip -> String) -> Skip -> Doc a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Skip -> String
    skipCompress

    -- | Render a compressed 'Skip', such that it can be read back in.
    --
    ppSkipReadable :: Skip -> Doc a
    ppSkipReadable :: forall a. Skip -> Doc a
    ppSkipReadable =
      String -> Doc a
    forall a. String -> Doc a
    WL.text (String -> Doc a) -> (Skip -> String) -> Skip -> Doc a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    forall a. Show a => a -> String
    show ShowS -> (Skip -> String) -> Skip -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Skip -> String
    skipCompress

    ppRawPropertyCount :: PropertyCount -> Doc a
    ppRawPropertyCount :: forall a. PropertyCount -> Doc a
    ppRawPropertyCount (PropertyCount Int
    n) =
      Int -> Doc a
    forall x a. Show x => x -> Doc a
    ppShow Int
    n

    ppWithDiscardCount :: DiscardCount -> Doc Markup
    ppWithDiscardCount :: DiscardCount -> Doc Markup
    ppWithDiscardCount = \case
      DiscardCount Int
    0 ->
        Doc Markup
    forall a. Monoid a => a
    mempty
      DiscardCount
    n ->
        Doc Markup
    " with" Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+> DiscardCount -> Doc Markup
    forall a. DiscardCount -> Doc a
    ppDiscardCount DiscardCount
    n

    ppShrinkDiscard :: ShrinkCount -> DiscardCount -> Doc Markup
    ppShrinkDiscard :: ShrinkCount -> DiscardCount -> Doc Markup
    ppShrinkDiscard ShrinkCount
    s DiscardCount
    d =
      case (ShrinkCount
    s, DiscardCount
    d) of
        (ShrinkCount
    0, DiscardCount
    0) ->
          Doc Markup
    ""
        (ShrinkCount
    0, DiscardCount
    _) ->
          Doc Markup
    " and" Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+> DiscardCount -> Doc Markup
    forall a. DiscardCount -> Doc a
    ppDiscardCount DiscardCount
    d
        (ShrinkCount
    _, DiscardCount
    0) ->
          Doc Markup
    " and" Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+> ShrinkCount -> Doc Markup
    forall a. ShrinkCount -> Doc a
    ppShrinkCount ShrinkCount
    s
        (ShrinkCount
    _, DiscardCount
    _) ->
          Doc Markup
    "," Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+> ShrinkCount -> Doc Markup
    forall a. ShrinkCount -> Doc a
    ppShrinkCount ShrinkCount
    s Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+> Doc Markup
    "and" Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+> DiscardCount -> Doc Markup
    forall a. DiscardCount -> Doc a
    ppDiscardCount DiscardCount
    d

    mapSource :: (Map LineNo (Line a) -> Map LineNo (Line a)) -> Declaration a -> Declaration a
    mapSource :: forall a.
    (Map LineNo (Line a) -> Map LineNo (Line a))
    -> Declaration a -> Declaration a
    mapSource Map LineNo (Line a) -> Map LineNo (Line a)
    f Declaration a
    decl =
      Declaration a
    decl {
          declarationSource =
            f (declarationSource decl)
        }

    -- | The span of non-whitespace characters for the line.
    --
    --   The result is @[inclusive, exclusive)@.
    --
    lineSpan :: Line a -> (ColumnNo, ColumnNo)
    lineSpan :: forall a. Line a -> (ColumnNo, ColumnNo)
    lineSpan (Line a
    _ LineNo
    _ String
    x0) =
      let
        (String
    pre, String
    x1) =
          (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span Char -> Bool
    Char.isSpace String
    x0

        (String
    _, String
    x2) =
          (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span Char -> Bool
    Char.isSpace (ShowS
    forall a. [a] -> [a]
    reverse String
    x1)

        start :: Int
    start =
          String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    pre

        end :: Int
    end =
          Int
    start Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    x2
      in
        (Int -> ColumnNo
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    start, Int -> ColumnNo
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    end)

    takeLines :: Span -> Declaration a -> Map LineNo (Line a)
    takeLines :: forall a. Span -> Declaration a -> Map LineNo (Line a)
    takeLines Span
    sloc =
      (Map LineNo (Line a), Map LineNo (Line a)) -> Map LineNo (Line a)
    forall a b. (a, b) -> a
    fst ((Map LineNo (Line a), Map LineNo (Line a)) -> Map LineNo (Line a))
    -> (Declaration a -> (Map LineNo (Line a), Map LineNo (Line a)))
    -> Declaration a
    -> Map LineNo (Line a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LineNo
    -> Map LineNo (Line a)
    -> (Map LineNo (Line a), Map LineNo (Line a))
    forall k a. Ord k => k -> Map k a -> (Map k a, Map k a)
    Map.split (Span -> LineNo
    spanEndLine Span
    sloc LineNo -> LineNo -> LineNo
    forall a. Num a => a -> a -> a
    + LineNo
    1) (Map LineNo (Line a) -> (Map LineNo (Line a), Map LineNo (Line a)))
    -> (Declaration a -> Map LineNo (Line a))
    -> Declaration a
    -> (Map LineNo (Line a), Map LineNo (Line a))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      (Map LineNo (Line a), Map LineNo (Line a)) -> Map LineNo (Line a)
    forall a b. (a, b) -> b
    snd ((Map LineNo (Line a), Map LineNo (Line a)) -> Map LineNo (Line a))
    -> (Declaration a -> (Map LineNo (Line a), Map LineNo (Line a)))
    -> Declaration a
    -> Map LineNo (Line a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LineNo
    -> Map LineNo (Line a)
    -> (Map LineNo (Line a), Map LineNo (Line a))
    forall k a. Ord k => k -> Map k a -> (Map k a, Map k a)
    Map.split (Span -> LineNo
    spanStartLine Span
    sloc LineNo -> LineNo -> LineNo
    forall a. Num a => a -> a -> a
    - LineNo
    1) (Map LineNo (Line a) -> (Map LineNo (Line a), Map LineNo (Line a)))
    -> (Declaration a -> Map LineNo (Line a))
    -> Declaration a
    -> (Map LineNo (Line a), Map LineNo (Line a))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      Declaration a -> Map LineNo (Line a)
    forall a. Declaration a -> Map LineNo (Line a)
    declarationSource

    readDeclaration :: MonadIO m => Span -> m (Maybe (Declaration ()))
    readDeclaration :: forall (m :: * -> *).
    MonadIO m =>
    Span -> m (Maybe (Declaration ()))
    readDeclaration Span
    sloc =
      MaybeT m (Declaration ()) -> m (Maybe (Declaration ()))
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (MaybeT m (Declaration ()) -> m (Maybe (Declaration ())))
    -> MaybeT m (Declaration ()) -> m (Maybe (Declaration ()))
    forall a b. (a -> b) -> a -> b
    $ do
        path <- IO String -> MaybeT m String
    forall a. IO a -> MaybeT m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO String -> MaybeT m String)
    -> (String -> IO String) -> String -> MaybeT m String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IO String
    makeRelativeToCurrentDirectory (String -> MaybeT m String) -> String -> MaybeT m String
    forall a b. (a -> b) -> a -> b
    $ Span -> String
    spanFile Span
    sloc

        (name, Pos (Position _ line0 _) src) <- MaybeT $
          Discovery.readDeclaration path (spanEndLine sloc)

        let
          line =
            LineNo -> LineNo
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral LineNo
    line0

        pure . Declaration path line name .
          Map.fromList .
          zip [line..] .
          zipWith (Line ()) [line..] $
          lines src

    defaultStyle :: Declaration a -> Declaration (Style, [(Style, Doc Markup)])
    defaultStyle :: forall a.
    Declaration a -> Declaration (Style, [(Style, Doc Markup)])
    defaultStyle =
      (a -> (Style, [(Style, Doc Markup)]))
    -> Declaration a -> Declaration (Style, [(Style, Doc Markup)])
    forall a b. (a -> b) -> Declaration a -> Declaration b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((a -> (Style, [(Style, Doc Markup)]))
     -> Declaration a -> Declaration (Style, [(Style, Doc Markup)]))
    -> (a -> (Style, [(Style, Doc Markup)]))
    -> Declaration a
    -> Declaration (Style, [(Style, Doc Markup)])
    forall a b. (a -> b) -> a -> b
    $ (Style, [(Style, Doc Markup)])
    -> a -> (Style, [(Style, Doc Markup)])
    forall a b. a -> b -> a
    const (Style
    StyleDefault, [])

    lastLineSpan :: Monad m => Span -> Declaration a -> MaybeT m (ColumnNo, ColumnNo)
    lastLineSpan :: forall (m :: * -> *) a.
    Monad m =>
    Span -> Declaration a -> MaybeT m (ColumnNo, ColumnNo)
    lastLineSpan Span
    sloc Declaration a
    decl =
      case [Line a] -> [Line a]
    forall a. [a] -> [a]
    reverse ([Line a] -> [Line a])
    -> (Map LineNo (Line a) -> [Line a])
    -> Map LineNo (Line a)
    -> [Line a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map LineNo (Line a) -> [Line a]
    forall k a. Map k a -> [a]
    Map.elems (Map LineNo (Line a) -> [Line a])
    -> Map LineNo (Line a) -> [Line a]
    forall a b. (a -> b) -> a -> b
    $ Span -> Declaration a -> Map LineNo (Line a)
    forall a. Span -> Declaration a -> Map LineNo (Line a)
    takeLines Span
    sloc Declaration a
    decl of
        [] ->
          m (Maybe (ColumnNo, ColumnNo)) -> MaybeT m (ColumnNo, ColumnNo)
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (m (Maybe (ColumnNo, ColumnNo)) -> MaybeT m (ColumnNo, ColumnNo))
    -> m (Maybe (ColumnNo, ColumnNo)) -> MaybeT m (ColumnNo, ColumnNo)
    forall a b. (a -> b) -> a -> b
    $ Maybe (ColumnNo, ColumnNo) -> m (Maybe (ColumnNo, ColumnNo))
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (ColumnNo, ColumnNo)
    forall a. Maybe a
    Nothing
        Line a
    x : [Line a]
    _ ->
          (ColumnNo, ColumnNo) -> MaybeT m (ColumnNo, ColumnNo)
    forall a. a -> MaybeT m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((ColumnNo, ColumnNo) -> MaybeT m (ColumnNo, ColumnNo))
    -> (ColumnNo, ColumnNo) -> MaybeT m (ColumnNo, ColumnNo)
    forall a b. (a -> b) -> a -> b
    $
            Line a -> (ColumnNo, ColumnNo)
    forall a. Line a -> (ColumnNo, ColumnNo)
    lineSpan Line a
    x

    ppFailedInputTypedArgument :: Int -> FailedAnnotation -> Doc Markup
    ppFailedInputTypedArgument :: Int -> FailedAnnotation -> Doc Markup
    ppFailedInputTypedArgument Int
    ix (FailedAnnotation Maybe Span
    _ String
    val) =
      [Doc Markup] -> Doc Markup
    forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
    WL.vsep [
          String -> Doc Markup
    forall a. String -> Doc a
    WL.text String
    "forAll" Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <> Int -> Doc Markup
    forall x a. Show x => x -> Doc a
    ppShow Int
    ix Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+> Doc Markup
    "="
        , Int -> Doc Markup -> Doc Markup
    forall a. Int -> Doc a -> Doc a
    WL.indent Int
    2 (Doc Markup -> Doc Markup)
    -> ([String] -> Doc Markup) -> [String] -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc Markup] -> Doc Markup
    forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
    WL.vsep ([Doc Markup] -> Doc Markup)
    -> ([String] -> [Doc Markup]) -> [String] -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Doc Markup) -> [String] -> [Doc Markup]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Markup -> Doc Markup -> Doc Markup
    markup Markup
    AnnotationValue (Doc Markup -> Doc Markup)
    -> (String -> Doc Markup) -> String -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Doc Markup
    forall a. String -> Doc a
    WL.text) ([String] -> Doc Markup) -> [String] -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    lines String
    val
        ]

    ppFailedInputDeclaration ::
         MonadIO m
      => FailedAnnotation
      -> m (Maybe (Declaration (Style, [(Style, Doc Markup)])))
    ppFailedInputDeclaration :: forall (m :: * -> *).
    MonadIO m =>
    FailedAnnotation
    -> m (Maybe (Declaration (Style, [(Style, Doc Markup)])))
    ppFailedInputDeclaration (FailedAnnotation Maybe Span
    msloc String
    val) =
      MaybeT m (Declaration (Style, [(Style, Doc Markup)]))
    -> m (Maybe (Declaration (Style, [(Style, Doc Markup)])))
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (MaybeT m (Declaration (Style, [(Style, Doc Markup)]))
     -> m (Maybe (Declaration (Style, [(Style, Doc Markup)]))))
    -> MaybeT m (Declaration (Style, [(Style, Doc Markup)]))
    -> m (Maybe (Declaration (Style, [(Style, Doc Markup)])))
    forall a b. (a -> b) -> a -> b
    $ do
        sloc <- m (Maybe Span) -> MaybeT m Span
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (m (Maybe Span) -> MaybeT m Span)
    -> m (Maybe Span) -> MaybeT m Span
    forall a b. (a -> b) -> a -> b
    $ Maybe Span -> m (Maybe Span)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Span
    msloc
        decl <- fmap defaultStyle . MaybeT $ readDeclaration sloc
        startCol <- fromIntegral . fst <$> lastLineSpan sloc decl

        let
          ppValLine =
            Int -> Doc Markup -> Doc Markup
    forall a. Int -> Doc a -> Doc a
    WL.indent Int
    startCol (Doc Markup -> Doc Markup)
    -> (String -> Doc Markup) -> String -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
              (Markup -> Doc Markup -> Doc Markup
    markup Markup
    AnnotationGutter (String -> Doc Markup
    forall a. String -> Doc a
    WL.text String
    "│ ") Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <>) (Doc Markup -> Doc Markup)
    -> (String -> Doc Markup) -> String -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
              Markup -> Doc Markup -> Doc Markup
    markup Markup
    AnnotationValue (Doc Markup -> Doc Markup)
    -> (String -> Doc Markup) -> String -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
              String -> Doc Markup
    forall a. String -> Doc a
    WL.text

          valDocs =
            (String -> (Style, Doc Markup))
    -> [String] -> [(Style, Doc Markup)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Style
    StyleAnnotation, ) (Doc Markup -> (Style, Doc Markup))
    -> (String -> Doc Markup) -> String -> (Style, Doc Markup)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Doc Markup
    ppValLine) ([String] -> [(Style, Doc Markup)])
    -> [String] -> [(Style, Doc Markup)]
    forall a b. (a -> b) -> a -> b
    $
            String -> [String]
    List.lines String
    val

          startLine =
            LineNo -> LineNo
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (LineNo -> LineNo) -> LineNo -> LineNo
    forall a b. (a -> b) -> a -> b
    $ Span -> LineNo
    spanStartLine Span
    sloc

          endLine =
            LineNo -> LineNo
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (LineNo -> LineNo) -> LineNo -> LineNo
    forall a b. (a -> b) -> a -> b
    $ Span -> LineNo
    spanEndLine Span
    sloc

          styleInput Map LineNo (f (p Style c))
    kvs =
            (LineNo
     -> Map LineNo (f (p Style c)) -> Map LineNo (f (p Style c)))
    -> Map LineNo (f (p Style c))
    -> [LineNo]
    -> Map LineNo (f (p Style c))
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((f (p Style c) -> f (p Style c))
    -> LineNo
    -> Map LineNo (f (p Style c))
    -> Map LineNo (f (p Style c))
    forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
    Map.adjust ((f (p Style c) -> f (p Style c))
     -> LineNo
     -> Map LineNo (f (p Style c))
     -> Map LineNo (f (p Style c)))
    -> ((Style -> Style) -> f (p Style c) -> f (p Style c))
    -> (Style -> Style)
    -> LineNo
    -> Map LineNo (f (p Style c))
    -> Map LineNo (f (p Style c))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (p Style c -> p Style c) -> f (p Style c) -> f (p Style c)
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((p Style c -> p Style c) -> f (p Style c) -> f (p Style c))
    -> ((Style -> Style) -> p Style c -> p Style c)
    -> (Style -> Style)
    -> f (p Style c)
    -> f (p Style c)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Style -> Style) -> p Style c -> p Style c
    forall a b c. (a -> b) -> p a c -> p b c
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first ((Style -> Style)
     -> LineNo
     -> Map LineNo (f (p Style c))
     -> Map LineNo (f (p Style c)))
    -> (Style -> Style)
    -> LineNo
    -> Map LineNo (f (p Style c))
    -> Map LineNo (f (p Style c))
    forall a b. (a -> b) -> a -> b
    $ Style -> Style -> Style
    forall a b. a -> b -> a
    const Style
    StyleAnnotation) Map LineNo (f (p Style c))
    kvs [LineNo
    startLine..LineNo
    endLine]

          insertDoc =
            (Line (a, [(Style, Doc Markup)])
     -> Line (a, [(Style, Doc Markup)]))
    -> LineNo
    -> Map LineNo (Line (a, [(Style, Doc Markup)]))
    -> Map LineNo (Line (a, [(Style, Doc Markup)]))
    forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
    Map.adjust (((a, [(Style, Doc Markup)]) -> (a, [(Style, Doc Markup)]))
    -> Line (a, [(Style, Doc Markup)])
    -> Line (a, [(Style, Doc Markup)])
    forall a b. (a -> b) -> Line a -> Line b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (((a, [(Style, Doc Markup)]) -> (a, [(Style, Doc Markup)]))
     -> Line (a, [(Style, Doc Markup)])
     -> Line (a, [(Style, Doc Markup)]))
    -> (([(Style, Doc Markup)] -> [(Style, Doc Markup)])
        -> (a, [(Style, Doc Markup)]) -> (a, [(Style, Doc Markup)]))
    -> ([(Style, Doc Markup)] -> [(Style, Doc Markup)])
    -> Line (a, [(Style, Doc Markup)])
    -> Line (a, [(Style, Doc Markup)])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([(Style, Doc Markup)] -> [(Style, Doc Markup)])
    -> (a, [(Style, Doc Markup)]) -> (a, [(Style, Doc Markup)])
    forall b c a. (b -> c) -> (a, b) -> (a, c)
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second (([(Style, Doc Markup)] -> [(Style, Doc Markup)])
     -> Line (a, [(Style, Doc Markup)])
     -> Line (a, [(Style, Doc Markup)]))
    -> ([(Style, Doc Markup)] -> [(Style, Doc Markup)])
    -> Line (a, [(Style, Doc Markup)])
    -> Line (a, [(Style, Doc Markup)])
    forall a b. (a -> b) -> a -> b
    $ [(Style, Doc Markup)]
    -> [(Style, Doc Markup)] -> [(Style, Doc Markup)]
    forall a b. a -> b -> a
    const [(Style, Doc Markup)]
    valDocs) LineNo
    endLine

        pure $
          mapSource (styleInput . insertDoc) decl

    ppFailedInput ::
         MonadIO m
      => Int
      -> FailedAnnotation
      -> m (Either (Doc Markup) (Declaration (Style, [(Style, Doc Markup)])))
    ppFailedInput :: forall (m :: * -> *).
    MonadIO m =>
    Int
    -> FailedAnnotation
    -> m (Either
            (Doc Markup) (Declaration (Style, [(Style, Doc Markup)])))
    ppFailedInput Int
    ix FailedAnnotation
    input = do
      mdecl <- FailedAnnotation
    -> m (Maybe (Declaration (Style, [(Style, Doc Markup)])))
    forall (m :: * -> *).
    MonadIO m =>
    FailedAnnotation
    -> m (Maybe (Declaration (Style, [(Style, Doc Markup)])))
    ppFailedInputDeclaration FailedAnnotation
    input
      case mdecl of
        Maybe (Declaration (Style, [(Style, Doc Markup)]))
    Nothing ->
          Either (Doc Markup) (Declaration (Style, [(Style, Doc Markup)]))
    -> m (Either
            (Doc Markup) (Declaration (Style, [(Style, Doc Markup)])))
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either (Doc Markup) (Declaration (Style, [(Style, Doc Markup)]))
     -> m (Either
             (Doc Markup) (Declaration (Style, [(Style, Doc Markup)]))))
    -> (Doc Markup
        -> Either
             (Doc Markup) (Declaration (Style, [(Style, Doc Markup)])))
    -> Doc Markup
    -> m (Either
            (Doc Markup) (Declaration (Style, [(Style, Doc Markup)])))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc Markup
    -> Either (Doc Markup) (Declaration (Style, [(Style, Doc Markup)]))
    forall a b. a -> Either a b
    Left (Doc Markup
     -> m (Either
             (Doc Markup) (Declaration (Style, [(Style, Doc Markup)]))))
    -> Doc Markup
    -> m (Either
            (Doc Markup) (Declaration (Style, [(Style, Doc Markup)])))
    forall a b. (a -> b) -> a -> b
    $ Int -> FailedAnnotation -> Doc Markup
    ppFailedInputTypedArgument Int
    ix FailedAnnotation
    input
        Just Declaration (Style, [(Style, Doc Markup)])
    decl ->
          Either (Doc Markup) (Declaration (Style, [(Style, Doc Markup)]))
    -> m (Either
            (Doc Markup) (Declaration (Style, [(Style, Doc Markup)])))
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either (Doc Markup) (Declaration (Style, [(Style, Doc Markup)]))
     -> m (Either
             (Doc Markup) (Declaration (Style, [(Style, Doc Markup)]))))
    -> Either (Doc Markup) (Declaration (Style, [(Style, Doc Markup)]))
    -> m (Either
            (Doc Markup) (Declaration (Style, [(Style, Doc Markup)])))
    forall a b. (a -> b) -> a -> b
    $ Declaration (Style, [(Style, Doc Markup)])
    -> Either (Doc Markup) (Declaration (Style, [(Style, Doc Markup)]))
    forall a b. b -> Either a b
    Right Declaration (Style, [(Style, Doc Markup)])
    decl

    ppLineDiff :: LineDiff -> Doc Markup
    ppLineDiff :: LineDiff -> Doc Markup
    ppLineDiff = \case
      LineSame String
    x ->
        Markup -> Doc Markup -> Doc Markup
    markup Markup
    DiffSame (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $
          Doc Markup
    "  " Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <> String -> Doc Markup
    forall a. String -> Doc a
    WL.text String
    x

      LineRemoved String
    x ->
        Markup -> Doc Markup -> Doc Markup
    markup Markup
    DiffRemoved (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $
          Doc Markup
    "- " Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <> String -> Doc Markup
    forall a. String -> Doc a
    WL.text String
    x

      LineAdded String
    x ->
        Markup -> Doc Markup -> Doc Markup
    markup Markup
    DiffAdded (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $
          Doc Markup
    "+ " Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <> String -> Doc Markup
    forall a. String -> Doc a
    WL.text String
    x

    ppDiff :: Diff -> [Doc Markup]
    ppDiff :: Diff -> [Doc Markup]
    ppDiff (Diff String
    prefix String
    removed String
    infix_ String
    added String
    suffix ValueDiff
    diff) = [
        Markup -> Doc Markup -> Doc Markup
    markup Markup
    DiffPrefix (String -> Doc Markup
    forall a. String -> Doc a
    WL.text String
    prefix) Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <>
        Markup -> Doc Markup -> Doc Markup
    markup Markup
    DiffRemoved (String -> Doc Markup
    forall a. String -> Doc a
    WL.text String
    removed) Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <>
        Markup -> Doc Markup -> Doc Markup
    markup Markup
    DiffInfix (String -> Doc Markup
    forall a. String -> Doc a
    WL.text String
    infix_) Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <>
        Markup -> Doc Markup -> Doc Markup
    markup Markup
    DiffAdded (String -> Doc Markup
    forall a. String -> Doc a
    WL.text String
    added) Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <>
        Markup -> Doc Markup -> Doc Markup
    markup Markup
    DiffSuffix (String -> Doc Markup
    forall a. String -> Doc a
    WL.text String
    suffix)
      ] [Doc Markup] -> [Doc Markup] -> [Doc Markup]
    forall a. [a] -> [a] -> [a]
    ++ (LineDiff -> Doc Markup) -> [LineDiff] -> [Doc Markup]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap LineDiff -> Doc Markup
    ppLineDiff (ValueDiff -> [LineDiff]
    toLineDiff ValueDiff
    diff)

    ppFailureLocation ::
         MonadIO m
      => [Doc Markup]
      -> Maybe Diff
      -> Span
      -> m (Maybe (Declaration (Style, [(Style, Doc Markup)])))
    ppFailureLocation :: forall (m :: * -> *).
    MonadIO m =>
    [Doc Markup]
    -> Maybe Diff
    -> Span
    -> m (Maybe (Declaration (Style, [(Style, Doc Markup)])))
    ppFailureLocation [Doc Markup]
    msgs Maybe Diff
    mdiff Span
    sloc =
      MaybeT m (Declaration (Style, [(Style, Doc Markup)]))
    -> m (Maybe (Declaration (Style, [(Style, Doc Markup)])))
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (MaybeT m (Declaration (Style, [(Style, Doc Markup)]))
     -> m (Maybe (Declaration (Style, [(Style, Doc Markup)]))))
    -> MaybeT m (Declaration (Style, [(Style, Doc Markup)]))
    -> m (Maybe (Declaration (Style, [(Style, Doc Markup)])))
    forall a b. (a -> b) -> a -> b
    $ do
        decl <- (Declaration () -> Declaration (Style, [(Style, Doc Markup)]))
    -> MaybeT m (Declaration ())
    -> MaybeT m (Declaration (Style, [(Style, Doc Markup)]))
    forall a b. (a -> b) -> MaybeT m a -> MaybeT m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Declaration () -> Declaration (Style, [(Style, Doc Markup)])
    forall a.
    Declaration a -> Declaration (Style, [(Style, Doc Markup)])
    defaultStyle (MaybeT m (Declaration ())
     -> MaybeT m (Declaration (Style, [(Style, Doc Markup)])))
    -> (m (Maybe (Declaration ())) -> MaybeT m (Declaration ()))
    -> m (Maybe (Declaration ()))
    -> MaybeT m (Declaration (Style, [(Style, Doc Markup)]))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m (Maybe (Declaration ())) -> MaybeT m (Declaration ())
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (m (Maybe (Declaration ()))
     -> MaybeT m (Declaration (Style, [(Style, Doc Markup)])))
    -> m (Maybe (Declaration ()))
    -> MaybeT m (Declaration (Style, [(Style, Doc Markup)]))
    forall a b. (a -> b) -> a -> b
    $ Span -> m (Maybe (Declaration ()))
    forall (m :: * -> *).
    MonadIO m =>
    Span -> m (Maybe (Declaration ()))
    readDeclaration Span
    sloc
        (startCol, endCol) <- bimap fromIntegral fromIntegral <$> lastLineSpan sloc decl

        let
          arrowDoc =
            Int -> Doc Markup -> Doc Markup
    forall a. Int -> Doc a -> Doc a
    WL.indent Int
    startCol (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $
              Markup -> Doc Markup -> Doc Markup
    markup Markup
    FailureArrows (String -> Doc Markup
    forall a. String -> Doc a
    WL.text (Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    endCol Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    startCol) Char
    '^'))

          ppFailure Doc Markup
    x =
            Int -> Doc Markup -> Doc Markup
    forall a. Int -> Doc a -> Doc a
    WL.indent Int
    startCol (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $
              Markup -> Doc Markup -> Doc Markup
    markup Markup
    FailureGutter (String -> Doc Markup
    forall a. String -> Doc a
    WL.text String
    "│ ") Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <> Doc Markup
    x

          msgDocs =
            (Doc Markup -> (Style, Doc Markup))
    -> [Doc Markup] -> [(Style, Doc Markup)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Style
    StyleFailure, ) (Doc Markup -> (Style, Doc Markup))
    -> (Doc Markup -> Doc Markup) -> Doc Markup -> (Style, Doc Markup)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc Markup -> Doc Markup
    ppFailure (Doc Markup -> Doc Markup)
    -> (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Markup -> Doc Markup -> Doc Markup
    markup Markup
    FailureMessage) [Doc Markup]
    msgs

          diffDocs =
            case Maybe Diff
    mdiff of
              Maybe Diff
    Nothing ->
                []
              Just Diff
    diff ->
                (Doc Markup -> (Style, Doc Markup))
    -> [Doc Markup] -> [(Style, Doc Markup)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Style
    StyleFailure, ) (Doc Markup -> (Style, Doc Markup))
    -> (Doc Markup -> Doc Markup) -> Doc Markup -> (Style, Doc Markup)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc Markup -> Doc Markup
    ppFailure) (Diff -> [Doc Markup]
    ppDiff Diff
    diff)

          docs =
            [(Style
    StyleFailure, Doc Markup
    arrowDoc)] [(Style, Doc Markup)]
    -> [(Style, Doc Markup)] -> [(Style, Doc Markup)]
    forall a. [a] -> [a] -> [a]
    ++ [(Style, Doc Markup)]
    msgDocs [(Style, Doc Markup)]
    -> [(Style, Doc Markup)] -> [(Style, Doc Markup)]
    forall a. [a] -> [a] -> [a]
    ++ [(Style, Doc Markup)]
    diffDocs

          startLine =
            Span -> LineNo
    spanStartLine Span
    sloc

          endLine =
            Span -> LineNo
    spanEndLine Span
    sloc

          styleFailure Map LineNo (f (p Style c))
    kvs =
            (LineNo
     -> Map LineNo (f (p Style c)) -> Map LineNo (f (p Style c)))
    -> Map LineNo (f (p Style c))
    -> [LineNo]
    -> Map LineNo (f (p Style c))
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((f (p Style c) -> f (p Style c))
    -> LineNo
    -> Map LineNo (f (p Style c))
    -> Map LineNo (f (p Style c))
    forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
    Map.adjust ((f (p Style c) -> f (p Style c))
     -> LineNo
     -> Map LineNo (f (p Style c))
     -> Map LineNo (f (p Style c)))
    -> ((Style -> Style) -> f (p Style c) -> f (p Style c))
    -> (Style -> Style)
    -> LineNo
    -> Map LineNo (f (p Style c))
    -> Map LineNo (f (p Style c))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (p Style c -> p Style c) -> f (p Style c) -> f (p Style c)
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((p Style c -> p Style c) -> f (p Style c) -> f (p Style c))
    -> ((Style -> Style) -> p Style c -> p Style c)
    -> (Style -> Style)
    -> f (p Style c)
    -> f (p Style c)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Style -> Style) -> p Style c -> p Style c
    forall a b c. (a -> b) -> p a c -> p b c
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first ((Style -> Style)
     -> LineNo
     -> Map LineNo (f (p Style c))
     -> Map LineNo (f (p Style c)))
    -> (Style -> Style)
    -> LineNo
    -> Map LineNo (f (p Style c))
    -> Map LineNo (f (p Style c))
    forall a b. (a -> b) -> a -> b
    $ Style -> Style -> Style
    forall a b. a -> b -> a
    const Style
    StyleFailure) Map LineNo (f (p Style c))
    kvs [LineNo
    startLine..LineNo
    endLine]

          insertDoc =
            (Line (a, [(Style, Doc Markup)])
     -> Line (a, [(Style, Doc Markup)]))
    -> LineNo
    -> Map LineNo (Line (a, [(Style, Doc Markup)]))
    -> Map LineNo (Line (a, [(Style, Doc Markup)]))
    forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
    Map.adjust (((a, [(Style, Doc Markup)]) -> (a, [(Style, Doc Markup)]))
    -> Line (a, [(Style, Doc Markup)])
    -> Line (a, [(Style, Doc Markup)])
    forall a b. (a -> b) -> Line a -> Line b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (((a, [(Style, Doc Markup)]) -> (a, [(Style, Doc Markup)]))
     -> Line (a, [(Style, Doc Markup)])
     -> Line (a, [(Style, Doc Markup)]))
    -> (([(Style, Doc Markup)] -> [(Style, Doc Markup)])
        -> (a, [(Style, Doc Markup)]) -> (a, [(Style, Doc Markup)]))
    -> ([(Style, Doc Markup)] -> [(Style, Doc Markup)])
    -> Line (a, [(Style, Doc Markup)])
    -> Line (a, [(Style, Doc Markup)])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([(Style, Doc Markup)] -> [(Style, Doc Markup)])
    -> (a, [(Style, Doc Markup)]) -> (a, [(Style, Doc Markup)])
    forall b c a. (b -> c) -> (a, b) -> (a, c)
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second (([(Style, Doc Markup)] -> [(Style, Doc Markup)])
     -> Line (a, [(Style, Doc Markup)])
     -> Line (a, [(Style, Doc Markup)]))
    -> ([(Style, Doc Markup)] -> [(Style, Doc Markup)])
    -> Line (a, [(Style, Doc Markup)])
    -> Line (a, [(Style, Doc Markup)])
    forall a b. (a -> b) -> a -> b
    $ [(Style, Doc Markup)]
    -> [(Style, Doc Markup)] -> [(Style, Doc Markup)]
    forall a b. a -> b -> a
    const [(Style, Doc Markup)]
    docs) LineNo
    endLine

        pure $
          mapSource (styleFailure . insertDoc) decl

    type Annotation = (Style, [(Style, Doc Markup)])

    newtype Lines = Lines Int
      deriving (Lines -> Lines -> Bool
    (Lines -> Lines -> Bool) -> (Lines -> Lines -> Bool) -> Eq Lines
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Lines -> Lines -> Bool
    == :: Lines -> Lines -> Bool
    $c/= :: Lines -> Lines -> Bool
    /= :: Lines -> Lines -> Bool
    Eq, Integer -> Lines
    Lines -> Lines
    Lines -> Lines -> Lines
    (Lines -> Lines -> Lines)
    -> (Lines -> Lines -> Lines)
    -> (Lines -> Lines -> Lines)
    -> (Lines -> Lines)
    -> (Lines -> Lines)
    -> (Lines -> Lines)
    -> (Integer -> Lines)
    -> Num Lines
    forall a.
    (a -> a -> a)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> (a -> a)
    -> (a -> a)
    -> (a -> a)
    -> (Integer -> a)
    -> Num a
    $c+ :: Lines -> Lines -> Lines
    + :: Lines -> Lines -> Lines
    $c- :: Lines -> Lines -> Lines
    - :: Lines -> Lines -> Lines
    $c* :: Lines -> Lines -> Lines
    * :: Lines -> Lines -> Lines
    $cnegate :: Lines -> Lines
    negate :: Lines -> Lines
    $cabs :: Lines -> Lines
    abs :: Lines -> Lines
    $csignum :: Lines -> Lines
    signum :: Lines -> Lines
    $cfromInteger :: Integer -> Lines
    fromInteger :: Integer -> Lines
    Num)

    instance Show Lines where
      showsPrec :: Int -> Lines -> ShowS
    showsPrec Int
    p (Lines Int
    n) = Int -> Int -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    p Int
    n

    data Context = FullContext | Context Lines
      deriving (Context -> Context -> Bool
    (Context -> Context -> Bool)
    -> (Context -> Context -> Bool) -> Eq Context
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Context -> Context -> Bool
    == :: Context -> Context -> Bool
    $c/= :: Context -> Context -> Bool
    /= :: Context -> Context -> Bool
    Eq, Int -> Context -> ShowS
    [Context] -> ShowS
    Context -> String
    (Int -> Context -> ShowS)
    -> (Context -> String) -> ([Context] -> ShowS) -> Show Context
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Context -> ShowS
    showsPrec :: Int -> Context -> ShowS
    $cshow :: Context -> String
    show :: Context -> String
    $cshowList :: [Context] -> ShowS
    showList :: [Context] -> ShowS
    Show)

    applyContext :: Context -> Declaration Annotation -> Declaration Annotation
    applyContext :: Context
    -> Declaration (Style, [(Style, Doc Markup)])
    -> Declaration (Style, [(Style, Doc Markup)])
    applyContext Context
    context Declaration (Style, [(Style, Doc Markup)])
    decl = case Context
    context of
      Context
    FullContext -> Declaration (Style, [(Style, Doc Markup)])
    decl
      Context Lines
    n -> Declaration (Style, [(Style, Doc Markup)])
    decl { declarationSource = limitContextTo n (declarationSource decl) }

    limitContextTo :: Lines -> Map LineNo (Line Annotation) -> Map LineNo (Line Annotation)
    limitContextTo :: Lines
    -> Map LineNo (Line (Style, [(Style, Doc Markup)]))
    -> Map LineNo (Line (Style, [(Style, Doc Markup)]))
    limitContextTo (Lines Int
    context) =
      let
        skipBoring :: [(a, Line (Style, [(Style, Doc Markup)]))]
    -> [(a, Line (Style, [(Style, Doc Markup)]))]
    skipBoring [(a, Line (Style, [(Style, Doc Markup)]))]
    xs = case ((a, Line (Style, [(Style, Doc Markup)])) -> Bool)
    -> [(a, Line (Style, [(Style, Doc Markup)]))]
    -> ([(a, Line (Style, [(Style, Doc Markup)]))],
        [(a, Line (Style, [(Style, Doc Markup)]))])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (a, Line (Style, [(Style, Doc Markup)])) -> Bool
    forall {a}. (a, Line (Style, [(Style, Doc Markup)])) -> Bool
    isBoring [(a, Line (Style, [(Style, Doc Markup)]))]
    xs of
          ([(a, Line (Style, [(Style, Doc Markup)]))]
    boring, []) -> Int
    -> [(a, Line (Style, [(Style, Doc Markup)]))]
    -> [(a, Line (Style, [(Style, Doc Markup)]))]
    forall a. Int -> [a] -> [a]
    take Int
    context [(a, Line (Style, [(Style, Doc Markup)]))]
    boring
          ([(a, Line (Style, [(Style, Doc Markup)]))]
    boring, [(a, Line (Style, [(Style, Doc Markup)]))]
    rest) -> Int
    -> [(a, Line (Style, [(Style, Doc Markup)]))]
    -> [(a, Line (Style, [(Style, Doc Markup)]))]
    forall a. Int -> [a] -> [a]
    takeEnd Int
    context [(a, Line (Style, [(Style, Doc Markup)]))]
    boring [(a, Line (Style, [(Style, Doc Markup)]))]
    -> [(a, Line (Style, [(Style, Doc Markup)]))]
    -> [(a, Line (Style, [(Style, Doc Markup)]))]
    forall a. Semigroup a => a -> a -> a
    <> [(a, Line (Style, [(Style, Doc Markup)]))]
    -> [(a, Line (Style, [(Style, Doc Markup)]))]
    keepInteresting [(a, Line (Style, [(Style, Doc Markup)]))]
    rest

        keepInteresting :: [(a, Line (Style, [(Style, Doc Markup)]))]
    -> [(a, Line (Style, [(Style, Doc Markup)]))]
    keepInteresting [(a, Line (Style, [(Style, Doc Markup)]))]
    xs = case ((a, Line (Style, [(Style, Doc Markup)])) -> Bool)
    -> [(a, Line (Style, [(Style, Doc Markup)]))]
    -> ([(a, Line (Style, [(Style, Doc Markup)]))],
        [(a, Line (Style, [(Style, Doc Markup)]))])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (a, Line (Style, [(Style, Doc Markup)])) -> Bool
    forall {a}. (a, Line (Style, [(Style, Doc Markup)])) -> Bool
    isBoring [(a, Line (Style, [(Style, Doc Markup)]))]
    xs of
          ([(a, Line (Style, [(Style, Doc Markup)]))]
    interesting, [(a, Line (Style, [(Style, Doc Markup)]))]
    rest) -> [(a, Line (Style, [(Style, Doc Markup)]))]
    interesting [(a, Line (Style, [(Style, Doc Markup)]))]
    -> [(a, Line (Style, [(Style, Doc Markup)]))]
    -> [(a, Line (Style, [(Style, Doc Markup)]))]
    forall a. Semigroup a => a -> a -> a
    <> Int
    -> [(a, Line (Style, [(Style, Doc Markup)]))]
    -> [(a, Line (Style, [(Style, Doc Markup)]))]
    forall a. Int -> [a] -> [a]
    take Int
    context [(a, Line (Style, [(Style, Doc Markup)]))]
    rest [(a, Line (Style, [(Style, Doc Markup)]))]
    -> [(a, Line (Style, [(Style, Doc Markup)]))]
    -> [(a, Line (Style, [(Style, Doc Markup)]))]
    forall a. Semigroup a => a -> a -> a
    <> [(a, Line (Style, [(Style, Doc Markup)]))]
    -> [(a, Line (Style, [(Style, Doc Markup)]))]
    skipBoring [(a, Line (Style, [(Style, Doc Markup)]))]
    rest

        isBoring :: (a, Line (Style, [(Style, Doc Markup)])) -> Bool
    isBoring = (Style, [(Style, Doc Markup)]) -> Bool
    isBoringAnnotation ((Style, [(Style, Doc Markup)]) -> Bool)
    -> ((a, Line (Style, [(Style, Doc Markup)]))
        -> (Style, [(Style, Doc Markup)]))
    -> (a, Line (Style, [(Style, Doc Markup)]))
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Line (Style, [(Style, Doc Markup)])
    -> (Style, [(Style, Doc Markup)])
    forall a. Line a -> a
    lineAnnotation (Line (Style, [(Style, Doc Markup)])
     -> (Style, [(Style, Doc Markup)]))
    -> ((a, Line (Style, [(Style, Doc Markup)]))
        -> Line (Style, [(Style, Doc Markup)]))
    -> (a, Line (Style, [(Style, Doc Markup)]))
    -> (Style, [(Style, Doc Markup)])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a, Line (Style, [(Style, Doc Markup)]))
    -> Line (Style, [(Style, Doc Markup)])
    forall a b. (a, b) -> b
    snd
      in
        [(LineNo, Line (Style, [(Style, Doc Markup)]))]
    -> Map LineNo (Line (Style, [(Style, Doc Markup)]))
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(LineNo, Line (Style, [(Style, Doc Markup)]))]
     -> Map LineNo (Line (Style, [(Style, Doc Markup)])))
    -> (Map LineNo (Line (Style, [(Style, Doc Markup)]))
        -> [(LineNo, Line (Style, [(Style, Doc Markup)]))])
    -> Map LineNo (Line (Style, [(Style, Doc Markup)]))
    -> Map LineNo (Line (Style, [(Style, Doc Markup)]))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(LineNo, Line (Style, [(Style, Doc Markup)]))]
    -> [(LineNo, Line (Style, [(Style, Doc Markup)]))]
    forall {a}.
    [(a, Line (Style, [(Style, Doc Markup)]))]
    -> [(a, Line (Style, [(Style, Doc Markup)]))]
    skipBoring ([(LineNo, Line (Style, [(Style, Doc Markup)]))]
     -> [(LineNo, Line (Style, [(Style, Doc Markup)]))])
    -> (Map LineNo (Line (Style, [(Style, Doc Markup)]))
        -> [(LineNo, Line (Style, [(Style, Doc Markup)]))])
    -> Map LineNo (Line (Style, [(Style, Doc Markup)]))
    -> [(LineNo, Line (Style, [(Style, Doc Markup)]))]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map LineNo (Line (Style, [(Style, Doc Markup)]))
    -> [(LineNo, Line (Style, [(Style, Doc Markup)]))]
    forall k a. Map k a -> [(k, a)]
    Map.toList

    takeEnd :: Int -> [a] -> [a]
    takeEnd :: forall a. Int -> [a] -> [a]
    takeEnd Int
    n = [a] -> [a]
    forall a. [a] -> [a]
    reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    take Int
    n ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> [a]
    forall a. [a] -> [a]
    reverse

    isBoringAnnotation :: Annotation -> Bool
    isBoringAnnotation :: (Style, [(Style, Doc Markup)]) -> Bool
    isBoringAnnotation = \ case
      (Style
    StyleDefault, []) -> Bool
    True
      (Style, [(Style, Doc Markup)])
    _ -> Bool
    False

    ppDeclaration :: Declaration (Style, [(Style, Doc Markup)]) -> Doc Markup
    ppDeclaration :: Declaration (Style, [(Style, Doc Markup)]) -> Doc Markup
    ppDeclaration Declaration (Style, [(Style, Doc Markup)])
    decl = let source :: Map LineNo (Line (Style, [(Style, Doc Markup)]))
    source = Declaration (Style, [(Style, Doc Markup)])
    -> Map LineNo (Line (Style, [(Style, Doc Markup)]))
    forall a. Declaration a -> Map LineNo (Line a)
    declarationSource Declaration (Style, [(Style, Doc Markup)])
    decl in
      case Map LineNo (Line (Style, [(Style, Doc Markup)]))
    -> Maybe
         (Line (Style, [(Style, Doc Markup)]),
          Map LineNo (Line (Style, [(Style, Doc Markup)])))
    forall k a. Map k a -> Maybe (a, Map k a)
    Map.maxView Map LineNo (Line (Style, [(Style, Doc Markup)]))
    source of
        Maybe
      (Line (Style, [(Style, Doc Markup)]),
       Map LineNo (Line (Style, [(Style, Doc Markup)])))
    Nothing ->
          Doc Markup
    forall a. Monoid a => a
    mempty
        Just (Line (Style, [(Style, Doc Markup)])
    lastLine, Map LineNo (Line (Style, [(Style, Doc Markup)]))
    _) ->
          let
            ppLocation :: Doc Markup
    ppLocation =
              Int -> Doc Markup -> Doc Markup
    forall a. Int -> Doc a -> Doc a
    WL.indent (Int
    digits Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $
                Markup -> Doc Markup -> Doc Markup
    markup (Style -> Markup
    StyledBorder Style
    StyleDefault) Doc Markup
    "┏━━" Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+>
                Markup -> Doc Markup -> Doc Markup
    markup Markup
    DeclarationLocation (String -> Doc Markup
    forall a. String -> Doc a
    WL.text (Declaration (Style, [(Style, Doc Markup)]) -> String
    forall a. Declaration a -> String
    declarationFile Declaration (Style, [(Style, Doc Markup)])
    decl)) Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+>
                Markup -> Doc Markup -> Doc Markup
    markup (Style -> Markup
    StyledBorder Style
    StyleDefault) Doc Markup
    "━━━"

            digits :: Int
    digits =
              String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Int) -> (LineNo -> String) -> LineNo -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> (LineNo -> Int) -> LineNo -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LineNo -> Int
    unLineNo (LineNo -> Int) -> LineNo -> Int
    forall a b. (a -> b) -> a -> b
    $ Line (Style, [(Style, Doc Markup)]) -> LineNo
    forall a. Line a -> LineNo
    lineNumber Line (Style, [(Style, Doc Markup)])
    lastLine

            ppLineNo :: LineNo -> Doc a
    ppLineNo =
              String -> Doc a
    forall a. String -> Doc a
    WL.text (String -> Doc a) -> (LineNo -> String) -> LineNo -> Doc a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Int -> String
    forall r. PrintfType r => String -> r
    printf (String
    "%" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Int -> String
    forall a. Show a => a -> String
    show Int
    digits String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    "d") (Int -> String) -> (LineNo -> Int) -> LineNo -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LineNo -> Int
    unLineNo

            ppEmptyNo :: Doc a
            ppEmptyNo :: forall a. Doc a
    ppEmptyNo =
              String -> Doc a
    forall a. String -> Doc a
    WL.text (String -> Doc a) -> String -> Doc a
    forall a b. (a -> b) -> a -> b
    $ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    digits Char
    ' '

            ppSource :: Style -> LineNo -> String -> Doc Markup
            ppSource :: Style -> LineNo -> String -> Doc Markup
    ppSource Style
    style LineNo
    n String
    src =
              (if LineNo -> Bool
    isOmittedLine (LineNo -> LineNo
    forall a. Enum a => a -> a
    pred LineNo
    n) then Doc Markup -> Doc Markup
    addVerticalEllipsis else Doc Markup -> Doc Markup
    forall a. a -> a
    id) (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $
              Markup -> Doc Markup -> Doc Markup
    markup (Style -> Markup
    StyledLineNo Style
    style) (LineNo -> Doc Markup
    forall {a}. LineNo -> Doc a
    ppLineNo LineNo
    n) Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+>
              Markup -> Doc Markup -> Doc Markup
    markup (Style -> Markup
    StyledBorder Style
    style) Doc Markup
    "┃" Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+>
              Markup -> Doc Markup -> Doc Markup
    markup (Style -> Markup
    StyledSource Style
    style) (String -> Doc Markup
    forall a. String -> Doc a
    WL.text String
    src)

            addVerticalEllipsis :: Doc Markup -> Doc Markup
    addVerticalEllipsis =
              (Doc Markup
    verticalEllipsis Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <#>)

            verticalEllipsis :: Doc Markup
    verticalEllipsis =
              Doc Markup
    "\x22ee"

            isOmittedLine :: LineNo -> Bool
    isOmittedLine LineNo
    n =
              LineNo
    n LineNo -> LineNo -> Bool
    forall a. Ord a => a -> a -> Bool
    >= LineNo
    firstLine Bool -> Bool -> Bool
    && LineNo -> Map LineNo (Line (Style, [(Style, Doc Markup)])) -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    Map.notMember LineNo
    n Map LineNo (Line (Style, [(Style, Doc Markup)]))
    source

            firstLine :: LineNo
    firstLine =
              (LineNo, Line (Style, [(Style, Doc Markup)])) -> LineNo
    forall a b. (a, b) -> a
    fst ((LineNo, Line (Style, [(Style, Doc Markup)])) -> LineNo)
    -> (LineNo, Line (Style, [(Style, Doc Markup)])) -> LineNo
    forall a b. (a -> b) -> a -> b
    $ Map LineNo (Line (Style, [(Style, Doc Markup)]))
    -> (LineNo, Line (Style, [(Style, Doc Markup)]))
    forall k a. Map k a -> (k, a)
    Map.findMin Map LineNo (Line (Style, [(Style, Doc Markup)]))
    source

            ppAnnot :: (Style, Doc Markup) -> Doc Markup
    ppAnnot (Style
    style, Doc Markup
    doc) =
              Markup -> Doc Markup -> Doc Markup
    markup (Style -> Markup
    StyledLineNo Style
    style) Doc Markup
    forall a. Doc a
    ppEmptyNo Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+>
              Markup -> Doc Markup -> Doc Markup
    markup (Style -> Markup
    StyledBorder Style
    style) Doc Markup
    "┃" Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+>
              Doc Markup
    doc

            ppLines :: [Doc Markup]
    ppLines = do
              Line (style, xs) n src <- Map LineNo (Line (Style, [(Style, Doc Markup)]))
    -> [Line (Style, [(Style, Doc Markup)])]
    forall k a. Map k a -> [a]
    Map.elems Map LineNo (Line (Style, [(Style, Doc Markup)]))
    source
              ppSource style n src : fmap ppAnnot xs
          in
            [Doc Markup] -> Doc Markup
    forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
    WL.vsep (Doc Markup
    ppLocation Doc Markup -> [Doc Markup] -> [Doc Markup]
    forall a. a -> [a] -> [a]
    : [Doc Markup]
    ppLines)

    ppReproduce :: Maybe PropertyName -> Seed -> Skip -> Doc Markup
    ppReproduce :: Maybe PropertyName -> Seed -> Skip -> Doc Markup
    ppReproduce Maybe PropertyName
    name Seed
    seed Skip
    skip =
      [Doc Markup] -> Doc Markup
    forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
    WL.vsep [
          Markup -> Doc Markup -> Doc Markup
    markup Markup
    ReproduceHeader
            Doc Markup
    "This failure can be reproduced by running:"
        , Markup -> Doc Markup -> Doc Markup
    gutter Markup
    ReproduceGutter (Doc Markup -> Doc Markup)
    -> (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Markup -> Doc Markup -> Doc Markup
    markup Markup
    ReproduceSource (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $
            Doc Markup
    "recheckAt" Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+>
            String -> Doc Markup
    forall a. String -> Doc a
    WL.text (Int -> Seed -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    11 Seed
    seed String
    "") Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+>
            Skip -> Doc Markup
    forall a. Skip -> Doc a
    ppSkipReadable Skip
    skip Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+>
            Doc Markup
    -> (PropertyName -> Doc Markup) -> Maybe PropertyName -> Doc Markup
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Doc Markup
    "<property>" (String -> Doc Markup
    forall a. String -> Doc a
    WL.text (String -> Doc Markup)
    -> (PropertyName -> String) -> PropertyName -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PropertyName -> String
    unPropertyName) Maybe PropertyName
    name
        ]

    mergeLine :: Semigroup a => Line a -> Line a -> Line a
    mergeLine :: forall a. Semigroup a => Line a -> Line a -> Line a
    mergeLine (Line a
    x LineNo
    no String
    src) (Line a
    y LineNo
    _ String
    _) =
      a -> LineNo -> String -> Line a
    forall a. a -> LineNo -> String -> Line a
    Line (a
    x a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    y) LineNo
    no String
    src

    mergeDeclaration :: Semigroup a => Declaration a -> Declaration a -> Declaration a
    mergeDeclaration :: forall a.
    Semigroup a =>
    Declaration a -> Declaration a -> Declaration a
    mergeDeclaration (Declaration String
    file LineNo
    line String
    name Map LineNo (Line a)
    src0) (Declaration String
    _ LineNo
    _ String
    _ Map LineNo (Line a)
    src1) =
      String -> LineNo -> String -> Map LineNo (Line a) -> Declaration a
    forall a.
    String -> LineNo -> String -> Map LineNo (Line a) -> Declaration a
    Declaration String
    file LineNo
    line String
    name (Map LineNo (Line a) -> Declaration a)
    -> Map LineNo (Line a) -> Declaration a
    forall a b. (a -> b) -> a -> b
    $
      (Line a -> Line a -> Line a)
    -> Map LineNo (Line a)
    -> Map LineNo (Line a)
    -> Map LineNo (Line a)
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    Map.unionWith Line a -> Line a -> Line a
    forall a. Semigroup a => Line a -> Line a -> Line a
    mergeLine Map LineNo (Line a)
    src0 Map LineNo (Line a)
    src1

    mergeDeclarations :: Semigroup a => [Declaration a] -> [Declaration a]
    mergeDeclarations :: forall a. Semigroup a => [Declaration a] -> [Declaration a]
    mergeDeclarations =
      Map (String, LineNo) (Declaration a) -> [Declaration a]
    forall k a. Map k a -> [a]
    Map.elems (Map (String, LineNo) (Declaration a) -> [Declaration a])
    -> ([Declaration a] -> Map (String, LineNo) (Declaration a))
    -> [Declaration a]
    -> [Declaration a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      (Declaration a -> Declaration a -> Declaration a)
    -> [((String, LineNo), Declaration a)]
    -> Map (String, LineNo) (Declaration a)
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith Declaration a -> Declaration a -> Declaration a
    forall a.
    Semigroup a =>
    Declaration a -> Declaration a -> Declaration a
    mergeDeclaration ([((String, LineNo), Declaration a)]
     -> Map (String, LineNo) (Declaration a))
    -> ([Declaration a] -> [((String, LineNo), Declaration a)])
    -> [Declaration a]
    -> Map (String, LineNo) (Declaration a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      (Declaration a -> ((String, LineNo), Declaration a))
    -> [Declaration a] -> [((String, LineNo), Declaration a)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\Declaration a
    d -> ((Declaration a -> String
    forall a. Declaration a -> String
    declarationFile Declaration a
    d, Declaration a -> LineNo
    forall a. Declaration a -> LineNo
    declarationLine Declaration a
    d), Declaration a
    d))

    ppTextLines :: String -> [Doc Markup]
    ppTextLines :: String -> [Doc Markup]
    ppTextLines =
      (String -> Doc Markup) -> [String] -> [Doc Markup]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> Doc Markup
    forall a. String -> Doc a
    WL.text ([String] -> [Doc Markup])
    -> (String -> [String]) -> String -> [Doc Markup]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    List.lines

    ppFailureReport :: MonadIO m => Config -> Maybe PropertyName -> TestCount -> DiscardCount -> Seed -> FailureReport -> m [Doc Markup]
    ppFailureReport :: forall (m :: * -> *).
    MonadIO m =>
    Config
    -> Maybe PropertyName
    -> TestCount
    -> DiscardCount
    -> Seed
    -> FailureReport
    -> m [Doc Markup]
    ppFailureReport Config
    config Maybe PropertyName
    name TestCount
    tests DiscardCount
    discards Seed
    seed (FailureReport ShrinkCount
    _ ShrinkPath
    shrinkPath Maybe (Coverage CoverCount)
    mcoverage [FailedAnnotation]
    inputs0 Maybe Span
    mlocation0 String
    msg Maybe Diff
    mdiff [String]
    msgs0) = do
      let
        basic :: ([Doc Markup], Maybe a)
    basic =
          -- Move the failure message to the end section if we have
          -- no source location or can't find the source file.
          let
            msgs1 :: [String]
    msgs1 =
              [String]
    msgs0 [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
              (if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    msg then [] else [String
    msg])

            docs :: [Doc Markup]
    docs =
              (String -> [Doc Markup]) -> [String] -> [Doc Markup]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap String -> [Doc Markup]
    ppTextLines [String]
    msgs1 [Doc Markup] -> [Doc Markup] -> [Doc Markup]
    forall a. [a] -> [a] -> [a]
    ++
              [Doc Markup]
    -> (Diff -> [Doc Markup]) -> Maybe Diff -> [Doc Markup]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] Diff -> [Doc Markup]
    ppDiff Maybe Diff
    mdiff
          in
            ([Doc Markup]
    docs, Maybe a
    forall a. Maybe a
    Nothing)

      (msgs1, mlocation) <-
        case Maybe Span
    mlocation0 of
          Maybe Span
    Nothing ->
            ([Doc Markup], Maybe (Declaration (Style, [(Style, Doc Markup)])))
    -> m ([Doc Markup],
          Maybe (Declaration (Style, [(Style, Doc Markup)])))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Doc Markup], Maybe (Declaration (Style, [(Style, Doc Markup)])))
    forall {a}. ([Doc Markup], Maybe a)
    basic

          Just Span
    location0 -> do
            mAdvanced <-
              [Doc Markup]
    -> Maybe Diff
    -> Span
    -> m (Maybe (Declaration (Style, [(Style, Doc Markup)])))
    forall (m :: * -> *).
    MonadIO m =>
    [Doc Markup]
    -> Maybe Diff
    -> Span
    -> m (Maybe (Declaration (Style, [(Style, Doc Markup)])))
    ppFailureLocation ((String -> Doc Markup) -> [String] -> [Doc Markup]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> Doc Markup
    forall a. String -> Doc a
    WL.text ([String] -> [Doc Markup]) -> [String] -> [Doc Markup]
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    List.lines String
    msg) Maybe Diff
    mdiff Span
    location0
            case mAdvanced of
              Just Declaration (Style, [(Style, Doc Markup)])
    advanced ->
                ([Doc Markup], Maybe (Declaration (Style, [(Style, Doc Markup)])))
    -> m ([Doc Markup],
          Maybe (Declaration (Style, [(Style, Doc Markup)])))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((String -> [Doc Markup]) -> [String] -> [Doc Markup]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap String -> [Doc Markup]
    ppTextLines [String]
    msgs0, Declaration (Style, [(Style, Doc Markup)])
    -> Maybe (Declaration (Style, [(Style, Doc Markup)]))
    forall a. a -> Maybe a
    Just Declaration (Style, [(Style, Doc Markup)])
    advanced)
              Maybe (Declaration (Style, [(Style, Doc Markup)]))
    Nothing ->
                ([Doc Markup], Maybe (Declaration (Style, [(Style, Doc Markup)])))
    -> m ([Doc Markup],
          Maybe (Declaration (Style, [(Style, Doc Markup)])))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Doc Markup], Maybe (Declaration (Style, [(Style, Doc Markup)])))
    forall {a}. ([Doc Markup], Maybe a)
    basic

      coverageLocations <-
        case mcoverage of
          Maybe (Coverage CoverCount)
    Nothing ->
            [Maybe (Declaration (Style, [(Style, Doc Markup)]))]
    -> m [Maybe (Declaration (Style, [(Style, Doc Markup)]))]
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []
          Just Coverage CoverCount
    coverage ->
            [Label CoverCount]
    -> (Label CoverCount
        -> m (Maybe (Declaration (Style, [(Style, Doc Markup)]))))
    -> m [Maybe (Declaration (Style, [(Style, Doc Markup)]))]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    t a -> (a -> f b) -> f (t b)
    for (TestCount -> Coverage CoverCount -> [Label CoverCount]
    coverageFailures TestCount
    tests Coverage CoverCount
    coverage) ((Label CoverCount
      -> m (Maybe (Declaration (Style, [(Style, Doc Markup)]))))
     -> m [Maybe (Declaration (Style, [(Style, Doc Markup)]))])
    -> (Label CoverCount
        -> m (Maybe (Declaration (Style, [(Style, Doc Markup)]))))
    -> m [Maybe (Declaration (Style, [(Style, Doc Markup)]))]
    forall a b. (a -> b) -> a -> b
    $ \(MkLabel LabelName
    _ Maybe Span
    mclocation CoverPercentage
    _ CoverCount
    count) ->
              case Maybe Span
    mclocation of
                Maybe Span
    Nothing ->
                  Maybe (Declaration (Style, [(Style, Doc Markup)]))
    -> m (Maybe (Declaration (Style, [(Style, Doc Markup)])))
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Declaration (Style, [(Style, Doc Markup)]))
    forall a. Maybe a
    Nothing
                Just Span
    clocation ->
                  let
                    coverageMsg :: Doc Markup
    coverageMsg =
                      [Doc Markup] -> Doc Markup
    forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
    WL.cat [
                          Doc Markup
    "Failed ("
                        , Markup -> Doc Markup -> Doc Markup
    forall a. a -> Doc a -> Doc a
    WL.annotate Markup
    CoverageText (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $
                            CoverPercentage -> Doc Markup
    ppCoverPercentage (TestCount -> CoverCount -> CoverPercentage
    coverPercentage TestCount
    tests CoverCount
    count) Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <> Doc Markup
    " coverage"
                        , Doc Markup
    ")"
                        ]
                  in
                    [Doc Markup]
    -> Maybe Diff
    -> Span
    -> m (Maybe (Declaration (Style, [(Style, Doc Markup)])))
    forall (m :: * -> *).
    MonadIO m =>
    [Doc Markup]
    -> Maybe Diff
    -> Span
    -> m (Maybe (Declaration (Style, [(Style, Doc Markup)])))
    ppFailureLocation [Doc Markup
    coverageMsg] Maybe Diff
    forall a. Maybe a
    Nothing Span
    clocation

      (args, idecls) <- fmap partitionEithers $ zipWithM ppFailedInput [0..] inputs0

      let
        decls :: [Declaration (Style, [(Style, Doc Markup)])]
        decls =
          [Declaration (Style, [(Style, Doc Markup)])]
    -> [Declaration (Style, [(Style, Doc Markup)])]
    forall a. Semigroup a => [Declaration a] -> [Declaration a]
    mergeDeclarations ([Declaration (Style, [(Style, Doc Markup)])]
     -> [Declaration (Style, [(Style, Doc Markup)])])
    -> [Declaration (Style, [(Style, Doc Markup)])]
    -> [Declaration (Style, [(Style, Doc Markup)])]
    forall a b. (a -> b) -> a -> b
    $
          [Maybe (Declaration (Style, [(Style, Doc Markup)]))]
    -> [Declaration (Style, [(Style, Doc Markup)])]
    forall a. [Maybe a] -> [a]
    catMaybes (Maybe (Declaration (Style, [(Style, Doc Markup)]))
    mlocation Maybe (Declaration (Style, [(Style, Doc Markup)]))
    -> [Maybe (Declaration (Style, [(Style, Doc Markup)]))]
    -> [Maybe (Declaration (Style, [(Style, Doc Markup)]))]
    forall a. a -> [a] -> [a]
    : [Maybe (Declaration (Style, [(Style, Doc Markup)]))]
    coverageLocations) [Declaration (Style, [(Style, Doc Markup)])]
    -> [Declaration (Style, [(Style, Doc Markup)])]
    -> [Declaration (Style, [(Style, Doc Markup)])]
    forall a. Semigroup a => a -> a -> a
    <> [Declaration (Style, [(Style, Doc Markup)])]
    idecls

        with t a
    xs t a -> a
    f =
          if t a -> Bool
    forall a. t a -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null t a
    xs then
            []
          else
            [t a -> a
    f t a
    xs]

        whenSome t a -> t a
    f t a
    xs =
          if t a -> Bool
    forall a. t a -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null t a
    xs then
            t a
    xs
          else
            t a -> t a
    f t a
    xs

        bottom = case Maybe (Coverage CoverCount)
    mcoverage of
          Maybe (Coverage CoverCount)
    Nothing | Config -> Bool
    configPrintReproduceMessage Config
    config ->
            [Maybe PropertyName -> Seed -> Skip -> Doc Markup
    ppReproduce Maybe PropertyName
    name Seed
    seed (TestCount -> DiscardCount -> ShrinkPath -> Skip
    SkipToShrink TestCount
    tests DiscardCount
    discards ShrinkPath
    shrinkPath)]
          Maybe (Coverage CoverCount)
    _ ->
            []

      pure .
        whenSome (mempty :) .
        whenSome (++ [mempty]) .
        WL.punctuate WL.line .
        fmap (WL.vsep . fmap (indentBy $ configPrintPrefixIcons config)) .
        fmap (id :: [Doc Markup] -> [Doc Markup]) .
        List.filter (not . null) $
        concat [
          with args $
            WL.punctuate WL.line
        , with decls $
            WL.punctuate WL.line . fmap (ppDeclaration . applyContext (configContext config))
        , with msgs1 $
            id
        , with bottom $
            id
        ]

    indentBy :: PrintPrefixIcons -> Doc a -> Doc a
    indentBy :: forall a. PrintPrefixIcons -> Doc a -> Doc a
    indentBy = \case
      PrintPrefixIcons
    DisablePrefixIcons ->
        Doc a -> Doc a
    forall a. a -> a
    id
      PrintPrefixIcons
    EnablePrefixIcons ->
        Int -> Doc a -> Doc a
    forall a. Int -> Doc a -> Doc a
    WL.indent Int
    2

    ppName :: Maybe PropertyName -> Doc a
    ppName :: forall a. Maybe PropertyName -> Doc a
    ppName = \case
      Maybe PropertyName
    Nothing ->
        Doc a
    "<interactive>" Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Doc a
    forall a. Doc a
    WL.space
      Just PropertyName
    "" ->
        Doc a
    forall a. Monoid a => a
    mempty
      Just (PropertyName String
    name) ->
        String -> Doc a
    forall a. String -> Doc a
    WL.text String
    name Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Doc a
    forall a. Doc a
    WL.space

    ppProgress :: MonadIO m => Maybe PropertyName -> Report Progress -> m (Doc Markup)
    ppProgress :: forall (m :: * -> *).
    MonadIO m =>
    Maybe PropertyName -> Report Progress -> m (Doc Markup)
    ppProgress Maybe PropertyName
    name (Report TestCount
    tests DiscardCount
    discards Coverage CoverCount
    coverage Seed
    _ Progress
    status) =
      case Progress
    status of
        Progress
    Running ->
          Doc Markup -> m (Doc Markup)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Doc Markup -> m (Doc Markup))
    -> ([Doc Markup] -> Doc Markup) -> [Doc Markup] -> m (Doc Markup)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc Markup] -> Doc Markup
    forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
    WL.vsep ([Doc Markup] -> m (Doc Markup)) -> [Doc Markup] -> m (Doc Markup)
    forall a b. (a -> b) -> a -> b
    $ [
              PrintPrefixIcons -> Markup -> Char -> Doc Markup -> Doc Markup
    icon PrintPrefixIcons
    EnablePrefixIcons Markup
    RunningIcon Char
    '●' (Doc Markup -> Doc Markup)
    -> (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Markup -> Doc Markup -> Doc Markup
    forall a. a -> Doc a -> Doc a
    WL.annotate Markup
    RunningHeader (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $
                Maybe PropertyName -> Doc Markup
    forall a. Maybe PropertyName -> Doc a
    ppName Maybe PropertyName
    name Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <>
                Doc Markup
    "passed" Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+>
                TestCount -> Doc Markup
    forall a. TestCount -> Doc a
    ppTestCount TestCount
    tests Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <>
                DiscardCount -> Doc Markup
    ppWithDiscardCount DiscardCount
    discards Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+>
                Doc Markup
    "(running)"
            ] [Doc Markup] -> [Doc Markup] -> [Doc Markup]
    forall a. [a] -> [a] -> [a]
    ++
            PrintPrefixIcons
    -> TestCount -> Coverage CoverCount -> [Doc Markup]
    ppCoverage PrintPrefixIcons
    EnablePrefixIcons TestCount
    tests Coverage CoverCount
    coverage

        Shrinking FailureReport
    failure ->
          Doc Markup -> m (Doc Markup)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Doc Markup -> m (Doc Markup))
    -> (Doc Markup -> Doc Markup) -> Doc Markup -> m (Doc Markup)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PrintPrefixIcons -> Markup -> Char -> Doc Markup -> Doc Markup
    icon PrintPrefixIcons
    EnablePrefixIcons Markup
    ShrinkingIcon Char
    '↯' (Doc Markup -> Doc Markup)
    -> (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Markup -> Doc Markup -> Doc Markup
    forall a. a -> Doc a -> Doc a
    WL.annotate Markup
    ShrinkingHeader (Doc Markup -> m (Doc Markup)) -> Doc Markup -> m (Doc Markup)
    forall a b. (a -> b) -> a -> b
    $
            Maybe PropertyName -> Doc Markup
    forall a. Maybe PropertyName -> Doc a
    ppName Maybe PropertyName
    name Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <>
            Doc Markup
    "failed" Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+> Maybe Span -> Doc Markup
    ppFailedAtLocation (FailureReport -> Maybe Span
    failureLocation FailureReport
    failure) Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <#>
            Doc Markup
    "after" Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+>
            TestCount -> Doc Markup
    forall a. TestCount -> Doc a
    ppTestCount TestCount
    tests Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <>
            ShrinkCount -> DiscardCount -> Doc Markup
    ppShrinkDiscard (FailureReport -> ShrinkCount
    failureShrinks FailureReport
    failure) DiscardCount
    discards Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+>
            Doc Markup
    "(shrinking)"

    ppResult :: MonadIO m => Maybe PropertyName -> Report Result -> m (Doc Markup)
    ppResult :: forall (m :: * -> *).
    MonadIO m =>
    Maybe PropertyName -> Report Result -> m (Doc Markup)
    ppResult = Config -> Maybe PropertyName -> Report Result -> m (Doc Markup)
    forall (m :: * -> *).
    MonadIO m =>
    Config -> Maybe PropertyName -> Report Result -> m (Doc Markup)
    ppResultWith Config
    defaultConfig

    ppResultWith :: MonadIO m => Config -> Maybe PropertyName -> Report Result -> m (Doc Markup)
    ppResultWith :: forall (m :: * -> *).
    MonadIO m =>
    Config -> Maybe PropertyName -> Report Result -> m (Doc Markup)
    ppResultWith Config
    config Maybe PropertyName
    name (Report TestCount
    tests DiscardCount
    discards Coverage CoverCount
    coverage Seed
    seed Result
    result) = do
      case Result
    result of
        Failed FailureReport
    failure -> do
          pfailure <- Config
    -> Maybe PropertyName
    -> TestCount
    -> DiscardCount
    -> Seed
    -> FailureReport
    -> m [Doc Markup]
    forall (m :: * -> *).
    MonadIO m =>
    Config
    -> Maybe PropertyName
    -> TestCount
    -> DiscardCount
    -> Seed
    -> FailureReport
    -> m [Doc Markup]
    ppFailureReport Config
    config Maybe PropertyName
    name TestCount
    tests DiscardCount
    discards Seed
    seed FailureReport
    failure
          pure . WL.vsep $ [
              icon (configPrintPrefixIcons config) FailedIcon '✗' . WL.align . WL.annotate FailedText $
                ppName name <>
                (
                  if configPrintFailedAtLocation config then
                    "failed" <+> ppFailedAtLocation (failureLocation failure) <#> "after"
                  else
                    "failed after"
                ) <+>
                ppTestCount tests <>
                ppShrinkDiscard (failureShrinks failure) discards <>
                "." <>
                (
                  if configPrintShrinkPath config then
                    WL.line <>
                    "shrink path:" <+>
                    ppSkip (SkipToShrink tests discards $ failureShrinkPath failure)
                  else
                    mempty
                )
            ] ++
            ppCoverage (configPrintPrefixIcons config) tests coverage ++
            pfailure

        Result
    GaveUp ->
          Doc Markup -> m (Doc Markup)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Doc Markup -> m (Doc Markup))
    -> ([Doc Markup] -> Doc Markup) -> [Doc Markup] -> m (Doc Markup)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc Markup] -> Doc Markup
    forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
    WL.vsep ([Doc Markup] -> m (Doc Markup)) -> [Doc Markup] -> m (Doc Markup)
    forall a b. (a -> b) -> a -> b
    $ [
              PrintPrefixIcons -> Markup -> Char -> Doc Markup -> Doc Markup
    icon (Config -> PrintPrefixIcons
    configPrintPrefixIcons Config
    config) Markup
    GaveUpIcon Char
    '⚐' (Doc Markup -> Doc Markup)
    -> (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Markup -> Doc Markup -> Doc Markup
    forall a. a -> Doc a -> Doc a
    WL.annotate Markup
    GaveUpText (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $
                Maybe PropertyName -> Doc Markup
    forall a. Maybe PropertyName -> Doc a
    ppName Maybe PropertyName
    name Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <>
                Doc Markup
    "gave up after" Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+>
                DiscardCount -> Doc Markup
    forall a. DiscardCount -> Doc a
    ppDiscardCount DiscardCount
    discards Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <>
                Doc Markup
    ", passed" Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+>
                TestCount -> Doc Markup
    forall a. TestCount -> Doc a
    ppTestCount TestCount
    tests Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <>
                Doc Markup
    "."
            ] [Doc Markup] -> [Doc Markup] -> [Doc Markup]
    forall a. [a] -> [a] -> [a]
    ++
            PrintPrefixIcons
    -> TestCount -> Coverage CoverCount -> [Doc Markup]
    ppCoverage (Config -> PrintPrefixIcons
    configPrintPrefixIcons Config
    config) TestCount
    tests Coverage CoverCount
    coverage

        Result
    OK ->
          Doc Markup -> m (Doc Markup)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Doc Markup -> m (Doc Markup))
    -> ([Doc Markup] -> Doc Markup) -> [Doc Markup] -> m (Doc Markup)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc Markup] -> Doc Markup
    forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
    WL.vsep ([Doc Markup] -> m (Doc Markup)) -> [Doc Markup] -> m (Doc Markup)
    forall a b. (a -> b) -> a -> b
    $ [
              PrintPrefixIcons -> Markup -> Char -> Doc Markup -> Doc Markup
    icon (Config -> PrintPrefixIcons
    configPrintPrefixIcons Config
    config) Markup
    SuccessIcon Char
    '✓' (Doc Markup -> Doc Markup)
    -> (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Markup -> Doc Markup -> Doc Markup
    forall a. a -> Doc a -> Doc a
    WL.annotate Markup
    SuccessText (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $
                Maybe PropertyName -> Doc Markup
    forall a. Maybe PropertyName -> Doc a
    ppName Maybe PropertyName
    name Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <>
                Doc Markup
    "passed" Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+>
                TestCount -> Doc Markup
    forall a. TestCount -> Doc a
    ppTestCount TestCount
    tests Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <>
                Doc Markup
    "."
            ] [Doc Markup] -> [Doc Markup] -> [Doc Markup]
    forall a. [a] -> [a] -> [a]
    ++
            PrintPrefixIcons
    -> TestCount -> Coverage CoverCount -> [Doc Markup]
    ppCoverage (Config -> PrintPrefixIcons
    configPrintPrefixIcons Config
    config) TestCount
    tests Coverage CoverCount
    coverage

    ppFailedAtLocation :: Maybe Span -> Doc Markup
    ppFailedAtLocation :: Maybe Span -> Doc Markup
    ppFailedAtLocation = \case
      Just Span
    x ->
        Doc Markup
    "at" Doc Markup -> Doc Markup -> Doc Markup
    forall a. Doc a -> Doc a -> Doc a
    <+>
        String -> Doc Markup
    forall a. String -> Doc a
    WL.text (Span -> String
    spanFile Span
    x) Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <> Doc Markup
    ":" Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <>
        Int -> Doc Markup
    forall b. Int -> Doc b
    forall a b. Pretty a => a -> Doc b
    WL.pretty (LineNo -> Int
    unLineNo (Span -> LineNo
    spanStartLine Span
    x)) Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <> Doc Markup
    ":" Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <>
        Int -> Doc Markup
    forall b. Int -> Doc b
    forall a b. Pretty a => a -> Doc b
    WL.pretty (ColumnNo -> Int
    unColumnNo (Span -> ColumnNo
    spanStartColumn Span
    x))
      Maybe Span
    Nothing ->
        Doc Markup
    forall a. Monoid a => a
    mempty

    ppCoverage :: PrintPrefixIcons -> TestCount -> Coverage CoverCount -> [Doc Markup]
    ppCoverage :: PrintPrefixIcons
    -> TestCount -> Coverage CoverCount -> [Doc Markup]
    ppCoverage PrintPrefixIcons
    icons TestCount
    tests Coverage CoverCount
    x =
      if Map LabelName (Label CoverCount) -> Bool
    forall k a. Map k a -> Bool
    Map.null (Coverage CoverCount -> Map LabelName (Label CoverCount)
    forall a. Coverage a -> Map LabelName (Label a)
    coverageLabels Coverage CoverCount
    x) then
        [Doc Markup]
    forall a. Monoid a => a
    mempty
      else
        (Label CoverCount -> Doc Markup)
    -> [Label CoverCount] -> [Doc Markup]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (PrintPrefixIcons
    -> TestCount -> ColumnWidth -> Label CoverCount -> Doc Markup
    ppLabel PrintPrefixIcons
    icons TestCount
    tests (TestCount -> Coverage CoverCount -> ColumnWidth
    coverageWidth TestCount
    tests Coverage CoverCount
    x)) ([Label CoverCount] -> [Doc Markup])
    -> ([Label CoverCount] -> [Label CoverCount])
    -> [Label CoverCount]
    -> [Doc Markup]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        (Label CoverCount -> Maybe Span)
    -> [Label CoverCount] -> [Label CoverCount]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    List.sortOn Label CoverCount -> Maybe Span
    forall a. Label a -> Maybe Span
    labelLocation ([Label CoverCount] -> [Doc Markup])
    -> [Label CoverCount] -> [Doc Markup]
    forall a b. (a -> b) -> a -> b
    $
        Map LabelName (Label CoverCount) -> [Label CoverCount]
    forall k a. Map k a -> [a]
    Map.elems (Coverage CoverCount -> Map LabelName (Label CoverCount)
    forall a. Coverage a -> Map LabelName (Label a)
    coverageLabels Coverage CoverCount
    x)

    data ColumnWidth =
      ColumnWidth {
          ColumnWidth -> Int
    widthPercentage :: !Int
        , ColumnWidth -> Int
    widthMinimum :: !Int
        , ColumnWidth -> Int
    widthName :: !Int
        , ColumnWidth -> Int
    _widthNameFail :: !Int
        }

    instance Semigroup ColumnWidth where
      <> :: ColumnWidth -> ColumnWidth -> ColumnWidth
    (<>) (ColumnWidth Int
    p0 Int
    m0 Int
    n0 Int
    f0) (ColumnWidth Int
    p1 Int
    m1 Int
    n1 Int
    f1) =
        Int -> Int -> Int -> Int -> ColumnWidth
    ColumnWidth
          (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    p0 Int
    p1)
          (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    m0 Int
    m1)
          (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    n0 Int
    n1)
          (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    f0 Int
    f1)

    instance Monoid ColumnWidth where
      mempty :: ColumnWidth
    mempty =
        Int -> Int -> Int -> Int -> ColumnWidth
    ColumnWidth Int
    0 Int
    0 Int
    0 Int
    0
      mappend :: ColumnWidth -> ColumnWidth -> ColumnWidth
    mappend =
        ColumnWidth -> ColumnWidth -> ColumnWidth
    forall a. Semigroup a => a -> a -> a
    (<>)

    coverageWidth :: TestCount -> Coverage CoverCount -> ColumnWidth
    coverageWidth :: TestCount -> Coverage CoverCount -> ColumnWidth
    coverageWidth TestCount
    tests (Coverage Map LabelName (Label CoverCount)
    labels) =
      (Label CoverCount -> ColumnWidth)
    -> Map LabelName (Label CoverCount) -> ColumnWidth
    forall m a. Monoid m => (a -> m) -> Map LabelName a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap (TestCount -> Label CoverCount -> ColumnWidth
    labelWidth TestCount
    tests) Map LabelName (Label CoverCount)
    labels

    labelWidth :: TestCount -> Label CoverCount -> ColumnWidth
    labelWidth :: TestCount -> Label CoverCount -> ColumnWidth
    labelWidth TestCount
    tests Label CoverCount
    x =
      let
        percentage :: Int
    percentage =
          String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Int) -> (CoverCount -> String) -> CoverCount -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
          CoverPercentage -> String
    renderCoverPercentage (CoverPercentage -> String)
    -> (CoverCount -> CoverPercentage) -> CoverCount -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
          TestCount -> CoverCount -> CoverPercentage
    coverPercentage TestCount
    tests (CoverCount -> Int) -> CoverCount -> Int
    forall a b. (a -> b) -> a -> b
    $
          Label CoverCount -> CoverCount
    forall a. Label a -> a
    labelAnnotation Label CoverCount
    x

        minimum_ :: Int
    minimum_ =
          if Label CoverCount -> CoverPercentage
    forall a. Label a -> CoverPercentage
    labelMinimum Label CoverCount
    x CoverPercentage -> CoverPercentage -> Bool
    forall a. Eq a => a -> a -> Bool
    == CoverPercentage
    0 then
            Int
    0
          else
            String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Int)
    -> (CoverPercentage -> String) -> CoverPercentage -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
            CoverPercentage -> String
    renderCoverPercentage (CoverPercentage -> Int) -> CoverPercentage -> Int
    forall a b. (a -> b) -> a -> b
    $
            Label CoverCount -> CoverPercentage
    forall a. Label a -> CoverPercentage
    labelMinimum Label CoverCount
    x

        name :: Int
    name =
          String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Int) -> (LabelName -> String) -> LabelName -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
          LabelName -> String
    unLabelName (LabelName -> Int) -> LabelName -> Int
    forall a b. (a -> b) -> a -> b
    $
          Label CoverCount -> LabelName
    forall a. Label a -> LabelName
    labelName Label CoverCount
    x

        nameFail :: Int
    nameFail =
          if TestCount -> Label CoverCount -> Bool
    labelCovered TestCount
    tests Label CoverCount
    x then
            Int
    0
          else
            Int
    name
      in
        Int -> Int -> Int -> Int -> ColumnWidth
    ColumnWidth Int
    percentage Int
    minimum_ Int
    name Int
    nameFail

    ppLeftPad :: Int -> Doc a -> Doc a
    ppLeftPad :: forall a. Int -> Doc a -> Doc a
    ppLeftPad Int
    n Doc a
    doc =
      let
        ndoc :: Int
    ndoc =
          String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (Doc a -> String
    forall a. Show a => a -> String
    show Doc a
    doc)

        pad :: Doc a
    pad =
          String -> Doc a
    forall a. String -> Doc a
    WL.text (String -> Doc a) -> String -> Doc a
    forall a b. (a -> b) -> a -> b
    $
            Int -> Char -> String
    forall a. Int -> a -> [a]
    List.replicate (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    ndoc) Char
    ' '
      in
        Doc a
    forall a. Doc a
    pad Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Doc a
    doc

    ppLabel :: PrintPrefixIcons -> TestCount -> ColumnWidth -> Label CoverCount -> Doc Markup
    ppLabel :: PrintPrefixIcons
    -> TestCount -> ColumnWidth -> Label CoverCount -> Doc Markup
    ppLabel PrintPrefixIcons
    icons TestCount
    tests ColumnWidth
    w x :: Label CoverCount
    x@(MkLabel LabelName
    name Maybe Span
    _ CoverPercentage
    minimum_ CoverCount
    count) =
      let
        covered :: Bool
    covered =
          TestCount -> Label CoverCount -> Bool
    labelCovered TestCount
    tests Label CoverCount
    x

        ltext :: Doc Markup -> Doc Markup
    ltext =
          if Bool -> Bool
    not Bool
    covered then
            Markup -> Doc Markup -> Doc Markup
    forall a. a -> Doc a -> Doc a
    WL.annotate Markup
    CoverageText
          else
            Doc Markup -> Doc Markup
    forall a. a -> a
    id

        lborder :: Doc Markup -> Doc Markup
    lborder =
          Markup -> Doc Markup -> Doc Markup
    forall a. a -> Doc a -> Doc a
    WL.annotate (Style -> Markup
    StyledBorder Style
    StyleDefault)

        licon :: Doc Markup
    licon = case PrintPrefixIcons
    icons of
          PrintPrefixIcons
    DisablePrefixIcons ->
            Doc Markup
    forall a. Monoid a => a
    mempty
          PrintPrefixIcons
    EnablePrefixIcons ->
            if Bool -> Bool
    not Bool
    covered then
              Markup -> Doc Markup -> Doc Markup
    forall a. a -> Doc a -> Doc a
    WL.annotate Markup
    CoverageText Doc Markup
    "⚠ "
            else
              Doc Markup
    "  "

        lname :: Doc a
    lname =
          Int -> Doc a -> Doc a
    forall a. Int -> Doc a -> Doc a
    WL.fill (ColumnWidth -> Int
    widthName ColumnWidth
    w) (LabelName -> Doc a
    forall a. LabelName -> Doc a
    ppLabelName LabelName
    name)

        wminimum :: Doc Markup
    wminimum =
          Int -> Doc Markup -> Doc Markup
    forall a. Int -> Doc a -> Doc a
    ppLeftPad (ColumnWidth -> Int
    widthMinimum ColumnWidth
    w) (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $
            CoverPercentage -> Doc Markup
    ppCoverPercentage CoverPercentage
    minimum_

        wcover :: String -> Doc Markup
    wcover String
    i =
          Int -> Doc Markup -> Doc Markup
    forall a. Int -> Doc a -> Doc a
    ppLeftPad (ColumnWidth -> Int
    widthPercentage ColumnWidth
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    i) (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $
            String -> Doc Markup
    forall a. String -> Doc a
    WL.text String
    i Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <>
            CoverPercentage -> Doc Markup
    ppCoverPercentage (TestCount -> CoverCount -> CoverPercentage
    coverPercentage TestCount
    tests CoverCount
    count)

        lminimum :: Doc Markup
    lminimum =
          if ColumnWidth -> Int
    widthMinimum ColumnWidth
    w Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 then
            Doc Markup
    forall a. Monoid a => a
    mempty
          else if Bool -> Bool
    not Bool
    covered then
            Doc Markup
    " ✗ " Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <> Doc Markup
    wminimum
          else if CoverPercentage
    minimum_ CoverPercentage -> CoverPercentage -> Bool
    forall a. Eq a => a -> a -> Bool
    == CoverPercentage
    0 then
            Doc Markup
    "   " Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <> Int -> Doc Markup -> Doc Markup
    forall a. Int -> Doc a -> Doc a
    ppLeftPad (ColumnWidth -> Int
    widthMinimum ColumnWidth
    w) Doc Markup
    ""
          else
            Doc Markup
    " ✓ " Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <> Doc Markup
    wminimum

        lcover :: Doc Markup
    lcover =
          if ColumnWidth -> Int
    widthMinimum ColumnWidth
    w Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 then
            String -> Doc Markup
    wcover String
    ""
          else if Bool -> Bool
    not Bool
    covered then
            String -> Doc Markup
    wcover String
    ""
          else if CoverPercentage
    minimum_ CoverPercentage -> CoverPercentage -> Bool
    forall a. Eq a => a -> a -> Bool
    == CoverPercentage
    0 then
            String -> Doc Markup
    wcover String
    ""
          else
            String -> Doc Markup
    wcover String
    ""
      in
        [Doc Markup] -> Doc Markup
    forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
    WL.hcat [
            Doc Markup
    licon
          , Doc Markup -> Doc Markup
    ltext Doc Markup
    forall a. Doc a
    lname
          , Doc Markup -> Doc Markup
    lborder Doc Markup
    " "
          , Doc Markup -> Doc Markup
    ltext Doc Markup
    lcover
          , Doc Markup -> Doc Markup
    lborder Doc Markup
    " "
          , Doc Markup -> Doc Markup
    ltext (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $ CoverPercentage -> CoverPercentage -> Doc Markup
    ppCoverBar (TestCount -> CoverCount -> CoverPercentage
    coverPercentage TestCount
    tests CoverCount
    count) CoverPercentage
    minimum_
          , Doc Markup -> Doc Markup
    lborder Doc Markup
    "" -- "│"
          , Doc Markup -> Doc Markup
    ltext Doc Markup
    lminimum
          ]

    ppLabelName :: LabelName -> Doc a
    ppLabelName :: forall a. LabelName -> Doc a
    ppLabelName (LabelName String
    name) =
      String -> Doc a
    forall a. String -> Doc a
    WL.text String
    name

    ppCoverPercentage :: CoverPercentage -> Doc Markup
    ppCoverPercentage :: CoverPercentage -> Doc Markup
    ppCoverPercentage =
      String -> Doc Markup
    forall a. String -> Doc a
    WL.text (String -> Doc Markup)
    -> (CoverPercentage -> String) -> CoverPercentage -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoverPercentage -> String
    renderCoverPercentage

    ppCoverBar :: CoverPercentage -> CoverPercentage -> Doc Markup
    ppCoverBar :: CoverPercentage -> CoverPercentage -> Doc Markup
    ppCoverBar (CoverPercentage Double
    percentage) (CoverPercentage Double
    minimum_) =
      let
        barWidth :: Int
        barWidth :: Int
    barWidth =
          Int
    20

        coverageRatio :: Double
        coverageRatio :: Double
    coverageRatio =
          Double
    percentage Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    100.0

        coverageWidth_ :: Int
        coverageWidth_ :: Int
    coverageWidth_ =
          Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Double -> Int) -> Double -> Int
    forall a b. (a -> b) -> a -> b
    $
            Double
    coverageRatio Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    barWidth

        minimumRatio :: Double
        minimumRatio :: Double
    minimumRatio =
          Double
    minimum_ Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    100.0

        minimumWidth :: Int
        minimumWidth :: Int
    minimumWidth =
          Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Double -> Int) -> Double -> Int
    forall a b. (a -> b) -> a -> b
    $
            Double
    minimumRatio Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    barWidth

        index :: [a] -> Int
        index :: forall a. [a] -> Int
    index [a]
    xs =
          Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Double -> Int) -> Double -> Int
    forall a b. (a -> b) -> a -> b
    $
            ((Double
    coverageRatio Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    barWidth) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    coverageWidth_) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    *
            Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ([a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    xs)

        part :: [a] -> a
    part [a]
    xs =
          [a]
    xs [a] -> Int -> a
    forall a. HasCallStack => [a] -> Int -> a
    !! [a] -> Int
    forall a. [a] -> Int
    index [a]
    xs

        fillWidth :: Int
    fillWidth =
          Int
    barWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    coverageWidth_ Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1

        fillErrorWidth :: Int
    fillErrorWidth =
          Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (Int
    minimumWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    coverageWidth_ Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)

        fillSurplusWidth :: Int
    fillSurplusWidth =
          Int
    fillWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fillErrorWidth

        bar :: (Char, [Char]) -> Doc Markup
        bar :: (Char, String) -> Doc Markup
    bar (Char
    full, String
    parts) =
          [Doc Markup] -> Doc Markup
    forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
    WL.hcat [
            String -> Doc Markup
    forall a. String -> Doc a
    WL.text (String -> Doc Markup) -> String -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    coverageWidth_ Char
    full
          , if Int
    fillWidth Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0 then
              if String -> Int
    forall a. [a] -> Int
    index String
    parts Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 then
                if Int
    fillErrorWidth Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 then
                  Markup -> Doc Markup -> Doc Markup
    forall a. a -> Doc a -> Doc a
    WL.annotate Markup
    FailedText (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $ String -> Doc Markup
    forall a. String -> Doc a
    WL.text [String -> Char
    forall {a}. [a] -> a
    part String
    parts]
                else
                  Markup -> Doc Markup -> Doc Markup
    forall a. a -> Doc a -> Doc a
    WL.annotate Markup
    CoverageFill (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $ String -> Doc Markup
    forall a. String -> Doc a
    WL.text [String -> Char
    forall {a}. [a] -> a
    part String
    parts]
              else
                String -> Doc Markup
    forall a. String -> Doc a
    WL.text [String -> Char
    forall {a}. [a] -> a
    part String
    parts]
            else
              Doc Markup
    ""
          , Markup -> Doc Markup -> Doc Markup
    forall a. a -> Doc a -> Doc a
    WL.annotate Markup
    FailedText (Doc Markup -> Doc Markup)
    -> (String -> Doc Markup) -> String -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Doc Markup
    forall a. String -> Doc a
    WL.text (String -> Doc Markup) -> String -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $
              Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    fillErrorWidth (String -> Char
    forall a. HasCallStack => [a] -> a
    head String
    parts)
          , Markup -> Doc Markup -> Doc Markup
    forall a. a -> Doc a -> Doc a
    WL.annotate Markup
    CoverageFill (Doc Markup -> Doc Markup)
    -> (String -> Doc Markup) -> String -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Doc Markup
    forall a. String -> Doc a
    WL.text (String -> Doc Markup) -> String -> Doc Markup
    forall a b. (a -> b) -> a -> b
    $
              Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    fillSurplusWidth (String -> Char
    forall a. HasCallStack => [a] -> a
    head String
    parts)
          --
          -- Uncomment when debugging:
          --
          -- , WL.annotate CoverageFill . WL.text $
          --        " " ++ show barWidth
          --     ++ " " ++ show coverageWidth_
          --     ++ " " ++ show minimumWidth
          --     ++ " " ++ "/"
          --     ++ " " ++ show fillErrorWidth
          --     ++ " " ++ "+"
          --     ++ " " ++ show fillSurplusWidth
          --     ++ " " ++ "="
          --     ++ " " ++ show fillWidth
          ]
      in
        (Char, String) -> Doc Markup
    bar (Char
    '█', [Char
    '·', Char
    '▏', Char
    '▎', Char
    '▍', Char
    '▌', Char
    '▋', Char
    '▊', Char
    '▉'])

        -- FIXME Maybe this should be configurable?
        -- Alternative histogram bars:
        --bar ('⣿', ['·', '⡀', '⡄', '⡆', '⡇', '⣇', '⣧', '⣷'])
        --bar ('⣿', ['⢕', '⡀', '⣀', '⣄', '⣤', '⣦', '⣶', '⣷'])
        --bar ('⣿', ['⢕', '⡵', '⢗', '⣗', '⣟'])
        --bar ('⣿', [' ', '⡵', '⢗', '⣗', '⣟'])
        --bar ('█', ['░','▓'])
        --bar ('█', ['░'])

    renderCoverPercentage :: CoverPercentage -> String
    renderCoverPercentage :: CoverPercentage -> String
    renderCoverPercentage (CoverPercentage Double
    percentage) =
      String -> Double -> String
    forall r. PrintfType r => String -> r
    printf String
    "%.0f" Double
    percentage String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    "%"

    ppWhenNonZero :: Doc a -> PropertyCount -> Maybe (Doc a)
    ppWhenNonZero :: forall a. Doc a -> PropertyCount -> Maybe (Doc a)
    ppWhenNonZero Doc a
    suffix PropertyCount
    n =
      if PropertyCount
    n PropertyCount -> PropertyCount -> Bool
    forall a. Ord a => a -> a -> Bool
    <= PropertyCount
    0 then
        Maybe (Doc a)
    forall a. Maybe a
    Nothing
      else
        Doc a -> Maybe (Doc a)
    forall a. a -> Maybe a
    Just (Doc a -> Maybe (Doc a)) -> Doc a -> Maybe (Doc a)
    forall a b. (a -> b) -> a -> b
    $ PropertyCount -> Doc a
    forall a. PropertyCount -> Doc a
    ppRawPropertyCount PropertyCount
    n Doc a -> Doc a -> Doc a
    forall a. Doc a -> Doc a -> Doc a
    <+> Doc a
    suffix

    annotateSummary :: Summary -> Doc Markup -> Doc Markup
    annotateSummary :: Summary -> Doc Markup -> Doc Markup
    annotateSummary Summary
    summary =
      if Summary -> PropertyCount
    summaryFailed Summary
    summary PropertyCount -> PropertyCount -> Bool
    forall a. Ord a => a -> a -> Bool
    > PropertyCount
    0 then
        PrintPrefixIcons -> Markup -> Char -> Doc Markup -> Doc Markup
    icon PrintPrefixIcons
    EnablePrefixIcons Markup
    FailedIcon Char
    '✗' (Doc Markup -> Doc Markup)
    -> (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Markup -> Doc Markup -> Doc Markup
    forall a. a -> Doc a -> Doc a
    WL.annotate Markup
    FailedText
      else if Summary -> PropertyCount
    summaryGaveUp Summary
    summary PropertyCount -> PropertyCount -> Bool
    forall a. Ord a => a -> a -> Bool
    > PropertyCount
    0 then
        PrintPrefixIcons -> Markup -> Char -> Doc Markup -> Doc Markup
    icon PrintPrefixIcons
    EnablePrefixIcons Markup
    GaveUpIcon Char
    '⚐' (Doc Markup -> Doc Markup)
    -> (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Markup -> Doc Markup -> Doc Markup
    forall a. a -> Doc a -> Doc a
    WL.annotate Markup
    GaveUpText
      else if Summary -> PropertyCount
    summaryWaiting Summary
    summary PropertyCount -> PropertyCount -> Bool
    forall a. Ord a => a -> a -> Bool
    > PropertyCount
    0 Bool -> Bool -> Bool
    || Summary -> PropertyCount
    summaryRunning Summary
    summary PropertyCount -> PropertyCount -> Bool
    forall a. Ord a => a -> a -> Bool
    > PropertyCount
    0 then
        PrintPrefixIcons -> Markup -> Char -> Doc Markup -> Doc Markup
    icon PrintPrefixIcons
    EnablePrefixIcons Markup
    WaitingIcon Char
    '○' (Doc Markup -> Doc Markup)
    -> (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Markup -> Doc Markup -> Doc Markup
    forall a. a -> Doc a -> Doc a
    WL.annotate Markup
    WaitingHeader
      else
        PrintPrefixIcons -> Markup -> Char -> Doc Markup -> Doc Markup
    icon PrintPrefixIcons
    EnablePrefixIcons Markup
    SuccessIcon Char
    '✓' (Doc Markup -> Doc Markup)
    -> (Doc Markup -> Doc Markup) -> Doc Markup -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Markup -> Doc Markup -> Doc Markup
    forall a. a -> Doc a -> Doc a
    WL.annotate Markup
    SuccessText

    ppSummary :: MonadIO m => Summary -> m (Doc Markup)
    ppSummary :: forall (m :: * -> *). MonadIO m => Summary -> m (Doc Markup)
    ppSummary Summary
    summary =
      let
        complete :: Bool
    complete =
          Summary -> PropertyCount
    summaryCompleted Summary
    summary PropertyCount -> PropertyCount -> Bool
    forall a. Eq a => a -> a -> Bool
    == Summary -> PropertyCount
    summaryTotal Summary
    summary

        prefix :: Doc a -> Doc a
    prefix Doc a
    end =
          if Bool
    complete then
            Doc a
    forall a. Monoid a => a
    mempty
          else
            PropertyCount -> Doc a
    forall a. PropertyCount -> Doc a
    ppRawPropertyCount (Summary -> PropertyCount
    summaryCompleted Summary
    summary) Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <>
            Doc a
    "/" Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <>
            PropertyCount -> Doc a
    forall a. PropertyCount -> Doc a
    ppRawPropertyCount (Summary -> PropertyCount
    summaryTotal Summary
    summary) Doc a -> Doc a -> Doc a
    forall a. Doc a -> Doc a -> Doc a
    <+>
            Doc a
    "complete" Doc a -> Doc a -> Doc a
    forall a. Semigroup a => a -> a -> a
    <> Doc a
    end

        addPrefix :: [Doc a] -> [Doc a]
    addPrefix [Doc a]
    xs =
          if [Doc a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Doc a]
    xs then
            Doc a -> Doc a
    forall a. Doc a -> Doc a
    prefix Doc a
    forall a. Monoid a => a
    mempty Doc a -> [Doc a] -> [Doc a]
    forall a. a -> [a] -> [a]
    : []
          else
            Doc a -> Doc a
    forall a. Doc a -> Doc a
    prefix Doc a
    ": " Doc a -> [Doc a] -> [Doc a]
    forall a. a -> [a] -> [a]
    : [Doc a]
    xs

        suffix :: Doc Markup
    suffix =
          if Bool
    complete then
            Doc Markup
    "."
          else
            Doc Markup
    " (running)"
      in
        Doc Markup -> m (Doc Markup)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Doc Markup -> m (Doc Markup))
    -> ([Doc Markup] -> Doc Markup) -> [Doc Markup] -> m (Doc Markup)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
          Summary -> Doc Markup -> Doc Markup
    annotateSummary Summary
    summary (Doc Markup -> Doc Markup)
    -> ([Doc Markup] -> Doc Markup) -> [Doc Markup] -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
          (Doc Markup -> Doc Markup -> Doc Markup
    forall a. Semigroup a => a -> a -> a
    <> Doc Markup
    suffix) (Doc Markup -> Doc Markup)
    -> ([Doc Markup] -> Doc Markup) -> [Doc Markup] -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
          [Doc Markup] -> Doc Markup
    forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
    WL.hcat ([Doc Markup] -> Doc Markup)
    -> ([Doc Markup] -> [Doc Markup]) -> [Doc Markup] -> Doc Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
          [Doc Markup] -> [Doc Markup]
    forall {a}. [Doc a] -> [Doc a]
    addPrefix ([Doc Markup] -> [Doc Markup])
    -> ([Doc Markup] -> [Doc Markup]) -> [Doc Markup] -> [Doc Markup]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
          Doc Markup -> [Doc Markup] -> [Doc Markup]
    forall (f :: * -> *) a.
    Traversable f =>
    Doc a -> f (Doc a) -> f (Doc a)
    WL.punctuate Doc Markup
    ", " ([Doc Markup] -> m (Doc Markup)) -> [Doc Markup] -> m (Doc Markup)
    forall a b. (a -> b) -> a -> b
    $
          [Maybe (Doc Markup)] -> [Doc Markup]
    forall a. [Maybe a] -> [a]
    catMaybes [
              Doc Markup -> PropertyCount -> Maybe (Doc Markup)
    forall a. Doc a -> PropertyCount -> Maybe (Doc a)
    ppWhenNonZero Doc Markup
    "failed" (Summary -> PropertyCount
    summaryFailed Summary
    summary)
            , Doc Markup -> PropertyCount -> Maybe (Doc Markup)
    forall a. Doc a -> PropertyCount -> Maybe (Doc a)
    ppWhenNonZero Doc Markup
    "gave up" (Summary -> PropertyCount
    summaryGaveUp Summary
    summary)
            , if Bool
    complete then
                Doc Markup -> PropertyCount -> Maybe (Doc Markup)
    forall a. Doc a -> PropertyCount -> Maybe (Doc a)
    ppWhenNonZero Doc Markup
    "succeeded" (Summary -> PropertyCount
    summaryOK Summary
    summary)
              else
                Maybe (Doc Markup)
    forall a. Maybe a
    Nothing
            ]

    renderDoc :: MonadIO m => UseColor -> Doc Markup -> m String
    renderDoc :: forall (m :: * -> *).
    MonadIO m =>
    UseColor -> Doc Markup -> m String
    renderDoc UseColor
    color Doc Markup
    doc = do
      let
        dull :: Color -> SGR
    dull =
          ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Dull

        vivid :: Color -> SGR
    vivid =
          ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Vivid

        bold :: SGR
    bold =
          ConsoleIntensity -> SGR
    SetConsoleIntensity ConsoleIntensity
    BoldIntensity

        start :: Markup -> String
    start = \case
          Markup
    WaitingIcon ->
            [SGR] -> String
    setSGRCode []
          Markup
    WaitingHeader ->
            [SGR] -> String
    setSGRCode []
          Markup
    RunningIcon ->
            [SGR] -> String
    setSGRCode []
          Markup
    RunningHeader ->
            [SGR] -> String
    setSGRCode []
          Markup
    ShrinkingIcon ->
            [SGR] -> String
    setSGRCode [Color -> SGR
    vivid Color
    Red]
          Markup
    ShrinkingHeader ->
            [SGR] -> String
    setSGRCode [Color -> SGR
    vivid Color
    Red]
          Markup
    FailedIcon ->
            [SGR] -> String
    setSGRCode [Color -> SGR
    vivid Color
    Red]
          Markup
    FailedText ->
            [SGR] -> String
    setSGRCode [Color -> SGR
    vivid Color
    Red]
          Markup
    GaveUpIcon ->
            [SGR] -> String
    setSGRCode [Color -> SGR
    dull Color
    Yellow]
          Markup
    GaveUpText ->
            [SGR] -> String
    setSGRCode [Color -> SGR
    dull Color
    Yellow]
          Markup
    SuccessIcon ->
            [SGR] -> String
    setSGRCode [Color -> SGR
    dull Color
    Green]
          Markup
    SuccessText ->
            [SGR] -> String
    setSGRCode [Color -> SGR
    dull Color
    Green]
          Markup
    CoverageIcon ->
            [SGR] -> String
    setSGRCode [Color -> SGR
    dull Color
    Yellow]
          Markup
    CoverageText ->
            [SGR] -> String
    setSGRCode [Color -> SGR
    dull Color
    Yellow]
          Markup
    CoverageFill ->
            [SGR] -> String
    setSGRCode [Color -> SGR
    vivid Color
    Black]

          Markup
    DeclarationLocation ->
            [SGR] -> String
    setSGRCode []

          StyledLineNo Style
    StyleDefault ->
            [SGR] -> String
    setSGRCode []
          StyledSource Style
    StyleDefault ->
            [SGR] -> String
    setSGRCode []
          StyledBorder Style
    StyleDefault ->
            [SGR] -> String
    setSGRCode []

          StyledLineNo Style
    StyleAnnotation ->
            [SGR] -> String
    setSGRCode [Color -> SGR
    dull Color
    Magenta]
          StyledSource Style
    StyleAnnotation ->
            [SGR] -> String
    setSGRCode []
          StyledBorder Style
    StyleAnnotation ->
            [SGR] -> String
    setSGRCode []
          Markup
    AnnotationGutter ->
            [SGR] -> String
    setSGRCode [Color -> SGR
    dull Color
    Magenta]
          Markup
    AnnotationValue ->
            [SGR] -> String
    setSGRCode [Color -> SGR
    dull Color
    Magenta]

          StyledLineNo Style
    StyleFailure ->
            [SGR] -> String
    setSGRCode [Color -> SGR
    vivid Color
    Red]
          StyledSource Style
    StyleFailure ->
            [SGR] -> String
    setSGRCode [Color -> SGR
    vivid Color
    Red, SGR
    bold]
          StyledBorder Style
    StyleFailure ->
            [SGR] -> String
    setSGRCode []
          Markup
    FailureArrows ->
            [SGR] -> String
    setSGRCode [Color -> SGR
    vivid Color
    Red]
          Markup
    FailureMessage ->
            [SGR] -> String
    setSGRCode []
          Markup
    FailureGutter ->
            [SGR] -> String
    setSGRCode []

          Markup
    DiffPrefix ->
            [SGR] -> String
    setSGRCode []
          Markup
    DiffInfix ->
            [SGR] -> String
    setSGRCode []
          Markup
    DiffSuffix ->
            [SGR] -> String
    setSGRCode []
          Markup
    DiffSame ->
            [SGR] -> String
    setSGRCode []
          Markup
    DiffRemoved ->
            [SGR] -> String
    setSGRCode [Color -> SGR
    dull Color
    Red]
          Markup
    DiffAdded ->
            [SGR] -> String
    setSGRCode [Color -> SGR
    dull Color
    Green]

          Markup
    ReproduceHeader ->
            [SGR] -> String
    setSGRCode []
          Markup
    ReproduceGutter ->
            [SGR] -> String
    setSGRCode []
          Markup
    ReproduceSource ->
            [SGR] -> String
    setSGRCode []

        end :: p -> String
    end p
    _ =
          [SGR] -> String
    setSGRCode [SGR
    Reset]

      let
        display :: SimpleDoc Markup -> String
    display =
          case UseColor
    color of
            UseColor
    EnableColor ->
              (Markup -> String)
    -> (Markup -> String) -> ShowS -> SimpleDoc Markup -> String
    forall o a.
    Monoid o =>
    (a -> o) -> (a -> o) -> (String -> o) -> SimpleDoc a -> o
    WL.displayDecorated Markup -> String
    start Markup -> String
    forall {p}. p -> String
    end ShowS
    forall a. a -> a
    id
            UseColor
    DisableColor ->
              SimpleDoc Markup -> String
    forall a. SimpleDoc a -> String
    WL.display

    #if mingw32_HOST_OS
      liftIO $ do
        hSetEncoding stdout utf8
        hSetEncoding stderr utf8
    #endif

      String -> m String
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> m String)
    -> (Doc Markup -> String) -> Doc Markup -> m String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        SimpleDoc Markup -> String
    display (SimpleDoc Markup -> String)
    -> (Doc Markup -> SimpleDoc Markup) -> Doc Markup -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        Int -> Doc Markup -> SimpleDoc Markup
    forall a. Int -> Doc a -> SimpleDoc a
    WL.renderSmart Int
    100 (Doc Markup -> m String) -> Doc Markup -> m String
    forall a b. (a -> b) -> a -> b
    $
        Int -> Doc Markup -> Doc Markup
    forall a. Int -> Doc a -> Doc a
    WL.indent Int
    2 Doc Markup
    doc

    renderProgress :: MonadIO m => UseColor -> Maybe PropertyName -> Report Progress -> m String
    renderProgress :: forall (m :: * -> *).
    MonadIO m =>
    UseColor -> Maybe PropertyName -> Report Progress -> m String
    renderProgress UseColor
    color Maybe PropertyName
    name Report Progress
    x =
      UseColor -> Doc Markup -> m String
    forall (m :: * -> *).
    MonadIO m =>
    UseColor -> Doc Markup -> m String
    renderDoc UseColor
    color (Doc Markup -> m String) -> m (Doc Markup) -> m String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Maybe PropertyName -> Report Progress -> m (Doc Markup)
    forall (m :: * -> *).
    MonadIO m =>
    Maybe PropertyName -> Report Progress -> m (Doc Markup)
    ppProgress Maybe PropertyName
    name Report Progress
    x

    renderResult :: MonadIO m => UseColor -> Maybe PropertyName -> Report Result -> m String
    renderResult :: forall (m :: * -> *).
    MonadIO m =>
    UseColor -> Maybe PropertyName -> Report Result -> m String
    renderResult = Config
    -> UseColor -> Maybe PropertyName -> Report Result -> m String
    forall (m :: * -> *).
    MonadIO m =>
    Config
    -> UseColor -> Maybe PropertyName -> Report Result -> m String
    renderResultWith Config
    defaultConfig

    data Config =
      Config {
          Config -> Context
    configContext :: Context
        , Config -> Bool
    configPrintFailedAtLocation :: Bool
        , Config -> Bool
    configPrintShrinkPath :: Bool
        , Config -> Bool
    configPrintReproduceMessage :: Bool
        , Config -> PrintPrefixIcons
    configPrintPrefixIcons :: PrintPrefixIcons
        } deriving (Config -> Config -> Bool
    (Config -> Config -> Bool)
    -> (Config -> Config -> Bool) -> Eq Config
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Config -> Config -> Bool
    == :: Config -> Config -> Bool
    $c/= :: Config -> Config -> Bool
    /= :: Config -> Config -> Bool
    Eq, Int -> Config -> ShowS
    [Config] -> ShowS
    Config -> String
    (Int -> Config -> ShowS)
    -> (Config -> String) -> ([Config] -> ShowS) -> Show Config
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Config -> ShowS
    showsPrec :: Int -> Config -> ShowS
    $cshow :: Config -> String
    show :: Config -> String
    $cshowList :: [Config] -> ShowS
    showList :: [Config] -> ShowS
    Show)

    -- | Whether to add icons to the start of important output lines or not.
    --
    data PrintPrefixIcons =
        DisablePrefixIcons
        -- ^ Do not add icons to the start of important output lines.
      | EnablePrefixIcons
        -- ^ Add icons to the start of important output lines.
        deriving (PrintPrefixIcons -> PrintPrefixIcons -> Bool
    (PrintPrefixIcons -> PrintPrefixIcons -> Bool)
    -> (PrintPrefixIcons -> PrintPrefixIcons -> Bool)
    -> Eq PrintPrefixIcons
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: PrintPrefixIcons -> PrintPrefixIcons -> Bool
    == :: PrintPrefixIcons -> PrintPrefixIcons -> Bool
    $c/= :: PrintPrefixIcons -> PrintPrefixIcons -> Bool
    /= :: PrintPrefixIcons -> PrintPrefixIcons -> Bool
    Eq, Int -> PrintPrefixIcons -> ShowS
    [PrintPrefixIcons] -> ShowS
    PrintPrefixIcons -> String
    (Int -> PrintPrefixIcons -> ShowS)
    -> (PrintPrefixIcons -> String)
    -> ([PrintPrefixIcons] -> ShowS)
    -> Show PrintPrefixIcons
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> PrintPrefixIcons -> ShowS
    showsPrec :: Int -> PrintPrefixIcons -> ShowS
    $cshow :: PrintPrefixIcons -> String
    show :: PrintPrefixIcons -> String
    $cshowList :: [PrintPrefixIcons] -> ShowS
    showList :: [PrintPrefixIcons] -> ShowS
    Show)

    defaultConfig :: Config
    defaultConfig :: Config
    defaultConfig = Context -> Bool -> Bool -> Bool -> PrintPrefixIcons -> Config
    Config Context
    FullContext Bool
    True Bool
    True Bool
    True PrintPrefixIcons
    EnablePrefixIcons

    renderResultWith :: MonadIO m => Config -> UseColor -> Maybe PropertyName -> Report Result -> m String
    renderResultWith :: forall (m :: * -> *).
    MonadIO m =>
    Config
    -> UseColor -> Maybe PropertyName -> Report Result -> m String
    renderResultWith Config
    config UseColor
    color Maybe PropertyName
    name Report Result
    x =
      UseColor -> Doc Markup -> m String
    forall (m :: * -> *).
    MonadIO m =>
    UseColor -> Doc Markup -> m String
    renderDoc UseColor
    color (Doc Markup -> m String) -> m (Doc Markup) -> m String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Config -> Maybe PropertyName -> Report Result -> m (Doc Markup)
    forall (m :: * -> *).
    MonadIO m =>
    Config -> Maybe PropertyName -> Report Result -> m (Doc Markup)
    ppResultWith Config
    config Maybe PropertyName
    name Report Result
    x

    renderSummary :: MonadIO m => UseColor -> Summary -> m String
    renderSummary :: forall (m :: * -> *). MonadIO m => UseColor -> Summary -> m String
    renderSummary UseColor
    color Summary
    x =
      UseColor -> Doc Markup -> m String
    forall (m :: * -> *).
    MonadIO m =>
    UseColor -> Doc Markup -> m String
    renderDoc UseColor
    color (Doc Markup -> m String) -> m (Doc Markup) -> m String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Summary -> m (Doc Markup)
    forall (m :: * -> *). MonadIO m => Summary -> m (Doc Markup)
    ppSummary Summary
    x