{-# LANGUAGE EmptyCase #-}

module Generics.Diff.Type where

import Data.List.NonEmpty
import Data.SOP.NP
import Generics.SOP as SOP

{- | A newtype wrapping a binary function producing a 'DiffResult'.
The only reason for this newtype is so that we can use it as a functor with the types from
@generic-sop@.
-}
newtype Differ x = Differ (x -> x -> DiffResult x)

{- | A GADT representing an error during the diff algorithm - i.e. this tells us where and how two values differ.

The special constructors for list are so that we can treat these types a bit uniquely. See 'ListDiffError'.
-}
data DiffError a where
  -- | All we can say is that the values being compared are not equal.
  TopLevelNotEqual :: DiffError a
  -- | We've identified a diff at a certain constructor or field
  Nested :: DiffErrorNested (Code a) -> DiffError a
  -- | Special case for lists
  DiffList :: ListDiffError a -> DiffError [a]
  -- | Special case for non-empty lists
  DiffNonEmpty :: ListDiffError a -> DiffError (NonEmpty a)

{- | If we did a normal 'Generics.Diff.gdiff' on a linked list, we'd have to recurse through one "level" of
'Generics.Diff.Diff's for each element of the input lists. The output would be really hard to read or understand.
Therefore this type lets us treat lists as a special case, depending on how they differ.
-}
data ListDiffError a
  = -- | If we find a difference when comparing the two lists pointwise, we report the index of the
    -- error and the error caused by the elements at that index of the input lists.
    DiffAtIndex Int (DiffError a)
  | -- | The two lists have different lengths. If we get a 'WrongLengths' instead of an 'Equal' or a
    -- 'DiffAtIndex' , we know that one of the lists must be a subset of the other.
    WrongLengths Int Int
  deriving (Int -> ListDiffError a -> ShowS
[ListDiffError a] -> ShowS
ListDiffError a -> String
(Int -> ListDiffError a -> ShowS)
-> (ListDiffError a -> String)
-> ([ListDiffError a] -> ShowS)
-> Show (ListDiffError a)
forall a. Int -> ListDiffError a -> ShowS
forall a. [ListDiffError a] -> ShowS
forall a. ListDiffError a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> ListDiffError a -> ShowS
showsPrec :: Int -> ListDiffError a -> ShowS
$cshow :: forall a. ListDiffError a -> String
show :: ListDiffError a -> String
$cshowList :: forall a. [ListDiffError a] -> ShowS
showList :: [ListDiffError a] -> ShowS
Show, ListDiffError a -> ListDiffError a -> Bool
(ListDiffError a -> ListDiffError a -> Bool)
-> (ListDiffError a -> ListDiffError a -> Bool)
-> Eq (ListDiffError a)
forall a. ListDiffError a -> ListDiffError a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. ListDiffError a -> ListDiffError a -> Bool
== :: ListDiffError a -> ListDiffError a -> Bool
$c/= :: forall a. ListDiffError a -> ListDiffError a -> Bool
/= :: ListDiffError a -> ListDiffError a -> Bool
Eq)

deriving instance (Show (DiffError a))

deriving instance (Eq (DiffError a))

infixr 6 :*:

-- | Lifted product of functors. We could have used 'Data.Functor.Product.Product', but this is more concise.
data (f :*: g) a = f a :*: g a
  deriving (Int -> (:*:) f g a -> ShowS
[(:*:) f g a] -> ShowS
(:*:) f g a -> String
(Int -> (:*:) f g a -> ShowS)
-> ((:*:) f g a -> String)
-> ([(:*:) f g a] -> ShowS)
-> Show ((:*:) f g a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
(Show (f a), Show (g a)) =>
Int -> (:*:) f g a -> ShowS
forall k (f :: k -> *) (g :: k -> *) (a :: k).
(Show (f a), Show (g a)) =>
[(:*:) f g a] -> ShowS
forall k (f :: k -> *) (g :: k -> *) (a :: k).
(Show (f a), Show (g a)) =>
(:*:) f g a -> String
$cshowsPrec :: forall k (f :: k -> *) (g :: k -> *) (a :: k).
(Show (f a), Show (g a)) =>
Int -> (:*:) f g a -> ShowS
showsPrec :: Int -> (:*:) f g a -> ShowS
$cshow :: forall k (f :: k -> *) (g :: k -> *) (a :: k).
(Show (f a), Show (g a)) =>
(:*:) f g a -> String
show :: (:*:) f g a -> String
$cshowList :: forall k (f :: k -> *) (g :: k -> *) (a :: k).
(Show (f a), Show (g a)) =>
[(:*:) f g a] -> ShowS
showList :: [(:*:) f g a] -> ShowS
Show, (:*:) f g a -> (:*:) f g a -> Bool
((:*:) f g a -> (:*:) f g a -> Bool)
-> ((:*:) f g a -> (:*:) f g a -> Bool) -> Eq ((:*:) f g a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
(Eq (f a), Eq (g a)) =>
(:*:) f g a -> (:*:) f g a -> Bool
$c== :: forall k (f :: k -> *) (g :: k -> *) (a :: k).
(Eq (f a), Eq (g a)) =>
(:*:) f g a -> (:*:) f g a -> Bool
== :: (:*:) f g a -> (:*:) f g a -> Bool
$c/= :: forall k (f :: k -> *) (g :: k -> *) (a :: k).
(Eq (f a), Eq (g a)) =>
(:*:) f g a -> (:*:) f g a -> Bool
/= :: (:*:) f g a -> (:*:) f g a -> Bool
Eq)

{- | This is where we actually detail the difference between two values, and where in their structure the
difference is.
-}
data DiffErrorNested xss
  = -- | The two input values use different constructor, which are included.
    WrongConstructor (NS ConstructorInfo xss) (NS ConstructorInfo xss)
  | -- | The inputs use the same constructor, but differ at one of the fields.
    -- 'DiffAtField' will tell us where and how.
    FieldMismatch (DiffAtField xss)

-- | The result of a 'Generics.Diff.diff'.
data DiffResult a
  = -- | There's a diff, here it is
    Error (DiffError a)
  | -- | No diff, inputs are equal
    Equal
  deriving (Int -> DiffResult a -> ShowS
[DiffResult a] -> ShowS
DiffResult a -> String
(Int -> DiffResult a -> ShowS)
-> (DiffResult a -> String)
-> ([DiffResult a] -> ShowS)
-> Show (DiffResult a)
forall a. Int -> DiffResult a -> ShowS
forall a. [DiffResult a] -> ShowS
forall a. DiffResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> DiffResult a -> ShowS
showsPrec :: Int -> DiffResult a -> ShowS
$cshow :: forall a. DiffResult a -> String
show :: DiffResult a -> String
$cshowList :: forall a. [DiffResult a] -> ShowS
showList :: [DiffResult a] -> ShowS
Show, DiffResult a -> DiffResult a -> Bool
(DiffResult a -> DiffResult a -> Bool)
-> (DiffResult a -> DiffResult a -> Bool) -> Eq (DiffResult a)
forall a. DiffResult a -> DiffResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. DiffResult a -> DiffResult a -> Bool
== :: DiffResult a -> DiffResult a -> Bool
$c/= :: forall a. DiffResult a -> DiffResult a -> Bool
/= :: DiffResult a -> DiffResult a -> Bool
Eq)

{- | In the case that two values have the same constructor but differ at a certain field, we want two
report two things: what the 'DiffError' is at that field, and exactly where that field is. Careful use
of 'NS' gives us both of those things.
-}
newtype DiffAtField xss = DiffAtField (NS (ConstructorInfo :*: NS DiffError) xss)

------------------------------------------------------------
-- Instance madness

eqPair :: (f a -> f a -> Bool) -> (g a -> g a -> Bool) -> (f :*: g) a -> (f :*: g) a -> Bool
eqPair :: forall {k} (f :: k -> *) (a :: k) (g :: k -> *).
(f a -> f a -> Bool)
-> (g a -> g a -> Bool) -> (:*:) f g a -> (:*:) f g a -> Bool
eqPair f a -> f a -> Bool
onF g a -> g a -> Bool
onG (f a
f1 :*: g a
g1) (f a
f2 :*: g a
g2) =
  f a -> f a -> Bool
onF f a
f1 f a
f2 Bool -> Bool -> Bool
&& g a -> g a -> Bool
onG g a
g1 g a
g2

showsPair :: (Int -> f a -> ShowS) -> (Int -> g a -> ShowS) -> Int -> (f :*: g) a -> ShowS
showsPair :: forall {k} (f :: k -> *) (a :: k) (g :: k -> *).
(Int -> f a -> ShowS)
-> (Int -> g a -> ShowS) -> Int -> (:*:) f g a -> ShowS
showsPair Int -> f a -> ShowS
onF Int -> g a -> ShowS
onG Int
d (f a
fa :*: g a
ga) =
  Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
5) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    Int -> f a -> ShowS
onF Int
6 f a
fa
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" :*: "
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> g a -> ShowS
onG Int
5 g a
ga

instance Eq (DiffAtField xss) where
  DiffAtField NS (ConstructorInfo :*: NS DiffError) xss
mss == :: DiffAtField xss -> DiffAtField xss -> Bool
== DiffAtField NS (ConstructorInfo :*: NS DiffError) xss
nss =
    (forall (x :: [*]).
 (:*:) ConstructorInfo (NS DiffError) x
 -> (:*:) ConstructorInfo (NS DiffError) x -> Bool)
-> NS (ConstructorInfo :*: NS DiffError) xss
-> NS (ConstructorInfo :*: NS DiffError) xss
-> Bool
forall {k} (f :: k -> *) (xs :: [k]).
(forall (x :: k). f x -> f x -> Bool) -> NS f xs -> NS f xs -> Bool
eqNS ((ConstructorInfo x -> ConstructorInfo x -> Bool)
-> (NS DiffError x -> NS DiffError x -> Bool)
-> (:*:) ConstructorInfo (NS DiffError) x
-> (:*:) ConstructorInfo (NS DiffError) x
-> Bool
forall {k} (f :: k -> *) (a :: k) (g :: k -> *).
(f a -> f a -> Bool)
-> (g a -> g a -> Bool) -> (:*:) f g a -> (:*:) f g a -> Bool
eqPair ConstructorInfo x -> ConstructorInfo x -> Bool
forall (xs :: [*]).
ConstructorInfo xs -> ConstructorInfo xs -> Bool
eqConstructorInfo ((forall a. DiffError a -> DiffError a -> Bool)
-> NS DiffError x -> NS DiffError x -> Bool
forall {k} (f :: k -> *) (xs :: [k]).
(forall (x :: k). f x -> f x -> Bool) -> NS f xs -> NS f xs -> Bool
eqNS DiffError x -> DiffError x -> Bool
forall a. Eq a => a -> a -> Bool
forall a. DiffError a -> DiffError a -> Bool
(==))) NS (ConstructorInfo :*: NS DiffError) xss
mss NS (ConstructorInfo :*: NS DiffError) xss
nss

instance Show (DiffAtField xss) where
  showsPrec :: Int -> DiffAtField xss -> ShowS
showsPrec Int
d (DiffAtField NS (ConstructorInfo :*: NS DiffError) xss
ns) =
    Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"DiffAtField "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (x :: [*]).
 Int -> (:*:) ConstructorInfo (NS DiffError) x -> ShowS)
-> Int -> NS (ConstructorInfo :*: NS DiffError) xss -> ShowS
forall {k} (f :: k -> *) (xs :: [k]).
(forall (x :: k). Int -> f x -> ShowS) -> Int -> NS f xs -> ShowS
showsNS ((Int -> ConstructorInfo x -> ShowS)
-> (Int -> NS DiffError x -> ShowS)
-> Int
-> (:*:) ConstructorInfo (NS DiffError) x
-> ShowS
forall {k} (f :: k -> *) (a :: k) (g :: k -> *).
(Int -> f a -> ShowS)
-> (Int -> g a -> ShowS) -> Int -> (:*:) f g a -> ShowS
showsPair Int -> ConstructorInfo x -> ShowS
forall (xs :: [*]). Int -> ConstructorInfo xs -> ShowS
showsConstructorInfo ((forall a. Int -> DiffError a -> ShowS)
-> Int -> NS DiffError x -> ShowS
forall {k} (f :: k -> *) (xs :: [k]).
(forall (x :: k). Int -> f x -> ShowS) -> Int -> NS f xs -> ShowS
showsNS Int -> DiffError x -> ShowS
forall a. Show a => Int -> a -> ShowS
forall a. Int -> DiffError a -> ShowS
showsPrec)) Int
11 NS (ConstructorInfo :*: NS DiffError) xss
ns

eqNP :: forall f xs. (SListI xs) => (forall x. f x -> f x -> Bool) -> NP f xs -> NP f xs -> Bool
eqNP :: forall {k} (f :: k -> *) (xs :: [k]).
SListI xs =>
(forall (x :: k). f x -> f x -> Bool) -> NP f xs -> NP f xs -> Bool
eqNP forall (x :: k). f x -> f x -> Bool
eq NP f xs
l NP f xs
r = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ NP (K Bool) xs -> [Bool]
forall {k} a (xs :: [k]). NP (K a) xs -> [a]
collapse_NP (NP (K Bool) xs -> [Bool]) -> NP (K Bool) xs -> [Bool]
forall a b. (a -> b) -> a -> b
$ (forall (a :: k). f a -> f a -> K Bool a)
-> NP f xs -> NP f xs -> NP (K Bool) xs
forall {k} (xs :: [k]) (f :: k -> *) (g :: k -> *) (h :: k -> *).
SListI xs =>
(forall (a :: k). f a -> g a -> h a)
-> NP f xs -> NP g xs -> NP h xs
liftA2_NP (\f a
x f a
y -> Bool -> K Bool a
forall k a (b :: k). a -> K a b
K (f a -> f a -> Bool
forall (x :: k). f x -> f x -> Bool
eq f a
x f a
y)) NP f xs
l NP f xs
r

showsNP :: forall f xs. (forall x. Int -> f x -> ShowS) -> Int -> NP f xs -> ShowS
showsNP :: forall {k} (f :: k -> *) (xs :: [k]).
(forall (x :: k). Int -> f x -> ShowS) -> Int -> NP f xs -> ShowS
showsNP forall (x :: k). Int -> f x -> ShowS
_ Int
_ NP f xs
Nil = String -> ShowS
showString String
"Nil"
showsNP forall (x :: k). Int -> f x -> ShowS
s Int
d NP f xs
ns = Int -> NP f xs -> ShowS
forall (ys :: [k]). Int -> NP f ys -> ShowS
go Int
d NP f xs
ns
  where
    go :: forall ys. Int -> NP f ys -> ShowS
    go :: forall (ys :: [k]). Int -> NP f ys -> ShowS
go Int
p = \case
      NP f ys
Nil -> String -> ShowS
showString String
"Nil"
      f x
x :* NP f xs
xs -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
5) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> f x -> ShowS
forall (x :: k). Int -> f x -> ShowS
s Int
6 f x
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" :* " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> NP f xs -> ShowS
forall (ys :: [k]). Int -> NP f ys -> ShowS
go Int
5 NP f xs
xs

