Merge pull request #1239 from github/diff-assignment-by-syntax

Generically diff assignment by syntax

src/Algorithm.hs

@@ -1,10 +1,15 @@
-{-# LANGUAGE GADTs, RankNTypes #-}
+{-# LANGUAGE DataKinds, DefaultSignatures, GADTs, RankNTypes, TypeOperators #-}
 module Algorithm where
 
 import Control.Monad.Free.Freer
+import Data.Functor.Both
 import Data.Functor.Classes
 import Data.These
+import Data.Union
+import Diff
+import GHC.Generics
 import Prologue hiding (liftF)
+import Term
 import Text.Show
 
 -- | A single step in a diffing algorithm, parameterized by the types of terms, diffs, and the result of the applicable algorithm.
@@ -73,3 +78,77 @@ instance Show term => Show1 (AlgorithmF term diff) where
     Delete t1 -> showsUnaryWith showsPrec "Delete" d t1
     Insert t2 -> showsUnaryWith showsPrec "Insert" d t2
     Replace t1 t2 -> showsBinaryWith showsPrec showsPrec "Replace" d t1 t2
+
+
+-- | Diff two terms based on their generic Diffable instances. If the terms are not diffable
+-- (represented by a Nothing diff returned from algorithmFor) replace one term with another.
+algorithmForTerms :: (Functor f, Diffable f) => Term f a -> Term f a -> Algorithm (Term f a) (Diff f a) (Diff f a)
+algorithmForTerms t1 t2 = fromMaybe (byReplacing t1 t2) (fmap (wrap . (both ann1 ann2 :<)) <$> algorithmFor f1 f2)
+  where ann1 :< f1 = runCofree t1
+        ann2 :< f2 = runCofree t2
+
+
+-- | A type class for determining what algorithm to use for diffing two terms.
+class Diffable f where
+  algorithmFor :: f term -> f term -> Maybe (Algorithm term diff (f diff))
+  default algorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f term -> f term -> Maybe (Algorithm term diff (f diff))
+  algorithmFor a b = fmap to1 <$> algorithmFor' (from1 a) (from1 b)
+
+-- | Diff a Union of Syntax terms. Left is the "rest" of the Syntax terms in the Union,
+-- Right is the "head" of the Union. 'weaken' relaxes the Union to allow the possible
+-- diff terms from the "rest" of the Union, and 'inj' adds the diff terms into the Union.
+-- NB: If Left or Right Syntax terms in our Union don't match, we fail fast by returning Nothing.
+instance (Diffable f, Diffable (Union fs)) => Diffable (Union (f ': fs)) where
+  algorithmFor u1 u2 = case (decompose u1, decompose u2) of
+    (Left l1, Left l2) -> fmap weaken <$> algorithmFor l1 l2
+    (Right r1, Right r2) -> fmap inj <$> algorithmFor r1 r2
+    _ -> Nothing
+
+-- | Diff two list parameters using RWS.
+instance Diffable [] where
+  algorithmFor a b = Just (byRWS a b)
+
+-- | Diffing an empty Union is technically impossible because Union '[] uninhabited.
+-- This instance is included because GHC cannot prove that.
+instance Diffable (Union '[]) where
+  algorithmFor _ _ = Nothing
+
+-- | A generic type class for diffing two terms defined by the Generic1 interface.
+class Diffable' f where
+  algorithmFor' :: f term -> f term -> Maybe (Algorithm term diff (f diff))
+
+-- | Diff two constructors (M1 is the Generic1 newtype for meta-information (possibly related to type constructors, record selectors, and data types))
+instance Diffable' f => Diffable' (M1 i c f) where
+  algorithmFor' (M1 a) (M1 b) = fmap M1 <$> algorithmFor' a b
+
+-- | Diff the fields of a product type.
+-- i.e. data Foo a b = Foo a b (the 'Foo a b' is captured by 'a :*: b').
+instance (Diffable' f, Diffable' g) => Diffable' (f :*: g) where
+  algorithmFor' (a1 :*: b1) (a2 :*: b2) = liftA2 (:*:) <$> algorithmFor' a1 a2 <*> algorithmFor' b1 b2
+
+-- | Diff the constructors of a sum type.
+-- i.e. data Foo a = Foo a | Bar a (the 'Foo a' is captured by L1 and 'Bar a' is R1).
+instance (Diffable' f, Diffable' g) => Diffable' (f :+: g) where
+  algorithmFor' (L1 a) (L1 b) = fmap L1 <$> algorithmFor' a b
+  algorithmFor' (R1 a) (R1 b) = fmap R1 <$> algorithmFor' a b
+  algorithmFor' _ _ = Nothing
+
+-- | Diff two parameters (Par1 is the Generic1 newtype representing a type parameter).
+-- i.e. data Foo a = Foo a (the 'a' is captured by Par1).
+instance Diffable' Par1 where
+  algorithmFor' (Par1 a) (Par1 b) = Just (Par1 <$> linearly a b)
+
+-- | Diff two constant parameters (K1 is the Generic1 newtype representing type parameter constants).
+-- i.e. data Foo = Foo Int (the 'Int' is a constant parameter).
+instance Eq c => Diffable' (K1 i c) where
+  algorithmFor' (K1 a) (K1 b) = guard (a == b) *> Just (pure (K1 a))
+
+-- | Diff two terms whose constructors contain 0 type parameters.
+-- i.e. data Foo = Foo.
+instance Diffable' U1 where
+  algorithmFor' _ _ = Just (pure U1)
+
+-- | Diff two recursively defined parameters (Rec1 is the Generic1 newtype representing recursive type parameters).
+-- i.e. data Tree a = Leaf a | Node (Tree a) (Tree a) (the two 'Tree a' in 'Node (Tree a) (Tree a)' are Rec1 type parameters).
+instance Diffable' (Rec1 []) where
+  algorithmFor' a b = fmap Rec1 <$> Just ((byRWS `on` unRec1) a b)

src/Data/Syntax.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveAnyClass #-}
 module Data.Syntax where
 
+import Algorithm
 import Data.Align.Generic
 import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Classes.Show.Generic
@@ -11,13 +12,13 @@ import Text.Show
 -- Undifferentiated
 
 newtype Leaf a = Leaf { leafContent :: ByteString }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Leaf where liftEq = genericLiftEq
 instance Show1 Leaf where liftShowsPrec = genericLiftShowsPrec
 
 newtype Branch a = Branch { branchElements :: [a] }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Branch where liftEq = genericLiftEq
 instance Show1 Branch where liftShowsPrec = genericLiftShowsPrec
@@ -27,7 +28,7 @@ instance Show1 Branch where liftShowsPrec = genericLiftShowsPrec
 
 -- | An identifier of some other construct, whether a containing declaration (e.g. a class name) or a reference (e.g. a variable).
 newtype Identifier a = Identifier ByteString
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Identifier where liftEq = genericLiftEq
 instance Show1 Identifier where liftShowsPrec = genericLiftShowsPrec
@@ -37,7 +38,7 @@ instance Show1 Identifier where liftShowsPrec = genericLiftShowsPrec
 --
 --   This can be used to represent an implicit no-op, e.g. the alternative in an 'if' statement without an 'else'.
 data Empty a = Empty
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Empty where liftEq _ _ _ = True
 instance Show1 Empty where liftShowsPrec _ _ _ _ = showString "Empty"
@@ -45,7 +46,7 @@ instance Show1 Empty where liftShowsPrec _ _ _ _ = showString "Empty"
 
 -- | Syntax representing a parsing or assignment error.
 data Error a = Error [a]
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Error where liftEq = genericLiftEq
 instance Show1 Error where liftShowsPrec = genericLiftShowsPrec

src/Data/Syntax/Comment.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveAnyClass #-}
 module Data.Syntax.Comment where
 
+import Algorithm
 import Data.Align.Generic
 import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Classes.Show.Generic
@@ -9,7 +10,7 @@ import Prologue
 
 -- | An unnested comment (line or block).
 newtype Comment a = Comment { commentContent :: ByteString }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Comment where liftEq = genericLiftEq
 instance Show1 Comment where liftShowsPrec = genericLiftShowsPrec

src/Data/Syntax/Declaration.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveAnyClass #-}
 module Data.Syntax.Declaration where
 
+import Algorithm
 import Data.Align.Generic
 import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Classes.Show.Generic
@@ -8,7 +9,7 @@ import GHC.Generics
 import Prologue
 
 data Function a = Function { functionName :: !a, functionParameters :: ![a], functionBody :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Function where liftEq = genericLiftEq
 instance Show1 Function where liftShowsPrec = genericLiftShowsPrec
@@ -16,7 +17,7 @@ instance Show1 Function where liftShowsPrec = genericLiftShowsPrec
 -- TODO: How should we represent function types, where applicable?
 
 data Method a = Method { methodReceiver :: !a, methodName :: !a, methodParameters :: ![a], methodBody :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Method where liftEq = genericLiftEq
 instance Show1 Method where liftShowsPrec = genericLiftShowsPrec
@@ -25,21 +26,21 @@ instance Show1 Method where liftShowsPrec = genericLiftShowsPrec
 -- TODO: How should we distinguish class/instance methods?
 
 data Variable a = Variable { variableName :: !a, variableType :: !a, variableValue :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Variable where liftEq = genericLiftEq
 instance Show1 Variable where liftShowsPrec = genericLiftShowsPrec
 
 
 data Class a = Class { classIdentifier :: !a, classSuperclasses :: ![a], classBody :: ![a] }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Class where liftEq = genericLiftEq
 instance Show1 Class where liftShowsPrec = genericLiftShowsPrec
 
 
 data Module a = Module { moduleIdentifier :: !a, moduleScope :: ![a] }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Module where liftEq = genericLiftEq
 instance Show1 Module where liftShowsPrec = genericLiftShowsPrec
@@ -47,7 +48,7 @@ instance Show1 Module where liftShowsPrec = genericLiftShowsPrec
 
 -- | A decorator in Python
 data Decorator a = Decorator { decoratorIdentifier :: !a, decoratorParamaters :: ![a], decoratorBody :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Decorator where liftEq = genericLiftEq
 instance Show1 Decorator where liftShowsPrec = genericLiftShowsPrec
@@ -57,14 +58,14 @@ instance Show1 Decorator where liftShowsPrec = genericLiftShowsPrec
 
 -- | An ADT, i.e. a disjoint sum of products, like 'data' in Haskell, or 'enum' in Rust or Swift.
 data Datatype a = Datatype { datatypeName :: !a, datatypeConstructors :: ![a] }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Data.Syntax.Declaration.Datatype where liftEq = genericLiftEq
 instance Show1 Data.Syntax.Declaration.Datatype where liftShowsPrec = genericLiftShowsPrec
 
 -- | A single constructor in a datatype, or equally a 'struct' in C, Rust, or Swift.
 data Constructor a = Constructor { constructorName :: !a, constructorFields :: ![a] }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Data.Syntax.Declaration.Constructor where liftEq = genericLiftEq
 instance Show1 Data.Syntax.Declaration.Constructor where liftShowsPrec = genericLiftShowsPrec
@@ -72,7 +73,7 @@ instance Show1 Data.Syntax.Declaration.Constructor where liftShowsPrec = generic
 
 -- | Comprehension (e.g. ((a for b in c) in Python)
 data Comprehension a = Comprehension { comprehensionMap :: !a, comprehensionBindings :: ![a], comprehensionContext :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Comprehension where liftEq = genericLiftEq
 instance Show1 Comprehension where liftShowsPrec = genericLiftShowsPrec
@@ -80,7 +81,7 @@ instance Show1 Comprehension where liftShowsPrec = genericLiftShowsPrec
 
 -- | Import declarations.
 data Import a = Import { importContent :: ![a] }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Import where liftEq = genericLiftEq
 instance Show1 Import where liftShowsPrec = genericLiftShowsPrec

src/Data/Syntax/Expression.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveAnyClass #-}
 module Data.Syntax.Expression where
 
+import Algorithm
 import Data.Align.Generic
 import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Classes.Show.Generic
@@ -9,7 +10,7 @@ import Prologue
 
 -- | Typical prefix function application, like `f(x)` in many languages, or `f x` in Haskell.
 data Call a = Call { callFunction :: !a, callParams :: ![a], callBlock :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Call where liftEq = genericLiftEq
 instance Show1 Call where liftShowsPrec = genericLiftShowsPrec
@@ -22,7 +23,7 @@ data Comparison a
   | GreaterThanEqual !a !a
   | Equal !a !a
   | Comparison !a !a
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Comparison where liftEq = genericLiftEq
 instance Show1 Comparison where liftShowsPrec = genericLiftShowsPrec
@@ -37,7 +38,7 @@ data Arithmetic a
   | Modulo !a !a
   | Power !a !a
   | Negate !a
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Arithmetic where liftEq = genericLiftEq
 instance Show1 Arithmetic where liftShowsPrec = genericLiftShowsPrec
@@ -47,7 +48,7 @@ data Boolean a
   = Or !a !a
   | And !a !a
   | Not !a
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Boolean where liftEq = genericLiftEq
 instance Show1 Boolean where liftShowsPrec = genericLiftShowsPrec
@@ -60,7 +61,7 @@ data Bitwise a
   | LShift !a !a
   | RShift !a !a
   | Complement a
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Bitwise where liftEq = genericLiftEq
 instance Show1 Bitwise where liftShowsPrec = genericLiftShowsPrec
@@ -68,7 +69,7 @@ instance Show1 Bitwise where liftShowsPrec = genericLiftShowsPrec
 -- | Member Access (e.g. a.b)
 data MemberAccess a
   = MemberAccess !a !a
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 MemberAccess where liftEq = genericLiftEq
 instance Show1 MemberAccess where liftShowsPrec = genericLiftShowsPrec
@@ -77,14 +78,14 @@ instance Show1 MemberAccess where liftShowsPrec = genericLiftShowsPrec
 data Subscript a
   = Subscript !a ![a]
   | Member !a !a
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Subscript where liftEq = genericLiftEq
 instance Show1 Subscript where liftShowsPrec = genericLiftShowsPrec
 
 -- | Enumeration (e.g. a[1:10:1] in Python (start at index 1, stop at index 10, step 1 element from start to stop))
 data Enumeration a = Enumeration { enumerationStart :: !a, enumerationEnd :: !a, enumerationStep :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Enumeration where liftEq = genericLiftEq
 instance Show1 Enumeration where liftShowsPrec = genericLiftShowsPrec
@@ -92,7 +93,7 @@ instance Show1 Enumeration where liftShowsPrec = genericLiftShowsPrec
 -- | ScopeResolution (e.g. import a.b in Python or a::b in C++)
 data ScopeResolution a
   = ScopeResolution ![a]
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 ScopeResolution where liftEq = genericLiftEq
 instance Show1 ScopeResolution where liftShowsPrec = genericLiftShowsPrec

src/Data/Syntax/Literal.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds, DeriveAnyClass, DeriveGeneric #-}
 module Data.Syntax.Literal where
 
+import Algorithm
 import Data.Align.Generic
 import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Classes.Show.Generic
@@ -10,7 +11,7 @@ import Prologue hiding (Set)
 -- Boolean
 
 newtype Boolean a = Boolean Bool
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 true :: Boolean a
 true = Boolean True
@@ -26,7 +27,7 @@ instance Show1 Boolean where liftShowsPrec = genericLiftShowsPrec
 
 -- | A literal integer of unspecified width. No particular base is implied.
 newtype Integer a = Integer { integerContent :: ByteString }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Data.Syntax.Literal.Integer where liftEq = genericLiftEq
 instance Show1 Data.Syntax.Literal.Integer where liftShowsPrec = genericLiftShowsPrec
@@ -37,7 +38,7 @@ instance Show1 Data.Syntax.Literal.Integer where liftShowsPrec = genericLiftShow
 
 -- | A literal float of unspecified width.
 newtype Float a = Float { floatContent :: ByteString }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Data.Syntax.Literal.Float where liftEq = genericLiftEq
 instance Show1 Data.Syntax.Literal.Float where liftShowsPrec = genericLiftShowsPrec
@@ -45,7 +46,7 @@ instance Show1 Data.Syntax.Literal.Float where liftShowsPrec = genericLiftShowsP
 -- Strings, symbols
 
 newtype String a = String { stringElements :: [a] }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 String where liftEq = genericLiftEq
 instance Show1 String where liftShowsPrec = genericLiftShowsPrec
@@ -54,7 +55,7 @@ instance Show1 String where liftShowsPrec = genericLiftShowsPrec
 
 -- | An interpolation element within a string literal.
 newtype InterpolationElement a = InterpolationElement { interpolationBody :: a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 InterpolationElement where liftEq = genericLiftEq
 instance Show1 InterpolationElement where liftShowsPrec = genericLiftShowsPrec
@@ -62,19 +63,19 @@ instance Show1 InterpolationElement where liftShowsPrec = genericLiftShowsPrec
 
 -- | A sequence of textual contents within a string literal.
 newtype TextElement a = TextElement { textElementContent :: ByteString }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 TextElement where liftEq = genericLiftEq
 instance Show1 TextElement where liftShowsPrec = genericLiftShowsPrec
 
 data Null a = Null
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Null where liftEq = genericLiftEq
 instance Show1 Null where liftShowsPrec = genericLiftShowsPrec
 
 newtype Symbol a = Symbol { symbolContent :: ByteString }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Symbol where liftEq = genericLiftEq
 instance Show1 Symbol where liftShowsPrec = genericLiftShowsPrec
@@ -87,35 +88,35 @@ instance Show1 Symbol where liftShowsPrec = genericLiftShowsPrec
 -- Collections
 
 newtype Array a = Array { arrayElements :: [a] }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Array where liftEq = genericLiftEq
 instance Show1 Array where liftShowsPrec = genericLiftShowsPrec
 
 
 newtype Hash a = Hash { hashElements :: [a] }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Hash where liftEq = genericLiftEq
 instance Show1 Hash where liftShowsPrec = genericLiftShowsPrec
 
 
 data KeyValue a = KeyValue { key :: !a, value :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 KeyValue where liftEq = genericLiftEq
 instance Show1 KeyValue where liftShowsPrec = genericLiftShowsPrec
 
 
 newtype Tuple a = Tuple { tupleContents :: [a]}
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Tuple where liftEq = genericLiftEq
 instance Show1 Tuple where liftShowsPrec = genericLiftShowsPrec
 
 
 newtype Set a = Set { setElements :: [a] }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Set where liftEq = genericLiftEq
 instance Show1 Set where liftShowsPrec = genericLiftShowsPrec

src/Data/Syntax/Markup.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveAnyClass #-}
 module Data.Syntax.Markup where
 
+import Algorithm
 import Data.Align.Generic
 import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Classes.Show.Generic
@@ -9,7 +10,7 @@ import Prologue hiding (Text)
 
 
 newtype Document a = Document [a]
- deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Document where liftEq = genericLiftEq
 instance Show1 Document where liftShowsPrec = genericLiftShowsPrec
@@ -18,49 +19,49 @@ instance Show1 Document where liftShowsPrec = genericLiftShowsPrec
 -- Block elements
 
 newtype Paragraph a = Paragraph [a]
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Paragraph where liftEq = genericLiftEq
 instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec
 
 data Section a = Section { sectionLevel :: Int, sectionHeading :: a, sectionContent :: [a] }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Section where liftEq = genericLiftEq
 instance Show1 Section where liftShowsPrec = genericLiftShowsPrec
 
 data Heading a = Heading { headingLevel :: Int, headingContent :: [a] }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Heading where liftEq = genericLiftEq
 instance Show1 Heading where liftShowsPrec = genericLiftShowsPrec
 
 newtype UnorderedList a = UnorderedList [a]
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 UnorderedList where liftEq = genericLiftEq
 instance Show1 UnorderedList where liftShowsPrec = genericLiftShowsPrec
 
 newtype OrderedList a = OrderedList [a]
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 OrderedList where liftEq = genericLiftEq
 instance Show1 OrderedList where liftShowsPrec = genericLiftShowsPrec
 
 newtype BlockQuote a = BlockQuote [a]
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 BlockQuote where liftEq = genericLiftEq
 instance Show1 BlockQuote where liftShowsPrec = genericLiftShowsPrec
 
 data ThematicBreak a = ThematicBreak
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 ThematicBreak where liftEq = genericLiftEq
 instance Show1 ThematicBreak where liftShowsPrec = genericLiftShowsPrec
 
 data HTMLBlock a = HTMLBlock ByteString
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 HTMLBlock where liftEq = genericLiftEq
 instance Show1 HTMLBlock where liftShowsPrec = genericLiftShowsPrec
@@ -69,43 +70,43 @@ instance Show1 HTMLBlock where liftShowsPrec = genericLiftShowsPrec
 -- Inline elements
 
 newtype Strong a = Strong [a]
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Strong where liftEq = genericLiftEq
 instance Show1 Strong where liftShowsPrec = genericLiftShowsPrec
 
 newtype Emphasis a = Emphasis [a]
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Emphasis where liftEq = genericLiftEq
 instance Show1 Emphasis where liftShowsPrec = genericLiftShowsPrec
 
 newtype Text a = Text ByteString
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Text where liftEq = genericLiftEq
 instance Show1 Text where liftShowsPrec = genericLiftShowsPrec
 
 data Link a = Link { linkURL :: ByteString, linkTitle :: Maybe ByteString }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Link where liftEq = genericLiftEq
 instance Show1 Link where liftShowsPrec = genericLiftShowsPrec
 
 data Image a = Image { imageURL :: ByteString, imageTitle :: Maybe ByteString }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Image where liftEq = genericLiftEq
 instance Show1 Image where liftShowsPrec = genericLiftShowsPrec
 
 data Code a = Code { codeLanguage :: Maybe ByteString, codeContent :: ByteString }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Code where liftEq = genericLiftEq
 instance Show1 Code where liftShowsPrec = genericLiftShowsPrec
 
 data LineBreak a = LineBreak
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 LineBreak where liftEq = genericLiftEq
 instance Show1 LineBreak where liftShowsPrec = genericLiftShowsPrec

src/Data/Syntax/Statement.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveAnyClass, StandaloneDeriving #-}
 module Data.Syntax.Statement where
 
+import Algorithm
 import Data.Align.Generic
 import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Classes.Show.Generic
@@ -9,14 +10,14 @@ import Prologue
 
 -- | Conditional. This must have an else block, which can be filled with some default value when omitted in the source, e.g. 'pure ()' for C-style if-without-else or 'pure Nothing' for Ruby-style, in both cases assuming some appropriate Applicative context into which the If will be lifted.
 data If a = If { ifCondition :: !a, ifThenBody :: !a, ifElseBody :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 If where liftEq = genericLiftEq
 instance Show1 If where liftShowsPrec = genericLiftShowsPrec
 
 -- | Else statement. The else condition is any term, that upon successful completion, continues evaluation to the elseBody, e.g. `for ... else` in Python.
 data Else a = Else { elseCondition :: !a, elseBody :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Else where liftEq = genericLiftEq
 instance Show1 Else where liftShowsPrec = genericLiftShowsPrec
@@ -25,21 +26,21 @@ instance Show1 Else where liftShowsPrec = genericLiftShowsPrec
 
 -- | A pattern-matching or computed jump control-flow statement, like 'switch' in C or JavaScript, or 'case' in Ruby or Haskell.
 data Match a = Match { matchSubject :: !a, matchPatterns :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Match where liftEq = genericLiftEq
 instance Show1 Match where liftShowsPrec = genericLiftShowsPrec
 
 -- | A pattern in a pattern-matching or computed jump control-flow statement, like 'case' in C or JavaScript, 'when' in Ruby, or the left-hand side of '->' in the body of Haskell 'case' expressions.
 data Pattern a = Pattern { pattern :: !a, patternBody :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Pattern where liftEq = genericLiftEq
 instance Show1 Pattern where liftShowsPrec = genericLiftShowsPrec
 
 -- | A let statement or local binding, like 'a as b' or 'let a = b'.
 data Let a  = Let { letVariable :: !a, letValue :: !a, letBody :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Let where liftEq = genericLiftEq
 instance Show1 Let where liftShowsPrec = genericLiftShowsPrec
@@ -49,7 +50,7 @@ instance Show1 Let where liftShowsPrec = genericLiftShowsPrec
 
 -- | Assignment to a variable or other lvalue.
 data Assignment a = Assignment { assignmentTarget :: !a, assignmentValue :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Assignment where liftEq = genericLiftEq
 instance Show1 Assignment where liftShowsPrec = genericLiftShowsPrec
@@ -58,37 +59,37 @@ instance Show1 Assignment where liftShowsPrec = genericLiftShowsPrec
 -- Returns
 
 newtype Return a = Return a
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Return where liftEq = genericLiftEq
 instance Show1 Return where liftShowsPrec = genericLiftShowsPrec
 
 newtype Yield a = Yield a
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Yield where liftEq = genericLiftEq
 instance Show1 Yield where liftShowsPrec = genericLiftShowsPrec
 
 newtype Break a = Break a
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Break where liftEq = genericLiftEq
 instance Show1 Break where liftShowsPrec = genericLiftShowsPrec
 
 newtype Continue a = Continue a
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Continue where liftEq = genericLiftEq
 instance Show1 Continue where liftShowsPrec = genericLiftShowsPrec
 
 newtype Retry a = Retry a
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Retry where liftEq = genericLiftEq
 instance Show1 Retry where liftShowsPrec = genericLiftShowsPrec
 
 newtype NoOp a = NoOp a
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 NoOp where liftEq = genericLiftEq
 instance Show1 NoOp where liftShowsPrec = genericLiftShowsPrec
@@ -97,25 +98,25 @@ instance Show1 NoOp where liftShowsPrec = genericLiftShowsPrec
 -- Loops
 
 data For a = For { forBefore :: !a, forCondition :: !a, forStep :: !a, forBody :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 For where liftEq = genericLiftEq
 instance Show1 For where liftShowsPrec = genericLiftShowsPrec
 
 data ForEach a = ForEach { forEachBinding :: !a, forEachSubject :: !a, forEachBody :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 ForEach where liftEq = genericLiftEq
 instance Show1 ForEach where liftShowsPrec = genericLiftShowsPrec
 
 data While a = While { whileCondition :: !a, whileBody :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 While where liftEq = genericLiftEq
 instance Show1 While where liftShowsPrec = genericLiftShowsPrec
 
 data DoWhile a = DoWhile { doWhileCondition :: !a, doWhileBody :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 DoWhile where liftEq = genericLiftEq
 instance Show1 DoWhile where liftShowsPrec = genericLiftShowsPrec
@@ -124,25 +125,25 @@ instance Show1 DoWhile where liftShowsPrec = genericLiftShowsPrec
 -- Exception handling
 
 newtype Throw a = Throw a
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Throw where liftEq = genericLiftEq
 instance Show1 Throw where liftShowsPrec = genericLiftShowsPrec
 
 data Try a = Try { tryBody :: !a, tryCatch :: ![a] }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Try where liftEq = genericLiftEq
 instance Show1 Try where liftShowsPrec = genericLiftShowsPrec
 
 data Catch a = Catch { catchException :: !a, catchBody :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Catch where liftEq = genericLiftEq
 instance Show1 Catch where liftShowsPrec = genericLiftShowsPrec
 
 newtype Finally a = Finally a
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Finally where liftEq = genericLiftEq
 instance Show1 Finally where liftShowsPrec = genericLiftShowsPrec
@@ -150,7 +151,7 @@ instance Show1 Finally where liftShowsPrec = genericLiftShowsPrec
 
 -- | ScopeEntry (e.g. `BEGIN {}` block in Ruby or Perl).
 newtype ScopeEntry a = ScopeEntry [a]
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 ScopeEntry where liftEq = genericLiftEq
 instance Show1 ScopeEntry where liftShowsPrec = genericLiftShowsPrec
@@ -158,7 +159,7 @@ instance Show1 ScopeEntry where liftShowsPrec = genericLiftShowsPrec
 
 -- | ScopeExit (e.g. `END {}` block in Ruby or Perl).
 newtype ScopeExit a = ScopeExit [a]
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 ScopeExit where liftEq = genericLiftEq
 instance Show1 ScopeExit where liftShowsPrec = genericLiftShowsPrec

src/Data/Syntax/Type.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveAnyClass #-}
 module Data.Syntax.Type where
 
+import Algorithm
 import Data.Align.Generic
 import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Classes.Show.Generic
@@ -8,13 +9,13 @@ import GHC.Generics
 import Prologue hiding (Product)
 
 data Annotation a = Annotation { annotationSubject :: !a, annotationType :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Annotation where liftEq = genericLiftEq
 instance Show1 Annotation where liftShowsPrec = genericLiftShowsPrec
 
 newtype Product a = Product { productElements :: [a] }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Product where liftEq = genericLiftEq
 instance Show1 Product where liftShowsPrec = genericLiftShowsPrec

src/Language/Python/Syntax.hs

@@ -6,6 +6,7 @@ module Language.Python.Syntax
 , Term
 ) where
 
+import Algorithm
 import Data.Align.Generic
 import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Classes.Show.Generic
@@ -83,14 +84,14 @@ type Assignment = HasCallStack => Assignment.Assignment (AST Grammar) Grammar Te
 
 -- | Ellipsis (used in splice expressions and alternatively can be used as a fill in expression, like `undefined` in Haskell)
 data Ellipsis a = Ellipsis
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Ellipsis where liftEq = genericLiftEq
 instance Show1 Ellipsis where liftShowsPrec = genericLiftShowsPrec
 
 
 data Redirect a = Redirect !a !a
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Redirect where liftEq = genericLiftEq
 instance Show1 Redirect where liftShowsPrec = genericLiftShowsPrec

src/Semantic.hs

@@ -67,20 +67,20 @@ diffBlobPairs renderer = fmap toS . distributeFoldMap (diffBlobPair renderer) .
 -- | A task to parse a pair of 'Blob's, diff them, and render the 'Diff'.
 diffBlobPair :: DiffRenderer output -> Both Blob -> Task output
 diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of
-  (ToCDiffRenderer, Just Language.Markdown) -> run (\ blob -> parse markdownParser blob >>= decorate (markupSectionAlgebra blob)) diffLinearly (renderToCDiff blobs)
+  (ToCDiffRenderer, Just Language.Markdown) -> run (\ blob -> parse markdownParser blob >>= decorate (markupSectionAlgebra blob)) diffRecursively (renderToCDiff blobs)
-  (ToCDiffRenderer, Just Language.Python) -> run (\ blob -> parse pythonParser blob >>= decorate (declarationAlgebra blob) . hoistCofree (weaken :: Union fs a -> Union (Declaration.Method ': fs) a)) diffLinearly (renderToCDiff blobs)
+  (ToCDiffRenderer, Just Language.Python) -> run (\ blob -> parse pythonParser blob >>= decorate (declarationAlgebra blob) . hoistCofree (weaken :: Union fs a -> Union (Declaration.Method ': fs) a)) diffRecursively (renderToCDiff blobs)
   (ToCDiffRenderer, _) -> run (\ blob -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob)) diffTerms (renderToCDiff blobs)
-  (JSONDiffRenderer, Just Language.Markdown) -> run (parse markdownParser) diffLinearly (renderJSONDiff blobs)
+  (JSONDiffRenderer, Just Language.Markdown) -> run (parse markdownParser) diffRecursively (renderJSONDiff blobs)
-  (JSONDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffLinearly (renderJSONDiff blobs)
+  (JSONDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffRecursively (renderJSONDiff blobs)
-  (JSONDiffRenderer, Just Language.JSON) -> run (parse jsonParser) diffLinearly (renderJSONDiff blobs)
+  (JSONDiffRenderer, Just Language.JSON) -> run (parse jsonParser) diffRecursively (renderJSONDiff blobs)
   (JSONDiffRenderer, _) -> run (decorate identifierAlgebra <=< parse syntaxParser) diffTerms (renderJSONDiff blobs)
-  (PatchDiffRenderer, Just Language.Markdown) -> run (parse markdownParser) diffLinearly (renderPatch blobs)
+  (PatchDiffRenderer, Just Language.JSON) -> run (parse jsonParser) diffRecursively (renderPatch blobs)
-  (PatchDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffLinearly (renderPatch blobs)
+  (PatchDiffRenderer, Just Language.Markdown) -> run (parse markdownParser) diffRecursively (renderPatch blobs)
-  (PatchDiffRenderer, Just Language.JSON) -> run (parse jsonParser) diffLinearly (renderPatch blobs)
+  (PatchDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffRecursively (renderPatch blobs)
   (PatchDiffRenderer, _) -> run (parse syntaxParser) diffTerms (renderPatch blobs)
-  (SExpressionDiffRenderer, Just Language.Markdown) -> run (decorate constructorLabel <=< parse markdownParser) diffLinearly (renderSExpressionDiff . mapAnnotations keepConstructorLabel)
+  (SExpressionDiffRenderer, Just Language.JSON) -> run (decorate constructorLabel <=< parse jsonParser) diffRecursively (renderSExpressionDiff . mapAnnotations keepConstructorLabel)
-  (SExpressionDiffRenderer, Just Language.Python) -> run (decorate constructorLabel <=< parse pythonParser) diffLinearly (renderSExpressionDiff . mapAnnotations keepConstructorLabel)
+  (SExpressionDiffRenderer, Just Language.Markdown) -> run (decorate constructorLabel <=< parse markdownParser) diffRecursively (renderSExpressionDiff . mapAnnotations keepConstructorLabel)
-  (SExpressionDiffRenderer, Just Language.JSON) -> run (decorate constructorLabel <=< parse jsonParser) diffLinearly (renderSExpressionDiff . mapAnnotations keepConstructorLabel)
+  (SExpressionDiffRenderer, Just Language.Python) -> run (decorate constructorLabel <=< parse pythonParser) diffRecursively (renderSExpressionDiff . mapAnnotations keepConstructorLabel)
   (SExpressionDiffRenderer, _) -> run (parse syntaxParser) diffTerms (renderSExpressionDiff . mapAnnotations keepCategory)
   (IdentityDiffRenderer, _) -> run (\ blob -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob)) diffTerms Just
   where effectiveLanguage = runBothWith (<|>) (blobLanguage <$> blobs)
@@ -89,8 +89,8 @@ diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of
         run :: Functor f => (Blob -> Task (Term f a)) -> (Both (Term f a) -> Diff f a) -> (Diff f a -> output) -> Task output
         run parse diff renderer = distributeFor blobs parse >>= diffTermPair blobs diff >>= render renderer
 
-        diffLinearly :: (Eq1 f, GAlign f, Show1 f, Traversable f) => Both (Term f (Record fields)) -> Diff f (Record fields)
+        diffRecursively :: (Eq1 f, GAlign f, Show1 f, Traversable f, Diffable f) => Both (Term f (Record fields)) -> Diff f (Record fields)
-        diffLinearly = decoratingWith constructorNameAndConstantFields (diffTermsWith linearly comparableByConstructor)
+        diffRecursively = decoratingWith constructorNameAndConstantFields (diffTermsWith algorithmForTerms comparableByConstructor)
 
 -- | A task to diff a pair of 'Term's, producing insertion/deletion 'Patch'es for non-existent 'Blob's.
 diffTermPair :: Functor f => Both Blob -> Differ f a -> Both (Term f a) -> Task (Diff f a)