-- SPDX-FileCopyrightText: 2022 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

{- | Helper utilities for rendering mismatch-type errors.

For cases where it's useful to get a diff-style mismatch report, i.e. where
types can be rendered multi-line, a few override instances are needed.

The diff is produced by printing the types in a multiline format, then computing
the line diff with the standard algorithm (as implemented by the @Diff@
package).

In general, assuming the type in question is @T@, those instances
can look like this:

@
instance Buildable (MismatchError T) where
  build = buildRenderDocExtended

instance RenderDoc (MismatchError T) where
  renderDoc ctx = renderDocDiff ctx . fmap Prettier
@

The @fmap Prettier@ part is only required to enable multi-line rendering.

Additionally, if there's a need to show mismatch errors for lists, the following
instance can be used:

@
instance RenderDoc (MismatchError [T]) where
  renderDoc ctx = renderDocDiffList ctx . (fmap . fmap) Prettier
@
-}
module Morley.Util.MismatchError
  ( MismatchError(..)
  , buildDocDiff
  , buildDocDiffList
  ) where

import Prelude hiding (First, (<$>))

import Data.Algorithm.Diff (PolyDiff(..), getDiffBy)
import Data.Text.Lazy as LT (lines, strip)
import Fmt (Buildable(..), Doc, unlessF, (<+>))
import Prettyprinter (align, fill, hardline, indent, line, vcat)

import Morley.Michelson.Printer.Util