eqNS :: forall f xs. (forall x. f x -> f x -> Bool) -> NS f xs -> NS f xs -> Bool
eqNS :: forall {k} (f :: k -> *) (xs :: [k]).
(forall (x :: k). f x -> f x -> Bool) -> NS f xs -> NS f xs -> Bool
eqNS forall (x :: k). f x -> f x -> Bool
eq = Bool
-> (forall (x :: k). f x -> f x -> Bool)
-> Bool
-> NS f xs
-> NS f xs
-> Bool
forall {k} r (f :: k -> *) (g :: k -> *) (xs :: [k]).
r
-> (forall (x :: k). f x -> g x -> r)
-> r
-> NS f xs
-> NS g xs
-> r
compare_NS Bool
False f x -> f x -> Bool
forall (x :: k). f x -> f x -> Bool
eq Bool
False

showsNS :: forall f xs. (forall x. Int -> f x -> ShowS) -> Int -> NS f xs -> ShowS
showsNS :: forall {k} (f :: k -> *) (xs :: [k]).
(forall (x :: k). Int -> f x -> ShowS) -> Int -> NS f xs -> ShowS
showsNS forall (x :: k). Int -> f x -> ShowS
s = Int -> NS f xs -> ShowS
forall (ys :: [k]). Int -> NS f ys -> ShowS
go
  where
    go :: forall ys. Int -> NS f ys -> ShowS
    go :: forall (ys :: [k]). Int -> NS f ys -> ShowS
