-- 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(..)
  , renderDocDiff
  , renderDocDiffList
  ) where

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

import Data.Algorithm.Diff (PolyDiff(..), getDiffBy)
import Data.Text.Lazy as LT (lines, strip)
import Fmt (Buildable(..), nameF)
import Text.PrettyPrint.Leijen.Text (Doc, align, fill, indent, text, 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
showList :: [MismatchError a] -> ShowS
$cshowList :: forall a. Show a => [MismatchError a] -> ShowS
show :: MismatchError a -> String
$cshow :: forall a. Show a => MismatchError a -> String
showsPrec :: Int -> MismatchError a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> 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
/= :: MismatchError a -> MismatchError a -> Bool
$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
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
$cto :: forall a x. Rep (MismatchError a) x -> MismatchError a
$cfrom :: forall a x. MismatchError a -> Rep (MismatchError a) x
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
<$ :: forall a b. a -> MismatchError b -> MismatchError a
$c<$ :: forall a b. a -> MismatchError b -> MismatchError a
fmap :: forall a b. (a -> b) -> MismatchError a -> MismatchError b
$cfmap :: forall a b. (a -> b) -> MismatchError a -> MismatchError b
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
product :: forall a. Num a => MismatchError a -> a
$cproduct :: forall a. Num a => MismatchError a -> a
sum :: forall a. Num a => MismatchError a -> a
$csum :: forall a. Num a => MismatchError a -> a
minimum :: forall a. Ord a => MismatchError a -> a
$cminimum :: forall a. Ord a => MismatchError a -> a
maximum :: forall a. Ord a => MismatchError a -> a
$cmaximum :: forall a. Ord a => MismatchError a -> a
elem :: forall a. Eq a => a -> MismatchError a -> Bool
$celem :: forall a. Eq a => a -> MismatchError a -> Bool
length :: forall a. MismatchError a -> Int
$clength :: forall a. MismatchError a -> Int
null :: forall a. MismatchError a -> Bool
$cnull :: forall a. MismatchError a -> Bool
toList :: forall a. MismatchError a -> [a]
$ctoList :: forall a. MismatchError a -> [a]
foldl1 :: forall a. (a -> a -> a) -> MismatchError a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> MismatchError a -> a
foldr1 :: forall a. (a -> a -> a) -> MismatchError a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> MismatchError a -> a
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
$cfoldl :: forall b a. (b -> a -> 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
$cfoldr :: forall a b. (a -> b -> b) -> b -> MismatchError a -> b
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
$cfoldMap :: forall m a. Monoid m => (a -> m) -> MismatchError a -> m
fold :: forall m. Monoid m => MismatchError m -> m
$cfold :: forall m. Monoid m => MismatchError m -> m
Foldable)
    deriving anyclass (MismatchError a -> ()
(MismatchError a -> ()) -> NFData (MismatchError a)
forall a. NFData a => MismatchError a -> ()
forall a. (a -> ()) -> NFData a
rnf :: MismatchError a -> ()
$crnf :: forall a. NFData a => 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 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
safeFoldl1 :: (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))
safeFoldr1 :: (Element (MismatchError a)
 -> Element (MismatchError a) -> 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))