-- | A helper record datatype representing a mismatch between two values of
-- some type. One is assumed to be in some sense the "expected" value, the other
-- one is assumed to be the "actual" value.
data MismatchError a = MkMismatchError
  { forall a. MismatchError a -> a
meExpected :: a -- ^ Expected value
  , forall a. MismatchError a -> a
meActual :: a -- ^ Actual value
  } deriving stock (Int -> MismatchError a -> ShowS
[MismatchError a] -> ShowS
MismatchError a -> String
(Int -> MismatchError a -> ShowS)
-> (MismatchError a -> String)
-> ([MismatchError a] -> ShowS)
-> Show (MismatchError a)
forall a. Show a => Int -> MismatchError a -> ShowS
forall a. Show a => [MismatchError a] -> ShowS
forall a. Show a => MismatchError a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> MismatchError a -> ShowS
showsPrec :: Int -> MismatchError a -> ShowS
$cshow :: forall a. Show a => MismatchError a -> String
show :: MismatchError a -> String
$cshowList :: forall a. Show a => [MismatchError a] -> ShowS
showList :: [MismatchError a] -> ShowS
Show, MismatchError a -> MismatchError a -> Bool
(MismatchError a -> MismatchError a -> Bool)
-> (MismatchError a -> MismatchError a -> Bool)
-> Eq (MismatchError a)
forall a. Eq a => MismatchError a -> MismatchError a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => MismatchError a -> MismatchError a -> Bool
== :: MismatchError a -> MismatchError a -> Bool
$c/= :: forall a. Eq a => MismatchError a -> MismatchError a -> Bool
/= :: MismatchError a -> MismatchError a -> Bool
Eq, (forall x. MismatchError a -> Rep (MismatchError a) x)
-> (forall x. Rep (MismatchError a) x -> MismatchError a)
-> Generic (MismatchError a)
forall x. Rep (MismatchError a) x -> MismatchError a
forall x. MismatchError a -> Rep (MismatchError a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (MismatchError a) x -> MismatchError a
forall a x. MismatchError a -> Rep (MismatchError a) x
$cfrom :: forall a x. MismatchError a -> Rep (MismatchError a) x
from :: forall x. MismatchError a -> Rep (MismatchError a) x
$cto :: forall a x. Rep (MismatchError a) x -> MismatchError a
to :: forall x. Rep (MismatchError a) x -> MismatchError a
Generic, (forall a b. (a -> b) -> MismatchError a -> MismatchError b)
-> (forall a b. a -> MismatchError b -> MismatchError a)
-> Functor MismatchError
forall a b. a -> MismatchError b -> MismatchError a
forall a b. (a -> b) -> MismatchError a -> MismatchError b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> MismatchError a -> MismatchError b
fmap :: forall a b. (a -> b) -> MismatchError a -> MismatchError b
$c<$ :: forall a b. a -> MismatchError b -> MismatchError a
<$ :: forall a b. a -> MismatchError b -> MismatchError a
Functor, (forall m. Monoid m => MismatchError m -> m)
-> (forall m a. Monoid m => (a -> m) -> MismatchError a -> m)
-> (forall m a. Monoid m => (a -> m) -> MismatchError a -> m)
-> (forall a b. (a -> b -> b) -> b -> MismatchError a -> b)
-> (forall a b. (a -> b -> b) -> b -> MismatchError a -> b)
-> (forall b a. (b -> a -> b) -> b -> MismatchError a -> b)
-> (forall b a. (b -> a -> b) -> b -> MismatchError a -> b)
-> (forall a. (a -> a -> a) -> MismatchError a -> a)
-> (forall a. (a -> a -> a) -> MismatchError a -> a)
-> (forall a. MismatchError a -> [a])
-> (forall a. MismatchError a -> Bool)
-> (forall a. MismatchError a -> Int)
-> (forall a. Eq a => a -> MismatchError a -> Bool)
-> (forall a. Ord a => MismatchError a -> a)
-> (forall a. Ord a => MismatchError a -> a)
-> (forall a. Num a => MismatchError a -> a)
-> (forall a. Num a => MismatchError a -> a)
-> Foldable MismatchError
forall a. Eq a => a -> MismatchError a -> Bool
forall a. Num a => MismatchError a -> a
forall a. Ord a => MismatchError a -> a
forall m. Monoid m => MismatchError m -> m
forall a. MismatchError a -> Bool
forall a. MismatchError a -> Int
forall a. MismatchError a -> [a]
forall a. (a -> a -> a) -> MismatchError a -> a
forall m a. Monoid m => (a -> m) -> MismatchError a -> m
forall b a. (b -> a -> b) -> b -> MismatchError a -> b
forall a b. (a -> b -> b) -> b -> MismatchError a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => MismatchError m -> m
fold :: forall m. Monoid m => MismatchError m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> MismatchError a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> MismatchError a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> MismatchError a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> MismatchError a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> MismatchError a -> b
foldr :: forall a b. (a -> b -> b) -> b -> MismatchError a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> MismatchError a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> MismatchError a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> MismatchError a -> b
foldl :: forall b a. (b -> a -> b) -> b -> MismatchError a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> MismatchError a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> MismatchError a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> MismatchError a -> a
foldr1 :: forall a. (a -> a -> a) -> MismatchError a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> MismatchError a -> a
foldl1 :: forall a. (a -> a -> a) -> MismatchError a -> a
$ctoList :: forall a. MismatchError a -> [a]
toList :: forall a. MismatchError a -> [a]
$cnull :: forall a. MismatchError a -> Bool
null :: forall a. MismatchError a -> Bool
$clength :: forall a. MismatchError a -> Int
length :: forall a. MismatchError a -> Int
$celem :: forall a. Eq a => a -> MismatchError a -> Bool
elem :: forall a. Eq a => a -> MismatchError a -> Bool
$cmaximum :: forall a. Ord a => MismatchError a -> a
maximum :: forall a. Ord a => MismatchError a -> a
$cminimum :: forall a. Ord a => MismatchError a -> a
minimum :: forall a. Ord a => MismatchError a -> a
$csum :: forall a. Num a => MismatchError a -> a
sum :: forall a. Num a => MismatchError a -> a
$cproduct :: forall a. Num a => MismatchError a -> a
product :: forall a. Num a => MismatchError a -> a
Foldable)
    deriving anyclass (MismatchError a -> ()
(MismatchError a -> ()) -> NFData (MismatchError a)
forall a. NFData a => MismatchError a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => MismatchError a -> ()
rnf :: MismatchError a -> ()
NFData, Eq (Element (MismatchError a)) =>
Element (MismatchError a) -> MismatchError a -> Bool
Ord (Element (MismatchError a)) =>
MismatchError a -> Maybe (Element (MismatchError a))
Monoid (Element (MismatchError a)) =>
MismatchError a -> Element (MismatchError a)
(Element (MismatchError a) ~ Bool) => MismatchError a -> Bool
MismatchError a -> Bool
MismatchError a -> Int
MismatchError a -> [Element (MismatchError a)]
MismatchError a -> Maybe (Element (MismatchError a))
(Element (MismatchError a) -> Bool) -> MismatchError a -> Bool
(Element (MismatchError a) -> Bool)
-> MismatchError a -> Maybe (Element (MismatchError a))
(Element (MismatchError a)
 -> Element (MismatchError a) -> Element (MismatchError a))
-> MismatchError a -> Maybe (Element (MismatchError a))
(MismatchError a -> [Element (MismatchError a)])
-> (MismatchError a -> Bool)
-> (forall b.
    (Element (MismatchError a) -> b -> b) -> b -> MismatchError a -> b)
-> (forall b.
    (b -> Element (MismatchError a) -> b) -> b -> MismatchError a -> b)
-> (forall b.
    (b -> Element (MismatchError a) -> b) -> b -> MismatchError a -> b)
-> (MismatchError a -> Int)
-> (Eq (Element (MismatchError a)) =>
    Element (MismatchError a) -> MismatchError a -> Bool)
-> (forall m.
    Monoid m =>
    (Element (MismatchError a) -> m) -> MismatchError a -> m)
-> (Monoid (Element (MismatchError a)) =>
    MismatchError a -> Element (MismatchError a))
-> (forall b.
    (Element (MismatchError a) -> b -> b) -> b -> MismatchError a -> b)
-> (Eq (Element (MismatchError a)) =>
    Element (MismatchError a) -> MismatchError a -> Bool)
-> ((Element (MismatchError a) -> Bool) -> MismatchError a -> Bool)
-> ((Element (MismatchError a) -> Bool) -> MismatchError a -> Bool)
-> ((Element (MismatchError a) ~ Bool) => MismatchError a -> Bool)
-> ((Element (MismatchError a) ~ Bool) => MismatchError a -> Bool)
-> ((Element (MismatchError a) -> Bool)
    -> MismatchError a -> Maybe (Element (MismatchError a)))
-> (MismatchError a -> Maybe (Element (MismatchError a)))
-> (Ord (Element (MismatchError a)) =>
    MismatchError a -> Maybe (Element (MismatchError a)))
-> (Ord (Element (MismatchError a)) =>
    MismatchError a -> Maybe (Element (MismatchError a)))
-> ((Element (MismatchError a)
     -> Element (MismatchError a) -> Element (MismatchError a))
    -> MismatchError a -> Maybe (Element (MismatchError a)))
-> ((Element (MismatchError a)
     -> Element (MismatchError a) -> Element (MismatchError a))
    -> MismatchError a -> Maybe (Element (MismatchError a)))
-> Container (MismatchError a)
forall a.
Eq (Element (MismatchError a)) =>
Element (MismatchError a) -> MismatchError a -> Bool
forall a.
Ord (Element (MismatchError a)) =>
MismatchError a -> Maybe (Element (MismatchError a))
forall m.
Monoid m =>
(Element (MismatchError a) -> m) -> MismatchError a -> m
forall a.
Monoid (Element (MismatchError a)) =>
MismatchError a -> Element (MismatchError a)
forall a.
(Element (MismatchError a) ~ Bool) =>
MismatchError a -> Bool
forall a. MismatchError a -> Bool
forall a. MismatchError a -> Int
forall a. MismatchError a -> [Element (MismatchError a)]
forall a. MismatchError a -> Maybe (Element (MismatchError a))
forall t.
(t -> [Element t])
-> (t -> Bool)
-> (forall b. (Element t -> b -> b) -> b -> t -> b)
-> (forall b. (b -> Element t -> b) -> b -> t -> b)
-> (forall b. (b -> Element t -> b) -> b -> t -> b)
-> (t -> Int)
-> (Eq (Element t) => Element t -> t -> Bool)
-> (forall m. Monoid m => (Element t -> m) -> t -> m)
-> (Monoid (Element t) => t -> Element t)
-> (forall b. (Element t -> b -> b) -> b -> t -> b)
-> (Eq (Element t) => Element t -> t -> Bool)
-> ((Element t -> Bool) -> t -> Bool)
-> ((Element t -> Bool) -> t -> Bool)
-> ((Element t ~ Bool) => t -> Bool)
-> ((Element t ~ Bool) => t -> Bool)
-> ((Element t -> Bool) -> t -> Maybe (Element t))
-> (t -> Maybe (Element t))
-> (Ord (Element t) => t -> Maybe (Element t))
-> (Ord (Element t) => t -> Maybe (Element t))
-> ((Element t -> Element t -> Element t)
    -> t -> Maybe (Element t))
-> ((Element t -> Element t -> Element t)
    -> t -> Maybe (Element t))
-> Container t
forall b.
(b -> Element (MismatchError a) -> b) -> b -> MismatchError a -> b
forall b.
(Element (MismatchError a) -> b -> b) -> b -> MismatchError a -> b
forall a.
(Element (MismatchError a) -> Bool) -> MismatchError a -> Bool
forall a.
(Element (MismatchError a) -> Bool)
-> MismatchError a -> Maybe (Element (MismatchError a))
forall a.
(Element (MismatchError a)
 -> Element (MismatchError a) -> Element (MismatchError a))
-> MismatchError a -> Maybe (Element (MismatchError a))
forall b.
(Element (MismatchError a) -> b -> b) -> b -> MismatchError a -> b
forall a m.
Monoid m =>
(Element (MismatchError a) -> m) -> MismatchError a -> m
forall a b.
(b -> Element (MismatchError a) -> b) -> b -> MismatchError a -> b
forall a b.
(Element (MismatchError a) -> b -> b) -> b -> MismatchError a -> b
$ctoList :: forall a. MismatchError a -> [Element (MismatchError a)]
toList :: MismatchError a -> [Element (MismatchError a)]
$cnull :: forall a. MismatchError a -> Bool
null :: MismatchError a -> Bool
$cfoldr :: forall a b.
(Element (MismatchError a) -> b -> b) -> b -> MismatchError a -> b
foldr :: forall b.
(Element (MismatchError a) -> b -> b) -> b -> MismatchError a -> b
$cfoldl :: forall a b.
(b -> Element (MismatchError a) -> b) -> b -> MismatchError a -> b
foldl :: forall b.
(b -> Element (MismatchError a) -> b) -> b -> MismatchError a -> b
$cfoldl' :: forall a b.
(b -> Element (MismatchError a) -> b) -> b -> MismatchError a -> b
foldl' :: forall b.
(b -> Element (MismatchError a) -> b) -> b -> MismatchError a -> b
$clength :: forall a. MismatchError a -> Int
length :: MismatchError a -> Int
$celem :: forall a.
Eq (Element (MismatchError a)) =>
Element (MismatchError a) -> MismatchError a -> Bool
elem :: Eq (Element (MismatchError a)) =>
Element (MismatchError a) -> MismatchError a -> Bool
$cfoldMap :: forall a m.
Monoid m =>
(Element (MismatchError a) -> m) -> MismatchError a -> m
foldMap :: forall m.
Monoid m =>
(Element (MismatchError a) -> m) -> MismatchError a -> m
$cfold :: forall a.
Monoid (Element (MismatchError a)) =>
MismatchError a -> Element (MismatchError a)
fold :: Monoid (Element (MismatchError a)) =>
MismatchError a -> Element (MismatchError a)
$cfoldr' :: forall a b.
(Element (MismatchError a) -> b -> b) -> b -> MismatchError a -> b
foldr' :: forall b.
(Element (MismatchError a) -> b -> b) -> b -> MismatchError a -> b
$cnotElem :: forall a.
Eq (Element (MismatchError a)) =>
Element (MismatchError a) -> MismatchError a -> Bool
notElem :: Eq (Element (MismatchError a)) =>
Element (MismatchError a) -> MismatchError a -> Bool
$call :: forall a.
(Element (MismatchError a) -> Bool) -> MismatchError a -> Bool
all :: (Element (MismatchError a) -> Bool) -> MismatchError a -> Bool
$cany :: forall a.
(Element (MismatchError a) -> Bool) -> MismatchError a -> Bool
any :: (Element (MismatchError a) -> Bool) -> MismatchError a -> Bool
$cand :: forall a.
(Element (MismatchError a) ~ Bool) =>
MismatchError a -> Bool
and :: (Element (MismatchError a) ~ Bool) => MismatchError a -> Bool
$cor :: forall a.
(Element (MismatchError a) ~ Bool) =>
MismatchError a -> Bool
or :: (Element (MismatchError a) ~ Bool) => MismatchError a -> Bool
$cfind :: forall a.
(Element (MismatchError a) -> Bool)
-> MismatchError a -> Maybe (Element (MismatchError a))
find :: (Element (MismatchError a) -> Bool)
-> MismatchError a -> Maybe (Element (MismatchError a))
$csafeHead :: forall a. MismatchError a -> Maybe (Element (MismatchError a))
safeHead :: MismatchError a -> Maybe (Element (MismatchError a))
$csafeMaximum :: forall a.
Ord (Element (MismatchError a)) =>
MismatchError a -> Maybe (Element (MismatchError a))
safeMaximum :: Ord (Element (MismatchError a)) =>
MismatchError a -> Maybe (Element (MismatchError a))
$csafeMinimum :: forall a.
Ord (Element (MismatchError a)) =>
MismatchError a -> Maybe (Element (MismatchError a))
safeMinimum :: Ord (Element (MismatchError a)) =>
MismatchError a -> Maybe (Element (MismatchError a))
$csafeFoldr1 :: forall a.
(Element (MismatchError a)
 -> Element (MismatchError a) -> Element (MismatchError a))
-> MismatchError a -> Maybe (Element (MismatchError a))
safeFoldr1 :: (Element (MismatchError a)
 -> Element (MismatchError a) -> Element (MismatchError a))
-> MismatchError a -> Maybe (Element (MismatchError a))
$csafeFoldl1 :: forall a.
(Element (MismatchError a)
 -> Element (MismatchError a) -> Element (MismatchError a))
-> MismatchError a -> Maybe (Element (MismatchError a))
safeFoldl1 :: (Element (MismatchError a)
 -> Element (MismatchError a) -> Element (MismatchError a))
-> MismatchError a -> Maybe (Element (MismatchError a))
Container)

instance {-# OVERLAPPABLE #-} Buildable a => Buildable (MismatchError a) where
  build :: MismatchError a -> Doc
build = MismatchError a -> Doc
forall a. Buildable a => MismatchError a -> Doc
buildStandard

buildStandard :: Buildable a => MismatchError a -> Doc
buildStandard :: forall a. Buildable a => MismatchError a -> Doc
buildStandard = MismatchError Doc -> Doc
buildDoc (MismatchError Doc -> Doc)
-> (MismatchError a -> MismatchError Doc) -> MismatchError a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> MismatchError a -> MismatchError Doc
forall a b. (a -> b) -> MismatchError a -> MismatchError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Doc
forall a. Buildable a => a -> Doc
build

buildStandardList :: Buildable a => MismatchError [a] -> Doc
buildStandardList :: forall a. Buildable a => MismatchError [a] -> Doc
buildStandardList = MismatchError Doc -> Doc
buildDoc (MismatchError Doc -> Doc)
-> (MismatchError [a] -> MismatchError Doc)
-> MismatchError [a]
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Doc) -> MismatchError [a] -> MismatchError Doc
forall a b. (a -> b) -> MismatchError a -> MismatchError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Doc
forall a. Buildable a => [a] -> Doc
buildList

buildDoc :: MismatchError Doc -> Doc
buildDoc :: MismatchError Doc -> Doc
buildDoc MkMismatchError{Doc
meExpected :: forall a. MismatchError a -> a
meActual :: forall a. MismatchError a -> a
meExpected :: Doc
meActual :: Doc
..}
  =  Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
fill Int
9 Doc
"Expected:" Doc -> Doc -> Doc
<+> Doc -> Doc
forall ann. Doc ann -> Doc ann
align Doc
meExpected Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
forall ann. Doc ann
hardline
  Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
fill Int
9 Doc
"Actual:"   Doc -> Doc -> Doc
<+> Doc -> Doc
forall ann. Doc ann -> Doc ann
align Doc
meActual

renderMismatch :: MismatchError Doc -> Doc
renderMismatch :: MismatchError Doc -> Doc
renderMismatch MismatchError Doc
errText
  =  Doc
forall ann. Doc ann
hardline Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"Mismatch:" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
forall ann. Doc ann
hardline
  Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 Doc
"--- expected +++ actual" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
forall ann. Doc ann
hardline
  Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
forall ann. Doc ann -> Doc ann
align (MismatchError Doc -> Doc
diff MismatchError Doc
errText)

-- | Render a mismatch error with a diff.
--
-- This is intended to be used with types for which 'RenderDoc' outputs
-- multiline 'Doc'.
buildDocDiff :: Buildable a => MismatchError a -> Doc
buildDocDiff :: forall a. Buildable a => MismatchError a -> Doc
buildDocDiff MismatchError a
err = MismatchError a -> Doc
forall a. Buildable a => MismatchError a -> Doc
buildStandard MismatchError a
err
  Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Bool -> Doc -> Doc
unlessF Bool
expectedAndActualBothSingleLine (MismatchError Doc -> Doc
renderMismatch MismatchError Doc
errText)
  where
    errText :: MismatchError Doc
errText = (a -> Doc) -> MismatchError a -> MismatchError Doc
forall a b. (a -> b) -> MismatchError a -> MismatchError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Doc
forall a. Buildable a => a -> Doc
build MismatchError a
err
    expectedAndActualBothSingleLine :: Bool
expectedAndActualBothSingleLine = (Element (MismatchError Doc) -> Bool) -> MismatchError Doc -> Bool
forall c b.
(Container c, BooleanMonoid b) =>
(Element c -> b) -> c -> b
all ([Text] -> Bool
forall t. Container t => t -> Bool
null ([Text] -> Bool) -> (Doc -> [Text]) -> Doc -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
1 ([Text] -> [Text]) -> (Doc -> [Text]) -> Doc -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
LT.lines (Text -> [Text]) -> (Doc -> Text) -> Doc -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Doc -> Text
forall a b. (RenderDoc a, FromSimpleDoc b) => Bool -> a -> b
printRenderDoc Bool
False) MismatchError Doc
errText

-- | Render a mismatch error of lists with a diff.
--
-- This is intended to be used with types for which 'RenderDoc' outputs
-- multiline 'Doc'.
buildDocDiffList :: Buildable a => MismatchError [a] -> Doc
buildDocDiffList :: forall a. Buildable a => MismatchError [a] -> Doc
buildDocDiffList MismatchError [a]
err = MismatchError [a] -> Doc
forall a. Buildable a => MismatchError [a] -> Doc
buildStandardList MismatchError [a]
err
  Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Bool -> Doc -> Doc
unlessF Bool
simple (MismatchError Doc -> Doc
renderMismatch MismatchError Doc
errText)
  where
    errText :: MismatchError Doc
errText = ([a] -> Doc) -> MismatchError [a] -> MismatchError Doc
forall a b. (a -> b) -> MismatchError a -> MismatchError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Doc] -> Doc
forall {ann}. [Doc ann] -> Doc ann
renderList' ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Doc -> Doc
forall ann. Doc ann -> Doc ann
align (Doc -> Doc) -> (a -> Doc) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Buildable a => a -> Doc
build)) MismatchError [a]
err
    -- "simple" here means that at least one is true:
    --
    --  * one of the lists is empty
    --  * rendered representation for both expected and actual types are single-line
    simple :: Bool
