{-# LANGUAGE TemplateHaskell, FlexibleContexts, UndecidableInstances #-}

module Hyper.Diff
    ( diff
    , Diff(..), _CommonBody, _CommonSubTree, _Different
    , CommonBody(..), anns, val
    , foldDiffs

    , diffP
    , DiffP(..), _CommonBodyP, _CommonSubTreeP, _DifferentP
    , foldDiffsP
    ) where

import Hyper
import Hyper.Class.ZipMatch (ZipMatch(..))
import Hyper.Internal.Prelude
import Hyper.Recurse

-- | A 'HyperType' which represents the difference between two annotated trees.
-- The annotation types also function as tokens
-- to describe which of the two trees a term comes from.
data Diff a b e
    = CommonSubTree (Ann (a :*: b) e)
    | CommonBody (CommonBody a b e)
    | Different ((Ann a :*: Ann b) e)
    deriving (forall x. Diff a b e -> Rep (Diff a b e) x)
-> (forall x. Rep (Diff a b e) x -> Diff a b e)
-> Generic (Diff a b e)
forall x. Rep (Diff a b e) x -> Diff a b e
forall x. Diff a b e -> Rep (Diff a b e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (a :: AHyperType -> *) (b :: AHyperType -> *)
       (e :: AHyperType) x.
Rep (Diff a b e) x -> Diff a b e
forall (a :: AHyperType -> *) (b :: AHyperType -> *)
       (e :: AHyperType) x.
Diff a b e -> Rep (Diff a b e) x
$cto :: forall (a :: AHyperType -> *) (b :: AHyperType -> *)
       (e :: AHyperType) x.
Rep (Diff a b e) x -> Diff a b e
$cfrom :: forall (a :: AHyperType -> *) (b :: AHyperType -> *)
       (e :: AHyperType) x.
Diff a b e -> Rep (Diff a b e) x
Generic

-- | A 'HyperType' which represents two trees which have the same top-level node,
-- but their children may differ.
data CommonBody a b e = MkCommonBody
    { CommonBody a b e -> (:*:) a b e
_anns :: (a :*: b) e
    , CommonBody a b e -> e :# Diff a b
_val :: e :# Diff a b
    } deriving (forall x. CommonBody a b e -> Rep (CommonBody a b e) x)
-> (forall x. Rep (CommonBody a b e) x -> CommonBody a b e)
-> Generic (CommonBody a b e)
forall x. Rep (CommonBody a b e) x -> CommonBody a b e
forall x. CommonBody a b e -> Rep (CommonBody a b e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (a :: AHyperType -> *) (b :: AHyperType -> *)
       (e :: AHyperType) x.
Rep (CommonBody a b e) x -> CommonBody a b e
forall (a :: AHyperType -> *) (b :: AHyperType -> *)
       (e :: AHyperType) x.
CommonBody a b e -> Rep (CommonBody a b e) x
$cto :: forall (a :: AHyperType -> *) (b :: AHyperType -> *)
       (e :: AHyperType) x.
Rep (CommonBody a b e) x -> CommonBody a b e
$cfrom :: forall (a :: AHyperType -> *) (b :: AHyperType -> *)
       (e :: AHyperType) x.
CommonBody a b e -> Rep (CommonBody a b e) x
Generic

makePrisms ''Diff
makeLenses ''CommonBody

-- | Compute the difference of two annotated trees.
diff ::
    forall t a b.
    (Recursively ZipMatch t, RTraversable t) =>
    Ann a # t -> Ann b # t -> Diff a b # t
diff :: (Ann a # t) -> (Ann b # t) -> Diff a b # t
diff x :: Ann a # t
x@(Ann a ('AHyperType t)
xA 'AHyperType t :# Ann a
xB) y :: Ann b # t
y@(Ann b ('AHyperType t)
yA 'AHyperType t :# Ann b
yB) =
    Dict (ZipMatch t, HNodesConstraint t (Recursively ZipMatch))
-> ((ZipMatch t, HNodesConstraint t (Recursively ZipMatch)) =>
    Diff a b # t)
-> Diff a b # t
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (Proxy (ZipMatch t)
-> Dict (ZipMatch t, HNodesConstraint t (Recursively ZipMatch))
forall (c :: (AHyperType -> *) -> Constraint)
       (h :: AHyperType -> *) (proxy :: Constraint -> *).
Recursively c h =>
proxy (c h) -> Dict (c h, HNodesConstraint h (Recursively c))
recursively (Proxy (ZipMatch t)
forall k (t :: k). Proxy t
Proxy @(ZipMatch t))) (((ZipMatch t, HNodesConstraint t (Recursively ZipMatch)) =>
  Diff a b # t)
 -> Diff a b # t)
-> ((ZipMatch t, HNodesConstraint t (Recursively ZipMatch)) =>
    Diff a b # t)
-> Diff a b # t
forall a b. (a -> b) -> a -> b
$
    Dict (HNodesConstraint t RTraversable)
-> (HNodesConstraint t RTraversable => Diff a b # t)
-> Diff a b # t
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (Proxy (RTraversable t) -> Dict (HNodesConstraint t RTraversable)
forall (c :: (AHyperType -> *) -> Constraint)
       (h :: AHyperType -> *) (proxy :: Constraint -> *).
(Recursive c, HNodes h, c h) =>
proxy (c h) -> Dict (HNodesConstraint h c)
recurse (Proxy (RTraversable t)
forall k (t :: k). Proxy t
Proxy @(RTraversable t))) ((HNodesConstraint t RTraversable => Diff a b # t) -> Diff a b # t)
-> (HNodesConstraint t RTraversable => Diff a b # t)
-> Diff a b # t
forall a b. (a -> b) -> a -> b
$
    case (t # Ann a) -> (t # Ann b) -> Maybe (t # (Ann a :*: Ann b))
forall (h :: AHyperType -> *) (p :: AHyperType -> *)
       (q :: AHyperType -> *).
ZipMatch h =>
(h # p) -> (h # q) -> Maybe (h # (p :*: q))
zipMatch t # Ann a
'AHyperType t :# Ann a
xB t # Ann b
'AHyperType t :# Ann b
yB of
    Maybe (t # (Ann a :*: Ann b))
Nothing -> (:*:) (Ann a) (Ann b) ('AHyperType t) -> Diff a b # t
forall (a :: AHyperType -> *) (b :: AHyperType -> *)
       (e :: AHyperType).
(:*:) (Ann a) (Ann b) e -> Diff a b e
Different (Ann a # t
x (Ann a # t) -> (Ann b # t) -> (:*:) (Ann a) (Ann b) ('AHyperType t)
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: Ann b # t
y)
    Just t # (Ann a :*: Ann b)
match ->
        case (forall (n :: AHyperType -> *).
 HWitness t n -> (Diff a b # n) -> Maybe (Ann (a :*: b) # n))
-> (t # Diff a b) -> Maybe (t # Ann (a :*: b))
forall (f :: * -> *) (h :: AHyperType -> *) (p :: AHyperType -> *)
       (q :: AHyperType -> *).
(Applicative f, HTraversable h) =>
(forall (n :: AHyperType -> *).
 HWitness h n -> (p # n) -> f (q # n))
-> (h # p) -> f (h # q)
htraverse (((Diff a b # n) -> Maybe (Ann (a :*: b) # n))
-> HWitness t n -> (Diff a b # n) -> Maybe (Ann (a :*: b) # n)
forall a b. a -> b -> a
const ((Diff a b # n)
-> Getting
     (First (Ann (a :*: b) # n)) (Diff a b # n) (Ann (a :*: b) # n)
-> Maybe (Ann (a :*: b) # n)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting
  (First (Ann (a :*: b) # n)) (Diff a b # n) (Ann (a :*: b) # n)
forall (a :: AHyperType -> *) (b :: AHyperType -> *)
       (e :: AHyperType).
Prism' (Diff a b e) (Ann (a :*: b) e)
_CommonSubTree)) t # Diff a b
sub of
        Maybe (t # Ann (a :*: b))
Nothing -> (:*:) a b ('AHyperType t)
-> ('AHyperType t :# Diff a b) -> CommonBody a b ('AHyperType t)
forall (a :: AHyperType -> *) (b :: AHyperType -> *)
       (e :: AHyperType).
(:*:) a b e -> (e :# Diff a b) -> CommonBody a b e
MkCommonBody (a ('AHyperType t)
xA a ('AHyperType t) -> b ('AHyperType t) -> (:*:) a b ('AHyperType t)
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b ('AHyperType t)
yA) t # Diff a b
'AHyperType t :# Diff a b
sub CommonBody a b ('AHyperType t)
-> (CommonBody a b ('AHyperType t) -> Diff a b # t) -> Diff a b # t
forall a b. a -> (a -> b) -> b
& CommonBody a b ('AHyperType t) -> Diff a b # t
forall (a :: AHyperType -> *) (b :: AHyperType -> *)
       (e :: AHyperType).
CommonBody a b e -> Diff a b e
CommonBody
        Just t # Ann (a :*: b)
r -> (:*:) a b ('AHyperType t)
-> ('AHyperType t :# Ann (a :*: b))
-> Ann (a :*: b) ('AHyperType t)
forall (a :: AHyperType -> *) (h :: AHyperType).
a h -> (h :# Ann a) -> Ann a h
Ann (a ('AHyperType t)
xA a ('AHyperType t) -> b ('AHyperType t) -> (:*:) a b ('AHyperType t)
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b ('AHyperType t)
yA) t # Ann (a :*: b)
'AHyperType t :# Ann (a :*: b)
r Ann (a :*: b) ('AHyperType t)
-> (Ann (a :*: b) ('AHyperType t) -> Diff a b # t) -> Diff a b # t
forall a b. a -> (a -> b) -> b
& Ann (a :*: b) ('AHyperType t) -> Diff a b # t
forall (a :: AHyperType -> *) (b :: AHyperType -> *)
       (e :: AHyperType).
Ann (a :*: b) e -> Diff a b e
CommonSubTree
        where
            sub :: t # Diff a b
sub =
                (forall (n :: AHyperType -> *).
 HWitness t n -> ((Ann a :*: Ann b) # n) -> Diff a b # n)
-> (t # (Ann a :*: Ann b)) -> t # Diff a b
forall (h :: AHyperType -> *) (p :: AHyperType -> *)
       (q :: AHyperType -> *).
HFunctor h =>
(forall (n :: AHyperType -> *). HWitness h n -> (p # n) -> q # n)
-> (h # p) -> h # q
hmap
                ( Proxy (Recursively ZipMatch)
forall k (t :: k). Proxy t
Proxy @(Recursively ZipMatch) Proxy (Recursively ZipMatch)
-> (Recursively ZipMatch n =>
    HWitness t n -> ((Ann a :*: Ann b) # n) -> Diff a b # n)
-> HWitness t n
-> ((Ann a :*: Ann b) # n)
-> Diff a b # n
forall (h :: AHyperType -> *)
       (c :: (AHyperType -> *) -> Constraint) (n :: AHyperType -> *) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => HWitness h n -> r) -> HWitness h n -> r
#*# Proxy RTraversable
forall k (t :: k). Proxy t
Proxy @RTraversable Proxy RTraversable
-> (RTraversable n => ((Ann a :*: Ann b) # n) -> Diff a b # n)
-> HWitness t n
-> ((Ann a :*: Ann b) # n)
-> Diff a b # n
forall (h :: AHyperType -> *)
       (c :: (AHyperType -> *) -> Constraint) (n :: AHyperType -> *) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => r) -> HWitness h n -> r
#>
                    \(Ann a ('AHyperType n)
xC :*: Ann b ('AHyperType n)
yC) -> Ann a ('AHyperType n) -> Ann b ('AHyperType n) -> Diff a b # n
forall (t :: AHyperType -> *) (a :: AHyperType -> *)
       (b :: AHyperType -> *).
(Recursively ZipMatch t, RTraversable t) =>
(Ann a # t) -> (Ann b # t) -> Diff a b # t
diff Ann a ('AHyperType n)
xC Ann b ('AHyperType n)
yC
                ) t # (Ann a :*: Ann b)
match

foldDiffs ::
    forall r h a b.
    (Monoid r, Recursively HFoldable h) =>
    (forall n. HRecWitness h n -> Ann a # n -> Ann b # n -> r) ->
    Diff a b # h ->
    r
foldDiffs :: (forall (n :: AHyperType -> *).
 HRecWitness h n -> (Ann a # n) -> (Ann b # n) -> r)
-> (Diff a b # h) -> r
foldDiffs forall (n :: AHyperType -> *).
HRecWitness h n -> (Ann a # n) -> (Ann b # n) -> r
_ CommonSubTree{} = r
forall a. Monoid a => a
mempty
foldDiffs forall (n :: AHyperType -> *).
HRecWitness h n -> (Ann a # n) -> (Ann b # n) -> r
f (Different (Ann a ('AHyperType h)
x :*: Ann b ('AHyperType h)
y)) = HRecWitness h h
-> Ann a ('AHyperType h) -> Ann b ('AHyperType h) -> r
forall (n :: AHyperType -> *).
HRecWitness h n -> (Ann a # n) -> (Ann b # n) -> r
f HRecWitness h h
forall (h :: AHyperType -> *). HRecWitness h h
HRecSelf Ann a ('AHyperType h)
x Ann b ('AHyperType h)
y
foldDiffs forall (n :: AHyperType -> *).
HRecWitness h n -> (Ann a # n) -> (Ann b # n) -> r
f (CommonBody (MkCommonBody (:*:) a b ('AHyperType h)
_ 'AHyperType h :# Diff a b
x)) =
    Dict (HFoldable h, HNodesConstraint h (Recursively HFoldable))
-> ((HFoldable h, HNodesConstraint h (Recursively HFoldable)) => r)
-> r
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (Proxy (HFoldable h)
-> Dict (HFoldable h, HNodesConstraint h (Recursively HFoldable))
forall (c :: (AHyperType -> *) -> Constraint)
       (h :: AHyperType -> *) (proxy :: Constraint -> *).
Recursively c h =>
proxy (c h) -> Dict (c h, HNodesConstraint h (Recursively c))
recursively (Proxy (HFoldable h)
forall k (t :: k). Proxy t
Proxy @(HFoldable h))) (((HFoldable h, HNodesConstraint h (Recursively HFoldable)) => r)
 -> r)
-> ((HFoldable h, HNodesConstraint h (Recursively HFoldable)) => r)
-> r
forall a b. (a -> b) -> a -> b
$
    (forall (n :: AHyperType -> *).
 HWitness h n -> (Diff a b # n) -> r)
-> (h # Diff a b) -> r
forall (h :: AHyperType -> *) a (p :: AHyperType -> *).
(HFoldable h, Monoid a) =>
(forall (n :: AHyperType -> *). HWitness h n -> (p # n) -> a)
-> (h # p) -> a
hfoldMap
    ( Proxy (Recursively HFoldable)
forall k (t :: k). Proxy t
Proxy @(Recursively HFoldable) Proxy (Recursively HFoldable)
-> (Recursively HFoldable n => HWitness h n -> (Diff a b # n) -> r)
-> HWitness h n
-> (Diff a b # n)
-> r
forall (h :: AHyperType -> *)
       (c :: (AHyperType -> *) -> Constraint) (n :: AHyperType -> *) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => HWitness h n -> r) -> HWitness h n -> r
#*#
        \HWitness h n
w -> (forall (n :: AHyperType -> *).
 HRecWitness n n -> (Ann a # n) -> (Ann b # n) -> r)
-> (Diff a b # n) -> r
forall r (h :: AHyperType -> *) (a :: AHyperType -> *)
       (b :: AHyperType -> *).
(Monoid r, Recursively HFoldable h) =>
(forall (n :: AHyperType -> *).
 HRecWitness h n -> (Ann a # n) -> (Ann b # n) -> r)
-> (Diff a b # h) -> r
foldDiffs (HRecWitness h n -> (Ann a # n) -> (Ann b # n) -> r
forall (n :: AHyperType -> *).
HRecWitness h n -> (Ann a # n) -> (Ann b # n) -> r
f (HRecWitness h n -> (Ann a # n) -> (Ann b # n) -> r)
-> (HRecWitness n n -> HRecWitness h n)
-> HRecWitness n n
-> (Ann a # n)
-> (Ann b # n)
-> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWitness h n -> HRecWitness n n -> HRecWitness h n
forall (h :: AHyperType -> *) (c :: AHyperType -> *)
       (n :: AHyperType -> *).
HWitness h c -> HRecWitness c n -> HRecWitness h n
HRecSub HWitness h n
w)
    ) h # Diff a b
'AHyperType h :# Diff a b
x

data DiffP h
    = CommonSubTreeP (HPlain (GetHyperType h))
    | CommonBodyP (h :# DiffP)
    | DifferentP (HPlain (GetHyperType h)) (HPlain (GetHyperType h))
    deriving (forall x. DiffP h -> Rep (DiffP h) x)
-> (forall x. Rep (DiffP h) x -> DiffP h) -> Generic (DiffP h)
forall x. Rep (DiffP h) x -> DiffP h
forall x. DiffP h -> Rep (DiffP h) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (h :: AHyperType) x. Rep (DiffP h) x -> DiffP h
forall (h :: AHyperType) x. DiffP h -> Rep (DiffP h) x
$cto :: forall (h :: AHyperType) x. Rep (DiffP h) x -> DiffP h
$cfrom :: forall (h :: AHyperType) x. DiffP h -> Rep (DiffP h) x
Generic
makePrisms ''DiffP

diffP ::
    forall h.
    (Recursively ZipMatch h, Recursively HasHPlain h, RTraversable h) =>
    HPlain h -> HPlain h -> DiffP # h
diffP :: HPlain h -> HPlain h -> DiffP # h
diffP HPlain h
x HPlain h
y =
    Dict (HasHPlain h, HNodesConstraint h (Recursively HasHPlain))
-> ((HasHPlain h, HNodesConstraint h (Recursively HasHPlain)) =>
    DiffP # h)
-> DiffP # h
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (Proxy (HasHPlain h)
-> Dict (HasHPlain h, HNodesConstraint h (Recursively HasHPlain))
forall (c :: (AHyperType -> *) -> Constraint)
       (h :: AHyperType -> *) (proxy :: Constraint -> *).
Recursively c h =>
proxy (c h) -> Dict (c h, HNodesConstraint h (Recursively c))
recursively (Proxy (HasHPlain h)
forall k (t :: k). Proxy t
Proxy @(HasHPlain h))) (((HasHPlain h, HNodesConstraint h (Recursively HasHPlain)) =>
  DiffP # h)
 -> DiffP # h)
-> ((HasHPlain h, HNodesConstraint h (Recursively HasHPlain)) =>
    DiffP # h)
-> DiffP # h
forall a b. (a -> b) -> a -> b
$
    (Pure # h) -> (Pure # h) -> DiffP # h
forall (h :: AHyperType -> *).
(Recursively ZipMatch h, Recursively HasHPlain h,
 RTraversable h) =>
(Pure # h) -> (Pure # h) -> DiffP # h
diffPH (HPlain h
x HPlain h -> Getting (Pure # h) (HPlain h) (Pure # h) -> Pure # h
forall s a. s -> Getting a s a -> a
^. Getting (Pure # h) (HPlain h) (Pure # h)
forall (h :: AHyperType -> *).
HasHPlain h =>
Iso' (HPlain h) (Pure # h)
hPlain) (HPlain h
y HPlain h -> Getting (Pure # h) (HPlain h) (Pure # h) -> Pure # h
forall s a. s -> Getting a s a -> a
^. Getting (Pure # h) (HPlain h) (Pure # h)
forall (h :: AHyperType -> *).
HasHPlain h =>
Iso' (HPlain h) (Pure # h)
hPlain)

diffPH ::
    forall h.
    (Recursively ZipMatch h, Recursively HasHPlain h, RTraversable h) =>
    Pure # h -> Pure # h -> DiffP # h
diffPH :: (Pure # h) -> (Pure # h) -> DiffP # h
diffPH Pure # h
x Pure # h
y =
    Dict (ZipMatch h, HNodesConstraint h (Recursively ZipMatch))
-> ((ZipMatch h, HNodesConstraint h (Recursively ZipMatch)) =>
    DiffP # h)
-> DiffP # h
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (Proxy (ZipMatch h)
-> Dict (ZipMatch h, HNodesConstraint h (Recursively ZipMatch))
forall (c :: (AHyperType -> *) -> Constraint)
       (h :: AHyperType -> *) (proxy :: Constraint -> *).
Recursively c h =>
proxy (c h) -> Dict (c h, HNodesConstraint h (Recursively c))
recursively (Proxy (ZipMatch h)
forall k (t :: k). Proxy t
Proxy @(ZipMatch h))) (((ZipMatch h, HNodesConstraint h (Recursively ZipMatch)) =>
  DiffP # h)
 -> DiffP # h)
-> ((ZipMatch h, HNodesConstraint h (Recursively ZipMatch)) =>
    DiffP # h)
-> DiffP # h
forall a b. (a -> b) -> a -> b
$
    Dict (HasHPlain h, HNodesConstraint h (Recursively HasHPlain))
-> ((HasHPlain h, HNodesConstraint h (Recursively HasHPlain)) =>
    DiffP # h)
-> DiffP # h
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (Proxy (HasHPlain h)
-> Dict (HasHPlain h, HNodesConstraint h (Recursively HasHPlain))
forall (c :: (AHyperType -> *) -> Constraint)
       (h :: AHyperType -> *) (proxy :: Constraint -> *).
Recursively c h =>
proxy (c h) -> Dict (c h, HNodesConstraint h (Recursively c))
recursively (Proxy (HasHPlain h)
forall k (t :: k). Proxy t
Proxy @(HasHPlain h))) (((HasHPlain h, HNodesConstraint h (Recursively HasHPlain)) =>
  DiffP # h)
 -> DiffP # h)
-> ((HasHPlain h, HNodesConstraint h (Recursively HasHPlain)) =>
    DiffP # h)
-> DiffP # h
forall a b. (a -> b) -> a -> b
$
    Dict (HNodesConstraint h RTraversable)
-> (HNodesConstraint h RTraversable => DiffP # h) -> DiffP # h
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (Proxy (RTraversable h) -> Dict (HNodesConstraint h RTraversable)
forall (c :: (AHyperType -> *) -> Constraint)
       (h :: AHyperType -> *) (proxy :: Constraint -> *).
(Recursive c, HNodes h, c h) =>
proxy (c h) -> Dict (HNodesConstraint h c)
recurse (Proxy (RTraversable h)
forall k (t :: k). Proxy t
Proxy @(RTraversable h))) ((HNodesConstraint h RTraversable => DiffP # h) -> DiffP # h)
-> (HNodesConstraint h RTraversable => DiffP # h) -> DiffP # h
forall a b. (a -> b) -> a -> b
$
    case (h # Pure) -> (h # Pure) -> Maybe (h # (Pure :*: Pure))
forall (h :: AHyperType -> *) (p :: AHyperType -> *)
       (q :: AHyperType -> *).
ZipMatch h =>
(h # p) -> (h # q) -> Maybe (h # (p :*: q))
zipMatch (Pure # h
x (Pure # h) -> Getting (h # Pure) (Pure # h) (h # Pure) -> h # Pure
forall s a. s -> Getting a s a -> a
^. Getting (h # Pure) (Pure # h) (h # Pure)
forall (h :: AHyperType -> *) (j :: AHyperType -> *).
Iso (Pure # h) (Pure # j) (h # Pure) (j # Pure)
_Pure) (Pure # h
y (Pure # h) -> Getting (h # Pure) (Pure # h) (h # Pure) -> h # Pure
forall s a. s -> Getting a s a -> a
^. Getting (h # Pure) (Pure # h) (h # Pure)
forall (h :: AHyperType -> *) (j :: AHyperType -> *).
Iso (Pure # h) (Pure # j) (h # Pure) (j # Pure)
_Pure) of
    Maybe (h # (Pure :*: Pure))
Nothing -> HPlain (GetHyperType ('AHyperType h))
-> HPlain (GetHyperType ('AHyperType h)) -> DiffP # h
forall (h :: AHyperType).
HPlain (GetHyperType h) -> HPlain (GetHyperType h) -> DiffP h
DifferentP (Tagged (Pure # h) (Identity (Pure # h))
-> Tagged (HPlain h) (Identity (HPlain h))
forall (h :: AHyperType -> *).
HasHPlain h =>
Iso' (HPlain h) (Pure # h)
hPlain (Tagged (Pure # h) (Identity (Pure # h))
 -> Tagged (HPlain h) (Identity (HPlain h)))
-> (Pure # h) -> HPlain h
forall t b. AReview t b -> b -> t
# Pure # h
x) (Tagged (Pure # h) (Identity (Pure # h))
-> Tagged (HPlain h) (Identity (HPlain h))
forall (h :: AHyperType -> *).
HasHPlain h =>
Iso' (HPlain h) (Pure # h)
hPlain (Tagged (Pure # h) (Identity (Pure # h))
 -> Tagged (HPlain h) (Identity (HPlain h)))
-> (Pure # h) -> HPlain h
forall t b. AReview t b -> b -> t
# Pure # h
y)
    Just h # (Pure :*: Pure)
match ->
        case (forall (c :: AHyperType -> *).
 HWitness h c -> (DiffP # c) -> Maybe ())
-> (h # DiffP) -> Maybe ()
forall (f :: * -> *) (h :: AHyperType -> *) (m :: AHyperType -> *).
(Applicative f, HFoldable h) =>
(forall (c :: AHyperType -> *). HWitness h c -> (m # c) -> f ())
-> (h # m) -> f ()
htraverse_ (((DiffP # c) -> Maybe ())
-> HWitness h c -> (DiffP # c) -> Maybe ()
forall a b. a -> b -> a
const ((() () -> Maybe (HPlain c) -> Maybe ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (Maybe (HPlain c) -> Maybe ())
-> ((DiffP # c) -> Maybe (HPlain c)) -> (DiffP # c) -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((DiffP # c)
-> Getting (First (HPlain c)) (DiffP # c) (HPlain c)
-> Maybe (HPlain c)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First (HPlain c)) (DiffP # c) (HPlain c)
forall (h :: AHyperType).
Prism' (DiffP h) (HPlain (GetHyperType h))
_CommonSubTreeP))) h # DiffP
sub of
        Maybe ()
Nothing -> ('AHyperType h :# DiffP) -> DiffP # h
forall (h :: AHyperType). (h :# DiffP) -> DiffP h
CommonBodyP h # DiffP
'AHyperType h :# DiffP
sub
        Just () -> Tagged (HPlain h) (Identity (HPlain h))
-> Tagged (DiffP # h) (Identity (DiffP # h))
forall (h :: AHyperType).
Prism' (DiffP h) (HPlain (GetHyperType h))
_CommonSubTreeP (Tagged (HPlain h) (Identity (HPlain h))
 -> Tagged (DiffP # h) (Identity (DiffP # h)))
-> (Tagged (Pure # h) (Identity (Pure # h))
    -> Tagged (HPlain h) (Identity (HPlain h)))
-> Tagged (Pure # h) (Identity (Pure # h))
-> Tagged (DiffP # h) (Identity (DiffP # h))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged (Pure # h) (Identity (Pure # h))
-> Tagged (HPlain h) (Identity (HPlain h))
forall (h :: AHyperType -> *).
HasHPlain h =>
Iso' (HPlain h) (Pure # h)
hPlain (Tagged (Pure # h) (Identity (Pure # h))
 -> Tagged (DiffP # h) (Identity (DiffP # h)))
-> (Pure # h) -> DiffP # h
forall t b. AReview t b -> b -> t
# Pure # h
x
        where
            sub :: h # DiffP
sub =
                (forall (n :: AHyperType -> *).
 HWitness h n -> ((Pure :*: Pure) # n) -> DiffP # n)
-> (h # (Pure :*: Pure)) -> h # DiffP
forall (h :: AHyperType -> *) (p :: AHyperType -> *)
       (q :: AHyperType -> *).
HFunctor h =>
(forall (n :: AHyperType -> *). HWitness h n -> (p # n) -> q # n)
-> (h # p) -> h # q
hmap
                ( Proxy (Recursively ZipMatch)
forall k (t :: k). Proxy t
Proxy @(Recursively ZipMatch) Proxy (Recursively ZipMatch)
-> (Recursively ZipMatch n =>
    HWitness h n -> ((Pure :*: Pure) # n) -> DiffP # n)
-> HWitness h n
-> ((Pure :*: Pure) # n)
-> DiffP # n
forall (h :: AHyperType -> *)
       (c :: (AHyperType -> *) -> Constraint) (n :: AHyperType -> *) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => HWitness h n -> r) -> HWitness h n -> r
#*#
                    Proxy (Recursively HasHPlain)
forall k (t :: k). Proxy t
Proxy @(Recursively HasHPlain) Proxy (Recursively HasHPlain)
-> (Recursively HasHPlain n =>
    HWitness h n -> ((Pure :*: Pure) # n) -> DiffP # n)
-> HWitness h n
-> ((Pure :*: Pure) # n)
-> DiffP # n
forall (h :: AHyperType -> *)
       (c :: (AHyperType -> *) -> Constraint) (n :: AHyperType -> *) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => HWitness h n -> r) -> HWitness h n -> r
#*#
                    Proxy RTraversable
forall k (t :: k). Proxy t
Proxy @RTraversable Proxy RTraversable
-> (RTraversable n => ((Pure :*: Pure) # n) -> DiffP # n)
-> HWitness h n
-> ((Pure :*: Pure) # n)
-> DiffP # n
forall (h :: AHyperType -> *)
       (c :: (AHyperType -> *) -> Constraint) (n :: AHyperType -> *) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => r) -> HWitness h n -> r
#>
                    \(Pure ('AHyperType n)
xC :*: Pure ('AHyperType n)
yC) -> Pure ('AHyperType n) -> Pure ('AHyperType n) -> DiffP # n
forall (h :: AHyperType -> *).
(Recursively ZipMatch h, Recursively HasHPlain h,
 RTraversable h) =>
(Pure # h) -> (Pure # h) -> DiffP # h
diffPH Pure ('AHyperType n)
xC Pure ('AHyperType n)
yC
                ) h # (Pure :*: Pure)
match

makeCommonInstances [''Diff, ''CommonBody, ''DiffP]

foldDiffsP ::
    forall r h.
    (Monoid r, Recursively HFoldable h, Recursively HasHPlain h) =>
    (forall n. HasHPlain n => HRecWitness h n -> HPlain n -> HPlain n -> r) ->
    DiffP # h ->
    r
foldDiffsP :: (forall (n :: AHyperType -> *).
 HasHPlain n =>
 HRecWitness h n -> HPlain n -> HPlain n -> r)
-> (DiffP # h) -> r
foldDiffsP forall (n :: AHyperType -> *).
HasHPlain n =>
HRecWitness h n -> HPlain n -> HPlain n -> r
f =
    Dict (HasHPlain h, HNodesConstraint h (Recursively HasHPlain))
-> ((HasHPlain h, HNodesConstraint h (Recursively HasHPlain)) =>
    (DiffP # h) -> r)
-> (DiffP # h)
-> r
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (Proxy (HasHPlain h)
-> Dict (HasHPlain h, HNodesConstraint h (Recursively HasHPlain))
forall (c :: (AHyperType -> *) -> Constraint)
       (h :: AHyperType -> *) (proxy :: Constraint -> *).
Recursively c h =>
proxy (c h) -> Dict (c h, HNodesConstraint h (Recursively c))
recursively (Proxy (HasHPlain h)
forall k (t :: k). Proxy t
Proxy @(HasHPlain h))) (((HasHPlain h, HNodesConstraint h (Recursively HasHPlain)) =>
  (DiffP # h) -> r)
 -> (DiffP # h) -> r)
-> ((HasHPlain h, HNodesConstraint h (Recursively HasHPlain)) =>
    (DiffP # h) -> r)
-> (DiffP # h)
-> r
forall a b. (a -> b) -> a -> b
$
    \case
    CommonSubTreeP{} -> r
forall a. Monoid a => a
mempty
    DifferentP HPlain (GetHyperType ('AHyperType h))
x HPlain (GetHyperType ('AHyperType h))
y -> HRecWitness h h -> HPlain h -> HPlain h -> r
forall (n :: AHyperType -> *).
HasHPlain n =>
HRecWitness h n -> HPlain n -> HPlain n -> r
f HRecWitness h h
forall (h :: AHyperType -> *). HRecWitness h h
HRecSelf HPlain h
HPlain (GetHyperType ('AHyperType h))
x HPlain h
HPlain (GetHyperType ('AHyperType h))
y
    CommonBodyP 'AHyperType h :# DiffP
x ->
        Dict (HFoldable h, HNodesConstraint h (Recursively HFoldable))
-> ((HFoldable h, HNodesConstraint h (Recursively HFoldable)) => r)
-> r
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (Proxy (HFoldable h)
-> Dict (HFoldable h, HNodesConstraint h (Recursively HFoldable))
forall (c :: (AHyperType -> *) -> Constraint)
       (h :: AHyperType -> *) (proxy :: Constraint -> *).
Recursively c h =>
proxy (c h) -> Dict (c h, HNodesConstraint h (Recursively c))
recursively (Proxy (HFoldable h)
forall k (t :: k). Proxy t
Proxy @(HFoldable h))) (((HFoldable h, HNodesConstraint h (Recursively HFoldable)) => r)
 -> r)
-> ((HFoldable h, HNodesConstraint h (Recursively HFoldable)) => r)
-> r
forall a b. (a -> b) -> a -> b
$
        (forall (n :: AHyperType -> *). HWitness h n -> (DiffP # n) -> r)
-> (h # DiffP) -> r
forall (h :: AHyperType -> *) a (p :: AHyperType -> *).
(HFoldable h, Monoid a) =>
(forall (n :: AHyperType -> *). HWitness h n -> (p # n) -> a)
-> (h # p) -> a
hfoldMap
        ( Proxy (Recursively HFoldable)
forall k (t :: k). Proxy t
Proxy @(Recursively HFoldable) Proxy (Recursively HFoldable)
-> (Recursively HFoldable n => HWitness h n -> (DiffP # n) -> r)
-> HWitness h n
-> (DiffP # n)
-> r
forall (h :: AHyperType -> *)
       (c :: (AHyperType -> *) -> Constraint) (n :: AHyperType -> *) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => HWitness h n -> r) -> HWitness h n -> r
#*# Proxy (Recursively HasHPlain)
forall k (t :: k). Proxy t
Proxy @(Recursively HasHPlain) Proxy (Recursively HasHPlain)
-> (Recursively HasHPlain n => HWitness h n -> (DiffP # n) -> r)
-> HWitness h n
-> (DiffP # n)
-> r
forall (h :: AHyperType -> *)
       (c :: (AHyperType -> *) -> Constraint) (n :: AHyperType -> *) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => HWitness h n -> r) -> HWitness h n -> r
#*#
            \HWitness h n
w -> (forall (n :: AHyperType -> *).
 HasHPlain n =>
 HRecWitness n n -> HPlain n -> HPlain n -> r)
-> (DiffP # n) -> r
forall r (h :: AHyperType -> *).
(Monoid r, Recursively HFoldable h, Recursively HasHPlain h) =>
(forall (n :: AHyperType -> *).
 HasHPlain n =>
 HRecWitness h n -> HPlain n -> HPlain n -> r)
-> (DiffP # h) -> r
foldDiffsP (HRecWitness h n -> HPlain n -> HPlain n -> r
forall (n :: AHyperType -> *).
HasHPlain n =>
HRecWitness h n -> HPlain n -> HPlain n -> r
f (HRecWitness h n -> HPlain n -> HPlain n -> r)
-> (HRecWitness n n -> HRecWitness h n)
-> HRecWitness n n
-> HPlain n
-> HPlain n
-> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWitness h n -> HRecWitness n n -> HRecWitness h n
forall (h :: AHyperType -> *) (c :: AHyperType -> *)
       (n :: AHyperType -> *).
HWitness h c -> HRecWitness c n -> HRecWitness h n
HRecSub HWitness h n
w)
        ) h # DiffP
'AHyperType h :# DiffP
x