safeMinimum :: Ord (Element (MismatchError a)) =>
MismatchError a -> Maybe (Element (MismatchError a))
$csafeMinimum :: forall a.
Ord (Element (MismatchError a)) =>
MismatchError a -> Maybe (Element (MismatchError a))
safeMaximum :: Ord (Element (MismatchError a)) =>
MismatchError a -> Maybe (Element (MismatchError a))
$csafeMaximum :: forall a.
Ord (Element (MismatchError a)) =>
MismatchError a -> Maybe (Element (MismatchError a))
safeHead :: MismatchError a -> Maybe (Element (MismatchError a))
$csafeHead :: forall a. MismatchError a -> Maybe (Element (MismatchError a))
find :: (Element (MismatchError a) -> Bool)
-> MismatchError a -> Maybe (Element (MismatchError a))
$cfind :: forall a.
(Element (MismatchError a) -> Bool)
-> MismatchError a -> Maybe (Element (MismatchError a))
or :: (Element (MismatchError a) ~ Bool) => MismatchError a -> Bool
$cor :: forall a.
(Element (MismatchError a) ~ Bool) =>
MismatchError a -> Bool
and :: (Element (MismatchError a) ~ Bool) => MismatchError a -> Bool
$cand :: forall a.
(Element (MismatchError a) ~ Bool) =>
MismatchError a -> Bool
any :: (Element (MismatchError a) -> Bool) -> MismatchError a -> Bool
$cany :: forall a.
(Element (MismatchError a) -> Bool) -> MismatchError a -> Bool
all :: (Element (MismatchError a) -> Bool) -> MismatchError a -> Bool
$call :: forall a.
(Element (MismatchError a) -> Bool) -> MismatchError a -> Bool
notElem :: Eq (Element (MismatchError a)) =>
Element (MismatchError a) -> MismatchError a -> Bool
$cnotElem :: forall a.
Eq (Element (MismatchError a)) =>
Element (MismatchError a) -> MismatchError a -> Bool
foldr' :: forall b.
(Element (MismatchError a) -> b -> b) -> b -> MismatchError a -> b
$cfoldr' :: forall a b.
(Element (MismatchError a) -> b -> b) -> b -> MismatchError a -> b
fold :: Monoid (Element (MismatchError a)) =>
MismatchError a -> Element (MismatchError a)
$cfold :: forall a.
Monoid (Element (MismatchError a)) =>
MismatchError a -> Element (MismatchError a)
foldMap :: forall m.
Monoid m =>
(Element (MismatchError a) -> m) -> MismatchError a -> m
$cfoldMap :: forall a m.
Monoid m =>
(Element (MismatchError a) -> m) -> MismatchError a -> m
elem :: Eq (Element (MismatchError a)) =>
Element (MismatchError a) -> MismatchError a -> Bool
$celem :: forall a.
Eq (Element (MismatchError a)) =>
Element (MismatchError a) -> MismatchError a -> Bool
length :: MismatchError a -> Int
$clength :: forall a. MismatchError a -> Int
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
$cfoldl :: forall a b.
(b -> Element (MismatchError a) -> b) -> b -> MismatchError a -> b
foldr :: forall b.
(Element (MismatchError a) -> b -> b) -> b -> MismatchError a -> b
$cfoldr :: forall a b.
(Element (MismatchError a) -> b -> b) -> b -> MismatchError a -> b
null :: MismatchError a -> Bool
$cnull :: forall a. MismatchError a -> Bool
toList :: MismatchError a -> [Element (MismatchError a)]
$ctoList :: forall a. MismatchError a -> [Element (MismatchError a)]
Container)

instance {-# OVERLAPPABLE #-} Buildable a => Buildable (MismatchError a) where
  build :: MismatchError a -> Builder
build MkMismatchError{a
meActual :: a
meExpected :: a
meActual :: forall a. MismatchError a -> a
meExpected :: forall a. MismatchError a -> a
..} =
    Builder -> Builder -> Builder
nameF Builder
"Expected" (a -> Builder
forall p. Buildable p => p -> Builder
build a
meExpected) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder -> Builder
nameF Builder
"Actual" (a -> Builder
forall p. Buildable p => p -> Builder
build a
meActual)

instance {-# OVERLAPPABLE #-} RenderDoc a => RenderDoc (MismatchError a) where
  renderDoc :: RenderContext -> MismatchError a -> Doc
renderDoc = RenderContext -> MismatchError a -> Doc
forall a. RenderDoc a => RenderContext -> MismatchError a -> Doc
renderDocStandard

renderDocStandard :: RenderDoc a => RenderContext -> MismatchError a -> Doc
renderDocStandard :: forall a. RenderDoc a => RenderContext -> MismatchError a -> Doc
renderDocStandard RenderContext
_ ((a -> Doc) -> MismatchError a -> MismatchError Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc -> Doc
align (Doc -> Doc) -> (a -> Doc) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderContext -> a -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
doesntNeedParens) -> MkMismatchError{Doc
meActual :: Doc
meExpected :: Doc
meActual :: forall a. MismatchError a -> a
meExpected :: forall a. MismatchError a -> a
..})
  =   Int -> Doc -> Doc
fill Int
9 Doc
"Expected:" Doc -> Doc -> Doc
<+> Doc
meExpected
  Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
fill Int
9 Doc
"Actual:"   Doc -> Doc -> Doc
<+> Doc
meActual

renderDocStandardList :: RenderDoc a => RenderContext -> MismatchError [a] -> Doc
renderDocStandardList :: forall a. RenderDoc a => RenderContext -> MismatchError [a] -> Doc
renderDocStandardList RenderContext
_ (([a] -> Doc) -> MismatchError [a] -> MismatchError Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc -> Doc
align (Doc -> Doc) -> ([a] -> Doc) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderContext -> [a] -> Doc
forall a. RenderDoc a => RenderContext -> [a] -> Doc
renderDocList RenderContext
doesntNeedParens) -> MkMismatchError{Doc
meActual :: Doc
meExpected :: Doc
meActual :: forall a. MismatchError a -> a
meExpected :: forall a. MismatchError a -> a
..})
  =   Int -> Doc -> Doc