simple = (Element (MismatchError [a]) -> Bool) -> MismatchError [a] -> Bool
forall c b.
(Container c, BooleanMonoid b) =>
(Element c -> b) -> c -> b
any [a] -> Bool
Element (MismatchError [a]) -> Bool
forall t. Container t => t -> Bool
null MismatchError [a]
err Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| (Element (MismatchError Doc) -> Bool) -> MismatchError Doc -> Bool
forall c b.
(Container c, BooleanMonoid b) =>
(Element c -> b) -> c -> b
all ([Text] -> Bool
forall t. Container t => t -> Bool
null ([Text] -> Bool) -> (Doc -> [Text]) -> Doc -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
1 ([Text] -> [Text]) -> (Doc -> [Text]) -> Doc -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
LT.lines (Text -> [Text]) -> (Doc -> Text) -> Doc -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Doc -> Text
forall a b. (RenderDoc a, FromSimpleDoc b) => Bool -> a -> b
printRenderDoc Bool
False) MismatchError Doc
errText
    renderList' :: [Doc ann] -> Doc ann
renderList' [Doc ann]
ds
      = case [Doc ann]
ds of
          []  -> Doc ann
"[]"
          [Doc ann
d] -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
"[ " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
d Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" ]"
          [Doc ann]
_   -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall {ann}. [Doc ann] -> Doc ann
vcat ((Doc ann -> Doc ann -> Doc ann)
-> [Doc ann] -> [Doc ann] -> [Doc ann]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
(<>) (Doc ann
"[ " Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: Doc ann -> [Doc ann]
forall a. a -> [a]
repeat Doc ann
", ") [Doc ann]
ds) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"]"

