{-# LANGUAGE EmptyCase #-}
{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-orphans #-}

module Generics.Diff.Class
  ( -- * Class
    Diff (..)

    -- ** Implementing diff
  , gdiff
  , gdiffTopLevel
  , gdiffWith
  , eqDiff
  , diffWithSpecial
  , gspecialDiffNested

    -- * Special case: lists
  , diffListWith
  )
where

import Data.SOP
import Data.SOP.NP
import qualified GHC.Generics as G
import Generics.Diff.Render
import Generics.Diff.Type
import Generics.SOP as SOP
import Generics.SOP.GGP as SOP

{- | A type with an instance of 'Diff' permits a more nuanced comparison than 'Eq' or 'Ord'.
If two values are not equal, 'diff' will tell you exactly where they differ ("in this contructor,
at that field"). The granularity of the pinpointing of the difference (how many "levels" of 'Diff'
we can "descend" through) depends on the implementation of the instance.

For user-defined types, it's strongly recommended you derive your 'Diff' instance using 'Generic' from
@generics-sop@. If those types refer to other types, those will need 'Diff' instances too. For example:

However, in some cases we'll want to use a custom type for representing diffs of user-defined or
third-party types. For example, if we have non-derived `Eq` instances, invariants etc. In that case,
see "Generics.Diff.Special".

@
{\-# LANGUAGE DerivingStrategies #-\}
{\-# LANGUAGE DeriveGeneric #-\}
{\-# LANGUAGE DeriveAnyClass #-\}

import qualified GHC.Generics as G
import qualified Generics.SOP as SOP

data BinOp = Plus | Minus
  deriving stock (Show, G.Generic)
  deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo, Diff)

data Expr
  = Atom Int
  | Bin {left :: Expr, op :: BinOp, right :: Expr}
  deriving stock (Show, G.Generic)
  deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo, Diff)
@

Now that we have our instances, we can 'diff' values to find out exactly where they differ:

@
-- If two values are equal, 'diff' should always return 'Equal'.
ghci> diff Plus Plus
Equal

ghci> diff Plus Minus
Error (Nested (WrongConstructor (Z (Constructor \"Plus\")) (S (Z (Constructor \"Minus\")))))

ghci> diff (Atom 1) (Atom 2)
Error (Nested (FieldMismatch (AtLoc (Z (Constructor \"Atom\" :*: Z (Nested TopLevelNotEqual))))))

ghci> diff (Bin (Atom 1) Plus (Atom 1)) (Atom 2)
Error (Nested (WrongConstructor (S (Z (Constructor \"Bin\"))) (Z (Constructor \"Atom\"))))

ghci> diff (Bin (Atom 1) Plus (Atom 1)) (Bin (Atom 1) Minus (Atom 1))
Error (Nested (FieldMismatch (AtLoc (S (Z (Constructor \"Bin\" :*: S (Z (Nested (WrongConstructor (Z (Constructor \"Plus\")) (S (Z (Constructor \"Minus\"))))))))))))

ghci> diff (Bin (Atom 1) Plus (Atom 1)) (Bin (Atom 1) Plus (Atom 2))
Error (Nested (FieldMismatch (DiffAtField (S (Z (Record \"Bin\" (FieldInfo \"left\" :* FieldInfo \"op\" :* FieldInfo \"right\" :* Nil) :*: S (S (Z (Nested (FieldMismatch (DiffAtField (Z (Constructor \"Atom\" :*: Z TopLevelNotEqual)))))))))))))
@

Of course, these are just as difficult to understand as derived 'Show' instances, or more so. Fortunately we can
use the functions in "Generics.Diff.Render" to get a nice, intuitive representation of the diffs:

@
ghci> printDiffResult $ diff Plus Plus
Equal

ghci> printDiffResult $ diff Plus Minus
Wrong constructor
Constructor of left value: Plus
Constructor of right value: Minus

ghci> printDiffResult $ diff (Atom 1) (Atom 2)
Both values use constructor Atom but fields don't match
In field 0 (0-indexed):
  Not equal

ghci> printDiffResult $ diff (Bin (Atom 1) Plus (Atom 1)) (Atom 2)
Wrong constructor
Constructor of left value: Bin
Constructor of right value: Atom

ghci> printDiffResult $ diff (Bin (Atom 1) Plus (Atom 1)) (Bin (Atom 1) Minus (Atom 1))
Both values use constructor Bin but fields don't match
In field op:
  Wrong constructor
  Constructor of left value: Plus
  Constructor of right value: Minus

ghci> printDiffResult $ diff (Bin (Atom 1) Plus (Atom 1)) (Bin (Atom 1) Plus (Atom 2))
Both values use constructor Bin but fields don't match
In field right:
  Both values use constructor Atom but fields don't match
  In field 0 (0-indexed):
    Not equal
@

= Laws

For type @a@ with @instance Diff a@, and values @x, y :: a@, the following should hold:

@
x == y   \<=\>  x \`diff\` y == 'Equal'
@
-}
class Diff a where
  -- | Detailed comparison of two values. It is strongly recommended to only use the
  -- default implementation, or one of 'eqDiff' or 'gdiffTopLevel'.
  diff :: a -> a -> DiffResult a
  default diff :: (Generic a, HasDatatypeInfo a, All2 Diff (Code a)) => a -> a -> DiffResult a
  diff = a -> a -> DiffResult a
forall a.
(Generic a, HasDatatypeInfo a, All2 Diff (Code a)) =>
a -> a -> DiffResult a
gdiff

  -- | Compare two lists of values. This mostly exists so that we can define a custom instance for 'String',
  -- in a similar vein to 'showList'.
  diffList :: [a] -> [a] -> DiffResult [a]
  diffList = [a] -> [a] -> DiffResult [a]
forall a. SpecialDiff a => a -> a -> DiffResult a
diffWithSpecial

-- | When we have an instance of 'SpecialDiff', we can implement 'diff' using 'DiffSpecial'.
diffWithSpecial :: (SpecialDiff a) => a -> a -> DiffResult a
diffWithSpecial :: forall a. SpecialDiff a => a -> a -> DiffResult a
diffWithSpecial a
l a
r = DiffResult a
-> (SpecialDiffError a -> DiffResult a)
-> Maybe (SpecialDiffError a)
-> DiffResult a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DiffResult a
forall a. DiffResult a
Equal (DiffError a -> DiffResult a
forall a. DiffError a -> DiffResult a
Error (DiffError a -> DiffResult a)
-> (SpecialDiffError a -> DiffError a)
-> SpecialDiffError a
-> DiffResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpecialDiffError a -> DiffError a
forall a. SpecialDiff a => SpecialDiffError a -> DiffError a
DiffSpecial) (Maybe (SpecialDiffError a) -> DiffResult a)
-> Maybe (SpecialDiffError a) -> DiffResult a
forall a b. (a -> b) -> a -> b
$ a -> a -> Maybe (SpecialDiffError a)
forall a. SpecialDiff a => a -> a -> Maybe (SpecialDiffError a)
specialDiff a
l a
r

instance (Diff a) => SpecialDiff [a] where
  type SpecialDiffError [a] = ListDiffError a
  specialDiff :: [a] -> [a] -> Maybe (SpecialDiffError [a])
specialDiff = (a -> a -> DiffResult a) -> [a] -> [a] -> Maybe (ListDiffError a)
forall a.
(a -> a -> DiffResult a) -> [a] -> [a] -> Maybe (ListDiffError a)
diffListWith a -> a -> DiffResult a
forall a. Diff a => a -> a -> DiffResult a
diff
  renderSpecialDiffError :: SpecialDiffError [a] -> Doc
renderSpecialDiffError = Builder -> ListDiffError a -> Doc
forall a. Builder -> ListDiffError a -> Doc
listDiffErrorDoc Builder
"list"

{- | Given two lists and a way to 'diff' the elements of the list,
return a 'ListDiffError'. Used to implement 'specialDiff' for list-like types.
See "Generics.Diff.Special" for an example.
-}
diffListWith :: (a -> a -> DiffResult a) -> [a] -> [a] -> Maybe (ListDiffError a)
diffListWith :: forall a.
(a -> a -> DiffResult a) -> [a] -> [a] -> Maybe (ListDiffError a)
diffListWith a -> a -> DiffResult a
d = Int -> [a] -> [a] -> Maybe (ListDiffError a)
go Int
0
  where
    go :: Int -> [a] -> [a] -> Maybe (ListDiffError a)
go Int
_ [] [] = Maybe (ListDiffError a)
forall a. Maybe a
Nothing
    go Int
n [] [a]
ys = ListDiffError a -> Maybe (ListDiffError a)
forall a. a -> Maybe a
Just (ListDiffError a -> Maybe (ListDiffError a))
-> ListDiffError a -> Maybe (ListDiffError a)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ListDiffError a
forall a. Int -> Int -> ListDiffError a
WrongLengths Int
n (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ys)
    go Int
n [a]
xs [] = ListDiffError a -> Maybe (ListDiffError a)
forall a. a -> Maybe a
Just (ListDiffError a -> Maybe (ListDiffError a))
-> ListDiffError a -> Maybe (ListDiffError a)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ListDiffError a
forall a. Int -> Int -> ListDiffError a
WrongLengths (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) Int
n
    go Int
n (a
x : [a]
xs) (a
y : [a]
ys) = case a -> a -> DiffResult a
d a
x a
y of
      DiffResult a
Equal -> Int -> [a] -> [a] -> Maybe (ListDiffError a)
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
xs [a]
ys
      Error DiffError a
err -> ListDiffError a -> Maybe (ListDiffError a)
forall a. a -> Maybe a
Just (ListDiffError a -> Maybe (ListDiffError a))
-> ListDiffError a -> Maybe (ListDiffError a)
forall a b. (a -> b) -> a -> b
$ Int -> DiffError a -> ListDiffError a
forall a. Int -> DiffError a -> ListDiffError a
DiffAtIndex Int
n DiffError a
err

{- | The most basic 'Differ' possible. If the two values are equal, return 'Equal';
otherwise, return 'TopLevelNotEqual'.
-}
eqDiff :: (Eq a) => a -> a -> DiffResult a
eqDiff :: forall a. Eq a => a -> a -> DiffResult a
eqDiff a
a a
b =
  if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b
    then DiffResult a
forall a. DiffResult a
Equal
    else DiffError a -> DiffResult a
forall a. DiffError a -> DiffResult a
Error DiffError a
forall a. DiffError a
TopLevelNotEqual

{- | The default implementation of 'diff'. Follows the procedure described above. We keep recursing
into the 'Diff' instances of the field types, as far as we can.
-}
gdiff ::
  forall a.
  (Generic a, HasDatatypeInfo a, All2 Diff (Code a)) =>
  a ->
  a ->
  DiffResult a
gdiff :: forall a.
(Generic a, HasDatatypeInfo a, All2 Diff (Code a)) =>
a -> a -> DiffResult a
gdiff = forall a (c :: * -> Constraint).
(Generic a, HasDatatypeInfo a, All2 c (Code a)) =>
(forall x. c x => Differ x) -> a -> a -> DiffResult a
gdiffWithPure @a @Diff ((x -> x -> DiffResult x) -> Differ x
forall x. (x -> x -> DiffResult x) -> Differ x
Differ x -> x -> DiffResult x
forall a. Diff a => a -> a -> DiffResult a
diff)

{- | Alternate implementation of 'diff' - basically one level of 'gdiff'. To compare individual fields of the
top-level values, we just use '(==)'.
-}
gdiffTopLevel ::
  forall a.
  (Generic a, HasDatatypeInfo a, All2 Eq (Code a)) =>
  a ->
  a ->
  DiffResult a
gdiffTopLevel :: forall a.
(Generic a, HasDatatypeInfo a, All2 Eq (Code a)) =>
a -> a -> DiffResult a
gdiffTopLevel = forall a (c :: * -> Constraint).
(Generic a, HasDatatypeInfo a, All2 c (Code a)) =>
(forall x. c x => Differ x) -> a -> a -> DiffResult a
gdiffWithPure @a @Eq ((x -> x -> DiffResult x) -> Differ x
forall x. (x -> x -> DiffResult x) -> Differ x
Differ x -> x -> DiffResult x
forall a. Eq a => a -> a -> DiffResult a
eqDiff)

{- | Follow the same algorithm as 'gdiff', but the caller can provide their own 'POP' grid of 'Differ's
specifying how to compare each field we might come across.
-}
gdiffWith ::
  forall a.
  (Generic a, HasDatatypeInfo a) =>
  POP Differ (Code a) ->
  a ->
  a ->
  DiffResult a
gdiffWith :: forall a.
(Generic a, HasDatatypeInfo a) =>
POP Differ (Code a) -> a -> a -> DiffResult a
gdiffWith (POP NP (NP Differ) (Code a)
ds) (a -> Rep a
forall a. Generic a => a -> Rep a
from -> SOP NS (NP I) (Code a)
xs) (a -> Rep a
forall a. Generic a => a -> Rep a
from -> SOP NS (NP I) (Code a)
ys) =
  DiffResult a
-> (DiffErrorNested (Code a) -> DiffResult a)
-> Maybe (DiffErrorNested (Code a))
-> DiffResult a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DiffResult a
forall a. DiffResult a
Equal (DiffError a -> DiffResult a
forall a. DiffError a -> DiffResult a
Error (DiffError a -> DiffResult a)
-> (DiffErrorNested (Code a) -> DiffError a)
-> DiffErrorNested (Code a)
-> DiffResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffErrorNested (Code a) -> DiffError a
forall a. DiffErrorNested (Code a) -> DiffError a
Nested) (Maybe (DiffErrorNested (Code a)) -> DiffResult a)
-> Maybe (DiffErrorNested (Code a)) -> DiffResult a
forall a b. (a -> b) -> a -> b
$ NP ConstructorInfo (Code a)
-> NP (NP Differ) (Code a)
-> NS (NP I) (Code a)
-> NS (NP I) (Code a)
-> Maybe (DiffErrorNested (Code a))
forall (xss :: [[*]]).
NP ConstructorInfo xss
-> NP (NP Differ) xss
-> NS (NP I) xss
-> NS (NP I) xss
-> Maybe (DiffErrorNested xss)
gdiff' (DatatypeInfo (Code a) -> NP ConstructorInfo (Code a)
forall (xss :: [[*]]). DatatypeInfo xss -> NP ConstructorInfo xss
constructorInfo (DatatypeInfo (Code a) -> NP ConstructorInfo (Code a))
-> DatatypeInfo (Code a) -> NP ConstructorInfo (Code a)
forall a b. (a -> b) -> a -> b
$ Proxy a -> DatatypeInfo (Code a)
forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> DatatypeInfo (Code a)
forall (proxy :: * -> *). proxy a -> DatatypeInfo (Code a)
datatypeInfo (Proxy a -> DatatypeInfo (Code a))
-> Proxy a -> DatatypeInfo (Code a)
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) NP (NP Differ) (Code a)
ds NS (NP I) (Code a)
xs NS (NP I) (Code a)
ys

gdiffWithPure ::
  forall a c.
  (Generic a, HasDatatypeInfo a, All2 c (Code a)) =>
  (forall x. (c x) => Differ x) ->
  a ->
  a ->
  DiffResult a
gdiffWithPure :: forall a (c :: * -> Constraint).
(Generic a, HasDatatypeInfo a, All2 c (Code a)) =>
(forall x. c x => Differ x) -> a -> a -> DiffResult a
gdiffWithPure forall x. c x => Differ x
ds = POP Differ (Code a) -> a -> a -> DiffResult a
forall a.
(Generic a, HasDatatypeInfo a) =>
POP Differ (Code a) -> a -> a -> DiffResult a
gdiffWith (POP Differ (Code a) -> a -> a -> DiffResult a)
-> POP Differ (Code a) -> a -> a -> DiffResult a
forall a b. (a -> b) -> a -> b
$ Proxy c -> (forall x. c x => Differ x) -> POP Differ (Code a)
forall {k} (c :: k -> Constraint) (xss :: [[k]])
       (proxy :: (k -> Constraint) -> *) (f :: k -> *).
All2 c xss =>
proxy c -> (forall (a :: k). c a => f a) -> POP f xss
cpure_POP (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @c) Differ a
forall x. c x => Differ x
ds

{- | Helper function to implement 'specialDiff' for an instance of "GHC.Generic", with
@SpecialDiffError a = DiffErrorNested xss@.

For example, say we want to implement 'SpecialDiff' (and then 'Diff') for @Tree@ from @containers@.
We'd ideally like to use a 'SOP.Generic' instance, but we don't have one. Nevertheless we can fake one,
using 'G.Generic' from "GHC.Generics".

@
data Tree a = Node
  { rootLabel :: a
  , subForest :: [Tree a]
  }
  deriving ('G.Generic')

instance ('Diff' a) => 'SpecialDiff' (Tree a) where
  type 'SpecialDiffError' (Tree a) = 'DiffErrorNested' ('GCode' (Tree a))
  'specialDiff' = 'gspecialDiffNested'

  'renderSpecialDiffError' = 'diffErrorNestedDoc'

instance ('Diff' a) => 'Diff' (Tree a) where
  diff = 'diffWithSpecial'
@
-}
gspecialDiffNested ::
  forall a.
  ( G.Generic a
  , GFrom a
  , GDatatypeInfo a
  , All2 Diff (GCode a)
  ) =>
  a ->
  a ->
  Maybe (DiffErrorNested (GCode a))
gspecialDiffNested :: forall a.
(Generic a, GFrom a, GDatatypeInfo a, All2 Diff (GCode a)) =>
a -> a -> Maybe (DiffErrorNested (GCode a))
gspecialDiffNested a
l a
r = NP ConstructorInfo (GCode a)
-> NP (NP Differ) (GCode a)
-> NS (NP I) (GCode a)
-> NS (NP I) (GCode a)
-> Maybe (DiffErrorNested (GCode a))
forall (xss :: [[*]]).
NP ConstructorInfo xss
-> NP (NP Differ) xss
-> NS (NP I) xss
-> NS (NP I) xss
-> Maybe (DiffErrorNested xss)
gdiff' NP ConstructorInfo (GCode a)
constructors NP (NP Differ) (GCode a)
differs (SOP I (GCode a) -> NS (NP I) (GCode a)
forall {k} (f :: k -> *) (xss :: [[k]]). SOP f xss -> NS (NP f) xss
unSOP (SOP I (GCode a) -> NS (NP I) (GCode a))
-> SOP I (GCode a) -> NS (NP I) (GCode a)
forall a b. (a -> b) -> a -> b
$ a -> SOP I (GCode a)
forall a. (GFrom a, Generic a) => a -> SOP I (GCode a)
gfrom a
l) (SOP I (GCode a) -> NS (NP I) (GCode a)
forall {k} (f :: k -> *) (xss :: [[k]]). SOP f xss -> NS (NP f) xss
unSOP (SOP I (GCode a) -> NS (NP I) (GCode a))
-> SOP I (GCode a) -> NS (NP I) (GCode a)
forall a b. (a -> b) -> a -> b
$ a -> SOP I (GCode a)
forall a. (GFrom a, Generic a) => a -> SOP I (GCode a)
gfrom a
r)
  where
    differs :: NP (NP Differ) (GCode a)
differs = POP Differ (GCode a) -> NP (NP Differ) (GCode a)
forall {k} (f :: k -> *) (xss :: [[k]]). POP f xss -> NP (NP f) xss
unPOP (POP Differ (GCode a) -> NP (NP Differ) (GCode a))
-> POP Differ (GCode a) -> NP (NP Differ) (GCode a)
forall a b. (a -> b) -> a -> b
$ Proxy Diff
-> (forall x. Diff x => Differ x) -> POP Differ (GCode a)
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
forall (c :: * -> Constraint) (xs :: [[*]])
       (proxy :: (* -> Constraint) -> *) (f :: * -> *).
AllN POP c xs =>
proxy c -> (forall a. c a => f a) -> POP f xs
hcpure (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @Diff) ((a -> a -> DiffResult a) -> Differ a
forall x. (x -> x -> DiffResult x) -> Differ x
Differ a -> a -> DiffResult a
forall a. Diff a => a -> a -> DiffResult a
diff)
    constructors :: NP ConstructorInfo (GCode a)
constructors = DatatypeInfo (GCode a) -> NP ConstructorInfo (GCode a)
forall (xss :: [[*]]). DatatypeInfo xss -> NP ConstructorInfo xss
constructorInfo (DatatypeInfo (GCode a) -> NP ConstructorInfo (GCode a))
-> DatatypeInfo (GCode a) -> NP ConstructorInfo (GCode a)
forall a b. (a -> b) -> a -> b
$ Proxy a -> DatatypeInfo (GCode a)
forall (proxy :: * -> *) a.
GDatatypeInfo a =>
proxy a -> DatatypeInfo (GCode a)
gdatatypeInfo (Proxy a -> DatatypeInfo (GCode a))
-> Proxy a -> DatatypeInfo (GCode a)
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a

------------------------------------------------------------
-- Auxiliary functions

{- | This is the workhorse of 'gdiff', 'gdiffWith' and 'gdiffTopLevel'. A 'Nothing' return value means there
were no errors (diffs), and so we can return 'Equal'. A 'Just' value means the two top-level values are
not equal, and tells us where.
-}
gdiff' ::
  NP ConstructorInfo xss ->
  NP (NP Differ) xss ->
  NS (NP I) xss ->
  NS (NP I) xss ->
  Maybe (DiffErrorNested xss)
gdiff' :: forall (xss :: [[*]]).
NP ConstructorInfo xss
-> NP (NP Differ) xss
-> NS (NP I) xss
-> NS (NP I) xss
-> Maybe (DiffErrorNested xss)
gdiff' NP ConstructorInfo xss
_ NP (NP Differ) xss
Nil NS (NP I) xss
xss NS (NP I) xss
_ = case NS (NP I) xss
xss of {}
gdiff' (ConstructorInfo x
i :* NP ConstructorInfo xs
_) (NP Differ x
ds :* NP (NP Differ) xs
_) (Z NP I x
xs) (Z NP I x
ys) =
  DiffAtField xss -> DiffErrorNested xss
forall (xss :: [[*]]). DiffAtField xss -> DiffErrorNested xss
FieldMismatch (DiffAtField xss -> DiffErrorNested xss)
-> (NS DiffError x -> DiffAtField xss)
-> NS DiffError x
-> DiffErrorNested xss
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS (ConstructorInfo :*: NS DiffError) xss -> DiffAtField xss
forall (xss :: [[*]]).
NS (ConstructorInfo :*: NS DiffError) xss -> DiffAtField xss
DiffAtField (NS (ConstructorInfo :*: NS DiffError) xss -> DiffAtField xss)
-> (NS DiffError x -> NS (ConstructorInfo :*: NS DiffError) xss)
-> NS DiffError x
-> DiffAtField xss
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:*:) ConstructorInfo (NS DiffError) x
-> NS (ConstructorInfo :*: NS DiffError) xss
(:*:) ConstructorInfo (NS DiffError) x
-> NS (ConstructorInfo :*: NS DiffError) (x : xs)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z ((:*:) ConstructorInfo (NS DiffError) x
 -> NS (ConstructorInfo :*: NS DiffError) xss)
-> (NS DiffError x -> (:*:) ConstructorInfo (NS DiffError) x)
-> NS DiffError x
-> NS (ConstructorInfo :*: NS DiffError) xss
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConstructorInfo x
i ConstructorInfo x
-> NS DiffError x -> (:*:) ConstructorInfo (NS DiffError) x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> (:*:) f g a
:*:) (NS DiffError x -> DiffErrorNested xss)
-> Maybe (NS DiffError x) -> Maybe (DiffErrorNested xss)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NP Differ x -> NP I x -> NP I x -> Maybe (NS DiffError x)
forall (as :: [*]).
NP Differ as -> NP I as -> NP I as -> Maybe (NS DiffError as)
goProduct NP Differ x
NP Differ x
ds NP I x
NP I x
xs NP I x
NP I x
ys
  where
    goProduct :: forall as. NP Differ as -> NP I as -> NP I as -> Maybe (NS DiffError as)
    goProduct :: forall (as :: [*]).
NP Differ as -> NP I as -> NP I as -> Maybe (NS DiffError as)
goProduct NP Differ as
Nil NP I as
Nil NP I as
Nil = Maybe (NS DiffError as)
forall a. Maybe a
Nothing
    goProduct (Differ x -> x -> DiffResult x
d :* NP Differ xs
ds') (I x
x :* NP I xs
bs) (I x
y :* NP I xs
cs) =
      case x -> x -> DiffResult x
d x
x
x x
x
y of
        DiffResult x
Equal -> NS DiffError xs -> NS DiffError as
NS DiffError xs -> NS DiffError (x : xs)
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS DiffError xs -> NS DiffError as)
-> Maybe (NS DiffError xs) -> Maybe (NS DiffError as)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NP Differ xs -> NP I xs -> NP I xs -> Maybe (NS DiffError xs)
forall (as :: [*]).
NP Differ as -> NP I as -> NP I as -> Maybe (NS DiffError as)
goProduct NP Differ xs
ds' NP I xs
NP I xs
bs NP I xs
NP I xs
cs
        Error DiffError x
err -> NS DiffError as -> Maybe (NS DiffError as)
forall a. a -> Maybe a
Just (NS DiffError as -> Maybe (NS DiffError as))
-> NS DiffError as -> Maybe (NS DiffError as)
forall a b. (a -> b) -> a -> b
$ DiffError x -> NS DiffError (x : xs)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z DiffError x
err
gdiff' (ConstructorInfo x
i :* NP ConstructorInfo xs
is) NP (NP Differ) xss
_ (Z NP I x
_) (S NS (NP I) xs
rest) = DiffErrorNested xss -> Maybe (DiffErrorNested xss)
forall a. a -> Maybe a
Just (DiffErrorNested xss -> Maybe (DiffErrorNested xss))
-> DiffErrorNested xss -> Maybe (DiffErrorNested xss)
forall a b. (a -> b) -> a -> b
$ NS ConstructorInfo xss
-> NS ConstructorInfo xss -> DiffErrorNested xss
forall (xss :: [[*]]).
NS ConstructorInfo xss
-> NS ConstructorInfo xss -> DiffErrorNested xss
WrongConstructor (ConstructorInfo x -> NS ConstructorInfo (x : xs)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z ConstructorInfo x
i) (NS ConstructorInfo xs -> NS ConstructorInfo (x : xs)
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS ConstructorInfo xs -> NS ConstructorInfo (x : xs))
-> NS ConstructorInfo xs -> NS ConstructorInfo (x : xs)
forall a b. (a -> b) -> a -> b
$ NP ConstructorInfo xs -> NS (NP I) xs -> NS ConstructorInfo xs
forall {k} (f :: k -> *) (xs :: [k]) (g :: k -> *).
NP f xs -> NS g xs -> NS f xs
pickOut NP ConstructorInfo xs
is NS (NP I) xs
NS (NP I) xs
rest)
gdiff' (ConstructorInfo x
i :* NP ConstructorInfo xs
is) NP (NP Differ) xss
_ (S NS (NP I) xs
rest) (Z NP I x
_) = DiffErrorNested xss -> Maybe (DiffErrorNested xss)
forall a. a -> Maybe a
Just (DiffErrorNested xss -> Maybe (DiffErrorNested xss))
-> DiffErrorNested xss -> Maybe (DiffErrorNested xss)
forall a b. (a -> b) -> a -> b
$ NS ConstructorInfo xss
-> NS ConstructorInfo xss -> DiffErrorNested xss
forall (xss :: [[*]]).
NS ConstructorInfo xss
-> NS ConstructorInfo xss -> DiffErrorNested xss
WrongConstructor (NS ConstructorInfo xs -> NS ConstructorInfo (x : xs)
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS ConstructorInfo xs -> NS ConstructorInfo (x : xs))
-> NS ConstructorInfo xs -> NS ConstructorInfo (x : xs)
forall a b. (a -> b) -> a -> b
$ NP ConstructorInfo xs -> NS (NP I) xs -> NS ConstructorInfo xs
forall {k} (f :: k -> *) (xs :: [k]) (g :: k -> *).
NP f xs -> NS g xs -> NS f xs
pickOut NP ConstructorInfo xs
is NS (NP I) xs
NS (NP I) xs
rest) (ConstructorInfo x -> NS ConstructorInfo (x : xs)
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z ConstructorInfo x
i)
gdiff' (ConstructorInfo x
_ :* NP ConstructorInfo xs
is) (NP Differ x
_ :* NP (NP Differ) xs
dss) (S NS (NP I) xs
xs) (S NS (NP I) xs
ys) = DiffErrorNested xs -> DiffErrorNested xss
DiffErrorNested xs -> DiffErrorNested (x : xs)
forall (xs :: [[*]]) (x :: [*]).
DiffErrorNested xs -> DiffErrorNested (x : xs)
shiftDiffError (DiffErrorNested xs -> DiffErrorNested xss)
-> Maybe (DiffErrorNested xs) -> Maybe (DiffErrorNested xss)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NP ConstructorInfo xs
-> NP (NP Differ) xs
-> NS (NP I) xs
-> NS (NP I) xs
-> Maybe (DiffErrorNested xs)
forall (xss :: [[*]]).
NP ConstructorInfo xss
-> NP (NP Differ) xss
-> NS (NP I) xss
-> NS (NP I) xss
-> Maybe (DiffErrorNested xss)
gdiff' NP ConstructorInfo xs
is NP (NP Differ) xs
NP (NP Differ) xs
dss NS (NP I) xs
NS (NP I) xs
xs NS (NP I) xs
NS (NP I) xs
ys

shiftDiffError :: DiffErrorNested xs -> DiffErrorNested (x ': xs)
shiftDiffError :: forall (xs :: [[*]]) (x :: [*]).
DiffErrorNested xs -> DiffErrorNested (x : xs)
shiftDiffError = \case
  WrongConstructor NS ConstructorInfo xs
xs NS ConstructorInfo xs
ys -> NS ConstructorInfo (x : xs)
-> NS ConstructorInfo (x : xs) -> DiffErrorNested (x : xs)
forall (xss :: [[*]]).
NS ConstructorInfo xss
-> NS ConstructorInfo xss -> DiffErrorNested xss
WrongConstructor (NS ConstructorInfo xs -> NS ConstructorInfo (x : xs)
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S NS ConstructorInfo xs
xs) (NS ConstructorInfo xs -> NS ConstructorInfo (x : xs)
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S NS ConstructorInfo xs
ys)
  FieldMismatch (DiffAtField NS (ConstructorInfo :*: NS DiffError) xs
ns) -> DiffAtField (x : xs) -> DiffErrorNested (x : xs)
forall (xss :: [[*]]). DiffAtField xss -> DiffErrorNested xss
FieldMismatch (NS (ConstructorInfo :*: NS DiffError) (x : xs)
-> DiffAtField (x : xs)
forall (xss :: [[*]]).
NS (ConstructorInfo :*: NS DiffError) xss -> DiffAtField xss
DiffAtField (NS (ConstructorInfo :*: NS DiffError) xs
-> NS (ConstructorInfo :*: NS DiffError) (x : xs)
forall {k} (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S NS (ConstructorInfo :*: NS DiffError) xs
ns))