Skip to content
12 changes: 6 additions & 6 deletions generic-diff-instances/test/Generics/Diff/UnitTestsSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -107,7 +107,7 @@ mapTestSets =
value1 = Map.fromList [(1, "one"), (3, "three")]

value2 = Map.fromList [(1, "one"), (3, "THREE")]
error2 = DiffSpecial $ Map.DiffAtKey 3 TopLevelNotEqual
error2 = DiffSpecial $ Map.DiffAtKey 3 $ TopLevelNotEqualShow "\"three\"" "\"THREE\""

value3 = Map.fromList [(1, "one"), (2, "two"), (3, "three")]
error3 = DiffSpecial $ Map.LeftMissingKey 2
Expand Down Expand Up @@ -143,7 +143,7 @@ seqTestSets =
error2 = DiffSpecial $ WrongLengths 2 3

value3 = Seq.fromList [1, 2]
error3 = DiffSpecial $ DiffAtIndex 1 TopLevelNotEqual
error3 = DiffSpecial $ DiffAtIndex 1 $ TopLevelNotEqualShow "3" "2"

treeTestSets :: [TestSet (Tree Int)]
treeTestSets =
Expand Down Expand Up @@ -176,7 +176,7 @@ treeTestSets =
value1 = Tree.Node 1 [Tree.Node 2 [], Tree.Node 3 [Tree.Node 4 [], Tree.Node 5 []]]

value2 = Tree.Node 2 []
error2 = DiffSpecial $ FieldMismatch $ DiffAtField $ Z $ nodeInfo :*: Z TopLevelNotEqual
error2 = DiffSpecial $ FieldMismatch $ DiffAtField $ Z $ nodeInfo :*: Z (TopLevelNotEqualShow "1" "2")

value3 = Tree.Node 1 [Tree.Node 2 []]
error3 =
Expand All @@ -185,7 +185,7 @@ treeTestSets =

value4 = Tree.Node 1 [Tree.Node 2 [], Tree.Node 4 []]
error4 =
let e = DiffSpecial $ DiffAtIndex 1 $ DiffSpecial $ FieldMismatch $ DiffAtField $ Z $ nodeInfo :*: Z TopLevelNotEqual
let e = DiffSpecial $ DiffAtIndex 1 $ DiffSpecial $ FieldMismatch $ DiffAtField $ Z $ nodeInfo :*: Z (TopLevelNotEqualShow "3" "4")
in DiffSpecial $ FieldMismatch $ DiffAtField $ Z $ nodeInfo :*: S (Z e)

nodeInfo :: ConstructorInfo '[Int, [Tree Int]]
Expand Down Expand Up @@ -222,10 +222,10 @@ customTreeTestSets =
value1 = CustomTree $ Tree.Node 1 [Tree.Node 2 [], Tree.Node 3 [Tree.Node 4 [], Tree.Node 5 []]]

value2 = CustomTree $ Tree.Node 2 []
error2 = DiffSpecial $ DiffAtNode (TreePath []) TopLevelNotEqual
error2 = DiffSpecial $ DiffAtNode (TreePath []) $ TopLevelNotEqualShow "1" "2"

value3 = CustomTree $ Tree.Node 1 [Tree.Node 2 []]
error3 = DiffSpecial $ WrongLengthsOfChildren (TreePath []) 2 1

