{-# 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 (
Summary(..)
, Report(..)
, Progress(..)
, Result(..)
, FailureReport(..)
, FailedAnnotation(..)
, Style(..)
, Markup(..)
, renderProgress
, renderResult
, renderSummary
, renderDoc
, ppProgress
, ppResult
, 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)
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.Seed (Seed)
import Hedgehog.Internal.Show
import Hedgehog.Internal.Source
import Hedgehog.Range (Size)
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 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
/= :: FailedAnnotation -> FailedAnnotation -> Bool
$c/= :: FailedAnnotation -> FailedAnnotation -> Bool
== :: FailedAnnotation -> FailedAnnotation -> Bool
$c== :: 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
showList :: [FailedAnnotation] -> ShowS
$cshowList :: [FailedAnnotation] -> ShowS
show :: FailedAnnotation -> String
$cshow :: FailedAnnotation -> String
showsPrec :: Int -> FailedAnnotation -> ShowS
$cshowsPrec :: Int -> FailedAnnotation -> ShowS
Show)
data FailureReport =
FailureReport {
FailureReport -> Size
failureSize :: !Size
, FailureReport -> Seed
failureSeed :: !Seed
, FailureReport -> ShrinkCount
failureShrinks :: !ShrinkCount
, 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)
, :: ![String]
} deriving (FailureReport -> FailureReport -> Bool
(FailureReport -> FailureReport -> Bool)
-> (FailureReport -> FailureReport -> Bool) -> Eq FailureReport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureReport -> FailureReport -> Bool
$c/= :: FailureReport -> FailureReport -> Bool
== :: FailureReport -> FailureReport -> Bool
$c== :: 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
showList :: [FailureReport] -> ShowS
$cshowList :: [FailureReport] -> ShowS
show :: FailureReport -> String
$cshow :: FailureReport -> String
showsPrec :: Int -> FailureReport -> ShowS
$cshowsPrec :: Int -> FailureReport -> ShowS
Show)
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
/= :: Progress -> Progress -> Bool
$c/= :: Progress -> Progress -> Bool
== :: Progress -> Progress -> Bool
$c== :: 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
showList :: [Progress] -> ShowS
$cshowList :: [Progress] -> ShowS
show :: Progress -> String
$cshow :: Progress -> String
showsPrec :: Int -> Progress -> ShowS
$cshowsPrec :: Int -> Progress -> ShowS
Show)
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
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: 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
showList :: [Result] -> ShowS
$cshowList :: [Result] -> ShowS
show :: Result -> String
$cshow :: Result -> String
showsPrec :: Int -> Result -> ShowS
$cshowsPrec :: Int -> Result -> ShowS
Show)
data Report a =
Report {
Report a -> TestCount
reportTests :: !TestCount
, Report a -> DiscardCount
reportDiscards :: !DiscardCount
, Report a -> Coverage CoverCount
reportCoverage :: !(Coverage CoverCount)
, 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
showList :: [Report a] -> ShowS
$cshowList :: forall a. Show a => [Report a] -> ShowS
show :: Report a -> String
$cshow :: forall a. Show a => Report a -> String
showsPrec :: Int -> Report a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Report a -> ShowS
Show, a -> Report b -> Report a
(a -> b) -> Report a -> Report b
(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
<$ :: a -> Report b -> Report a
$c<$ :: forall a b. a -> Report b -> Report a
fmap :: (a -> b) -> Report a -> Report b
$cfmap :: forall a b. (a -> b) -> Report a -> Report b
Functor, Report a -> Bool
(a -> m) -> Report a -> m
(a -> b -> b) -> b -> Report a -> b
(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
product :: Report a -> a
$cproduct :: forall a. Num a => Report a -> a
sum :: Report a -> a
$csum :: forall a. Num a => Report a -> a
minimum :: Report a -> a
$cminimum :: forall a. Ord a => Report a -> a
maximum :: Report a -> a
$cmaximum :: forall a. Ord a => Report a -> a
elem :: a -> Report a -> Bool
$celem :: forall a. Eq a => a -> Report a -> Bool
length :: Report a -> Int
$clength :: forall a. Report a -> Int
null :: Report a -> Bool
$cnull :: forall a. Report a -> Bool
toList :: Report a -> [a]
$ctoList :: forall a. Report a -> [a]
foldl1 :: (a -> a -> a) -> Report a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Report a -> a
foldr1 :: (a -> a -> a) -> Report a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Report a -> a
foldl' :: (b -> a -> b) -> b -> Report a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Report a -> b
foldl :: (b -> a -> b) -> b -> Report a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Report a -> b
foldr' :: (a -> b -> b) -> b -> Report a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Report a -> b
foldr :: (a -> b -> b) -> b -> Report a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Report a -> b
foldMap' :: (a -> m) -> Report a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Report a -> m
foldMap :: (a -> m) -> Report a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Report a -> m
fold :: Report m -> m
$cfold :: forall m. Monoid m => Report m -> m
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
(a -> f b) -> Report a -> f (Report b)
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)
sequence :: Report (m a) -> m (Report a)
$csequence :: forall (m :: * -> *) a. Monad m => Report (m a) -> m (Report a)
mapM :: (a -> m b) -> Report a -> m (Report b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Report a -> m (Report b)
sequenceA :: Report (f a) -> f (Report a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Report (f a) -> f (Report a)
traverse :: (a -> f b) -> Report a -> f (Report b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Report a -> f (Report b)
$cp2Traversable :: Foldable Report
$cp1Traversable :: Functor Report
Traversable)
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
showList :: [Summary] -> ShowS
$cshowList :: [Summary] -> ShowS
show :: Summary -> String
$cshow :: Summary -> String
showsPrec :: Int -> Summary -> ShowS
$cshowsPrec :: Int -> Summary -> ShowS
Show)
instance Monoid Summary where
mempty :: Summary
mempty =
PropertyCount
-> PropertyCount
-> PropertyCount
-> PropertyCount
-> PropertyCount
-> Summary
Summary 0 0 0 0 0
mappend :: Summary -> Summary -> Summary
mappend (Summary x1 :: PropertyCount
x1 x2 :: PropertyCount
x2 x3 :: PropertyCount
x3 x4 :: PropertyCount
x4 x5 :: PropertyCount
x5) (Summary y1 :: PropertyCount
y1 y2 :: PropertyCount
y2 y3 :: PropertyCount
y3 y4 :: PropertyCount
y4 y5 :: 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)
instance Semigroup Summary where
<> :: Summary -> Summary -> Summary
(<>) = Summary -> Summary -> Summary
forall a. Monoid a => a -> a -> a
mappend
fromResult :: Result -> Summary
fromResult :: Result -> Summary
fromResult = \case
Failed _ ->
Summary
forall a. Monoid a => a
mempty { summaryFailed :: PropertyCount
summaryFailed = 1 }
GaveUp ->
Summary
forall a. Monoid a => a
mempty { summaryGaveUp :: PropertyCount
summaryGaveUp = 1 }
OK ->
Summary
forall a. Monoid a => a
mempty { summaryOK :: PropertyCount
summaryOK = 1 }
summaryCompleted :: Summary -> PropertyCount
summaryCompleted :: Summary -> PropertyCount
summaryCompleted (Summary _ _ x3 :: PropertyCount
x3 x4 :: PropertyCount
x4 x5 :: 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 x1 :: PropertyCount
x1 x2 :: PropertyCount
x2 x3 :: PropertyCount
x3 x4 :: PropertyCount
x4 x5 :: 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
data Line a =
Line {
Line a -> a
_lineAnnotation :: !a
, Line a -> LineNo
lineNumber :: !LineNo
, 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
/= :: Line a -> Line a -> Bool
$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
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
min :: Line a -> Line a -> Line a
$cmin :: forall a. Ord a => Line a -> Line a -> Line a
max :: Line a -> Line a -> Line a
$cmax :: forall a. Ord a => Line a -> Line a -> Line a
>= :: 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
$c< :: forall a. Ord a => Line a -> Line a -> Bool
compare :: Line a -> Line a -> Ordering
$ccompare :: forall a. Ord a => Line a -> Line a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (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
showList :: [Line a] -> ShowS
$cshowList :: forall a. Show a => [Line a] -> ShowS
show :: Line a -> String
$cshow :: forall a. Show a => Line a -> String
showsPrec :: Int -> Line a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Line a -> ShowS
Show, a -> Line b -> Line a
(a -> b) -> Line a -> Line b
(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
<$ :: a -> Line b -> Line a
$c<$ :: forall a b. a -> Line b -> Line a
fmap :: (a -> b) -> Line a -> Line b
$cfmap :: forall a b. (a -> b) -> Line a -> Line b
Functor)
data Declaration a =
Declaration {
Declaration a -> String
declarationFile :: !FilePath
, Declaration a -> LineNo
declarationLine :: !LineNo
, Declaration a -> String
_declarationName :: !String
, 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
/= :: Declaration a -> Declaration a -> Bool
$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
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
min :: Declaration a -> Declaration a -> Declaration a
$cmin :: forall a. Ord a => Declaration a -> Declaration a -> Declaration a
max :: Declaration a -> Declaration a -> Declaration a
$cmax :: forall a. Ord a => Declaration a -> Declaration a -> Declaration a
>= :: 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
$c< :: forall a. Ord a => Declaration a -> Declaration a -> Bool
compare :: Declaration a -> Declaration a -> Ordering
$ccompare :: forall a. Ord a => Declaration a -> Declaration a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (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
showList :: [Declaration a] -> ShowS
$cshowList :: forall a. Show a => [Declaration a] -> ShowS
show :: Declaration a -> String
$cshow :: forall a. Show a => Declaration a -> String
showsPrec :: Int -> Declaration a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Declaration a -> ShowS
Show, a -> Declaration b -> Declaration a
(a -> b) -> Declaration a -> Declaration b
(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
<$ :: a -> Declaration b -> Declaration a
$c<$ :: forall a b. a -> Declaration b -> Declaration a
fmap :: (a -> b) -> Declaration a -> Declaration b
$cfmap :: forall a b. (a -> b) -> Declaration a -> Declaration b
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
/= :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c== :: 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
min :: Style -> Style -> Style
$cmin :: Style -> Style -> Style
max :: Style -> Style -> Style
$cmax :: Style -> Style -> Style
>= :: Style -> Style -> Bool
$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
compare :: Style -> Style -> Ordering
$ccompare :: Style -> Style -> Ordering
$cp1Ord :: Eq 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
showList :: [Style] -> ShowS
$cshowList :: [Style] -> ShowS
show :: Style -> String
$cshow :: Style -> String
showsPrec :: Int -> Style -> ShowS
$cshowsPrec :: Int -> Style -> ShowS
Show)
data Markup =
WaitingIcon
|
| RunningIcon
|
| ShrinkingIcon
|
| 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
|
| ReproduceGutter
| ReproduceSource
deriving (Markup -> Markup -> Bool
(Markup -> Markup -> Bool)
-> (Markup -> Markup -> Bool) -> Eq Markup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Markup -> Markup -> Bool
$c/= :: Markup -> Markup -> Bool
== :: Markup -> Markup -> Bool
$c== :: 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
min :: Markup -> Markup -> Markup
$cmin :: Markup -> Markup -> Markup
max :: Markup -> Markup -> Markup
$cmax :: Markup -> Markup -> Markup
>= :: Markup -> Markup -> Bool
$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
compare :: Markup -> Markup -> Ordering
$ccompare :: Markup -> Markup -> Ordering
$cp1Ord :: Eq 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
showList :: [Markup] -> ShowS
$cshowList :: [Markup] -> ShowS
show :: Markup -> String
$cshow :: Markup -> String
showsPrec :: Int -> Markup -> ShowS
$cshowsPrec :: Int -> Markup -> ShowS
Show)
instance Semigroup Style where
<> :: Style -> Style -> Style
(<>) x :: Style
x y :: Style
y =
case (Style
x, Style
y) of
(StyleFailure, _) ->
Style
StyleFailure
(_, StyleFailure) ->
Style
StyleFailure
(StyleAnnotation, _) ->
Style
StyleAnnotation
(_, StyleAnnotation) ->
Style
StyleAnnotation
(StyleDefault, _) ->
Style
StyleDefault
takeAnnotation :: Log -> Maybe FailedAnnotation
takeAnnotation :: Log -> Maybe FailedAnnotation
takeAnnotation = \case
Annotation loc :: Maybe Span
loc val :: 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
_ ->
Maybe FailedAnnotation
forall a. Maybe a
Nothing
takeFootnote :: Log -> Maybe String
= \case
Footnote x :: String
x ->
String -> Maybe String
forall a. a -> Maybe a
Just String
x
_ ->
Maybe String
forall a. Maybe a
Nothing
mkFailure ::
Size
-> Seed
-> ShrinkCount
-> Maybe (Coverage CoverCount)
-> Maybe Span
-> String
-> Maybe Diff
-> [Log]
-> FailureReport
mkFailure :: Size
-> Seed
-> ShrinkCount
-> Maybe (Coverage CoverCount)
-> Maybe Span
-> String
-> Maybe Diff
-> [Log]
-> FailureReport
mkFailure size :: Size
size seed :: Seed
seed shrinks :: ShrinkCount
shrinks mcoverage :: Maybe (Coverage CoverCount)
mcoverage location :: Maybe Span
location message :: String
message diff :: Maybe Diff
diff logs :: [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
Size
-> Seed
-> ShrinkCount
-> Maybe (Coverage CoverCount)
-> [FailedAnnotation]
-> Maybe Span
-> String
-> Maybe Diff
-> [String]
-> FailureReport
FailureReport Size
size Seed
seed ShrinkCount
shrinks Maybe (Coverage CoverCount)
mcoverage [FailedAnnotation]
inputs Maybe Span
location String
message Maybe Diff
diff [String]
footnotes
ppShow :: Show x => x -> Doc a
ppShow :: x -> Doc a
ppShow =
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 m :: Markup
m x :: Doc Markup
x =
Markup -> Doc Markup -> Doc Markup
markup Markup
m ">" Doc Markup -> Doc Markup -> Doc Markup
forall a. Doc a -> Doc a -> Doc a
<+> Doc Markup
x
icon :: Markup -> Char -> Doc Markup -> Doc Markup
icon :: Markup -> Char -> Doc Markup -> Doc Markup
icon m :: Markup
m i :: Char
i x :: Doc Markup
x =
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 :: TestCount -> Doc a
ppTestCount = \case
TestCount 1 ->
"1 test"
TestCount n :: 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
<+> "tests"
ppDiscardCount :: DiscardCount -> Doc a
ppDiscardCount :: DiscardCount -> Doc a
ppDiscardCount = \case
DiscardCount 1 ->
"1 discard"
DiscardCount n :: 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
<+> "discards"
ppShrinkCount :: ShrinkCount -> Doc a
ppShrinkCount :: ShrinkCount -> Doc a
ppShrinkCount = \case
ShrinkCount 1 ->
"1 shrink"
ShrinkCount n :: 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
<+> "shrinks"
ppRawPropertyCount :: PropertyCount -> Doc a
ppRawPropertyCount :: PropertyCount -> Doc a
ppRawPropertyCount (PropertyCount n :: 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 0 ->
Doc Markup
forall a. Monoid a => a
mempty
n :: DiscardCount
n ->
" 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 s :: ShrinkCount
s d :: DiscardCount
d =
case (ShrinkCount
s, DiscardCount
d) of
(0, 0) ->
""
(0, _) ->
" 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
(_, 0) ->
" 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
(_, _) ->
"," 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
<+> "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 :: (Map LineNo (Line a) -> Map LineNo (Line a))
-> Declaration a -> Declaration a
mapSource f :: Map LineNo (Line a) -> Map LineNo (Line a)
f decl :: Declaration a
decl =
Declaration a
decl {
declarationSource :: Map LineNo (Line a)
declarationSource =
Map LineNo (Line a) -> Map LineNo (Line a)
f (Declaration a -> Map LineNo (Line a)
forall a. Declaration a -> Map LineNo (Line a)
declarationSource Declaration a
decl)
}
lineSpan :: Line a -> (ColumnNo, ColumnNo)
lineSpan :: Line a -> (ColumnNo, ColumnNo)
lineSpan (Line _ _ x0 :: String
x0) =
let
(pre :: String
pre, x1 :: String
x1) =
(Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
Char.isSpace String
x0
(_, x2 :: 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 (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 (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 :: Span -> Declaration a -> Map LineNo (Line a)
takeLines sloc :: 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
+ 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
- 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 :: Span -> m (Maybe (Declaration ()))
readDeclaration sloc :: 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
String
path <- IO String -> MaybeT m String
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 :: String
name, Pos (Position _ line0 :: LineNo
line0 _) src :: String
src) <- m (Maybe (String, Pos String)) -> MaybeT m (String, Pos String)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (String, Pos String)) -> MaybeT m (String, Pos String))
-> m (Maybe (String, Pos String)) -> MaybeT m (String, Pos String)
forall a b. (a -> b) -> a -> b
$
String -> LineNo -> m (Maybe (String, Pos String))
forall (m :: * -> *).
MonadIO m =>
String -> LineNo -> m (Maybe (String, Pos String))
Discovery.readDeclaration String
path (Span -> LineNo
spanEndLine Span
sloc)
let
line :: LineNo
line =
LineNo -> LineNo
forall a b. (Integral a, Num b) => a -> b
fromIntegral LineNo
line0
Declaration () -> MaybeT m (Declaration ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Declaration () -> MaybeT m (Declaration ()))
-> ([String] -> Declaration ())
-> [String]
-> MaybeT m (Declaration ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> LineNo -> String -> Map LineNo (Line ()) -> Declaration ()
forall a.
String -> LineNo -> String -> Map LineNo (Line a) -> Declaration a
Declaration String
path LineNo
line String
name (Map LineNo (Line ()) -> Declaration ())
-> ([String] -> Map LineNo (Line ())) -> [String] -> Declaration ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[(LineNo, Line ())] -> Map LineNo (Line ())
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(LineNo, Line ())] -> Map LineNo (Line ()))
-> ([String] -> [(LineNo, Line ())])
-> [String]
-> Map LineNo (Line ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[LineNo] -> [Line ()] -> [(LineNo, Line ())]
forall a b. [a] -> [b] -> [(a, b)]
zip [LineNo
line..] ([Line ()] -> [(LineNo, Line ())])
-> ([String] -> [Line ()]) -> [String] -> [(LineNo, Line ())]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(LineNo -> String -> Line ()) -> [LineNo] -> [String] -> [Line ()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (() -> LineNo -> String -> Line ()
forall a. a -> LineNo -> String -> Line a
Line ()) [LineNo
line..] ([String] -> MaybeT m (Declaration ()))
-> [String] -> MaybeT m (Declaration ())
forall a b. (a -> b) -> a -> b
$
String -> [String]
lines String
src
defaultStyle :: Declaration a -> Declaration (Style, [(Style, Doc Markup)])
defaultStyle :: Declaration a -> Declaration (Style, [(Style, Doc Markup)])
defaultStyle =
(a -> (Style, [(Style, Doc Markup)]))
-> Declaration a -> Declaration (Style, [(Style, Doc Markup)])
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 :: Span -> Declaration a -> MaybeT m (ColumnNo, ColumnNo)
lastLineSpan sloc :: Span
sloc decl :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ColumnNo, ColumnNo)
forall a. Maybe a
Nothing
x :: Line a
x : _ ->
(ColumnNo, ColumnNo) -> MaybeT m (ColumnNo, ColumnNo)
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 ix :: Int
ix (FailedAnnotation _ val :: 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 "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
<+> "="
, Int -> Doc Markup -> Doc Markup
forall a. Int -> Doc a -> Doc a
WL.indent 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 (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 :: FailedAnnotation
-> m (Maybe (Declaration (Style, [(Style, Doc Markup)])))
ppFailedInputDeclaration (FailedAnnotation msloc :: Maybe Span
msloc val :: 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
Span
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 (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Span
msloc
Declaration (Style, [(Style, Doc Markup)])
decl <- (Declaration () -> Declaration (Style, [(Style, Doc Markup)]))
-> MaybeT m (Declaration ())
-> MaybeT m (Declaration (Style, [(Style, Doc Markup)]))
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
Int
startCol <- ColumnNo -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ColumnNo -> Int)
-> ((ColumnNo, ColumnNo) -> ColumnNo)
-> (ColumnNo, ColumnNo)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColumnNo, ColumnNo) -> ColumnNo
forall a b. (a, b) -> a
fst ((ColumnNo, ColumnNo) -> Int)
-> MaybeT m (ColumnNo, ColumnNo) -> MaybeT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Span
-> Declaration (Style, [(Style, Doc Markup)])
-> MaybeT m (ColumnNo, ColumnNo)
forall (m :: * -> *) a.
Monad m =>
Span -> Declaration a -> MaybeT m (ColumnNo, ColumnNo)
lastLineSpan Span
sloc Declaration (Style, [(Style, Doc Markup)])
decl
let
ppValLine :: String -> Doc Markup
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 "│ ") 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 :: [(Style, Doc Markup)]
valDocs =
(String -> (Style, Doc Markup))
-> [String] -> [(Style, Doc Markup)]
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
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
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)) -> Map LineNo (f (p Style c))
styleInput kvs :: 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 (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 (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 (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 :: Map LineNo (Line (a, [(Style, Doc Markup)]))
-> Map LineNo (Line (a, [(Style, Doc Markup)]))
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 (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 (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
Declaration (Style, [(Style, Doc Markup)])
-> MaybeT m (Declaration (Style, [(Style, Doc Markup)]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Declaration (Style, [(Style, Doc Markup)])
-> MaybeT m (Declaration (Style, [(Style, Doc Markup)])))
-> Declaration (Style, [(Style, Doc Markup)])
-> MaybeT m (Declaration (Style, [(Style, Doc Markup)]))
forall a b. (a -> b) -> a -> b
$
(Map LineNo (Line (Style, [(Style, Doc Markup)]))
-> Map LineNo (Line (Style, [(Style, Doc Markup)])))
-> Declaration (Style, [(Style, Doc Markup)])
-> Declaration (Style, [(Style, Doc Markup)])
forall a.
(Map LineNo (Line a) -> Map LineNo (Line a))
-> Declaration a -> Declaration a
mapSource (Map LineNo (Line (Style, [(Style, Doc Markup)]))
-> Map LineNo (Line (Style, [(Style, Doc Markup)]))
forall (f :: * -> *) (p :: * -> * -> *) c.
(Functor f, Bifunctor p) =>
Map LineNo (f (p Style c)) -> Map LineNo (f (p Style c))
styleInput (Map LineNo (Line (Style, [(Style, Doc Markup)]))
-> Map LineNo (Line (Style, [(Style, Doc Markup)])))
-> (Map LineNo (Line (Style, [(Style, Doc Markup)]))
-> Map 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
. Map LineNo (Line (Style, [(Style, Doc Markup)]))
-> Map LineNo (Line (Style, [(Style, Doc Markup)]))
forall a.
Map LineNo (Line (a, [(Style, Doc Markup)]))
-> Map LineNo (Line (a, [(Style, Doc Markup)]))
insertDoc) Declaration (Style, [(Style, Doc Markup)])
decl
ppFailedInput ::
MonadIO m
=> Int
-> FailedAnnotation
-> m (Either (Doc Markup) (Declaration (Style, [(Style, Doc Markup)])))
ppFailedInput :: Int
-> FailedAnnotation
-> m (Either
(Doc Markup) (Declaration (Style, [(Style, Doc Markup)])))
ppFailedInput ix :: Int
ix input :: FailedAnnotation
input = do
Maybe (Declaration (Style, [(Style, Doc Markup)]))
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 Maybe (Declaration (Style, [(Style, Doc Markup)]))
mdecl of
Nothing ->
Either (Doc Markup) (Declaration (Style, [(Style, Doc Markup)]))
-> m (Either
(Doc Markup) (Declaration (Style, [(Style, Doc Markup)])))
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 decl :: Declaration (Style, [(Style, Doc Markup)])
decl ->
Either (Doc Markup) (Declaration (Style, [(Style, Doc Markup)]))
-> m (Either
(Doc Markup) (Declaration (Style, [(Style, Doc Markup)])))
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 x :: 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
forall a. Semigroup a => a -> a -> a
<> String -> Doc Markup
forall a. String -> Doc a
WL.text String
x
LineRemoved x :: 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
forall a. Semigroup a => a -> a -> a
<> String -> Doc Markup
forall a. String -> Doc a
WL.text String
x
LineAdded x :: 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
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 prefix :: String
prefix removed :: String
removed infix_ :: String
infix_ added :: String
added suffix :: String
suffix diff :: 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 (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 :: [Doc Markup]
-> Maybe Diff
-> Span
-> m (Maybe (Declaration (Style, [(Style, Doc Markup)])))
ppFailureLocation msgs :: [Doc Markup]
msgs mdiff :: Maybe Diff
mdiff sloc :: 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
Declaration (Style, [(Style, Doc Markup)])
decl <- (Declaration () -> Declaration (Style, [(Style, Doc Markup)]))
-> MaybeT m (Declaration ())
-> MaybeT m (Declaration (Style, [(Style, Doc Markup)]))
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 :: Int
startCol, endCol :: Int
endCol) <- (ColumnNo -> Int)
-> (ColumnNo -> Int) -> (ColumnNo, ColumnNo) -> (Int, Int)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ColumnNo -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ColumnNo -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((ColumnNo, ColumnNo) -> (Int, Int))
-> MaybeT m (ColumnNo, ColumnNo) -> MaybeT m (Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Span
-> Declaration (Style, [(Style, Doc Markup)])
-> MaybeT m (ColumnNo, ColumnNo)
forall (m :: * -> *) a.
Monad m =>
Span -> Declaration a -> MaybeT m (ColumnNo, ColumnNo)
lastLineSpan Span
sloc Declaration (Style, [(Style, Doc Markup)])
decl
let
arrowDoc :: Doc Markup
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) '^'))
ppFailure :: Doc Markup -> Doc Markup
ppFailure x :: 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 "│ ") Doc Markup -> Doc Markup -> Doc Markup
forall a. Semigroup a => a -> a -> a
<> Doc Markup
x
msgDocs :: [(Style, Doc Markup)]
msgDocs =
(Doc Markup -> (Style, Doc Markup))
-> [Doc Markup] -> [(Style, Doc Markup)]
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 :: [(Style, Doc Markup)]
diffDocs =
case Maybe Diff
mdiff of
Nothing ->
[]
Just diff :: Diff
diff ->
(Doc Markup -> (Style, Doc Markup))
-> [Doc Markup] -> [(Style, Doc Markup)]
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, Doc Markup)]
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 :: LineNo
startLine =
Span -> LineNo
spanStartLine Span
sloc
endLine :: LineNo
endLine =
Span -> LineNo
spanEndLine Span
sloc
styleFailure :: Map LineNo (f (p Style c)) -> Map LineNo (f (p Style c))
styleFailure kvs :: 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 (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 (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 (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 :: Map LineNo (Line (a, [(Style, Doc Markup)]))
-> Map LineNo (Line (a, [(Style, Doc Markup)]))
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 (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 (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
Declaration (Style, [(Style, Doc Markup)])
-> MaybeT m (Declaration (Style, [(Style, Doc Markup)]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Declaration (Style, [(Style, Doc Markup)])
-> MaybeT m (Declaration (Style, [(Style, Doc Markup)])))
-> Declaration (Style, [(Style, Doc Markup)])
-> MaybeT m (Declaration (Style, [(Style, Doc Markup)]))
forall a b. (a -> b) -> a -> b
$
(Map LineNo (Line (Style, [(Style, Doc Markup)]))
-> Map LineNo (Line (Style, [(Style, Doc Markup)])))
-> Declaration (Style, [(Style, Doc Markup)])
-> Declaration (Style, [(Style, Doc Markup)])
forall a.
(Map LineNo (Line a) -> Map LineNo (Line a))
-> Declaration a -> Declaration a
mapSource (Map LineNo (Line (Style, [(Style, Doc Markup)]))
-> Map LineNo (Line (Style, [(Style, Doc Markup)]))
forall (f :: * -> *) (p :: * -> * -> *) c.
(Functor f, Bifunctor p) =>
Map LineNo (f (p Style c)) -> Map LineNo (f (p Style c))
styleFailure (Map LineNo (Line (Style, [(Style, Doc Markup)]))
-> Map LineNo (Line (Style, [(Style, Doc Markup)])))
-> (Map LineNo (Line (Style, [(Style, Doc Markup)]))
-> Map 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
. Map LineNo (Line (Style, [(Style, Doc Markup)]))
-> Map LineNo (Line (Style, [(Style, Doc Markup)]))
forall a.
Map LineNo (Line (a, [(Style, Doc Markup)]))
-> Map LineNo (Line (a, [(Style, Doc Markup)]))
insertDoc) Declaration (Style, [(Style, Doc Markup)])
decl
ppDeclaration :: Declaration (Style, [(Style, Doc Markup)]) -> Doc Markup
ppDeclaration :: Declaration (Style, [(Style, Doc Markup)]) -> Doc Markup
ppDeclaration decl :: Declaration (Style, [(Style, Doc Markup)])
decl =
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)]))
-> Maybe
(Line (Style, [(Style, Doc Markup)]),
Map LineNo (Line (Style, [(Style, Doc Markup)]))))
-> Map LineNo (Line (Style, [(Style, Doc Markup)]))
-> Maybe
(Line (Style, [(Style, Doc Markup)]),
Map LineNo (Line (Style, [(Style, Doc Markup)])))
forall a b. (a -> b) -> a -> b
$ 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 of
Nothing ->
Doc Markup
forall a. Monoid a => a
mempty
Just (lastLine :: Line (Style, [(Style, Doc Markup)])
lastLine, _) ->
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
+ 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
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) "━━━"
digits :: Int
digits =
String -> 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 -> 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
<> "d") (Int -> String) -> (LineNo -> Int) -> LineNo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineNo -> Int
unLineNo
ppEmptyNo :: 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 ' '
ppSource :: Style -> LineNo -> String -> Doc Markup
ppSource style :: Style
style n :: LineNo
n src :: String
src =
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
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)
ppAnnot :: (Style, Doc Markup) -> Doc Markup
ppAnnot (style :: Style
style, doc :: 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
forall a. Doc a -> Doc a -> Doc a
<+>
Doc Markup
doc
ppLines :: [Doc Markup]
ppLines = do
Line (style :: Style
style, xs :: [(Style, Doc Markup)]
xs) n :: LineNo
n src :: String
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)]))
-> [Line (Style, [(Style, Doc Markup)])])
-> Map LineNo (Line (Style, [(Style, Doc Markup)]))
-> [Line (Style, [(Style, Doc Markup)])]
forall a b. (a -> b) -> a -> b
$ 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
Style -> LineNo -> String -> Doc Markup
ppSource Style
style LineNo
n String
src Doc Markup -> [Doc Markup] -> [Doc Markup]
forall a. a -> [a] -> [a]
: ((Style, Doc Markup) -> Doc Markup)
-> [(Style, Doc Markup)] -> [Doc Markup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Style, Doc Markup) -> Doc Markup
ppAnnot [(Style, Doc Markup)]
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 -> Size -> Seed -> Doc Markup
ppReproduce :: Maybe PropertyName -> Size -> Seed -> Doc Markup
ppReproduce name :: Maybe PropertyName
name size :: Size
size seed :: Seed
seed =
[Doc Markup] -> Doc Markup
forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
WL.vsep [
Markup -> Doc Markup -> Doc Markup
markup Markup
ReproduceHeader
"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
$
"recheck" 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 -> Size -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 Size
size "") 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 11 Seed
seed "") 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 "<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 :: Line a -> Line a -> Line a
mergeLine (Line x :: a
x no :: LineNo
no src :: String
src) (Line y :: a
y _ _) =
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 :: Declaration a -> Declaration a -> Declaration a
mergeDeclaration (Declaration file :: String
file line :: LineNo
line name :: String
name src0 :: Map LineNo (Line a)
src0) (Declaration _ _ _ src1 :: 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 :: [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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\d :: 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 (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 => Maybe PropertyName -> TestCount -> FailureReport -> m [Doc Markup]
ppFailureReport :: Maybe PropertyName -> TestCount -> FailureReport -> m [Doc Markup]
ppFailureReport name :: Maybe PropertyName
name tests :: TestCount
tests (FailureReport size :: Size
size seed :: Seed
seed _ mcoverage :: Maybe (Coverage CoverCount)
mcoverage inputs0 :: [FailedAnnotation]
inputs0 mlocation0 :: Maybe Span
mlocation0 msg :: String
msg mdiff :: Maybe Diff
mdiff msgs0 :: [String]
msgs0) = do
let
basic :: ([Doc Markup], Maybe a)
basic =
let
msgs1 :: [String]
msgs1 =
[String]
msgs0 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
(if String -> 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 :: [Doc Markup]
msgs1, mlocation :: Maybe (Declaration (Style, [(Style, Doc Markup)]))
mlocation) <-
case Maybe Span
mlocation0 of
Nothing ->
([Doc Markup], Maybe (Declaration (Style, [(Style, Doc Markup)])))
-> m ([Doc Markup],
Maybe (Declaration (Style, [(Style, Doc Markup)])))
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 location0 :: Span
location0 -> do
Maybe (Declaration (Style, [(Style, Doc Markup)]))
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 (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 Maybe (Declaration (Style, [(Style, Doc Markup)]))
mAdvanced of
Just advanced :: Declaration (Style, [(Style, Doc Markup)])
advanced ->
([Doc Markup], Maybe (Declaration (Style, [(Style, Doc Markup)])))
-> m ([Doc Markup],
Maybe (Declaration (Style, [(Style, Doc Markup)])))
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)
Nothing ->
([Doc Markup], Maybe (Declaration (Style, [(Style, Doc Markup)])))
-> m ([Doc Markup],
Maybe (Declaration (Style, [(Style, Doc Markup)])))
forall (m :: * -> *) a. Monad m => a -> m a
return ([Doc Markup], Maybe (Declaration (Style, [(Style, Doc Markup)])))
forall a. ([Doc Markup], Maybe a)
basic
[Maybe (Declaration (Style, [(Style, Doc Markup)]))]
coverageLocations <-
case Maybe (Coverage CoverCount)
mcoverage of
Nothing ->
[Maybe (Declaration (Style, [(Style, Doc Markup)]))]
-> m [Maybe (Declaration (Style, [(Style, Doc Markup)]))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Just coverage :: 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 _ mclocation :: Maybe Span
mclocation _ count :: CoverCount
count) ->
case Maybe Span
mclocation of
Nothing ->
Maybe (Declaration (Style, [(Style, Doc Markup)]))
-> m (Maybe (Declaration (Style, [(Style, Doc Markup)])))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Declaration (Style, [(Style, Doc Markup)]))
forall a. Maybe a
Nothing
Just clocation :: Span
clocation ->
let
coverageMsg :: Doc Markup
coverageMsg =
[Doc Markup] -> Doc Markup
forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
WL.cat [
"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
<> " coverage"
, ")"
]
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 :: [Doc Markup]
args, idecls :: [Declaration (Style, [(Style, Doc Markup)])]
idecls) <- ([Either (Doc Markup) (Declaration (Style, [(Style, Doc Markup)]))]
-> ([Doc Markup], [Declaration (Style, [(Style, Doc Markup)])]))
-> m [Either
(Doc Markup) (Declaration (Style, [(Style, Doc Markup)]))]
-> m ([Doc Markup], [Declaration (Style, [(Style, Doc Markup)])])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either (Doc Markup) (Declaration (Style, [(Style, Doc Markup)]))]
-> ([Doc Markup], [Declaration (Style, [(Style, Doc Markup)])])
forall a b. [Either a b] -> ([a], [b])
partitionEithers (m [Either
(Doc Markup) (Declaration (Style, [(Style, Doc Markup)]))]
-> m ([Doc Markup], [Declaration (Style, [(Style, Doc Markup)])]))
-> m [Either
(Doc Markup) (Declaration (Style, [(Style, Doc Markup)]))]
-> m ([Doc Markup], [Declaration (Style, [(Style, Doc Markup)])])
forall a b. (a -> b) -> a -> b
$ (Int
-> FailedAnnotation
-> m (Either
(Doc Markup) (Declaration (Style, [(Style, Doc Markup)]))))
-> [Int]
-> [FailedAnnotation]
-> m [Either
(Doc Markup) (Declaration (Style, [(Style, Doc Markup)]))]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Int
-> FailedAnnotation
-> m (Either
(Doc Markup) (Declaration (Style, [(Style, Doc Markup)])))
forall (m :: * -> *).
MonadIO m =>
Int
-> FailedAnnotation
-> m (Either
(Doc Markup) (Declaration (Style, [(Style, Doc Markup)])))
ppFailedInput [0..] [FailedAnnotation]
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)])])
-> ([Maybe (Declaration (Style, [(Style, Doc Markup)]))]
-> [Declaration (Style, [(Style, Doc Markup)])])
-> [Maybe (Declaration (Style, [(Style, Doc Markup)]))]
-> [Declaration (Style, [(Style, Doc Markup)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Maybe (Declaration (Style, [(Style, Doc Markup)]))]
-> [Declaration (Style, [(Style, Doc Markup)])]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Declaration (Style, [(Style, Doc Markup)]))]
-> [Declaration (Style, [(Style, Doc Markup)])])
-> [Maybe (Declaration (Style, [(Style, Doc Markup)]))]
-> [Declaration (Style, [(Style, Doc Markup)])]
forall a b. (a -> b) -> a -> b
$
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 [Maybe (Declaration (Style, [(Style, Doc Markup)]))]
-> [Maybe (Declaration (Style, [(Style, Doc Markup)]))]
-> [Maybe (Declaration (Style, [(Style, Doc Markup)]))]
forall a. Semigroup a => a -> a -> a
<> (Declaration (Style, [(Style, Doc Markup)])
-> Maybe (Declaration (Style, [(Style, Doc Markup)])))
-> [Declaration (Style, [(Style, Doc Markup)])]
-> [Maybe (Declaration (Style, [(Style, Doc Markup)]))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Declaration (Style, [(Style, Doc Markup)])
-> Maybe (Declaration (Style, [(Style, Doc Markup)]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Declaration (Style, [(Style, Doc Markup)])]
idecls
with :: t a -> (t a -> a) -> [a]
with xs :: t a
xs f :: t a -> a
f =
if 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) -> t a -> t a
whenSome f :: t a -> t a
f xs :: t a
xs =
if 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 :: [Doc Markup]
bottom =
[Doc Markup]
-> (Coverage CoverCount -> [Doc Markup])
-> Maybe (Coverage CoverCount)
-> [Doc Markup]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Maybe PropertyName -> Size -> Seed -> Doc Markup
ppReproduce Maybe PropertyName
name Size
size Seed
seed] ([Doc Markup] -> Coverage CoverCount -> [Doc Markup]
forall a b. a -> b -> a
const []) Maybe (Coverage CoverCount)
mcoverage
[Doc Markup] -> m [Doc Markup]
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]) -> [Doc Markup] -> [Doc Markup]
forall (t :: * -> *) a. Foldable t => (t a -> t a) -> t a -> t a
whenSome (Doc Markup
forall a. Monoid a => a
mempty Doc Markup -> [Doc Markup] -> [Doc Markup]
forall a. a -> [a] -> [a]
:) ([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] -> [Doc Markup]
forall (t :: * -> *) a. Foldable t => (t a -> t a) -> t a -> t a
whenSome ([Doc Markup] -> [Doc Markup] -> [Doc Markup]
forall a. [a] -> [a] -> [a]
++ [Doc Markup
forall a. Monoid a => a
mempty]) ([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
forall a. Doc a
WL.line ([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]] -> [Doc Markup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Doc Markup] -> Doc Markup
forall (f :: * -> *) a. Foldable f => f (Doc a) -> Doc a
WL.vsep ([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] -> [Doc Markup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Doc Markup -> Doc Markup
forall a. Int -> Doc a -> Doc a
WL.indent 2)) ([[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]] -> [[Doc Markup]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Doc Markup] -> [Doc Markup]
forall a. a -> a
id :: [Doc Markup] -> [Doc Markup]) ([[Doc Markup]] -> [[Doc Markup]])
-> ([[Doc Markup]] -> [[Doc Markup]])
-> [[Doc Markup]]
-> [[Doc Markup]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
([Doc Markup] -> Bool) -> [[Doc Markup]] -> [[Doc Markup]]
forall a. (a -> Bool) -> [a] -> [a]
List.filter (Bool -> Bool
not (Bool -> Bool) -> ([Doc Markup] -> Bool) -> [Doc Markup] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Markup] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Doc Markup]] -> m [Doc Markup])
-> [[Doc Markup]] -> m [Doc Markup]
forall a b. (a -> b) -> a -> b
$
[[[Doc Markup]]] -> [[Doc Markup]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
[Doc Markup] -> ([Doc Markup] -> [Doc Markup]) -> [[Doc Markup]]
forall (t :: * -> *) a a. Foldable t => t a -> (t a -> a) -> [a]
with [Doc Markup]
args (([Doc Markup] -> [Doc Markup]) -> [[Doc Markup]])
-> ([Doc Markup] -> [Doc Markup]) -> [[Doc Markup]]
forall a b. (a -> b) -> a -> b
$
Doc Markup -> [Doc Markup] -> [Doc Markup]
forall (f :: * -> *) a.
Traversable f =>
Doc a -> f (Doc a) -> f (Doc a)
WL.punctuate Doc Markup
forall a. Doc a
WL.line
, [Declaration (Style, [(Style, Doc Markup)])]
-> ([Declaration (Style, [(Style, Doc Markup)])] -> [Doc Markup])
-> [[Doc Markup]]
forall (t :: * -> *) a a. Foldable t => t a -> (t a -> a) -> [a]
with [Declaration (Style, [(Style, Doc Markup)])]
decls (([Declaration (Style, [(Style, Doc Markup)])] -> [Doc Markup])
-> [[Doc Markup]])
-> ([Declaration (Style, [(Style, Doc Markup)])] -> [Doc Markup])
-> [[Doc Markup]]
forall a b. (a -> b) -> a -> b
$
Doc Markup -> [Doc Markup] -> [Doc Markup]
forall (f :: * -> *) a.
Traversable f =>
Doc a -> f (Doc a) -> f (Doc a)
WL.punctuate Doc Markup
forall a. Doc a
WL.line ([Doc Markup] -> [Doc Markup])
-> ([Declaration (Style, [(Style, Doc Markup)])] -> [Doc Markup])
-> [Declaration (Style, [(Style, Doc Markup)])]
-> [Doc Markup]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Declaration (Style, [(Style, Doc Markup)]) -> Doc Markup)
-> [Declaration (Style, [(Style, Doc Markup)])] -> [Doc Markup]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Declaration (Style, [(Style, Doc Markup)]) -> Doc Markup
ppDeclaration
, [Doc Markup] -> ([Doc Markup] -> [Doc Markup]) -> [[Doc Markup]]
forall (t :: * -> *) a a. Foldable t => t a -> (t a -> a) -> [a]
with [Doc Markup]
msgs1 (([Doc Markup] -> [Doc Markup]) -> [[Doc Markup]])
-> ([Doc Markup] -> [Doc Markup]) -> [[Doc Markup]]
forall a b. (a -> b) -> a -> b
$
[Doc Markup] -> [Doc Markup]
forall a. a -> a
id
, [Doc Markup] -> ([Doc Markup] -> [Doc Markup]) -> [[Doc Markup]]
forall (t :: * -> *) a a. Foldable t => t a -> (t a -> a) -> [a]
with [Doc Markup]
bottom (([Doc Markup] -> [Doc Markup]) -> [[Doc Markup]])
-> ([Doc Markup] -> [Doc Markup]) -> [[Doc Markup]]
forall a b. (a -> b) -> a -> b
$
[Doc Markup] -> [Doc Markup]
forall a. a -> a
id
]
ppName :: Maybe PropertyName -> Doc a
ppName :: Maybe PropertyName -> Doc a
ppName = \case
Nothing ->
"<interactive>"
Just (PropertyName name :: String
name) ->
String -> Doc a
forall a. String -> Doc a
WL.text String
name
ppProgress :: MonadIO m => Maybe PropertyName -> Report Progress -> m (Doc Markup)
ppProgress :: Maybe PropertyName -> Report Progress -> m (Doc Markup)
ppProgress name :: Maybe PropertyName
name (Report tests :: TestCount
tests discards :: DiscardCount
discards coverage :: Coverage CoverCount
coverage status :: Progress
status) =
case Progress
status of
Running ->
Doc Markup -> m (Doc Markup)
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
$ [
Markup -> Char -> Doc Markup -> Doc Markup
icon Markup
RunningIcon '●' (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. Doc a -> Doc a -> Doc a
<+>
"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
<+>
"(running)"
] [Doc Markup] -> [Doc Markup] -> [Doc Markup]
forall a. [a] -> [a] -> [a]
++
TestCount -> Coverage CoverCount -> [Doc Markup]
ppCoverage TestCount
tests Coverage CoverCount
coverage
Shrinking failure :: FailureReport
failure ->
Doc Markup -> m (Doc Markup)
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
. Markup -> Char -> Doc Markup -> Doc Markup
icon Markup
ShrinkingIcon '↯' (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. Doc a -> Doc a -> Doc a
<+>
"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
<#>
"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
<+>
"(shrinking)"
ppResult :: MonadIO m => Maybe PropertyName -> Report Result -> m (Doc Markup)
ppResult :: Maybe PropertyName -> Report Result -> m (Doc Markup)
ppResult name :: Maybe PropertyName
name (Report tests :: TestCount
tests discards :: DiscardCount
discards coverage :: Coverage CoverCount
coverage result :: Result
result) = do
case Result
result of
Failed failure :: FailureReport
failure -> do
[Doc Markup]
pfailure <- Maybe PropertyName -> TestCount -> FailureReport -> m [Doc Markup]
forall (m :: * -> *).
MonadIO m =>
Maybe PropertyName -> TestCount -> FailureReport -> m [Doc Markup]
ppFailureReport Maybe PropertyName
name TestCount
tests FailureReport
failure
Doc Markup -> m (Doc Markup)
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
$ [
Markup -> Char -> Doc Markup -> Doc Markup
icon Markup
FailedIcon '✗' (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
WL.align (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 (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. Doc a -> Doc a -> Doc a
<+>
"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
<#>
"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. Semigroup a => a -> a -> a
<>
"."
] [Doc Markup] -> [Doc Markup] -> [Doc Markup]
forall a. [a] -> [a] -> [a]
++
TestCount -> Coverage CoverCount -> [Doc Markup]
ppCoverage TestCount
tests Coverage CoverCount
coverage [Doc Markup] -> [Doc Markup] -> [Doc Markup]
forall a. [a] -> [a] -> [a]
++
[Doc Markup]
pfailure
GaveUp ->
Doc Markup -> m (Doc Markup)
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
$ [
Markup -> Char -> Doc Markup -> Doc Markup
icon Markup
GaveUpIcon '⚐' (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. Doc a -> Doc a -> Doc a
<+>
"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
<>
", 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]
forall a. [a] -> [a] -> [a]
++
TestCount -> Coverage CoverCount -> [Doc Markup]
ppCoverage TestCount
tests Coverage CoverCount
coverage
OK ->
Doc Markup -> m (Doc Markup)
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
$ [
Markup -> Char -> Doc Markup -> Doc Markup
icon Markup
SuccessIcon '✓' (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. Doc a -> Doc a -> Doc a
<+>
"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]
forall a. [a] -> [a] -> [a]
++
TestCount -> Coverage CoverCount -> [Doc Markup]
ppCoverage TestCount
tests Coverage CoverCount
coverage
ppFailedAtLocation :: Maybe Span -> Doc Markup
ppFailedAtLocation :: Maybe Span -> Doc Markup
ppFailedAtLocation = \case
Just x :: Span
x ->
"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
forall a. Semigroup a => a -> a -> a
<>
Int -> Doc Markup
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
forall a. Semigroup a => a -> a -> a
<>
Int -> Doc Markup
forall a b. Pretty a => a -> Doc b
WL.pretty (ColumnNo -> Int
unColumnNo (Span -> ColumnNo
spanStartColumn Span
x))
Nothing ->
Doc Markup
forall a. Monoid a => a
mempty
ppCoverage :: TestCount -> Coverage CoverCount -> [Doc Markup]
ppCoverage :: TestCount -> Coverage CoverCount -> [Doc Markup]
ppCoverage tests :: TestCount
tests x :: 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TestCount -> ColumnWidth -> Label CoverCount -> Doc Markup
ppLabel 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 p0 :: Int
p0 m0 :: Int
m0 n0 :: Int
n0 f0 :: Int
f0) (ColumnWidth p1 :: Int
p1 m1 :: Int
m1 n1 :: Int
n1 f1 :: 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 0 0 0 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 tests :: TestCount
tests (Coverage labels :: Map LabelName (Label CoverCount)
labels) =
(Label CoverCount -> ColumnWidth)
-> Map LabelName (Label CoverCount) -> ColumnWidth
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 tests :: TestCount
tests x :: Label CoverCount
x =
let
percentage :: Int
percentage =
String -> 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
== 0 then
0
else
String -> 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 (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
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 :: Int -> Doc a -> Doc a
ppLeftPad n :: Int
n doc :: Doc a
doc =
let
ndoc :: Int
ndoc =
String -> 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) ' '
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 :: TestCount -> ColumnWidth -> Label CoverCount -> Doc Markup
ppLabel :: TestCount -> ColumnWidth -> Label CoverCount -> Doc Markup
ppLabel tests :: TestCount
tests w :: ColumnWidth
w x :: Label CoverCount
x@(MkLabel name :: LabelName
name _ minimum_ :: CoverPercentage
minimum_ count :: 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 =
if Bool -> Bool
not Bool
covered then
Markup -> Doc Markup -> Doc Markup
forall a. a -> Doc a -> Doc a
WL.annotate Markup
CoverageText "⚠ "
else
" "
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 i :: 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 (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
== 0 then
Doc Markup
forall a. Monoid a => a
mempty
else if Bool -> Bool
not Bool
covered then
" ✗ " 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
== 0 then
" " 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) ""
else
" ✓ " 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
== 0 then
String -> Doc Markup
wcover ""
else if Bool -> Bool
not Bool
covered then
String -> Doc Markup
wcover ""
else if CoverPercentage
minimum_ CoverPercentage -> CoverPercentage -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then
String -> Doc Markup
wcover ""
else
String -> Doc Markup
wcover ""
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
ltext Doc Markup
lcover
, Doc Markup -> Doc Markup
lborder " "
, 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
ltext Doc Markup
lminimum
]
ppLabelName :: LabelName -> Doc a
ppLabelName :: LabelName -> Doc a
ppLabelName (LabelName name :: 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 percentage :: Double
percentage) (CoverPercentage minimum_ :: Double
minimum_) =
let
barWidth :: Int
barWidth :: Int
barWidth =
20
coverageRatio :: Double
coverageRatio :: Double
coverageRatio =
Double
percentage Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 100.0
coverageWidth_ :: Int
coverageWidth_ :: Int
coverageWidth_ =
Double -> Int
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
/ 100.0
minimumWidth :: Int
minimumWidth :: Int
minimumWidth =
Double -> Int
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 :: [a] -> Int
index xs :: [a]
xs =
Double -> Int
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 (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)
part :: [a] -> a
part xs :: [a]
xs =
[a]
xs [a] -> Int -> a
forall a. [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
- 1
fillErrorWidth :: Int
fillErrorWidth =
Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 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
- 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 (full :: Char
full, parts :: 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
>= 0 then
if String -> Int
forall a. [a] -> Int
index String
parts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then
if Int
fillErrorWidth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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
""
, 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. [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. [a] -> a
head String
parts)
]
in
(Char, String) -> Doc Markup
bar ('█', ['·', '▏', '▎', '▍', '▌', '▋', '▊', '▉'])
renderCoverPercentage :: CoverPercentage -> String
renderCoverPercentage :: CoverPercentage -> String
renderCoverPercentage (CoverPercentage percentage :: Double
percentage) =
String -> Double -> String
forall r. PrintfType r => String -> r
printf "%.0f" Double
percentage String -> ShowS
forall a. Semigroup a => a -> a -> a
<> "%"
ppWhenNonZero :: Doc a -> PropertyCount -> Maybe (Doc a)
ppWhenNonZero :: Doc a -> PropertyCount -> Maybe (Doc a)
ppWhenNonZero suffix :: Doc a
suffix n :: PropertyCount
n =
if PropertyCount
n PropertyCount -> PropertyCount -> Bool
forall a. Ord a => a -> a -> Bool
<= 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
summary =
if Summary -> PropertyCount
summaryFailed Summary
summary PropertyCount -> PropertyCount -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then
Markup -> Char -> Doc Markup -> Doc Markup
icon Markup
FailedIcon '✗' (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
> 0 then
Markup -> Char -> Doc Markup -> Doc Markup
icon Markup
GaveUpIcon '⚐' (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
> 0 Bool -> Bool -> Bool
|| Summary -> PropertyCount
summaryRunning Summary
summary PropertyCount -> PropertyCount -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then
Markup -> Char -> Doc Markup -> Doc Markup
icon Markup
WaitingIcon '○' (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
Markup -> Char -> Doc Markup -> Doc Markup
icon Markup
SuccessIcon '✓' (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 :: Summary -> m (Doc Markup)
ppSummary summary :: 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 end :: 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
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
<+>
"complete" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
end
addPrefix :: [Doc a] -> [Doc a]
addPrefix xs :: [Doc a]
xs =
if [Doc 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]
forall a. a -> [a] -> [a]
: [Doc a]
xs
suffix :: Doc Markup
suffix =
if Bool
complete then
"."
else
" (running)"
in
Doc Markup -> m (Doc Markup)
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] -> 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 "failed" (Summary -> PropertyCount
summaryFailed Summary
summary)
, Doc Markup -> PropertyCount -> Maybe (Doc Markup)
forall a. Doc a -> PropertyCount -> Maybe (Doc a)
ppWhenNonZero "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 "succeeded" (Summary -> PropertyCount
summaryOK Summary
summary)
else
Maybe (Doc Markup)
forall a. Maybe a
Nothing
]
renderDoc :: MonadIO m => UseColor -> Doc Markup -> m String
renderDoc :: UseColor -> Doc Markup -> m String
renderDoc color :: UseColor
color doc :: 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
WaitingIcon ->
[SGR] -> String
setSGRCode []
WaitingHeader ->
[SGR] -> String
setSGRCode []
RunningIcon ->
[SGR] -> String
setSGRCode []
RunningHeader ->
[SGR] -> String
setSGRCode []
ShrinkingIcon ->
[SGR] -> String
setSGRCode [Color -> SGR
vivid Color
Red]
ShrinkingHeader ->
[SGR] -> String
setSGRCode [Color -> SGR
vivid Color
Red]
FailedIcon ->
[SGR] -> String
setSGRCode [Color -> SGR
vivid Color
Red]
FailedText ->
[SGR] -> String
setSGRCode [Color -> SGR
vivid Color
Red]
GaveUpIcon ->
[SGR] -> String
setSGRCode [Color -> SGR
dull Color
Yellow]
GaveUpText ->
[SGR] -> String
setSGRCode [Color -> SGR
dull Color
Yellow]
SuccessIcon ->
[SGR] -> String
setSGRCode [Color -> SGR
dull Color
Green]
SuccessText ->
[SGR] -> String
setSGRCode [Color -> SGR
dull Color
Green]
CoverageIcon ->
[SGR] -> String
setSGRCode [Color -> SGR
dull Color
Yellow]
CoverageText ->
[SGR] -> String
setSGRCode [Color -> SGR
dull Color
Yellow]
CoverageFill ->
[SGR] -> String
setSGRCode [Color -> SGR
vivid Color
Black]
DeclarationLocation ->
[SGR] -> String
setSGRCode []
StyledLineNo StyleDefault ->
[SGR] -> String
setSGRCode []
StyledSource StyleDefault ->
[SGR] -> String
setSGRCode []
StyledBorder StyleDefault ->
[SGR] -> String
setSGRCode []
StyledLineNo StyleAnnotation ->
[SGR] -> String
setSGRCode [Color -> SGR
dull Color
Magenta]
StyledSource StyleAnnotation ->
[SGR] -> String
setSGRCode []
StyledBorder StyleAnnotation ->
[SGR] -> String
setSGRCode []
AnnotationGutter ->
[SGR] -> String
setSGRCode [Color -> SGR
dull Color
Magenta]
AnnotationValue ->
[SGR] -> String
setSGRCode [Color -> SGR
dull Color
Magenta]
StyledLineNo StyleFailure ->
[SGR] -> String
setSGRCode [Color -> SGR
vivid Color
Red]
StyledSource StyleFailure ->
[SGR] -> String
setSGRCode [Color -> SGR
vivid Color
Red, SGR
bold]
StyledBorder StyleFailure ->
[SGR] -> String
setSGRCode []
FailureArrows ->
[SGR] -> String
setSGRCode [Color -> SGR
vivid Color
Red]
FailureMessage ->
[SGR] -> String
setSGRCode []
FailureGutter ->
[SGR] -> String
setSGRCode []
DiffPrefix ->
[SGR] -> String
setSGRCode []
DiffInfix ->
[SGR] -> String
setSGRCode []
DiffSuffix ->
[SGR] -> String
setSGRCode []
DiffSame ->
[SGR] -> String
setSGRCode []
DiffRemoved ->
[SGR] -> String
setSGRCode [Color -> SGR
dull Color
Red]
DiffAdded ->
[SGR] -> String
setSGRCode [Color -> SGR
dull Color
Green]
ReproduceHeader ->
[SGR] -> String
setSGRCode []
ReproduceGutter ->
[SGR] -> String
setSGRCode []
ReproduceSource ->
[SGR] -> String
setSGRCode []
end :: p -> String
end _ =
[SGR] -> String
setSGRCode [SGR
Reset]
let
display :: SimpleDoc Markup -> String
display =
case UseColor
color of
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
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 (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 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 2 Doc Markup
doc
renderProgress :: MonadIO m => UseColor -> Maybe PropertyName -> Report Progress -> m String
renderProgress :: UseColor -> Maybe PropertyName -> Report Progress -> m String
renderProgress color :: UseColor
color name :: Maybe PropertyName
name x :: 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 :: UseColor -> Maybe PropertyName -> Report Result -> m String
renderResult color :: UseColor
color name :: Maybe PropertyName
name x :: 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
=<< Maybe PropertyName -> Report Result -> m (Doc Markup)
forall (m :: * -> *).
MonadIO m =>
Maybe PropertyName -> Report Result -> m (Doc Markup)
ppResult Maybe PropertyName
name Report Result
x
renderSummary :: MonadIO m => UseColor -> Summary -> m String
renderSummary :: UseColor -> Summary -> m String
renderSummary color :: UseColor
color x :: 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