go Int
d =
      Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> (NS f ys -> ShowS) -> NS f ys -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        Z f x
z -> String -> ShowS
showString String
"Z " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f x -> ShowS
forall (x :: k). Int -> f x -> ShowS
s Int
11 f x
z
        S NS f xs
zs -> String -> ShowS
showString String
"S " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> NS f xs -> ShowS
forall (ys :: [k]). Int -> NS f ys -> ShowS
go Int
11 NS f xs
zs

eqFieldInfo :: FieldInfo x -> FieldInfo x -> Bool
eqFieldInfo :: forall x. FieldInfo x -> FieldInfo x -> Bool
eqFieldInfo (FieldInfo String
fn1) (FieldInfo String
fn2) = String
fn1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
fn2

eqConstructorInfo :: ConstructorInfo xs -> ConstructorInfo xs -> Bool
eqConstructorInfo :: forall (xs :: [*]).
ConstructorInfo xs -> ConstructorInfo xs -> Bool
eqConstructorInfo (Constructor String
cn1) (Constructor String
cn2) = String
cn1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
cn2
eqConstructorInfo (Infix String
cn1 Associativity
a1 Int
f1) (Infix String
cn2 Associativity
a2 Int
f2) =
  String
cn1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
cn2 Bool -> Bool -> Bool
&& Associativity
a1 Associativity -> Associativity -> Bool
forall a. Eq a => a -> a -> Bool
== Associativity
a2 Bool -> Bool -> Bool
&& Int
f1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
f2
eqConstructorInfo (Record String
cn1 NP FieldInfo xs
f1) (Record String
cn2 NP FieldInfo xs
f2) =
  String