value4 = CustomTree $ Tree.Node 1 [Tree.Node 2 [], Tree.Node 4 []]
error4 = DiffSpecial $ DiffAtNode (TreePath [1]) TopLevelNotEqual
error4 = DiffSpecial $ DiffAtNode (TreePath [1]) $ TopLevelNotEqualShow "3" "4"
4 changes: 4 additions & 0 deletions generic-diff/CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,10 @@ and this project adheres to [Haskell Package Versioning Policy](https://pvp.hask

## [Unreleased]

### Changed

- New `DiffError` constructor that includes a `Text` showing the two values compared at the top level in [#18](https://github.com/fpringle/generic-diff/pull/18).

## [0.1.0.1] - 01.02.2026

### Changed
Expand Down
2 changes: 2 additions & 0 deletions generic-diff/README.md
Original file line number Diff line number Diff line change
Expand Up @@ -42,4 +42,6 @@ In field right:
Both values use constructor Atom but fields don't match
In field 0 (0-indexed):
Not equal
Left value: 1
Right value: 2
```
18 changes: 13 additions & 5 deletions generic-diff/src/Generics/Diff.hs
Original file line number Diff line number Diff line change
Expand Up @@ -127,13 +127,16 @@ uses the @Right@ constructor"! And of course, once we have one step of recursion

The 'Diff' class encapsulates the above behaviour with 'diff'. It's very strongly recommended that you don't
implement 'diff' yourself, but use the default implementation using 'Generics.SOP.Generic', which is just 'gdiff'.
In case you might want to implement 'diff' yourself, there are three other functions you might want to use.
In case you might want to implement 'diff' yourself, there are five other functions you might want to use.

- 'eqDiff' simply delegates the entire process to '(==)', and will only ever give 'Equal' or 'TopLevelNotEqual'. This is
no more useful than 'Eq', and should only be used for primitive types (e.g. all numeric types like 'Char' and 'Int')
use 'eqDiff', since they don't really have ADTs or recursion.
- 'eqDiffShow' simply delegates the entire process to '(==)', and will only ever give 'Equal' or 'TopLevelNotEqualShow'. This is
no more useful than 'Eq', and should only be used for primitive types (e.g. all numeric types like 'Char' and 'Int'
use 'eqDiff', since they don't really have ADTs or recursion).

- 'gdiffTopLevel' does the above process, but without recursion. In other words each pair of fields is compared using
- 'eqDiff' is the same as 'eqDiffShow', but uses 'TopLevelNotEqual'. This should only be used for primitive types that
do not have 'Show' instances.

- 'gdiffTopLevelShow' does the above process, but without recursion. In other words each pair of fields is compared using
'(==)'. This is definitely better than 'Eq', by one "level". One situation when this might be useful is when your
type refers to types from other libraries, and you want to avoid orphan 'Diff' instances for those types. Another
is when the types of the fields are "small" enough that we don't care about recursing into them. For example:
Expand All @@ -159,6 +162,9 @@ instance 'Diff' Request where
'diff' = 'gdiffTopLevel'
@

- 'gdiffTopLevel' is the same as 'gdiffTopLevelShow', but uses 'eqDiffShow' instead of 'eqDiff'. This should only be used
for primitive types that do not have 'Show' instances.

- 'diffWithSpecial' lets us handle edge cases for funky types with unusual 'Eq' instances or preserved
invariants. See "Generics.Diff.Special".

Expand All @@ -172,8 +178,10 @@ module Generics.Diff

-- ** Implementing diff
, gdiff
, gdiffTopLevelShow
, gdiffTopLevel
, gdiffWith
, eqDiffShow
, eqDiff

-- * Types
Expand Down
42 changes: 39 additions & 3 deletions generic-diff/src/Generics/Diff/Class.hs
Original file line number Diff line number Diff line change
Expand Up @@ -7,8 +7,10 @@ module Generics.Diff.Class

-- ** Implementing diff
, gdiff
, gdiffTopLevelShow
, gdiffTopLevel
, gdiffWith
, eqDiffShow
, eqDiff
, diffWithSpecial
, gspecialDiffNested
Expand All @@ -20,6 +22,7 @@ where

import Data.SOP
import Data.SOP.NP
import qualified Data.Text as T
import qualified GHC.Generics as G
import Generics.Diff.Render
import Generics.Diff.Type
Expand Down Expand Up @@ -68,7 +71,7 @@ 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))))))
Error (Nested (FieldMismatch (AtLoc (Z (Constructor \"Atom\" :*: Z (Nested $ TopLevelNotEqualShow \"1\" \"2\"))))))

ghci> diff (Bin (Atom 1) Plus (Atom 1)) (Atom 2)
Error (Nested (WrongConstructor (S (Z (Constructor \"Bin\"))) (Z (Constructor \"Atom\"))))
Expand All @@ -77,7 +80,7 @@ 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)))))))))))))
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 $ TopLevelNotEqualShow "1" "2")))))))))))))
@

Of course, these are just as difficult to understand as derived 'Show' instances, or more so. Fortunately we can
Expand All @@ -96,6 +99,8 @@ ghci> printDiffResult $ diff (Atom 1) (Atom 2)
Both values use constructor Atom but fields don't match
In field 0 (0-indexed):
Not equal
Left value: 1
Right value: 2

ghci> printDiffResult $ diff (Bin (Atom 1) Plus (Atom 1)) (Atom 2)
Wrong constructor
Expand All @@ -115,6 +120,8 @@ In field right:
Both values use constructor Atom but fields don't match
In field 0 (0-indexed):
Not equal
Left value: 1
Right value: 2
@

= Laws
Expand All @@ -127,7 +134,8 @@ 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'.
-- default implementation, or one of 'eqDiffShow' or 'gdiffTopLevelShow'
-- (or 'eqDiff' or 'gdiffTopLevel' if the type doesn't have a 'Show' instance).
diff :: a -> a -> DiffResult a
default diff :: (Generic a, HasDatatypeInfo a, All2 Diff (Code a)) => a -> a -> DiffResult a
diff = gdiff
Expand Down Expand Up @@ -162,13 +170,29 @@ diffListWith d = go 0

{- | The most basic 'Differ' possible. If the two values are equal, return 'Equal';
otherwise, return 'TopLevelNotEqual'.

Note that if @a@ has a 'Show' instance, then 'eqDiffShow' is more informative since
it actually displays the compared values.
-}
eqDiff :: (Eq a) => a -> a -> DiffResult a
eqDiff a b =
if a == b
then Equal
else Error TopLevelNotEqual

tshow :: (Show a) => a -> T.Text
tshow = T.pack . show
{-# INLINE tshow #-}

{- | Like 'eqDiff', 'eqDiffShow' only compares the values at the top-level. It also includes
a textual representation of the compared values.
-}
eqDiffShow :: (Eq a, Show a) => a -> a -> DiffResult a
eqDiffShow a b =
if a == b
then Equal
else Error $ TopLevelNotEqualShow (tshow a) (tshow b)

{- | 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.
-}
Expand All @@ -182,6 +206,9 @@ gdiff = gdiffWithPure @a @Diff (Differ diff)

{- | Alternate implementation of 'diff' - basically one level of 'gdiff'. To compare individual fields of the
top-level values, we just use '(==)'.

Note that if @a@ has a 'Show' instance, then 'gdiffTopLevelShow' is more informative since
it actually displays the compared values.
-}
gdiffTopLevel ::
forall a.
Expand All @@ -191,6 +218,15 @@ gdiffTopLevel ::
DiffResult a
gdiffTopLevel = gdiffWithPure @a @Eq (Differ eqDiff)

-- | Same as 'gdiffTopLevel', but includes a textual representation of the compared values.
gdiffTopLevelShow ::
forall a.
(Generic a, HasDatatypeInfo a, All2 (And Eq Show) (Code a)) =>
a ->
a ->
DiffResult a
gdiffTopLevelShow = gdiffWithPure @a @(And Eq Show) (Differ eqDiffShow)

{- | 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.
-}
Expand Down
Loading
Loading