fill Int
9 Doc
"Expected:" Doc -> Doc -> Doc
<+> Doc
meExpected
  Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
fill Int
9 Doc
"Actual:"   Doc -> Doc -> Doc
<+> Doc
meActual

-- | Render a mismatch error with a diff.
--
-- This is intended to be used with types for which 'RenderDoc' outputs
-- multiline 'Doc'. Generally those are types wrapped in 'Prettier'.
renderDocDiff :: RenderDoc a => RenderContext -> MismatchError a -> Doc
renderDocDiff :: forall a. RenderDoc a => RenderContext -> MismatchError a -> Doc
renderDocDiff RenderContext
ctx MismatchError a
err = RenderContext -> MismatchError a -> Doc
forall a. RenderDoc a => RenderContext -> MismatchError a -> Doc
renderDocStandard RenderContext
ctx MismatchError a
err
  Doc -> Doc -> Doc
<$> if Bool
expectedAndActualBothSingleLine
      then Doc
forall a. Monoid a => a
mempty
      else Doc
"Mismatch:"
       Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 Doc
"--- expected +++ actual"
       Doc -> Doc -> Doc
<$> Doc -> Doc
align (MismatchError Doc -> Doc
diff MismatchError Doc
errText)
  where
    errText :: MismatchError Doc
errText = (a -> Doc) -> MismatchError a -> MismatchError Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RenderContext -> a -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
doesntNeedParens) MismatchError a
err
    expectedAndActualBothSingleLine :: Bool
expectedAndActualBothSingleLine = (Element (MismatchError Doc) -> Bool) -> MismatchError Doc -> Bool
forall t. Container t => (Element t -> Bool) -> t -> Bool
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
printDoc 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'. Generally those are types wrapped in 'Prettier'.
renderDocDiffList :: RenderDoc a => RenderContext -> MismatchError [a] -> Doc
renderDocDiffList :: forall a. RenderDoc a => RenderContext -> MismatchError [a] -> Doc
renderDocDiffList RenderContext
ctx MismatchError [a]
err = RenderContext -> MismatchError [a] -> Doc
forall a. RenderDoc a => RenderContext -> MismatchError [a] -> Doc
renderDocStandardList RenderContext
ctx MismatchError [a]
err
  Doc -> Doc -> Doc
<$> if Bool
simple
      then Doc
forall a. Monoid a => a
mempty
      else Doc
"Mismatch:"
       Doc -> Doc -> Doc
<$> Int -> Doc -> Doc
indent Int
2 Doc
"--- expected +++ actual"
       Doc -> Doc -> Doc
<$> Doc -> Doc
align (MismatchError Doc -> Doc
diff MismatchError Doc
errText)
  where
    errText :: MismatchError Doc
errText = ([a] -> Doc) -> MismatchError [a] -> MismatchError Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Doc] -> Doc
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
align (Doc -> Doc) -> (a -> Doc) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderContext -> a -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
doesntNeedParens)) 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 t. Container t => (Element t -> Bool) -> t -> Bool
any 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 t. Container t => (Element t -> Bool) -> t -> Bool
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
printDoc Bool
False) MismatchError Doc
errText
    renderList' :: [Doc] -> Doc
renderList' [Doc]
ds
      = case [Doc]
ds of
          []  -> Doc
"[]"
          [Doc
d] -> Doc -> Doc
align (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"[ " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
d Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" ]"
          [Doc]
_   -> Doc -> Doc
align (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ((Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>) (Doc
"[ " Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc]
forall a. a -> [a]
repeat Doc
", ") [Doc]
ds) Doc -> Doc -> Doc
<$> Doc
"]"

diff :: MismatchError Doc -> Doc
diff :: MismatchError Doc -> Doc
diff ((Doc -> [Text]) -> MismatchError Doc -> MismatchError [Text]
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
printDoc Bool
False -> MkMismatchError{[Text]
meActual :: [Text]
meExpected :: [Text]
meActual :: forall a. MismatchError a -> a
meExpected :: forall a. MismatchError a -> a
..}) = [Doc] -> Doc
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 (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
indent Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> Doc
text Text
b
      (First Text
x) -> Doc
"-" Doc -> Doc -> Doc
<+> Text -> Doc
text Text
x
      (Second Text
x) -> Doc
"+" Doc -> Doc -> Doc
<+> Text -> Doc
text Text
x