cn1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
cn2 Bool -> Bool -> Bool
&& (forall x. FieldInfo x -> FieldInfo x -> Bool)
-> NP FieldInfo xs -> NP FieldInfo xs -> Bool
forall {k} (f :: k -> *) (xs :: [k]).
SListI xs =>
(forall (x :: k). f x -> f x -> Bool) -> NP f xs -> NP f xs -> Bool
eqNP FieldInfo x -> FieldInfo x -> Bool
forall x. FieldInfo x -> FieldInfo x -> Bool
eqFieldInfo NP FieldInfo xs
f1 NP FieldInfo xs
f2
eqConstructorInfo ConstructorInfo xs
_ ConstructorInfo xs
_ = Bool
False

showsConstructorInfo :: Int -> ConstructorInfo xs -> ShowS
showsConstructorInfo :: forall (xs :: [*]). Int -> ConstructorInfo xs -> ShowS
showsConstructorInfo Int
d =
  Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS)
-> (ConstructorInfo xs -> ShowS) -> ConstructorInfo xs -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    Constructor String
name -> String -> ShowS
showString String
"Constructor " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 String
name
    Infix String
name Associativity
ass Int
fix ->
      String -> ShowS
showString String
"Infix "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 String
name
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Associativity -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Associativity
ass
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Int
fix
    Record String
