-- Copyright 2018-2021 Google LLC
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.

-- | Typeclass for pretty-printed diffs between two instances of a type.
--
-- Derive it for arbitrary sum-of-products types as follows:
--
-- @
--     data Foo = Foo Int | Bar Bool
--       deriving Generic
--       deriving (Portray, Diff) via Wrapped Generic Foo
-- @
--
-- If the type of the compared values has a custom Eq instance, the equality
-- comparison used by the Generic derived Diff instance *will differ* from the
-- custom one implemented for the type. It will only check to make sure that
-- the representations of the two types are the same. If you still want the diff
-- algorithm to look into the type, you will need to implement a custom Diff
-- instance alongside the custom Eq instance. If you don't want the diff
-- algorithm to look inside a type, and instead use the custom Eq instance, use:
--
-- @
--     data Foo = ...
--     instance Diff Foo where diff = diffAtom
-- @

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.Portray.Diff (Diff(..), diffAtom, DiffAtom(..), diffVs) where

import Prelude hiding (zipWith)

import qualified Data.Foldable as F (toList)
import Data.Function (on)
import Data.Functor.Const (Const(..))
import Data.Functor.Identity (Identity(..))
import Data.Int (Int8, Int16, Int32, Int64)
import qualified Data.IntMap.Strict as IM
import Data.List.NonEmpty (NonEmpty)
import Data.Maybe (fromMaybe, isNothing)
import Data.Ratio (Ratio)
import Data.Semigroup (Any(..))
import Data.Sequence (Seq)
import Data.Text (Text)
import Data.Type.Equality ((:~:)(..))
import Data.Word (Word8, Word16, Word32, Word64)
import GHC.Exts (IsList(..), fromString, proxy#)
import qualified GHC.Exts as Exts (toList)
import GHC.Generics
import GHC.TypeLits (KnownSymbol, symbolVal')
import Type.Reflection (TypeRep, SomeTypeRep(..))

import Data.Portray
         ( Portray(..), Portrayal(..), PortrayalF(..), Fix(..)
         , IdentKind(..), Ident(..)
         , Infixity(..), Assoc(..), FactorPortrayal(..)
         , showAtom, portrayType
         )
import qualified Data.DList as D
import Data.Wrapped (Wrapped(..), Wrapped1(..))

class Diff a where
  -- | Returns 'Nothing' when equal; or a 'Portrayal' showing the differences.
  diff :: a -> a -> Maybe Portrayal
  default diff :: (Generic a, GDiff a (Rep a)) => a -> a -> Maybe Portrayal
  diff = Wrapped Generic a -> Wrapped Generic a -> Maybe Portrayal
forall a. Diff a => a -> a -> Maybe Portrayal
diff (Wrapped Generic a -> Wrapped Generic a -> Maybe Portrayal)
-> (a -> Wrapped Generic a) -> a -> a -> Maybe Portrayal
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. a -> Wrapped Generic a
forall (c :: * -> Constraint) a. a -> Wrapped c a
Wrapped @Generic

instance (Generic a, GDiff a (Rep a)) => Diff (Wrapped Generic a) where
  diff :: Wrapped Generic a -> Wrapped Generic a -> Maybe Portrayal
diff (Wrapped a
x) (Wrapped a
y) = a -> a -> Rep a Any -> Rep a Any -> Maybe Portrayal
forall a (f :: * -> *) x.
GDiff a f =>
a -> a -> f x -> f x -> Maybe Portrayal
gdiff a
x a
y (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
x) (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
y)

vs, diffVs :: Portrayal -> Portrayal -> Portrayal
vs :: Portrayal -> Portrayal -> Portrayal
vs Portrayal
a Portrayal
b = Ident -> Infixity -> Portrayal -> Portrayal -> Portrayal
Binop (IdentKind -> Text -> Ident
Ident IdentKind
OpIdent Text
"/=") (Assoc -> Rational -> Infixity
Infixity Assoc
AssocNope Rational
4) Portrayal
a Portrayal
b
diffVs :: Portrayal -> Portrayal -> Portrayal
diffVs = Portrayal -> Portrayal -> Portrayal
vs

-- | Diff on an atomic type, just by using the Eq and Portray instances without
-- using any internal structure of the type.
diffAtom :: (Eq a, Portray a) => a -> a -> Maybe Portrayal
diffAtom :: a -> a -> Maybe Portrayal
diffAtom a
a a
b
  | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b = Maybe Portrayal
forall a. Maybe a
Nothing
  | Bool
otherwise = Portrayal -> Maybe Portrayal
forall a. a -> Maybe a
Just (a -> Portrayal
forall a. Portray a => a -> Portrayal
portray a
a Portrayal -> Portrayal -> Portrayal
`vs` a -> Portrayal
forall a. Portray a => a -> Portrayal
portray a
b)

-- Diff record fields, creating docs only for fields that differ.
class GDiffRecord f where
  gdiffRecord :: f x -> f x -> D.DList (FactorPortrayal Portrayal)

-- Note: no instance GDiffRecord U1 because empty "records" like
-- @data Rec = Rec {}@ are not considered to be records by Generic; they'll go
-- through GDiffCtor instead.

instance (Selector s, Diff a) => GDiffRecord (S1 s (K1 i a)) where
  gdiffRecord :: S1 s (K1 i a) x
-> S1 s (K1 i a) x -> DList (FactorPortrayal Portrayal)
gdiffRecord (M1 (K1 a
a)) (M1 (K1 a
b)) =
    (FactorPortrayal Portrayal -> DList (FactorPortrayal Portrayal))
-> Maybe (FactorPortrayal Portrayal)
-> DList (FactorPortrayal Portrayal)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap FactorPortrayal Portrayal -> DList (FactorPortrayal Portrayal)
forall a. a -> DList a
D.singleton (Maybe (FactorPortrayal Portrayal)
 -> DList (FactorPortrayal Portrayal))
-> Maybe (FactorPortrayal Portrayal)
-> DList (FactorPortrayal Portrayal)
forall a b. (a -> b) -> a -> b
$  -- Maybe diff to DList of (zero or one) diffs.
      Ident -> Portrayal -> FactorPortrayal Portrayal
forall a. Ident -> a -> FactorPortrayal a
FactorPortrayal (String -> Ident
forall a. IsString a => String -> a
fromString (String -> Ident) -> String -> Ident
forall a b. (a -> b) -> a -> b
$ Any s Any Any -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName @s Any s Any Any
forall a. HasCallStack => a
undefined) (Portrayal -> FactorPortrayal Portrayal)
-> Maybe Portrayal -> Maybe (FactorPortrayal Portrayal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      a -> a -> Maybe Portrayal
forall a. Diff a => a -> a -> Maybe Portrayal
diff a
a a
b

instance (GDiffRecord f, GDiffRecord g) => GDiffRecord (f :*: g) where
  gdiffRecord :: (:*:) f g x -> (:*:) f g x -> DList (FactorPortrayal Portrayal)
gdiffRecord (f x
fa :*: g x
ga) (f x
fb :*: g x
gb) = f x -> f x -> DList (FactorPortrayal Portrayal)
forall (f :: * -> *) x.
GDiffRecord f =>
f x -> f x -> DList (FactorPortrayal Portrayal)
gdiffRecord f x
fa f x
fb DList (FactorPortrayal Portrayal)
-> DList (FactorPortrayal Portrayal)
-> DList (FactorPortrayal Portrayal)
forall a. Semigroup a => a -> a -> a
<> g x -> g x -> DList (FactorPortrayal Portrayal)
forall (f :: * -> *) x.
GDiffRecord f =>
f x -> f x -> DList (FactorPortrayal Portrayal)
gdiffRecord g x
ga g x
gb

-- Diff constructor fields, filling equal fields with "_" and reporting whether
-- any diffs were detected.
--
-- N.B. this works fine on record constructors, too, in case we want to support
-- configuring whether to use record syntax or constructor application syntax.
--
-- This is a separate class from GDiffRecord because it'd be wasteful to
-- accumulate tons of "_" docs for records with lots of fields and then discard
-- them.
class GDiffCtor f where
  gdiffCtor :: f x -> f x -> (Any, D.DList Portrayal)

-- Nullary constructors have no diffs compared against themselves.
instance GDiffCtor U1 where
  gdiffCtor :: U1 x -> U1 x -> (Any, DList Portrayal)
gdiffCtor U1 x
U1 U1 x
U1 = (Any, DList Portrayal)
forall a. Monoid a => a
mempty

instance Diff a => GDiffCtor (S1 s (K1 i a)) where
  gdiffCtor :: S1 s (K1 i a) x -> S1 s (K1 i a) x -> (Any, DList Portrayal)
gdiffCtor (M1 (K1 a
a)) (M1 (K1 a
b)) = case a -> a -> Maybe Portrayal
forall a. Diff a => a -> a -> Maybe Portrayal
diff a
a a
b of
    Maybe Portrayal
Nothing -> (Any
forall a. Monoid a => a
mempty, Portrayal -> DList Portrayal
forall a. a -> DList a
D.singleton (Text -> Portrayal
Opaque Text
"_"))
    Just Portrayal
d -> (Bool -> Any
Any Bool
True, Portrayal -> DList Portrayal
forall a. a -> DList a
D.singleton Portrayal
d)

instance (GDiffCtor f, GDiffCtor g) => GDiffCtor (f :*: g) where
  gdiffCtor :: (:*:) f g x -> (:*:) f g x -> (Any, DList Portrayal)
gdiffCtor (f x
fa :*: g x
ga) (f x
fb :*: g x
gb) = f x -> f x -> (Any, DList Portrayal)
forall (f :: * -> *) x.
GDiffCtor f =>
f x -> f x -> (Any, DList Portrayal)
gdiffCtor f x
fa f x
fb (Any, DList Portrayal)
-> (Any, DList Portrayal) -> (Any, DList Portrayal)
forall a. Semigroup a => a -> a -> a
<> g x -> g x -> (Any, DList Portrayal)
forall (f :: * -> *) x.
GDiffCtor f =>
f x -> f x -> (Any, DList Portrayal)
gdiffCtor g x
ga g x
gb

class GDiff a f where
  gdiff :: a -> a -> f x -> f x -> Maybe Portrayal

instance (KnownSymbol n, GDiffRecord f)
      => GDiff a (C1 ('MetaCons n fx 'True) f) where
  gdiff :: a
-> a
-> C1 ('MetaCons n fx 'True) f x
-> C1 ('MetaCons n fx 'True) f x
-> Maybe Portrayal
gdiff a
_ a
_ (M1 f x
a) (M1 f x
b) = case DList (FactorPortrayal Portrayal) -> [FactorPortrayal Portrayal]
forall a. DList a -> [a]
D.toList (f x -> f x -> DList (FactorPortrayal Portrayal)
forall (f :: * -> *) x.
GDiffRecord f =>
f x -> f x -> DList (FactorPortrayal Portrayal)
gdiffRecord f x
a f x
b) of
    [] -> Maybe Portrayal
forall a. Maybe a
Nothing
    [FactorPortrayal Portrayal]
ds -> Portrayal -> Maybe Portrayal
forall a. a -> Maybe a
Just (Portrayal -> Maybe Portrayal) -> Portrayal -> Maybe Portrayal
forall a b. (a -> b) -> a -> b
$ Portrayal -> [FactorPortrayal Portrayal] -> Portrayal
Record (Ident -> Portrayal
Name (Ident -> Portrayal) -> Ident -> Portrayal
forall a b. (a -> b) -> a -> b
$ String -> Ident
forall a. IsString a => String -> a
fromString (String -> Ident) -> String -> Ident
forall a b. (a -> b) -> a -> b
$ Proxy# n -> String
forall (n :: Symbol). KnownSymbol n => Proxy# n -> String
symbolVal' @n Proxy# n
forall k (a :: k). Proxy# a
proxy#) [FactorPortrayal Portrayal]
ds

instance (KnownSymbol n, GDiffCtor f)
      => GDiff a (C1 ('MetaCons n fx 'False) f) where
  gdiff :: a
-> a
-> C1 ('MetaCons n fx 'False) f x
-> C1 ('MetaCons n fx 'False) f x
-> Maybe Portrayal
gdiff a
_ a
_ (M1 f x
a) (M1 f x
b) = case f x -> f x -> (Any, DList Portrayal)
forall (f :: * -> *) x.
GDiffCtor f =>
f x -> f x -> (Any, DList Portrayal)
gdiffCtor f x
a f x
b of
    (Any Bool
False, DList Portrayal
_ ) -> Maybe Portrayal
forall a. Maybe a
Nothing
    (Any Bool
True , DList Portrayal
ds) -> Portrayal -> Maybe Portrayal
forall a. a -> Maybe a
Just (Portrayal -> Maybe Portrayal) -> Portrayal -> Maybe Portrayal
forall a b. (a -> b) -> a -> b
$ case String
nm of
      -- Print tuple constructors with tuple syntax.  Ignore infix
      -- constructors, since they'd make for pretty hard-to-read diffs.
      Char
'(':Char
',':String
_ -> [Portrayal] -> Portrayal
Tuple (DList Portrayal -> [Portrayal]
forall a. DList a -> [a]
D.toList DList Portrayal
ds)
      String
_ -> Portrayal -> [Portrayal] -> Portrayal
Apply (Ident -> Portrayal
Name (Ident -> Portrayal) -> Ident -> Portrayal
forall a b. (a -> b) -> a -> b
$ String -> Ident
forall a. IsString a => String -> a
fromString String
nm) (DList Portrayal -> [Portrayal]
forall a. DList a -> [a]
D.toList DList Portrayal
ds)
   where
    nm :: String
nm = Proxy# n -> String
forall (n :: Symbol). KnownSymbol n => Proxy# n -> String
symbolVal' @n Proxy# n
forall k (a :: k). Proxy# a
proxy#

instance (Portray a, GDiff a f, GDiff a g) => GDiff a (f :+: g) where
  gdiff :: a -> a -> (:+:) f g x -> (:+:) f g x -> Maybe Portrayal
gdiff a
origA a
origB (:+:) f g x
a (:+:) f g x
b = case ((:+:) f g x
a, (:+:) f g x
b) of
    (L1 f x
fa, L1 f x
fb) -> a -> a -> f x -> f x -> Maybe Portrayal
forall a (f :: * -> *) x.
GDiff a f =>
a -> a -> f x -> f x -> Maybe Portrayal
gdiff a
origA a
origB f x
fa f x
fb
    (R1 g x
ga, R1 g x
gb) -> a -> a -> g x -> g x -> Maybe Portrayal
forall a (f :: * -> *) x.
GDiff a f =>
a -> a -> f x -> f x -> Maybe Portrayal
gdiff a
origA a
origB g x
ga g x
gb
    ((:+:) f g x, (:+:) f g x)
_              -> Portrayal -> Maybe Portrayal
forall a. a -> Maybe a
Just (a -> Portrayal
forall a. Portray a => a -> Portrayal
portray a
origA Portrayal -> Portrayal -> Portrayal
`vs` a -> Portrayal
forall a. Portray a => a -> Portrayal
portray a
origB)

instance GDiff a f => GDiff a (D1 d f) where
  gdiff :: a -> a -> D1 d f x -> D1 d f x -> Maybe Portrayal
gdiff a
origA a
origB (M1 f x
a) (M1 f x
b) = a -> a -> f x -> f x -> Maybe Portrayal
forall a (f :: * -> *) x.
GDiff a f =>
a -> a -> f x -> f x -> Maybe Portrayal
gdiff a
origA a
origB f x
a f x
b

instance Diff ()
instance (Portray a, Portray b, Diff a, Diff b) => Diff (a, b)
instance (Portray a, Portray b, Portray c, Diff a, Diff b, Diff c)
       => Diff (a, b, c)
instance ( Portray a, Portray b, Portray c, Portray d
         , Diff a, Diff b, Diff c, Diff d
         )
      => Diff (a, b, c, d)
instance ( Portray a, Portray b, Portray c, Portray d, Portray e
         , Diff a, Diff b, Diff c, Diff d, Diff e
         )
      => Diff (a, b, c, d, e)
instance (Portray a, Portray b, Diff a, Diff b) => Diff (Either a b)
instance (Portray a, Diff a) => Diff (Maybe a)

instance Diff Bool
instance Diff Int where diff :: Int -> Int -> Maybe Portrayal
diff = Int -> Int -> Maybe Portrayal
forall a. (Eq a, Portray a) => a -> a -> Maybe Portrayal
diffAtom
instance Diff Int8 where diff :: Int8 -> Int8 -> Maybe Portrayal
diff = Int8 -> Int8 -> Maybe Portrayal
forall a. (Eq a, Portray a) => a -> a -> Maybe Portrayal
diffAtom
instance Diff Int16 where diff :: Int16 -> Int16 -> Maybe Portrayal
diff = Int16 -> Int16 -> Maybe Portrayal
forall a. (Eq a, Portray a) => a -> a -> Maybe Portrayal
diffAtom
instance Diff Int32 where diff :: Int32 -> Int32 -> Maybe Portrayal
diff = Int32 -> Int32 -> Maybe Portrayal
forall a. (Eq a, Portray a) => a -> a -> Maybe Portrayal
diffAtom
instance Diff Int64 where diff :: Int64 -> Int64 -> Maybe Portrayal
diff = Int64 -> Int64 -> Maybe Portrayal
forall a. (Eq a, Portray a) => a -> a -> Maybe Portrayal
diffAtom
instance Diff Word where diff :: Word -> Word -> Maybe Portrayal
diff = Word -> Word -> Maybe Portrayal
forall a. (Eq a, Portray a) => a -> a -> Maybe Portrayal
diffAtom
instance Diff Word8 where diff :: Word8 -> Word8 -> Maybe Portrayal
diff = Word8 -> Word8 -> Maybe Portrayal
forall a. (Eq a, Portray a) => a -> a -> Maybe Portrayal
diffAtom
instance Diff Word16 where diff :: Word16 -> Word16 -> Maybe Portrayal
diff = Word16 -> Word16 -> Maybe Portrayal
forall a. (Eq a, Portray a) => a -> a -> Maybe Portrayal
diffAtom
instance Diff Word32 where diff :: Word32 -> Word32 -> Maybe Portrayal
diff = Word32 -> Word32 -> Maybe Portrayal
forall a. (Eq a, Portray a) => a -> a -> Maybe Portrayal
diffAtom
instance Diff Word64 where diff :: Word64 -> Word64 -> Maybe Portrayal
diff = Word64 -> Word64 -> Maybe Portrayal
forall a. (Eq a, Portray a) => a -> a -> Maybe Portrayal
diffAtom
instance Diff Char where diff :: Char -> Char -> Maybe Portrayal
diff = Char -> Char -> Maybe Portrayal
forall a. (Eq a, Portray a) => a -> a -> Maybe Portrayal
diffAtom
instance Diff Integer where diff :: Integer -> Integer -> Maybe Portrayal
diff = Integer -> Integer -> Maybe Portrayal
forall a. (Eq a, Portray a) => a -> a -> Maybe Portrayal
diffAtom
instance Diff Float where diff :: Float -> Float -> Maybe Portrayal
diff = Float -> Float -> Maybe Portrayal
forall a. (Eq a, Portray a) => a -> a -> Maybe Portrayal
diffAtom
instance Diff Double where diff :: Double -> Double -> Maybe Portrayal
diff = Double -> Double -> Maybe Portrayal
forall a. (Eq a, Portray a) => a -> a -> Maybe Portrayal
diffAtom
instance Diff Text where diff :: Text -> Text -> Maybe Portrayal
diff = Text -> Text -> Maybe Portrayal
forall a. (Eq a, Portray a) => a -> a -> Maybe Portrayal
diffAtom
instance (Eq a, Portray a) => Diff (Ratio a) where diff :: Ratio a -> Ratio a -> Maybe Portrayal
diff = Ratio a -> Ratio a -> Maybe Portrayal
forall a. (Eq a, Portray a) => a -> a -> Maybe Portrayal
diffAtom

newtype DiffAtom a = DiffAtom a
  deriving newtype (DiffAtom a -> DiffAtom a -> Bool
(DiffAtom a -> DiffAtom a -> Bool)
-> (DiffAtom a -> DiffAtom a -> Bool) -> Eq (DiffAtom a)
forall a. Eq a => DiffAtom a -> DiffAtom a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiffAtom a -> DiffAtom a -> Bool
$c/= :: forall a. Eq a => DiffAtom a -> DiffAtom a -> Bool
== :: DiffAtom a -> DiffAtom a -> Bool
$c== :: forall a. Eq a => DiffAtom a -> DiffAtom a -> Bool
Eq, [DiffAtom a] -> Portrayal
DiffAtom a -> Portrayal
(DiffAtom a -> Portrayal)
-> ([DiffAtom a] -> Portrayal) -> Portray (DiffAtom a)
forall a. Portray a => [DiffAtom a] -> Portrayal
forall a. Portray a => DiffAtom a -> Portrayal
forall a. (a -> Portrayal) -> ([a] -> Portrayal) -> Portray a
portrayList :: [DiffAtom a] -> Portrayal
$cportrayList :: forall a. Portray a => [DiffAtom a] -> Portrayal
portray :: DiffAtom a -> Portrayal
$cportray :: forall a. Portray a => DiffAtom a -> Portrayal
Portray)

instance (Eq a, Portray a) => Diff (DiffAtom a) where diff :: DiffAtom a -> DiffAtom a -> Maybe Portrayal
diff = DiffAtom a -> DiffAtom a -> Maybe Portrayal
forall a. (Eq a, Portray a) => a -> a -> Maybe Portrayal
diffAtom

-- | Diff on lists does a diff on the zip, plus special handling for the
-- mismatched lengths.
instance (Portray a, Diff a) => Diff [a] where
  diff :: [a] -> [a] -> Maybe Portrayal
diff [a]
as0 [a]
bs0 =
    if (Maybe Portrayal -> Bool) -> [Maybe Portrayal] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Maybe Portrayal -> Bool
forall a. Maybe a -> Bool
isNothing [Maybe Portrayal]
d
      then Maybe Portrayal
forall a. Maybe a
Nothing
      else Portrayal -> Maybe Portrayal
forall a. a -> Maybe a
Just (Portrayal -> Maybe Portrayal) -> Portrayal -> Maybe Portrayal
forall a b. (a -> b) -> a -> b
$ [Portrayal] -> Portrayal
List ([Portrayal] -> Portrayal) -> [Portrayal] -> Portrayal
forall a b. (a -> b) -> a -> b
$ Portrayal -> Maybe Portrayal -> Portrayal
forall a. a -> Maybe a -> a
fromMaybe (Text -> Portrayal
Opaque Text
"_") (Maybe Portrayal -> Portrayal) -> [Maybe Portrayal] -> [Portrayal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe Portrayal]
d
   where
    -- Extended @zipWith diff@ which doesn't drop on mismatched lengths.
    go :: [a] -> [a] -> [Maybe Portrayal]
    go :: [a] -> [a] -> [Maybe Portrayal]
go [] [] = []
    go (a
a:[a]
as) [] =
      Portrayal -> Maybe Portrayal
forall a. a -> Maybe a
Just (a -> Portrayal
forall a. Portray a => a -> Portrayal
portray a
a Portrayal -> Portrayal -> Portrayal
`vs` Text -> Portrayal
Opaque Text
"_") Maybe Portrayal -> [Maybe Portrayal] -> [Maybe Portrayal]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [Maybe Portrayal]
go [a]
as []
    go [] (a
b:[a]
bs) =
      Portrayal -> Maybe Portrayal
forall a. a -> Maybe a
Just (Text -> Portrayal
Opaque Text
"_" Portrayal -> Portrayal -> Portrayal
`vs` a -> Portrayal
forall a. Portray a => a -> Portrayal
portray a
b) Maybe Portrayal -> [Maybe Portrayal] -> [Maybe Portrayal]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [Maybe Portrayal]
go [] [a]
bs
    go (a
a:[a]
as) (a
b:[a]
bs) = a -> a -> Maybe Portrayal
forall a. Diff a => a -> a -> Maybe Portrayal
diff a
a a
b Maybe Portrayal -> [Maybe Portrayal] -> [Maybe Portrayal]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [Maybe Portrayal]
go [a]
as [a]
bs

    d :: [Maybe Portrayal]
d = [a] -> [a] -> [Maybe Portrayal]
go [a]
as0 [a]
bs0

-- | Diff as if the type were a list, via 'Exts.toList'.
instance (IsList a, Portray (Item a), Diff (Item a))
      => Diff (Wrapped IsList a) where
  diff :: Wrapped IsList a -> Wrapped IsList a -> Maybe Portrayal
diff = [Item a] -> [Item a] -> Maybe Portrayal
forall a. Diff a => a -> a -> Maybe Portrayal
diff ([Item a] -> [Item a] -> Maybe Portrayal)
-> (Wrapped IsList a -> [Item a])
-> Wrapped IsList a
-> Wrapped IsList a
-> Maybe Portrayal
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Wrapped IsList a -> [Item a]
forall l. IsList l => l -> [Item l]
Exts.toList

-- | Diff as if the type were a list, via 'F.toList'.
instance (Portray a, Foldable f, Diff a)
      => Diff (Wrapped1 Foldable f a) where
  diff :: Wrapped1 Foldable f a -> Wrapped1 Foldable f a -> Maybe Portrayal
diff = [a] -> [a] -> Maybe Portrayal
forall a. Diff a => a -> a -> Maybe Portrayal
diff ([a] -> [a] -> Maybe Portrayal)
-> (Wrapped1 Foldable f a -> [a])
-> Wrapped1 Foldable f a
-> Wrapped1 Foldable f a
-> Maybe Portrayal
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Wrapped1 Foldable f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

deriving via Wrapped IsList (NonEmpty a)
  instance (Portray a, Diff a) => Diff (NonEmpty a)
deriving via Wrapped IsList (Seq a)
  instance (Portray a, Diff a) => Diff (Seq a)

instance (Portray a, Diff a) => Diff (IM.IntMap a) where
  diff :: IntMap a -> IntMap a -> Maybe Portrayal
diff IntMap a
as IntMap a
bs =
    if IntMap Portrayal -> Bool
forall a. IntMap a -> Bool
IM.null IntMap Portrayal
allDiffs
      then Maybe Portrayal
forall a. Maybe a
Nothing
      else Portrayal -> Maybe Portrayal
forall a. a -> Maybe a
Just (Portrayal -> Maybe Portrayal) -> Portrayal -> Maybe Portrayal
forall a b. (a -> b) -> a -> b
$ [Portrayal] -> Portrayal
List [[Portrayal] -> Portrayal
Tuple [Int -> Portrayal
forall a. Show a => a -> Portrayal
showAtom Int
k, Portrayal
v] | (Int
k, Portrayal
v) <- IntMap Portrayal -> [(Int, Portrayal)]
forall a. IntMap a -> [(Int, a)]
IM.toList IntMap Portrayal
allDiffs]
   where
    -- Note: we could have used 'align', but "these" has a ton of dependencies
    -- and it'd only save a few lines of code.
    aOnly, bOnly, valDiffs, allDiffs :: IM.IntMap Portrayal
    aOnly :: IntMap Portrayal
aOnly = (a -> Portrayal) -> IntMap a -> IntMap Portrayal
forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map (\a
a -> a -> Portrayal
forall a. Portray a => a -> Portrayal
portray a
a Portrayal -> Portrayal -> Portrayal
`vs` Text -> Portrayal
Opaque Text
"_") (IntMap a -> IntMap Portrayal) -> IntMap a -> IntMap Portrayal
forall a b. (a -> b) -> a -> b
$ IntMap a -> IntMap a -> IntMap a
forall a b. IntMap a -> IntMap b -> IntMap a
IM.difference IntMap a
as IntMap a
bs
    bOnly :: IntMap Portrayal
bOnly = (a -> Portrayal) -> IntMap a -> IntMap Portrayal
forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map (\a
b -> Text -> Portrayal
Opaque Text
"_" Portrayal -> Portrayal -> Portrayal
`vs` a -> Portrayal
forall a. Portray a => a -> Portrayal
portray a
b) (IntMap a -> IntMap Portrayal) -> IntMap a -> IntMap Portrayal
forall a b. (a -> b) -> a -> b
$ IntMap a -> IntMap a -> IntMap a
forall a b. IntMap a -> IntMap b -> IntMap a
IM.difference IntMap a
bs IntMap a
as
    valDiffs :: IntMap Portrayal
valDiffs = (Maybe Portrayal -> Maybe Portrayal)
-> IntMap (Maybe Portrayal) -> IntMap Portrayal
forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
IM.mapMaybe Maybe Portrayal -> Maybe Portrayal
forall a. a -> a
id (IntMap (Maybe Portrayal) -> IntMap Portrayal)
-> IntMap (Maybe Portrayal) -> IntMap Portrayal
forall a b. (a -> b) -> a -> b
$ (a -> a -> Maybe Portrayal)
-> IntMap a -> IntMap a -> IntMap (Maybe Portrayal)
forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWith a -> a -> Maybe Portrayal
forall a. Diff a => a -> a -> Maybe Portrayal
diff IntMap a
as IntMap a
bs
    allDiffs :: IntMap Portrayal
allDiffs = [IntMap Portrayal] -> IntMap Portrayal
forall (f :: * -> *) a. Foldable f => f (IntMap a) -> IntMap a
IM.unions [IntMap Portrayal
aOnly, IntMap Portrayal
bOnly, IntMap Portrayal
valDiffs]

deriving via Wrapped Generic Assoc instance Diff Assoc
deriving via Wrapped Generic IdentKind instance Diff IdentKind
deriving via Wrapped Generic Ident instance Diff Ident
deriving via Wrapped Generic Infixity instance Diff Infixity
deriving via Wrapped Generic (FactorPortrayal a)
  instance Diff a => Diff (FactorPortrayal a)
deriving via Wrapped Generic (PortrayalF a)
  instance (Portray a, Diff a) => Diff (PortrayalF a)
deriving newtype
  instance ( forall a. (Portray a, Diff a) => Diff (f a)
           , forall a. Portray a => Portray (f a)
           )
        => Diff (Fix f)
deriving newtype instance Diff Portrayal

deriving via Wrapped Generic (Identity a) instance Diff a => Diff (Identity a)
deriving via Wrapped Generic (Const a b) instance Diff a => Diff (Const a b)

instance Diff (TypeRep a) where
  diff :: TypeRep a -> TypeRep a -> Maybe Portrayal
diff TypeRep a
x TypeRep a
y
    | TypeRep a
x TypeRep a -> TypeRep a -> Bool
forall a. Eq a => a -> a -> Bool
== TypeRep a
y    = Maybe Portrayal
forall a. Maybe a
Nothing
    | Bool
otherwise = Portrayal -> Maybe Portrayal
forall a. a -> Maybe a
Just (Portrayal -> Maybe Portrayal) -> Portrayal -> Maybe Portrayal
forall a b. (a -> b) -> a -> b
$ TypeRep a -> Portrayal
forall a. Portray a => a -> Portrayal
portray TypeRep a
x Portrayal -> Portrayal -> Portrayal
`diffVs` TypeRep a -> Portrayal
forall a. Portray a => a -> Portrayal
portray TypeRep a
y

instance Diff SomeTypeRep where
  diff :: SomeTypeRep -> SomeTypeRep -> Maybe Portrayal
diff x :: SomeTypeRep
x@(SomeTypeRep TypeRep a
tx) y :: SomeTypeRep
y@(SomeTypeRep TypeRep a
ty)
    | SomeTypeRep
x SomeTypeRep -> SomeTypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== SomeTypeRep
y = Maybe Portrayal
forall a. Maybe a
Nothing
    | Bool
otherwise =
        Portrayal -> Maybe Portrayal
forall a. a -> Maybe a
Just (Portrayal -> Maybe Portrayal) -> Portrayal -> Maybe Portrayal
forall a b. (a -> b) -> a -> b
$ Portrayal -> [Portrayal] -> Portrayal
Apply
          (Portrayal -> Portrayal -> Portrayal
TyApp
            (Ident -> Portrayal
Name (Ident -> Portrayal) -> Ident -> Portrayal
forall a b. (a -> b) -> a -> b
$ IdentKind -> Text -> Ident
Ident IdentKind
ConIdent Text
"SomeTypeRep")
            (TypeRep a -> Portrayal
forall k (a :: k). TypeRep a -> Portrayal
portrayType TypeRep a
tx Portrayal -> Portrayal -> Portrayal
`diffVs` TypeRep a -> Portrayal
forall k (a :: k). TypeRep a -> Portrayal
portrayType TypeRep a
ty))
          [Ident -> Portrayal
Name (Ident -> Portrayal) -> Ident -> Portrayal
forall a b. (a -> b) -> a -> b
$ IdentKind -> Text -> Ident
Ident IdentKind
VarIdent Text
"typeRep"]

instance Diff (a :~: b) where diff :: (a :~: b) -> (a :~: b) -> Maybe Portrayal
diff a :~: b
Refl a :~: b
Refl = Maybe Portrayal
forall a. Maybe a
Nothing