diff :: MismatchError Doc -> Doc
diff :: MismatchError Doc -> Doc
diff ((Doc -> [Text]) -> MismatchError Doc -> MismatchError [Text]
forall a b. (a -> b) -> MismatchError a -> MismatchError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Doc -> [Text]) -> MismatchError Doc -> MismatchError [Text])
-> (Doc -> [Text]) -> MismatchError Doc -> MismatchError [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
LT.lines (Text -> [Text]) -> (Doc -> Text) -> Doc -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Doc -> Text
forall a b. (RenderDoc a, FromSimpleDoc b) => Bool -> a -> b
printRenderDoc Bool
False -> MkMismatchError{[Text]
meExpected :: forall a. MismatchError a -> a
meActual :: forall a. MismatchError a -> a
meExpected :: [Text]
meActual :: [Text]
..}) = [Doc] -> Doc
forall {ann}. [Doc ann] -> Doc ann
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
  PolyDiff Text Text -> Doc
showLine (PolyDiff Text Text -> Doc) -> [PolyDiff Text Text] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Text -> Text -> Bool) -> [Text] -> [Text] -> [PolyDiff Text Text]
forall a b. (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff a b]
getDiffBy (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text -> Bool) -> (Text -> Text) -> Text -> Text -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Text -> Text
LT.strip) [Text]
meExpected [Text]
meActual
  where
    showLine :: PolyDiff Text Text -> Doc
showLine = \case
      (Both Text
_ Text
b) -> Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> Doc
forall a. Buildable a => a -> Doc
build Text
b
      (First Text
x) -> Doc
"-" Doc -> Doc -> Doc
<+> Text -> Doc
forall a. Buildable a => a -> Doc
build Text
x
      (Second Text
x) -> Doc
"+" Doc -> Doc -> Doc
<+> Text -> Doc
forall a. Buildable a => a -> Doc
build Text
x