name NP FieldInfo xs
fields ->
      String -> ShowS
showString String
"Record "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 String
name
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Int -> FieldInfo x -> ShowS)
-> Int -> NP FieldInfo xs -> ShowS
forall {k} (f :: k -> *) (xs :: [k]).
(forall (x :: k). Int -> f x -> ShowS) -> Int -> NP f xs -> ShowS
showsNP Int -> FieldInfo x -> ShowS
forall a. Show a => Int -> a -> ShowS
forall x. Int -> FieldInfo x -> ShowS
showsPrec Int
11 NP FieldInfo xs
fields

instance Eq (DiffErrorNested xss) where
  WrongConstructor NS ConstructorInfo xss
l1 NS ConstructorInfo xss
r1 == :: DiffErrorNested xss -> DiffErrorNested xss -> Bool
== WrongConstructor NS ConstructorInfo xss
l2 NS ConstructorInfo xss
r2 =
    (forall (xs :: [*]).
 ConstructorInfo xs -> ConstructorInfo xs -> Bool)
-> NS ConstructorInfo xss -> NS ConstructorInfo xss -> Bool
forall {k} (f :: k -> *) (xs :: [k]).
(forall (x :: k). f x -> f x -> Bool) -> NS f xs -> NS f xs -> Bool
eqNS ConstructorInfo x -> ConstructorInfo x -> Bool
forall (xs :: [*]).
ConstructorInfo xs -> ConstructorInfo xs -> Bool
eqConstructorInfo NS ConstructorInfo xss
l1 NS ConstructorInfo xss
l2 Bool -> Bool -> Bool
&& (forall (xs :: [*]).
 ConstructorInfo xs -> ConstructorInfo xs -> Bool)
