{-# LANGUAGE EmptyCase #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Generics.Diff.Class
(
Diff (..)
, gdiff
, gdiffTopLevel
, gdiffWith
, eqDiff
, diffListWith
)
where
import Data.SOP
import Data.SOP.NP
import Generics.Diff.Type
import Generics.SOP
class Diff a where
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
diffList :: [a] -> [a] -> DiffResult [a]
diffList = (ListDiffError a -> DiffError [a])
-> (a -> a -> DiffResult a) -> [a] -> [a] -> DiffResult [a]
forall a b.
(ListDiffError a -> DiffError b)
-> (a -> a -> DiffResult a) -> [a] -> [a] -> DiffResult b
diffListWith ListDiffError a -> DiffError [a]
forall a1. ListDiffError a1 -> DiffError [a1]
DiffList a -> a -> DiffResult a
forall a. Diff a => a -> a -> DiffResult a
diff
diffListWith :: (ListDiffError a -> DiffError b) -> (a -> a -> DiffResult a) -> [a] -> [a] -> DiffResult b
diffListWith :: forall a b.
(ListDiffError a -> DiffError b)
-> (a -> a -> DiffResult a) -> [a] -> [a] -> DiffResult b
diffListWith ListDiffError a -> DiffError b
f a -> a -> DiffResult a
d = Int -> [a] -> [a] -> DiffResult b
go Int
0
where
go :: Int -> [a] -> [a] -> DiffResult b
go Int
_ [] [] = DiffResult b
forall a. DiffResult a
Equal
go Int
n [] [a]
ys = DiffError b -> DiffResult b
forall a. DiffError a -> DiffResult a
Error (DiffError b -> DiffResult b) -> DiffError b -> DiffResult b
forall a b. (a -> b) -> a -> b
$ ListDiffError a -> DiffError b
f (ListDiffError a -> DiffError b) -> ListDiffError a -> DiffError b
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 [] = DiffError b -> DiffResult b
forall a. DiffError a -> DiffResult a
Error (DiffError b -> DiffResult b) -> DiffError b -> DiffResult b
forall a b. (a -> b) -> a -> b
$ ListDiffError a -> DiffError b
f (ListDiffError a -> DiffError b) -> ListDiffError a -> DiffError b
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] -> DiffResult b
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
xs [a]
ys
Error DiffError a
err -> DiffError b -> DiffResult b
forall a. DiffError a -> DiffResult a
Error (DiffError b -> DiffResult b) -> DiffError b -> DiffResult b
forall a b. (a -> b) -> a -> b
$ ListDiffError a -> DiffError b
f (ListDiffError a -> DiffError b) -> ListDiffError a -> DiffError b
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
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
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)
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)
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
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))