-> NS ConstructorInfo xss -> NS ConstructorInfo xss -> Bool
forall {k} (f :: k -> *) (xs :: [k]).
(forall (x :: k). f x -> f x -> Bool) -> NS f xs -> NS f xs -> Bool
eqNS ConstructorInfo x -> ConstructorInfo x -> Bool
forall (xs :: [*]).
ConstructorInfo xs -> ConstructorInfo xs -> Bool
eqConstructorInfo NS ConstructorInfo xss
r1 NS ConstructorInfo xss
r2
  FieldMismatch DiffAtField xss
al1 == FieldMismatch DiffAtField xss
al2 = DiffAtField xss
al1 DiffAtField xss -> DiffAtField xss -> Bool
forall a. Eq a => a -> a -> Bool
== DiffAtField xss
al2
  DiffErrorNested xss
_ == DiffErrorNested xss
_ = Bool
False

instance Show (DiffErrorNested xss) where
  showsPrec :: Int -> DiffErrorNested xss -> ShowS
showsPrec Int
d = \case
    WrongConstructor NS ConstructorInfo xss
l NS ConstructorInfo xss
r ->
      Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"WrongConstructor "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (xs :: [*]). Int -> ConstructorInfo xs -> ShowS)
-> Int -> NS ConstructorInfo xss -> ShowS
forall {k} (f :: k -> *) (xs :: [k]).
(forall (x :: k). Int -> f x -> ShowS) -> Int -> NS f xs -> ShowS
showsNS Int -> ConstructorInfo x -> ShowS
forall (xs :: [*]). Int -> ConstructorInfo xs -> ShowS
showsConstructorInfo Int
11 NS ConstructorInfo xss
l
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (xs :: [*]). Int -> ConstructorInfo xs -> ShowS)
-> Int -> NS ConstructorInfo xss -> ShowS
forall {k} (f :: k -> *) (xs :: [k]).
(forall (x :: k). Int -> f x -> ShowS) -> Int -> NS f xs -> ShowS
showsNS Int -> ConstructorInfo x -> ShowS
forall (xs :: [*]). Int -> ConstructorInfo xs -> ShowS
showsConstructorInfo Int
11 NS ConstructorInfo xss
r
    FieldMismatch DiffAtField xss
al ->
      Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"FieldMismatch "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> DiffAtField xss -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 DiffAtField xss
al

pickOut :: NP f xs -> NS g xs -> NS f xs
pickOut :: forall {k} (f :: k -> *) (xs :: [k]) (g :: k -> *).
NP f xs -> NS g xs -> NS f xs
pickOut NP f xs
Nil NS g xs
gs = case NS g xs
gs of {}
pickOut (f x
x :* NP f xs
_) (Z g x
_) = f x -> NS f (x : xs)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z f x
x
pickOut (f x
_ :* NP f xs
xs) (S NS g xs
gs) = NS f xs -> NS f (x : xs)
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS f xs -> NS f (x : xs)) -> NS f xs -> NS f (x : xs)
forall a b. (a -> b) -> a -> b
$ NP f xs -> NS g xs -> NS f xs
forall {k} (f :: k -> *) (xs :: [k]) (g :: k -> *).
NP f xs -> NS g xs -> NS f xs
pickOut NP f xs
xs NS g xs
NS g xs
gs