From d353f798c5c60a24ec256d0ffeb0f1f1f32cea35 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 13 Sep 2017 18:52:27 -0400
Subject: [PATCH 01/65] Add annotation parameters to Algorithm.

---
 src/Algorithm.hs | 36 ++++++++++++++++++------------------
 1 file changed, 18 insertions(+), 18 deletions(-)

diff --git a/src/Algorithm.hs b/src/Algorithm.hs
index 9fe83bf05..404479f9b 100644
--- a/src/Algorithm.hs
+++ b/src/Algorithm.hs
@@ -18,17 +18,17 @@ import Term
 -- | A single step in a diffing algorithm, parameterized by the types of terms, diffs, and the result of the applicable algorithm.
 data AlgorithmF term diff result where
   -- | Diff two terms with the choice of algorithm left to the interpreter’s discretion.
-  Diff :: term -> term -> AlgorithmF term diff diff
+  Diff :: term ann -> term ann -> AlgorithmF (term ann) (diff ann) (diff ann)
   -- | Diff two terms recursively in O(n) time, resulting in a single diff node.
-  Linear :: term -> term -> AlgorithmF term diff diff
+  Linear :: term ann -> term ann -> AlgorithmF (term ann) (diff ann) (diff ann)
   -- | Diff two lists of terms by each element’s similarity in O(n³ log n), resulting in a list of diffs.
-  RWS :: [term] -> [term] -> AlgorithmF term diff [diff]
+  RWS :: [term ann] -> [term ann] -> AlgorithmF (term ann) (diff ann) [diff ann]
   -- | Delete a term..
-  Delete :: term -> AlgorithmF term diff diff
+  Delete :: term ann -> AlgorithmF (term ann) (diff ann) (diff ann)
   -- | Insert a term.
-  Insert :: term -> AlgorithmF term diff diff
+  Insert :: term ann -> AlgorithmF (term ann) (diff ann) (diff ann)
   -- | Replace one term with another.
-  Replace :: term -> term -> AlgorithmF term diff diff
+  Replace :: term ann -> term ann -> AlgorithmF (term ann) (diff ann) (diff ann)
 
 -- | The free applicative for 'AlgorithmF'. This enables us to construct diff values using <$> and <*> notation.
 type Algorithm term diff = Freer (AlgorithmF term diff)
@@ -37,15 +37,15 @@ type Algorithm term diff = Freer (AlgorithmF term diff)
 -- DSL
 
 -- | Diff two terms without specifying the algorithm to be used.
-diff :: term -> term -> Algorithm term diff diff
+diff :: term ann -> term ann -> Algorithm (term ann) (diff ann) (diff ann)
 diff = (liftF .) . Algorithm.Diff
 
 -- | Diff a These of terms without specifying the algorithm to be used.
-diffThese :: These term term -> Algorithm term diff diff
+diffThese :: These (term ann) (term ann) -> Algorithm (term ann) (diff ann) (diff ann)
 diffThese = these byDeleting byInserting diff
 
 -- | Diff a pair of optional terms without specifying the algorithm to be used.
-diffMaybe :: Maybe term -> Maybe term -> Algorithm term diff (Maybe diff)
+diffMaybe :: Maybe (term ann) -> Maybe (term ann) -> Algorithm (term ann) (diff ann) (Maybe (diff ann))
 diffMaybe a b = case (a, b) of
   (Just a, Just b) -> Just <$> diff a b
   (Just a, _) -> Just <$> byDeleting a
@@ -53,23 +53,23 @@ diffMaybe a b = case (a, b) of
   _ -> pure Nothing
 
 -- | Diff two terms linearly.
-linearly :: term -> term -> Algorithm term diff diff
+linearly :: term ann -> term ann -> Algorithm (term ann) (diff ann) (diff ann)
 linearly a b = liftF (Linear a b)
 
 -- | Diff two terms using RWS.
-byRWS :: [term] -> [term] -> Algorithm term diff [diff]
+byRWS :: [term ann] -> [term ann] -> Algorithm (term ann) (diff ann) [diff ann]
 byRWS a b = liftF (RWS a b)
 
 -- | Delete a term.
-byDeleting :: term -> Algorithm term diff diff
+byDeleting :: term ann -> Algorithm (term ann) (diff ann) (diff ann)
 byDeleting = liftF . Delete
 
 -- | Insert a term.
-byInserting :: term -> Algorithm term diff diff
+byInserting :: term ann -> Algorithm (term ann) (diff ann) (diff ann)
 byInserting = liftF . Insert
 
 -- | Replace one term with another.
-byReplacing :: term -> term -> Algorithm term diff diff
+byReplacing :: term ann -> term ann -> Algorithm (term ann) (diff ann) (diff ann)
 byReplacing = (liftF .) . Replace
 
 
@@ -94,11 +94,11 @@ algorithmForComparableTerms (Term (In ann1 f1)) (Term (In ann2 f2)) = fmap (merg
 
 -- | 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 :: f (term ann) -> f (term ann) -> Maybe (Algorithm (term ann) (diff ann) (f (diff ann)))
+  default algorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann) -> f (term ann) -> Maybe (Algorithm (term ann) (diff ann) (f (diff ann)))
   algorithmFor = genericAlgorithmFor
 
-genericAlgorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f term -> f term -> Maybe (Algorithm term diff (f diff))
+genericAlgorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann) -> f (term ann) -> Maybe (Algorithm (term ann) (diff ann) (f (diff ann)))
 genericAlgorithmFor a b = fmap to1 <$> algorithmFor' (from1 a) (from1 b)
 
 
@@ -115,7 +115,7 @@ instance Diffable [] where
 
 -- | 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))
+  algorithmFor' :: f (term ann) -> f (term ann) -> Maybe (Algorithm (term ann) (diff ann) (f (diff ann)))
 
 -- | 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

From d612b22fcaf0402caad1f35978214cc3fb7e48dd Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 13 Sep 2017 18:59:38 -0400
Subject: [PATCH 02/65] Make the term parameter * -> *.

---
 src/Algorithm.hs   | 58 ++++++++++++++++++++++++----------------------
 src/Data/Syntax.hs |  6 ++---
 src/Interpreter.hs |  6 ++---
 3 files changed, 36 insertions(+), 34 deletions(-)

diff --git a/src/Algorithm.hs b/src/Algorithm.hs
index 404479f9b..1b0313250 100644
--- a/src/Algorithm.hs
+++ b/src/Algorithm.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, DefaultSignatures, GADTs, RankNTypes, TypeOperators #-}
+{-# LANGUAGE DataKinds, DefaultSignatures, GADTs, RankNTypes, ScopedTypeVariables, TypeOperators #-}
 module Algorithm where
 
 import Control.Applicative (liftA2)
@@ -18,17 +18,17 @@ import Term
 -- | A single step in a diffing algorithm, parameterized by the types of terms, diffs, and the result of the applicable algorithm.
 data AlgorithmF term diff result where
   -- | Diff two terms with the choice of algorithm left to the interpreter’s discretion.
-  Diff :: term ann -> term ann -> AlgorithmF (term ann) (diff ann) (diff ann)
+  Diff :: term ann -> term ann -> AlgorithmF term (diff ann) (diff ann)
   -- | Diff two terms recursively in O(n) time, resulting in a single diff node.
-  Linear :: term ann -> term ann -> AlgorithmF (term ann) (diff ann) (diff ann)
+  Linear :: term ann -> term ann -> AlgorithmF term (diff ann) (diff ann)
   -- | Diff two lists of terms by each element’s similarity in O(n³ log n), resulting in a list of diffs.
-  RWS :: [term ann] -> [term ann] -> AlgorithmF (term ann) (diff ann) [diff ann]
+  RWS :: [term ann] -> [term ann] -> AlgorithmF term (diff ann) [diff ann]
   -- | Delete a term..
-  Delete :: term ann -> AlgorithmF (term ann) (diff ann) (diff ann)
+  Delete :: term ann -> AlgorithmF term (diff ann) (diff ann)
   -- | Insert a term.
-  Insert :: term ann -> AlgorithmF (term ann) (diff ann) (diff ann)
+  Insert :: term ann -> AlgorithmF term (diff ann) (diff ann)
   -- | Replace one term with another.
-  Replace :: term ann -> term ann -> AlgorithmF (term ann) (diff ann) (diff ann)
+  Replace :: term ann -> term ann -> AlgorithmF term (diff ann) (diff ann)
 
 -- | The free applicative for 'AlgorithmF'. This enables us to construct diff values using <$> and <*> notation.
 type Algorithm term diff = Freer (AlgorithmF term diff)
@@ -37,15 +37,15 @@ type Algorithm term diff = Freer (AlgorithmF term diff)
 -- DSL
 
 -- | Diff two terms without specifying the algorithm to be used.
-diff :: term ann -> term ann -> Algorithm (term ann) (diff ann) (diff ann)
+diff :: term ann -> term ann -> Algorithm term (diff ann) (diff ann)
 diff = (liftF .) . Algorithm.Diff
 
 -- | Diff a These of terms without specifying the algorithm to be used.
-diffThese :: These (term ann) (term ann) -> Algorithm (term ann) (diff ann) (diff ann)
+diffThese :: These (term ann) (term ann) -> Algorithm term (diff ann) (diff ann)
 diffThese = these byDeleting byInserting diff
 
 -- | Diff a pair of optional terms without specifying the algorithm to be used.
-diffMaybe :: Maybe (term ann) -> Maybe (term ann) -> Algorithm (term ann) (diff ann) (Maybe (diff ann))
+diffMaybe :: Maybe (term ann) -> Maybe (term ann) -> Algorithm term (diff ann) (Maybe (diff ann))
 diffMaybe a b = case (a, b) of
   (Just a, Just b) -> Just <$> diff a b
   (Just a, _) -> Just <$> byDeleting a
@@ -53,52 +53,54 @@ diffMaybe a b = case (a, b) of
   _ -> pure Nothing
 
 -- | Diff two terms linearly.
-linearly :: term ann -> term ann -> Algorithm (term ann) (diff ann) (diff ann)
+linearly :: term ann -> term ann -> Algorithm term (diff ann) (diff ann)
 linearly a b = liftF (Linear a b)
 
 -- | Diff two terms using RWS.
-byRWS :: [term ann] -> [term ann] -> Algorithm (term ann) (diff ann) [diff ann]
+byRWS :: [term ann] -> [term ann] -> Algorithm term (diff ann) [diff ann]
 byRWS a b = liftF (RWS a b)
 
 -- | Delete a term.
-byDeleting :: term ann -> Algorithm (term ann) (diff ann) (diff ann)
+byDeleting :: term ann -> Algorithm term (diff ann) (diff ann)
 byDeleting = liftF . Delete
 
 -- | Insert a term.
-byInserting :: term ann -> Algorithm (term ann) (diff ann) (diff ann)
+byInserting :: term ann -> Algorithm term (diff ann) (diff ann)
 byInserting = liftF . Insert
 
 -- | Replace one term with another.
-byReplacing :: term ann -> term ann -> Algorithm (term ann) (diff ann) (diff ann)
+byReplacing :: term ann -> term ann -> Algorithm term (diff ann) (diff ann)
 byReplacing = (liftF .) . Replace
 
 
-instance Show term => Show1 (AlgorithmF term diff) where
+instance (Show1 term, Show ann) => Show1 (AlgorithmF term (diff ann)) where
   liftShowsPrec _ _ d algorithm = case algorithm of
-    Algorithm.Diff t1 t2 -> showsBinaryWith showsPrec showsPrec "Diff" d t1 t2
-    Linear t1 t2 -> showsBinaryWith showsPrec showsPrec "Linear" d t1 t2
-    RWS as bs -> showsBinaryWith showsPrec showsPrec "RWS" d as bs
-    Delete t1 -> showsUnaryWith showsPrec "Delete" d t1
-    Insert t2 -> showsUnaryWith showsPrec "Insert" d t2
-    Replace t1 t2 -> showsBinaryWith showsPrec showsPrec "Replace" d t1 t2
+    Algorithm.Diff t1 t2 -> showsBinaryWith showsTerm showsTerm "Diff" d t1 t2
+    Linear t1 t2 -> showsBinaryWith showsTerm showsTerm "Linear" d t1 t2
+    RWS as bs -> showsBinaryWith (liftShowsPrec showsTerm (liftShowList showsPrec showList)) (liftShowsPrec showsTerm (liftShowList showsPrec showList)) "RWS" d as bs
+    Delete t1 -> showsUnaryWith showsTerm "Delete" d t1
+    Insert t2 -> showsUnaryWith showsTerm "Insert" d t2
+    Replace t1 t2 -> showsBinaryWith showsTerm showsTerm "Replace" d t1 t2
+    where showsTerm :: Int -> term ann -> ShowS
+          showsTerm = liftShowsPrec showsPrec showList
 
 
 -- | 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 :: (Functor f, Diffable f) => Term f a -> Term f a -> Algorithm (Term f) (Diff f a) (Diff f a)
 algorithmForTerms t1 t2 = fromMaybe (byReplacing t1 t2) (algorithmForComparableTerms t1 t2)
 
-algorithmForComparableTerms :: (Functor f, Diffable f) => Term f a -> Term f a -> Maybe (Algorithm (Term f a) (Diff f a) (Diff f a))
+algorithmForComparableTerms :: (Functor f, Diffable f) => Term f a -> Term f a -> Maybe (Algorithm (Term f) (Diff f a) (Diff f a))
 algorithmForComparableTerms (Term (In ann1 f1)) (Term (In ann2 f2)) = fmap (merge (ann1, ann2)) <$> algorithmFor f1 f2
 
 
 -- | A type class for determining what algorithm to use for diffing two terms.
 class Diffable f where
-  algorithmFor :: f (term ann) -> f (term ann) -> Maybe (Algorithm (term ann) (diff ann) (f (diff ann)))
-  default algorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann) -> f (term ann) -> Maybe (Algorithm (term ann) (diff ann) (f (diff ann)))
+  algorithmFor :: f (term ann) -> f (term ann) -> Maybe (Algorithm term (diff ann) (f (diff ann)))
+  default algorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann) -> f (term ann) -> Maybe (Algorithm term (diff ann) (f (diff ann)))
   algorithmFor = genericAlgorithmFor
 
-genericAlgorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann) -> f (term ann) -> Maybe (Algorithm (term ann) (diff ann) (f (diff ann)))
+genericAlgorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann) -> f (term ann) -> Maybe (Algorithm term (diff ann) (f (diff ann)))
 genericAlgorithmFor a b = fmap to1 <$> algorithmFor' (from1 a) (from1 b)
 
 
@@ -115,7 +117,7 @@ instance Diffable [] where
 
 -- | A generic type class for diffing two terms defined by the Generic1 interface.
 class Diffable' f where
-  algorithmFor' :: f (term ann) -> f (term ann) -> Maybe (Algorithm (term ann) (diff ann) (f (diff ann)))
+  algorithmFor' :: f (term ann) -> f (term ann) -> Maybe (Algorithm term (diff ann) (f (diff ann)))
 
 -- | 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
diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs
index 2a9011ec6..63fe6ca6b 100644
--- a/src/Data/Syntax.hs
+++ b/src/Data/Syntax.hs
@@ -161,19 +161,19 @@ instance Show1 Context where liftShowsPrec = genericLiftShowsPrec
 algorithmDeletingContext :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
                          => TermF Context a (Term (Union fs) a)
                          -> Term (Union fs) a
-                         -> Maybe (Algorithm (Term (Union fs) a) (Diff (Union fs) a) (TermF Context a (Diff (Union fs) a)))
+                         -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs) a) (TermF Context a (Diff (Union fs) a)))
 algorithmDeletingContext (In a1 (Context n1 s1)) s2 = fmap (In a1 . Context (deleting <$> n1)) <$> algorithmForComparableTerms s1 s2
 
 algorithmInsertingContext :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
                           => Term (Union fs) a
                           -> TermF Context a (Term (Union fs) a)
-                          -> Maybe (Algorithm (Term (Union fs) a) (Diff (Union fs) a) (TermF Context a (Diff (Union fs) a)))
+                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs) a) (TermF Context a (Diff (Union fs) a)))
 algorithmInsertingContext s1 (In a2 (Context n2 s2)) = fmap (In a2 . Context (inserting <$> n2)) <$> algorithmForComparableTerms s1 s2
 
 algorithmForContextUnions :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
                           => Term (Union fs) a
                           -> Term (Union fs) a
-                          -> Maybe (Algorithm (Term (Union fs) a) (Diff (Union fs) a) (Diff (Union fs) a))
+                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs) a) (Diff (Union fs) a))
 algorithmForContextUnions t1 t2
   | Just algo <- algorithmForComparableTerms t1 t2 = Just algo
   | Just c1@(In _ Context{}) <- prjTermF (unTerm t1) = fmap (deleteF . hoistTermF inj) <$> algorithmDeletingContext c1 t2
diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index b6525c24d..d4734675e 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -40,12 +40,12 @@ decoratingWith getLabel differ = stripDiff . differ . fmap (defaultFeatureVector
 
 -- | Diff a pair of terms recurisvely, using the supplied continuation and 'ComparabilityRelation'.
 diffTermsWith :: forall f fields . (Traversable f, GAlign f, Eq1 f, HasField fields FeatureVector)
-              => (Term f (Record fields) -> Term f (Record fields) -> Algorithm (Term f (Record fields)) (Diff f (Record fields)) (Diff f (Record fields))) -- ^ A function producing syntax-directed continuations of the algorithm.
+              => (Term f (Record fields) -> Term f (Record fields) -> Algorithm (Term f) (Diff f (Record fields)) (Diff f (Record fields))) -- ^ A function producing syntax-directed continuations of the algorithm.
               -> ComparabilityRelation f fields -- ^ A relation on terms used to determine comparability and equality.
               -> Both (Term f (Record fields)) -- ^ A pair of terms.
               -> Diff f (Record fields) -- ^ The resulting diff.
 diffTermsWith refine comparable (Join (a, b)) = runFreer decompose (diff a b)
-  where decompose :: AlgorithmF (Term f (Record fields)) (Diff f (Record fields)) result -> Algorithm (Term f (Record fields)) (Diff f (Record fields)) result
+  where decompose :: AlgorithmF (Term f) (Diff f (Record fields)) result -> Algorithm (Term f) (Diff f (Record fields)) result
         decompose step = case step of
           Algorithm.Diff t1 t2 -> refine t1 t2
           Linear t1 t2 -> case galignWith diffThese (unwrap t1) (unwrap t2) of
@@ -66,7 +66,7 @@ getLabel (In h t) = (Info.category h, case t of
 -- | Construct an algorithm to diff a pair of terms.
 algorithmWithTerms :: SyntaxTerm fields
                    -> SyntaxTerm fields
-                   -> Algorithm (SyntaxTerm fields) (SyntaxDiff fields) (SyntaxDiff fields)
+                   -> Algorithm (Term Syntax) (SyntaxDiff fields) (SyntaxDiff fields)
 algorithmWithTerms t1 t2 = case (unwrap t1, unwrap t2) of
   (Indexed a, Indexed b) ->
     annotate . Indexed <$> byRWS a b

From 9de429be45de759bb8cb3dca3684e192a54c925b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 13 Sep 2017 19:14:01 -0400
Subject: [PATCH 03/65] :fire: the SyntaxTerm, SyntaxTermF, & SyntaxDiff type
 synonyms.

---
 src/Diff.hs                            |  4 ----
 src/Interpreter.hs                     | 10 +++++-----
 src/Language.hs                        |  4 ++--
 src/Language/Go.hs                     |  5 +++--
 src/Language/Ruby.hs                   |  5 +++--
 src/Language/TypeScript.hs             |  5 +++--
 src/Parser.hs                          |  8 ++++----
 src/Renderer.hs                        | 11 ++++++-----
 src/Renderer/TOC.hs                    |  2 +-
 src/Term.hs                            |  6 ------
 src/TreeSitter.hs                      | 14 +++++++-------
 test/Data/RandomWalkSimilarity/Spec.hs | 12 ++++++------
 test/DiffSpec.hs                       | 10 ++++++----
 test/InterpreterSpec.hs                |  6 +++---
 test/TOCSpec.hs                        |  4 ++--
 test/TermSpec.hs                       |  4 +++-
 16 files changed, 54 insertions(+), 56 deletions(-)

diff --git a/src/Diff.hs b/src/Diff.hs
index 6b11502c8..9bc1d2976 100644
--- a/src/Diff.hs
+++ b/src/Diff.hs
@@ -12,7 +12,6 @@ import Data.JSON.Fields
 import Data.Mergeable
 import Data.Record
 import Patch
-import Syntax
 import Term
 import Text.Show
 
@@ -52,9 +51,6 @@ merge :: (ann, ann) -> syntax (Diff syntax ann) -> Diff syntax ann
 merge = (Diff .) . (Merge .) . In
 
 
-type SyntaxDiff fields = Diff Syntax (Record fields)
-
-
 diffSum :: (Foldable syntax, Functor syntax) => (forall a. Patch a -> Int) -> Diff syntax ann -> Int
 diffSum patchCost = cata $ \ diff -> case diff of
   Patch patch -> patchCost patch + sum (sum <$> patch)
diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index d4734675e..3db72a897 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -26,8 +26,8 @@ import Term
 
 -- | Diff two terms recursively, given functions characterizing the diffing.
 diffTerms :: HasField fields Category
-          => Both (SyntaxTerm fields) -- ^ A pair of terms representing the old and new state, respectively.
-          -> SyntaxDiff fields
+          => Both (Term Syntax (Record fields)) -- ^ A pair of terms representing the old and new state, respectively.
+          -> Diff Syntax (Record fields)
 diffTerms = decoratingWith getLabel (diffTermsWith algorithmWithTerms comparableByCategory)
 
 -- | Diff two terms by decorating with feature vectors computed using the supplied labelling algebra, and stripping the feature vectors from the resulting diff.
@@ -64,9 +64,9 @@ getLabel (In h t) = (Info.category h, case t of
 
 
 -- | Construct an algorithm to diff a pair of terms.
-algorithmWithTerms :: SyntaxTerm fields
-                   -> SyntaxTerm fields
-                   -> Algorithm (Term Syntax) (SyntaxDiff fields) (SyntaxDiff fields)
+algorithmWithTerms :: Term Syntax (Record fields)
+                   -> Term Syntax (Record fields)
+                   -> Algorithm (Term Syntax) (Diff Syntax (Record fields)) (Diff Syntax (Record fields))
 algorithmWithTerms t1 t2 = case (unwrap t1, unwrap t2) of
   (Indexed a, Indexed b) ->
     annotate . Indexed <$> byRWS a b
diff --git a/src/Language.hs b/src/Language.hs
index 7d0c04bd5..ede762aa3 100644
--- a/src/Language.hs
+++ b/src/Language.hs
@@ -53,13 +53,13 @@ toTuple child | S.Fixed [key,value] <- unwrap child = [termIn (extract child) (S
 toTuple child | S.Leaf c <- unwrap child = [termIn (extract child) (S.Comment c)]
 toTuple child = pure child
 
-toPublicFieldDefinition :: HasField fields Category => [SyntaxTerm fields] -> Maybe (S.Syntax (SyntaxTerm fields))
+toPublicFieldDefinition :: HasField fields Category => [Term S.Syntax (Record fields)] -> Maybe (S.Syntax (Term S.Syntax (Record fields)))
 toPublicFieldDefinition children = case break (\x -> category (extract x) == Identifier) children of
   (prev, [identifier, assignment]) -> Just $ S.VarAssignment (prev ++ [identifier]) assignment
   (_, [_]) -> Just $ S.VarDecl children
   _ -> Nothing
 
-toInterface :: HasField fields Category => [SyntaxTerm fields] -> Maybe (S.Syntax (SyntaxTerm fields))
+toInterface :: HasField fields Category => [Term S.Syntax (Record fields)] -> Maybe (S.Syntax (Term S.Syntax (Record fields)))
 toInterface (id : rest) = case break (\x -> category (extract x) == Other "object_type") rest of
   (clauses, [body]) -> Just $ S.Interface id clauses (toList (unwrap body))
   _ -> Nothing
diff --git a/src/Language/Go.hs b/src/Language/Go.hs
index 636be0922..e93e98302 100644
--- a/src/Language/Go.hs
+++ b/src/Language/Go.hs
@@ -5,6 +5,7 @@ import Control.Comonad
 import Control.Comonad.Cofree
 import Data.Foldable (toList)
 import Data.Maybe
+import Data.Record
 import Data.Source
 import Data.Text
 import Info
@@ -14,8 +15,8 @@ import Term
 termAssignment
   :: Source -- ^ The source of the term.
   -> Category -- ^ The category for the term.
-  -> [ SyntaxTerm DefaultFields ] -- ^ The child nodes of the term.
-  -> Maybe (S.Syntax (SyntaxTerm DefaultFields)) -- ^ The resulting term, in Maybe.
+  -> [ Term S.Syntax (Record DefaultFields) ] -- ^ The child nodes of the term.
+  -> Maybe (S.Syntax (Term S.Syntax (Record DefaultFields))) -- ^ The resulting term, in Maybe.
 termAssignment source category children = case (category, children) of
   (Module, [moduleName]) -> Just $ S.Module moduleName []
   (Import, [importName]) -> Just $ S.Import importName []
diff --git a/src/Language/Ruby.hs b/src/Language/Ruby.hs
index 26eac68ba..3ba432cc9 100644
--- a/src/Language/Ruby.hs
+++ b/src/Language/Ruby.hs
@@ -3,6 +3,7 @@ module Language.Ruby where
 
 import Data.Foldable (toList)
 import Data.List (partition)
+import Data.Record
 import Data.Semigroup
 import Data.Source
 import Data.Text (Text)
@@ -14,8 +15,8 @@ import Term
 termAssignment
   :: Source -- ^ The source of the term.
   -> Category -- ^ The category for the term.
-  -> [ SyntaxTerm DefaultFields ] -- ^ The child nodes of the term.
-  -> Maybe (S.Syntax (SyntaxTerm DefaultFields)) -- ^ The resulting term, in Maybe.
+  -> [ Term S.Syntax (Record DefaultFields) ] -- ^ The child nodes of the term.
+  -> Maybe (S.Syntax (Term S.Syntax (Record DefaultFields))) -- ^ The resulting term, in Maybe.
 termAssignment _ category children
   = case (category, children) of
     (ArgumentPair, [ k, v ] ) -> Just $ S.Pair k v
diff --git a/src/Language/TypeScript.hs b/src/Language/TypeScript.hs
index 03cc8cb4a..7a562836c 100644
--- a/src/Language/TypeScript.hs
+++ b/src/Language/TypeScript.hs
@@ -4,6 +4,7 @@ module Language.TypeScript where
 import Control.Comonad (extract)
 import Control.Comonad.Cofree (unwrap)
 import Data.Foldable (toList)
+import Data.Record
 import Data.Source
 import Data.Text (Text)
 import Info
@@ -14,8 +15,8 @@ import Term
 termAssignment
   :: Source -- ^ The source of the term.
   -> Category -- ^ The category for the term.
-  -> [ SyntaxTerm DefaultFields ] -- ^ The child nodes of the term.
-  -> Maybe (S.Syntax (SyntaxTerm DefaultFields)) -- ^ The resulting term, in Maybe.
+  -> [ Term S.Syntax (Record DefaultFields) ] -- ^ The child nodes of the term.
+  -> Maybe (S.Syntax (Term S.Syntax (Record DefaultFields))) -- ^ The resulting term, in Maybe.
 termAssignment _ category children =
   case (category, children) of
     (Assignment, [ identifier, value ]) -> Just $ S.Assignment identifier value
diff --git a/src/Parser.hs b/src/Parser.hs
index 7d249ac24..9eef7967d 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -45,14 +45,14 @@ data Parser term where
                    -> Assignment ast grammar (Term (Union fs) (Record Location)) -- ^ An assignment from AST onto 'Term's.
                    -> Parser (Term (Union fs) (Record Location))                 -- ^ A parser producing 'Term's.
   -- | A tree-sitter parser.
-  TreeSitterParser :: Ptr TS.Language -> Parser (SyntaxTerm DefaultFields)
+  TreeSitterParser :: Ptr TS.Language -> Parser (Term Syntax (Record DefaultFields))
   -- | A parser for 'Markdown' using cmark.
   MarkdownParser :: Parser (Term (TermF [] CMarkGFM.NodeType) (Node Markdown.Grammar))
   -- | A parser which will parse any input 'Source' into a top-level 'Term' whose children are leaves consisting of the 'Source's lines.
-  LineByLineParser :: Parser (SyntaxTerm DefaultFields)
+  LineByLineParser :: Parser (Term Syntax (Record DefaultFields))
 
 -- | Return a 'Language'-specific 'Parser', if one exists, falling back to the 'LineByLineParser'.
-parserForLanguage :: Maybe Language -> Parser (SyntaxTerm DefaultFields)
+parserForLanguage :: Maybe Language -> Parser (Term Syntax (Record DefaultFields))
 parserForLanguage Nothing = LineByLineParser
 parserForLanguage (Just language) = case language of
   Go -> TreeSitterParser tree_sitter_go
@@ -77,6 +77,6 @@ markdownParser = AssignmentParser MarkdownParser Markdown.assignment
 
 
 -- | A fallback parser that treats a file simply as rows of strings.
-lineByLineParser :: Source -> SyntaxTerm DefaultFields
+lineByLineParser :: Source -> Term Syntax (Record DefaultFields)
 lineByLineParser source = termIn (totalRange source :. Program :. totalSpan source :. Nil) (Indexed (zipWith toLine [1..] (sourceLineRanges source)))
   where toLine line range = termIn (range :. Program :. Span (Pos line 1) (Pos line (end range)) :. Nil) (Leaf (toText (slice range source)))
diff --git a/src/Renderer.hs b/src/Renderer.hs
index 55ca035b4..38f4941a7 100644
--- a/src/Renderer.hs
+++ b/src/Renderer.hs
@@ -24,9 +24,10 @@ import Data.Foldable (asum)
 import Data.JSON.Fields
 import qualified Data.Map as Map
 import Data.Output
+import Data.Record
 import Data.Syntax.Algebra (RAlgebra)
 import Data.Text (Text)
-import Diff (SyntaxDiff)
+import Diff
 import Info (DefaultFields)
 import Renderer.JSON as R
 import Renderer.Patch as R
@@ -45,8 +46,8 @@ data DiffRenderer output where
   JSONDiffRenderer :: DiffRenderer (Map.Map Text Value)
   -- | Render to a 'ByteString' formatted as nested s-expressions with patches indicated.
   SExpressionDiffRenderer :: DiffRenderer ByteString
-  -- | “Render” by returning the computed 'SyntaxDiff'. This renderer is not surfaced in the command-line interface, and is intended strictly for tests. Further, as it cannot render à la carte terms, it should be regarded as a (very) short-term hack until such time as we have a better idea for TOCSpec.hs.
-  IdentityDiffRenderer :: DiffRenderer (Maybe (SyntaxDiff (Maybe Declaration ': DefaultFields)))
+  -- | “Render” by returning the computed 'Diff'. This renderer is not surfaced in the command-line interface, and is intended strictly for tests. Further, as it cannot render à la carte terms, it should be regarded as a (very) short-term hack until such time as we have a better idea for TOCSpec.hs.
+  IdentityDiffRenderer :: DiffRenderer (Maybe (Diff Syntax (Record (Maybe Declaration ': DefaultFields))))
 
 deriving instance Eq (DiffRenderer output)
 deriving instance Show (DiffRenderer output)
@@ -59,8 +60,8 @@ data TermRenderer output where
   JSONTermRenderer :: TermRenderer [Value]
   -- | Render to a 'ByteString' formatted as nested s-expressions.
   SExpressionTermRenderer :: TermRenderer ByteString
-  -- | “Render” by returning the computed 'SyntaxTerm'. This renderer is not surfaced in the command-line interface, and is intended strictly for tests. Further, as it cannot render à la carte terms, it should be regarded as a (very) short-term hack until such time as we have a better idea for SemanticSpec.hs.
-  IdentityTermRenderer :: TermRenderer (Maybe (SyntaxTerm DefaultFields))
+  -- | “Render” by returning the computed 'Term'. This renderer is not surfaced in the command-line interface, and is intended strictly for tests. Further, as it cannot render à la carte terms, it should be regarded as a (very) short-term hack until such time as we have a better idea for SemanticSpec.hs.
+  IdentityTermRenderer :: TermRenderer (Maybe (Term Syntax (Record DefaultFields)))
 
 deriving instance Eq (TermRenderer output)
 deriving instance Show (TermRenderer output)
diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs
index 9abea609d..4fea7f57f 100644
--- a/src/Renderer/TOC.hs
+++ b/src/Renderer/TOC.hs
@@ -99,7 +99,7 @@ declaration (In annotation _) = annotation <$ (getField annotation :: Maybe Decl
 
 
 -- | Compute 'Declaration's for methods and functions in 'Syntax'.
-syntaxDeclarationAlgebra :: HasField fields Range => Blob -> RAlgebra (SyntaxTermF fields) (SyntaxTerm fields) (Maybe Declaration)
+syntaxDeclarationAlgebra :: HasField fields Range => Blob -> RAlgebra (TermF S.Syntax (Record fields)) (Term S.Syntax (Record fields)) (Maybe Declaration)
 syntaxDeclarationAlgebra Blob{..} (In a r) = case r of
   S.Function (identifier, _) _ _ -> Just $ FunctionDeclaration (getSource identifier)
   S.Method _ (identifier, _) Nothing _ _ -> Just $ MethodDeclaration (getSource identifier)
diff --git a/src/Term.hs b/src/Term.hs
index 6cfdc2bb4..2f67b29f6 100644
--- a/src/Term.hs
+++ b/src/Term.hs
@@ -3,8 +3,6 @@ module Term
 ( Term(..)
 , termIn
 , TermF(..)
-, SyntaxTerm
-, SyntaxTermF
 , termSize
 , extract
 , unwrap
@@ -24,7 +22,6 @@ import Data.Functor.Foldable
 import Data.JSON.Fields
 import Data.Record
 import Data.Semigroup ((<>))
-import Syntax
 import Text.Show
 
 -- | A Term with an abstract syntax tree and an annotation.
@@ -33,9 +30,6 @@ newtype Term syntax ann = Term { unTerm :: TermF syntax ann (Term syntax ann) }
 data TermF syntax ann recur = In { termAnnotation :: ann, termOut :: syntax recur }
   deriving (Eq, Foldable, Functor, Show, Traversable)
 
--- | A Term with a Syntax leaf and a record of fields.
-type SyntaxTerm fields = Term Syntax (Record fields)
-type SyntaxTermF fields = TermF Syntax (Record fields)
 
 -- | Return the node count of a term.
 termSize :: (Foldable f, Functor f) => Term f annotation -> Int
diff --git a/src/TreeSitter.hs b/src/TreeSitter.hs
index 3e3145dfb..fd405c9f2 100644
--- a/src/TreeSitter.hs
+++ b/src/TreeSitter.hs
@@ -35,7 +35,7 @@ import qualified TreeSitter.TypeScript as TS
 import Info
 
 -- | Returns a TreeSitter parser for the given language and TreeSitter grammar.
-treeSitterParser :: Ptr TS.Language -> Blob -> IO (SyntaxTerm DefaultFields)
+treeSitterParser :: Ptr TS.Language -> Blob -> IO (Term S.Syntax (Record DefaultFields))
 treeSitterParser language blob = bracket TS.ts_document_new TS.ts_document_free $ \ document -> do
   TS.ts_document_set_language document language
   unsafeUseAsCStringLen (sourceBytes (blobSource blob)) $ \ (sourceBytes, len) -> do
@@ -71,13 +71,13 @@ anaM g = a where a = pure . embed <=< traverse a <=< g
 
 
 -- | Return a parser for a tree sitter language & document.
-documentToTerm :: Ptr TS.Language -> Ptr TS.Document -> Blob -> IO (SyntaxTerm DefaultFields)
+documentToTerm :: Ptr TS.Language -> Ptr TS.Document -> Blob -> IO (Term S.Syntax (Record DefaultFields))
 documentToTerm language document Blob{..} = do
   root <- alloca (\ rootPtr -> do
     TS.ts_document_root_node_p document rootPtr
     peek rootPtr)
   toTerm root
-  where toTerm :: TS.Node -> IO (SyntaxTerm DefaultFields)
+  where toTerm :: TS.Node -> IO (Term S.Syntax (Record DefaultFields))
         toTerm node@TS.Node{..} = do
           name <- peekCString nodeType
 
@@ -96,7 +96,7 @@ documentToTerm language document Blob{..} = do
         copyNamed = TS.ts_node_copy_named_child_nodes document
         copyAll = TS.ts_node_copy_child_nodes document
 
-isNonEmpty :: HasField fields Category => SyntaxTerm fields -> Bool
+isNonEmpty :: HasField fields Category => Term S.Syntax (Record fields) -> Bool
 isNonEmpty = (/= Empty) . category . extract
 
 nodeRange :: TS.Node -> Range
@@ -106,19 +106,19 @@ nodeSpan :: TS.Node -> Span
 nodeSpan TS.Node{..} = nodeStartPoint `seq` nodeEndPoint `seq` Span (pointPos nodeStartPoint) (pointPos nodeEndPoint)
   where pointPos TS.TSPoint{..} = pointRow `seq` pointColumn `seq` Pos (1 + fromIntegral pointRow) (1 + fromIntegral pointColumn)
 
-assignTerm :: Ptr TS.Language -> Source -> Record DefaultFields -> [ SyntaxTerm DefaultFields ] -> IO [ SyntaxTerm DefaultFields ] -> IO (SyntaxTerm DefaultFields)
+assignTerm :: Ptr TS.Language -> Source -> Record DefaultFields -> [ Term S.Syntax (Record DefaultFields) ] -> IO [ Term S.Syntax (Record DefaultFields) ] -> IO (Term S.Syntax (Record DefaultFields))
 assignTerm language source annotation children allChildren =
   case assignTermByLanguage source (category annotation) children of
     Just a -> pure (termIn annotation a)
     _ -> defaultTermAssignment source annotation children allChildren
-  where assignTermByLanguage :: Source -> Category -> [ SyntaxTerm DefaultFields ] -> Maybe (S.Syntax (SyntaxTerm DefaultFields))
+  where assignTermByLanguage :: Source -> Category -> [ Term S.Syntax (Record DefaultFields) ] -> Maybe (S.Syntax (Term S.Syntax (Record DefaultFields)))
         assignTermByLanguage = case languageForTSLanguage language of
           Just Language.Go -> Go.termAssignment
           Just Ruby -> Ruby.termAssignment
           Just TypeScript -> TS.termAssignment
           _ -> \ _ _ _ -> Nothing
 
-defaultTermAssignment :: Source -> Record DefaultFields -> [ SyntaxTerm DefaultFields ] -> IO [ SyntaxTerm DefaultFields ] -> IO (SyntaxTerm DefaultFields)
+defaultTermAssignment :: Source -> Record DefaultFields -> [ Term S.Syntax (Record DefaultFields) ] -> IO [ Term S.Syntax (Record DefaultFields) ] -> IO (Term S.Syntax (Record DefaultFields))
 defaultTermAssignment source annotation children allChildren
   | category annotation `elem` operatorCategories = Term . In annotation . S.Operator <$> allChildren
   | otherwise = case (category annotation, children) of
diff --git a/test/Data/RandomWalkSimilarity/Spec.hs b/test/Data/RandomWalkSimilarity/Spec.hs
index 9ef5003ac..d0b36bb5d 100644
--- a/test/Data/RandomWalkSimilarity/Spec.hs
+++ b/test/Data/RandomWalkSimilarity/Spec.hs
@@ -20,19 +20,19 @@ spec = parallel $ do
   let positively = succ . abs
   describe "pqGramDecorator" $ do
     prop "produces grams with stems of the specified length" $
-      \ (term, p, q) -> pqGramDecorator (rhead . termAnnotation) (positively p) (positively q) (term :: SyntaxTerm '[Category]) `shouldSatisfy` all ((== positively p) . length . stem . rhead)
+      \ (term, p, q) -> pqGramDecorator (rhead . termAnnotation) (positively p) (positively q) (term :: Term Syntax (Record '[Category])) `shouldSatisfy` all ((== positively p) . length . stem . rhead)
 
     prop "produces grams with bases of the specified width" $
-      \ (term, p, q) -> pqGramDecorator (rhead . termAnnotation) (positively p) (positively q) (term :: SyntaxTerm '[Category]) `shouldSatisfy` all ((== positively q) . length . base . rhead)
+      \ (term, p, q) -> pqGramDecorator (rhead . termAnnotation) (positively p) (positively q) (term :: Term Syntax (Record '[Category])) `shouldSatisfy` all ((== positively q) . length . base . rhead)
 
   describe "featureVectorDecorator" $ do
     prop "produces a vector of the specified dimension" $
-      \ (term, p, q, d) -> featureVectorDecorator (rhead . termAnnotation) (positively p) (positively q) (positively d) (term :: SyntaxTerm '[Category]) `shouldSatisfy` all ((== (0, abs d)) . bounds . rhead)
+      \ (term, p, q, d) -> featureVectorDecorator (rhead . termAnnotation) (positively p) (positively q) (positively d) (term :: Term Syntax (Record '[Category])) `shouldSatisfy` all ((== (0, abs d)) . bounds . rhead)
 
   describe "rws" $ do
     prop "produces correct diffs" $
-      \ (as, bs) -> let tas = decorate <$> (as :: [SyntaxTerm '[Category]])
-                        tbs = decorate <$> (bs :: [SyntaxTerm '[Category]])
+      \ (as, bs) -> let tas = decorate <$> (as :: [Term Syntax (Record '[Category])])
+                        tbs = decorate <$> (bs :: [Term Syntax (Record '[Category])])
                         root = termIn (Program :. Nil) . Indexed
                         diff = merge ((Program :. Nil, Program :. Nil)) (Indexed (stripDiff . diffThese <$> rws editDistance canCompare tas tbs)) in
         (beforeTerm diff, afterTerm diff) `shouldBe` (Just (root (stripTerm <$> tas)), Just (root (stripTerm <$> tbs)))
@@ -43,7 +43,7 @@ spec = parallel $ do
 
   where canCompare a b = termAnnotation a == termAnnotation b
 
-        decorate :: SyntaxTerm '[Category] -> SyntaxTerm '[FeatureVector, Category]
+        decorate :: Term Syntax (Record '[Category]) -> Term Syntax (Record '[FeatureVector, Category])
         decorate = defaultFeatureVectorDecorator (category . termAnnotation)
 
         diffThese = these deleting inserting replacing
diff --git a/test/DiffSpec.hs b/test/DiffSpec.hs
index 3bf1fbae7..f2f531666 100644
--- a/test/DiffSpec.hs
+++ b/test/DiffSpec.hs
@@ -4,10 +4,12 @@ module DiffSpec where
 import Category
 import Data.Functor.Both
 import Data.Functor.Listable ()
+import Data.Record
 import RWS
 import Diff
 import Info
 import Interpreter
+import Syntax
 import Term
 import Test.Hspec
 import Test.Hspec.LeanCheck
@@ -16,19 +18,19 @@ spec :: Spec
 spec = parallel $ do
   let decorate = defaultFeatureVectorDecorator (category . termAnnotation)
   prop "equality is reflexive" $
-    \ a -> let diff = a :: SyntaxDiff '[Category] in
+    \ a -> let diff = a :: Term Syntax (Record '[Category]) in
       diff `shouldBe` diff
 
   prop "equal terms produce identity diffs" $
-    \ a -> let term = decorate (a :: SyntaxTerm '[Category]) in
+    \ a -> let term = decorate (a :: Term Syntax (Record '[Category])) in
       diffCost (diffTerms (pure term)) `shouldBe` 0
 
   describe "beforeTerm" $ do
     prop "recovers the before term" $
-      \ a b -> let diff = diffTerms (both a b :: Both (SyntaxTerm '[Category])) in
+      \ a b -> let diff = diffTerms (both a b :: Both (Term Syntax (Record '[Category]))) in
         beforeTerm diff `shouldBe` Just a
 
   describe "afterTerm" $ do
     prop "recovers the after term" $
-      \ a b -> let diff = diffTerms (both a b :: Both (SyntaxTerm '[Category])) in
+      \ a b -> let diff = diffTerms (both a b :: Both (Term Syntax (Record '[Category]))) in
         afterTerm diff `shouldBe` Just b
diff --git a/test/InterpreterSpec.hs b/test/InterpreterSpec.hs
index 0dda6ef02..7ee205282 100644
--- a/test/InterpreterSpec.hs
+++ b/test/InterpreterSpec.hs
@@ -23,15 +23,15 @@ spec = parallel $ do
           diffTerms (both termA termB) `shouldBe` replacing termA termB
 
     prop "produces correct diffs" $
-      \ a b -> let diff = diffTerms (unListableF <$> both a b :: Both (SyntaxTerm '[Category])) in
+      \ a b -> let diff = diffTerms (unListableF <$> both a b :: Both (Term Syntax (Record '[Category]))) in
                    (beforeTerm diff, afterTerm diff) `shouldBe` (Just (unListableF a), Just (unListableF b))
 
     prop "constructs zero-cost diffs of equal terms" $
-      \ a -> let term = (unListableF a :: SyntaxTerm '[Category])
+      \ a -> let term = (unListableF a :: Term Syntax (Record '[Category]))
                  diff = diffTerms (pure term) in
                  diffCost diff `shouldBe` 0
 
     it "produces unbiased insertions within branches" $
-      let term s = Term ((StringLiteral :. Nil) `In` Indexed [ Term ((StringLiteral :. Nil) `In` Leaf s) ]) :: SyntaxTerm '[Category]
+      let term s = Term ((StringLiteral :. Nil) `In` Indexed [ Term ((StringLiteral :. Nil) `In` Leaf s) ]) :: Term Syntax (Record '[Category])
           root = termIn (Program :. Nil) . Indexed in
       diffTerms (both (root [ term "b" ]) (root [ term "a", term "b" ])) `shouldBe` merge ((Program :. Nil, Program :. Nil)) (Indexed [ inserting (term "a"), cata (\ (In a r) -> merge (a, a) r) (term "b") ])
diff --git a/test/TOCSpec.hs b/test/TOCSpec.hs
index d0ef8452f..98f47a0dd 100644
--- a/test/TOCSpec.hs
+++ b/test/TOCSpec.hs
@@ -160,8 +160,8 @@ spec = parallel $ do
       toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/markdown/headings.A.md -> test/fixtures/toc/markdown/headings.B.md\":[{\"span\":{\"start\":[5,1],\"end\":[7,10]},\"category\":\"Heading 2\",\"term\":\"Two\",\"changeType\":\"added\"},{\"span\":{\"start\":[9,1],\"end\":[10,4]},\"category\":\"Heading 1\",\"term\":\"Final\",\"changeType\":\"added\"}]},\"errors\":{}}\n" :: ByteString)
 
 
-type Diff' = SyntaxDiff (Maybe Declaration ': DefaultFields)
-type Term' = SyntaxTerm (Maybe Declaration ': DefaultFields)
+type Diff' = Diff Syntax (Record (Maybe Declaration ': DefaultFields))
+type Term' = Term Syntax (Record (Maybe Declaration ': DefaultFields))
 
 numTocSummaries :: Diff' -> Int
 numTocSummaries diff = length $ filter isValidSummary (diffTOC diff)
diff --git a/test/TermSpec.hs b/test/TermSpec.hs
index eb6376558..bf85527d8 100644
--- a/test/TermSpec.hs
+++ b/test/TermSpec.hs
@@ -3,6 +3,8 @@ module TermSpec where
 
 import Category
 import Data.Functor.Listable
+import Data.Record
+import Syntax
 import Term
 import Test.Hspec (Spec, describe, parallel)
 import Test.Hspec.Expectations.Pretty
@@ -12,4 +14,4 @@ spec :: Spec
 spec = parallel $ do
   describe "Term" $ do
     prop "equality is reflexive" $
-      \ a -> unListableF a `shouldBe` (unListableF a :: SyntaxTerm '[Category])
+      \ a -> unListableF a `shouldBe` (unListableF a :: Term Syntax (Record '[Category]))

From 8816a1b7056f289d2c70cdd9f65856e0b6e24da7 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 13 Sep 2017 19:18:38 -0400
Subject: [PATCH 04/65] Parameterize Algorithm by the annotation type.

---
 src/Algorithm.hs   | 46 +++++++++++++++++++++++-----------------------
 src/Data/Syntax.hs |  6 +++---
 src/Interpreter.hs |  6 +++---
 3 files changed, 29 insertions(+), 29 deletions(-)

diff --git a/src/Algorithm.hs b/src/Algorithm.hs
index 1b0313250..7af88df53 100644
--- a/src/Algorithm.hs
+++ b/src/Algorithm.hs
@@ -16,36 +16,36 @@ import GHC.Generics
 import Term
 
 -- | A single step in a diffing algorithm, parameterized by the types of terms, diffs, and the result of the applicable algorithm.
-data AlgorithmF term diff result where
+data AlgorithmF term diff ann result where
   -- | Diff two terms with the choice of algorithm left to the interpreter’s discretion.
-  Diff :: term ann -> term ann -> AlgorithmF term (diff ann) (diff ann)
+  Diff :: term ann -> term ann -> AlgorithmF term diff ann (diff ann)
   -- | Diff two terms recursively in O(n) time, resulting in a single diff node.
-  Linear :: term ann -> term ann -> AlgorithmF term (diff ann) (diff ann)
+  Linear :: term ann -> term ann -> AlgorithmF term diff ann (diff ann)
   -- | Diff two lists of terms by each element’s similarity in O(n³ log n), resulting in a list of diffs.
-  RWS :: [term ann] -> [term ann] -> AlgorithmF term (diff ann) [diff ann]
+  RWS :: [term ann] -> [term ann] -> AlgorithmF term diff ann [diff ann]
   -- | Delete a term..
-  Delete :: term ann -> AlgorithmF term (diff ann) (diff ann)
+  Delete :: term ann -> AlgorithmF term diff ann (diff ann)
   -- | Insert a term.
-  Insert :: term ann -> AlgorithmF term (diff ann) (diff ann)
+  Insert :: term ann -> AlgorithmF term diff ann (diff ann)
   -- | Replace one term with another.
-  Replace :: term ann -> term ann -> AlgorithmF term (diff ann) (diff ann)
+  Replace :: term ann -> term ann -> AlgorithmF term diff ann (diff ann)
 
 -- | The free applicative for 'AlgorithmF'. This enables us to construct diff values using <$> and <*> notation.
-type Algorithm term diff = Freer (AlgorithmF term diff)
+type Algorithm term diff ann = Freer (AlgorithmF term diff ann)
 
 
 -- DSL
 
 -- | Diff two terms without specifying the algorithm to be used.
-diff :: term ann -> term ann -> Algorithm term (diff ann) (diff ann)
+diff :: term ann -> term ann -> Algorithm term diff ann (diff ann)
 diff = (liftF .) . Algorithm.Diff
 
 -- | Diff a These of terms without specifying the algorithm to be used.
-diffThese :: These (term ann) (term ann) -> Algorithm term (diff ann) (diff ann)
+diffThese :: These (term ann) (term ann) -> Algorithm term diff ann (diff ann)
 diffThese = these byDeleting byInserting diff
 
 -- | Diff a pair of optional terms without specifying the algorithm to be used.
-diffMaybe :: Maybe (term ann) -> Maybe (term ann) -> Algorithm term (diff ann) (Maybe (diff ann))
+diffMaybe :: Maybe (term ann) -> Maybe (term ann) -> Algorithm term diff ann (Maybe (diff ann))
 diffMaybe a b = case (a, b) of
   (Just a, Just b) -> Just <$> diff a b
   (Just a, _) -> Just <$> byDeleting a
@@ -53,27 +53,27 @@ diffMaybe a b = case (a, b) of
   _ -> pure Nothing
 
 -- | Diff two terms linearly.
-linearly :: term ann -> term ann -> Algorithm term (diff ann) (diff ann)
+linearly :: term ann -> term ann -> Algorithm term diff ann (diff ann)
 linearly a b = liftF (Linear a b)
 
 -- | Diff two terms using RWS.
-byRWS :: [term ann] -> [term ann] -> Algorithm term (diff ann) [diff ann]
+byRWS :: [term ann] -> [term ann] -> Algorithm term diff ann [diff ann]
 byRWS a b = liftF (RWS a b)
 
 -- | Delete a term.
-byDeleting :: term ann -> Algorithm term (diff ann) (diff ann)
+byDeleting :: term ann -> Algorithm term diff ann (diff ann)
 byDeleting = liftF . Delete
 
 -- | Insert a term.
-byInserting :: term ann -> Algorithm term (diff ann) (diff ann)
+byInserting :: term ann -> Algorithm term diff ann (diff ann)
 byInserting = liftF . Insert
 
 -- | Replace one term with another.
-byReplacing :: term ann -> term ann -> Algorithm term (diff ann) (diff ann)
+byReplacing :: term ann -> term ann -> Algorithm term diff ann (diff ann)
 byReplacing = (liftF .) . Replace
 
 
-instance (Show1 term, Show ann) => Show1 (AlgorithmF term (diff ann)) where
+instance (Show1 term, Show ann) => Show1 (AlgorithmF term diff ann) where
   liftShowsPrec _ _ d algorithm = case algorithm of
     Algorithm.Diff t1 t2 -> showsBinaryWith showsTerm showsTerm "Diff" d t1 t2
     Linear t1 t2 -> showsBinaryWith showsTerm showsTerm "Linear" d t1 t2
@@ -87,20 +87,20 @@ instance (Show1 term, Show ann) => Show1 (AlgorithmF term (diff ann)) where
 
 -- | 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) (Diff f a) (Diff f a)
+algorithmForTerms :: (Functor f, Diffable f) => Term f a -> Term f a -> Algorithm (Term f) (Diff f) a (Diff f a)
 algorithmForTerms t1 t2 = fromMaybe (byReplacing t1 t2) (algorithmForComparableTerms t1 t2)
 
-algorithmForComparableTerms :: (Functor f, Diffable f) => Term f a -> Term f a -> Maybe (Algorithm (Term f) (Diff f a) (Diff f a))
+algorithmForComparableTerms :: (Functor f, Diffable f) => Term f a -> Term f a -> Maybe (Algorithm (Term f) (Diff f) a (Diff f a))
 algorithmForComparableTerms (Term (In ann1 f1)) (Term (In ann2 f2)) = fmap (merge (ann1, ann2)) <$> algorithmFor f1 f2
 
 
 -- | A type class for determining what algorithm to use for diffing two terms.
 class Diffable f where
-  algorithmFor :: f (term ann) -> f (term ann) -> Maybe (Algorithm term (diff ann) (f (diff ann)))
-  default algorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann) -> f (term ann) -> Maybe (Algorithm term (diff ann) (f (diff ann)))
+  algorithmFor :: f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann (f (diff ann)))
+  default algorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann (f (diff ann)))
   algorithmFor = genericAlgorithmFor
 
-genericAlgorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann) -> f (term ann) -> Maybe (Algorithm term (diff ann) (f (diff ann)))
+genericAlgorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann (f (diff ann)))
 genericAlgorithmFor a b = fmap to1 <$> algorithmFor' (from1 a) (from1 b)
 
 
@@ -117,7 +117,7 @@ instance Diffable [] where
 
 -- | A generic type class for diffing two terms defined by the Generic1 interface.
 class Diffable' f where
-  algorithmFor' :: f (term ann) -> f (term ann) -> Maybe (Algorithm term (diff ann) (f (diff ann)))
+  algorithmFor' :: f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann (f (diff ann)))
 
 -- | 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
diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs
index 63fe6ca6b..b47ca2bc7 100644
--- a/src/Data/Syntax.hs
+++ b/src/Data/Syntax.hs
@@ -161,19 +161,19 @@ instance Show1 Context where liftShowsPrec = genericLiftShowsPrec
 algorithmDeletingContext :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
                          => TermF Context a (Term (Union fs) a)
                          -> Term (Union fs) a
-                         -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs) a) (TermF Context a (Diff (Union fs) a)))
+                         -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a (TermF Context a (Diff (Union fs) a)))
 algorithmDeletingContext (In a1 (Context n1 s1)) s2 = fmap (In a1 . Context (deleting <$> n1)) <$> algorithmForComparableTerms s1 s2
 
 algorithmInsertingContext :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
                           => Term (Union fs) a
                           -> TermF Context a (Term (Union fs) a)
-                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs) a) (TermF Context a (Diff (Union fs) a)))
+                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a (TermF Context a (Diff (Union fs) a)))
 algorithmInsertingContext s1 (In a2 (Context n2 s2)) = fmap (In a2 . Context (inserting <$> n2)) <$> algorithmForComparableTerms s1 s2
 
 algorithmForContextUnions :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
                           => Term (Union fs) a
                           -> Term (Union fs) a
-                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs) a) (Diff (Union fs) a))
+                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a (Diff (Union fs) a))
 algorithmForContextUnions t1 t2
   | Just algo <- algorithmForComparableTerms t1 t2 = Just algo
   | Just c1@(In _ Context{}) <- prjTermF (unTerm t1) = fmap (deleteF . hoistTermF inj) <$> algorithmDeletingContext c1 t2
diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 3db72a897..2f0dfc7dc 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -40,12 +40,12 @@ decoratingWith getLabel differ = stripDiff . differ . fmap (defaultFeatureVector
 
 -- | Diff a pair of terms recurisvely, using the supplied continuation and 'ComparabilityRelation'.
 diffTermsWith :: forall f fields . (Traversable f, GAlign f, Eq1 f, HasField fields FeatureVector)
-              => (Term f (Record fields) -> Term f (Record fields) -> Algorithm (Term f) (Diff f (Record fields)) (Diff f (Record fields))) -- ^ A function producing syntax-directed continuations of the algorithm.
+              => (Term f (Record fields) -> Term f (Record fields) -> Algorithm (Term f) (Diff f) (Record fields) (Diff f (Record fields))) -- ^ A function producing syntax-directed continuations of the algorithm.
               -> ComparabilityRelation f fields -- ^ A relation on terms used to determine comparability and equality.
               -> Both (Term f (Record fields)) -- ^ A pair of terms.
               -> Diff f (Record fields) -- ^ The resulting diff.
 diffTermsWith refine comparable (Join (a, b)) = runFreer decompose (diff a b)
-  where decompose :: AlgorithmF (Term f) (Diff f (Record fields)) result -> Algorithm (Term f) (Diff f (Record fields)) result
+  where decompose :: AlgorithmF (Term f) (Diff f) (Record fields) result -> Algorithm (Term f) (Diff f) (Record fields) result
         decompose step = case step of
           Algorithm.Diff t1 t2 -> refine t1 t2
           Linear t1 t2 -> case galignWith diffThese (unwrap t1) (unwrap t2) of
@@ -66,7 +66,7 @@ getLabel (In h t) = (Info.category h, case t of
 -- | Construct an algorithm to diff a pair of terms.
 algorithmWithTerms :: Term Syntax (Record fields)
                    -> Term Syntax (Record fields)
-                   -> Algorithm (Term Syntax) (Diff Syntax (Record fields)) (Diff Syntax (Record fields))
+                   -> Algorithm (Term Syntax) (Diff Syntax) (Record fields) (Diff Syntax (Record fields))
 algorithmWithTerms t1 t2 = case (unwrap t1, unwrap t2) of
   (Indexed a, Indexed b) ->
     annotate . Indexed <$> byRWS a b

From bf2de994ac0fcc7bf9579a6f13d2ce8794ead66d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 13 Sep 2017 19:34:27 -0400
Subject: [PATCH 05/65] Curry diffing operations.

---
 src/Interpreter.hs      | 16 +++++++++-------
 src/Semantic.hs         | 16 ++++++++--------
 src/Semantic/Task.hs    | 10 +++++-----
 test/DiffSpec.hs        |  6 +++---
 test/InterpreterSpec.hs | 11 +++++------
 test/SemanticSpec.hs    |  4 ++--
 test/TOCSpec.hs         |  4 ++--
 7 files changed, 34 insertions(+), 33 deletions(-)

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 2f0dfc7dc..29de031b7 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -9,7 +9,6 @@ module Interpreter
 import Algorithm
 import Control.Monad.Free.Freer
 import Data.Align.Generic
-import Data.Functor.Both
 import Data.Functor.Foldable (cata)
 import Data.Functor.Classes (Eq1)
 import Data.Hashable (Hashable)
@@ -26,25 +25,28 @@ import Term
 
 -- | Diff two terms recursively, given functions characterizing the diffing.
 diffTerms :: HasField fields Category
-          => Both (Term Syntax (Record fields)) -- ^ A pair of terms representing the old and new state, respectively.
+          => Term Syntax (Record fields) -- ^ A term representing the old state.
+          -> Term Syntax (Record fields) -- ^ A term representing the new state.
           -> Diff Syntax (Record fields)
 diffTerms = decoratingWith getLabel (diffTermsWith algorithmWithTerms comparableByCategory)
 
 -- | Diff two terms by decorating with feature vectors computed using the supplied labelling algebra, and stripping the feature vectors from the resulting diff.
 decoratingWith :: (Hashable label, Traversable f)
                => (forall a. TermF f (Record fields) a -> label)
-               -> (Both (Term f (Record (FeatureVector ': fields))) -> Diff f (Record (FeatureVector ': fields)))
-               -> Both (Term f (Record fields))
+               -> (Term f (Record (FeatureVector ': fields)) -> Term f (Record (FeatureVector ': fields)) -> Diff f (Record (FeatureVector ': fields)))
+               -> Term f (Record fields)
+               -> Term f (Record fields)
                -> Diff f (Record fields)
-decoratingWith getLabel differ = stripDiff . differ . fmap (defaultFeatureVectorDecorator getLabel)
+decoratingWith getLabel differ t1 t2 = stripDiff (differ (defaultFeatureVectorDecorator getLabel t1) (defaultFeatureVectorDecorator getLabel t2))
 
 -- | Diff a pair of terms recurisvely, using the supplied continuation and 'ComparabilityRelation'.
 diffTermsWith :: forall f fields . (Traversable f, GAlign f, Eq1 f, HasField fields FeatureVector)
               => (Term f (Record fields) -> Term f (Record fields) -> Algorithm (Term f) (Diff f) (Record fields) (Diff f (Record fields))) -- ^ A function producing syntax-directed continuations of the algorithm.
               -> ComparabilityRelation f fields -- ^ A relation on terms used to determine comparability and equality.
-              -> Both (Term f (Record fields)) -- ^ A pair of terms.
+              -> Term f (Record fields) -- ^ A term representing the old state.
+              -> Term f (Record fields) -- ^ A term representing the new state.
               -> Diff f (Record fields) -- ^ The resulting diff.
-diffTermsWith refine comparable (Join (a, b)) = runFreer decompose (diff a b)
+diffTermsWith refine comparable t1 t2 = runFreer decompose (diff t1 t2)
   where decompose :: AlgorithmF (Term f) (Diff f) (Record fields) result -> Algorithm (Term f) (Diff f) (Record fields) result
         decompose step = case step of
           Algorithm.Diff t1 t2 -> refine t1 t2
diff --git a/src/Semantic.hs b/src/Semantic.hs
index 388a6ebee..b66115fb6 100644
--- a/src/Semantic.hs
+++ b/src/Semantic.hs
@@ -88,18 +88,18 @@ diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of
   where effectiveLanguage = runBothWith (<|>) (blobLanguage <$> blobs)
         syntaxParser = parserForLanguage effectiveLanguage
 
-        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
+        run :: Functor f => (Blob -> Task (Term f a)) -> (Term f a -> Term f a -> Diff f a) -> (Diff f a -> output) -> Task output
+        run parse diff renderer = distributeFor blobs parse >>= runBothWith (diffTermPair blobs diff) >>= render renderer
 
-        diffRecursively :: (Eq1 f, GAlign f, Show1 f, Traversable f, Diffable f) => Both (Term f (Record fields)) -> Diff f (Record fields)
+        diffRecursively :: (Eq1 f, GAlign f, Show1 f, Traversable f, Diffable f) => Term f (Record fields) -> Term f (Record fields) -> Diff f (Record fields)
         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)
-diffTermPair blobs differ terms = case runJoin (blobExists <$> blobs) of
-  (True, False) -> pure (deleting (Both.fst terms))
-  (False, True) -> pure (inserting (Both.snd terms))
-  _ -> time "diff" logInfo $ diff differ terms
+diffTermPair :: Functor f => Both Blob -> Differ f a -> Term f a -> Term f a -> Task (Diff f a)
+diffTermPair blobs differ t1 t2 = case runJoin (blobExists <$> blobs) of
+  (True, False) -> pure (deleting t1)
+  (False, True) -> pure (inserting t2)
+  _ -> time "diff" logInfo $ diff differ t1 t2
   where
     logInfo = let (a, b) = runJoin blobs in
             [ ("before_path", blobPath a)
diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs
index 538238c28..1ca726dcf 100644
--- a/src/Semantic/Task.hs
+++ b/src/Semantic/Task.hs
@@ -67,7 +67,7 @@ data TaskF output where
   Time :: String -> [(String, String)] -> Task output -> TaskF output
   Parse :: Parser term -> Blob -> TaskF term
   Decorate :: Functor f => RAlgebra (TermF f (Record fields)) (Term f (Record fields)) field -> Term f (Record fields) -> TaskF (Term f (Record (field ': fields)))
-  Diff :: Differ f a -> Both (Term f a) -> TaskF (Diff f a)
+  Diff :: Differ f a -> Term f a -> Term f a -> TaskF (Diff f a)
   Render :: Renderer input output -> input -> TaskF output
   Distribute :: Traversable t => t (Task output) -> TaskF (t output)
 
@@ -82,7 +82,7 @@ data TaskF output where
 type Task = Freer TaskF
 
 -- | A function to compute the 'Diff' for a pair of 'Term's with arbitrary syntax functor & annotation types.
-type Differ f a = Both (Term f a) -> Diff f a
+type Differ f a = Term f a -> Term f a -> Diff f a
 
 -- | A function to render terms or diffs.
 type Renderer i o = i -> o
@@ -117,8 +117,8 @@ decorate :: Functor f => RAlgebra (TermF f (Record fields)) (Term f (Record fiel
 decorate algebra term = Decorate algebra term `Then` return
 
 -- | A 'Task' which diffs a pair of terms using the supplied 'Differ' function.
-diff :: Differ f a -> Both (Term f a) -> Task (Diff f a)
-diff differ terms = Semantic.Task.Diff differ terms `Then` return
+diff :: Differ f a -> Term f a -> Term f a -> Task (Diff f a)
+diff differ term1 term2 = Semantic.Task.Diff differ term1 term2 `Then` return
 
 -- | A 'Task' which renders some input using the supplied 'Renderer' function.
 render :: Renderer input output -> input -> Task output
@@ -182,7 +182,7 @@ runTaskWithOptions options task = do
                     either (pure . Left) yield res
                   Parse parser blob -> go (runParser options blob parser) >>= either (pure . Left) yield
                   Decorate algebra term -> pure (decoratorWithAlgebra algebra term) >>= yield
-                  Semantic.Task.Diff differ terms -> pure (differ terms) >>= yield
+                  Semantic.Task.Diff differ term1 term2 -> pure (differ term1 term2) >>= yield
                   Render renderer input -> pure (renderer input) >>= yield
                   Distribute tasks -> Async.mapConcurrently go tasks >>= either (pure . Left) yield . sequenceA . withStrategy (parTraversable (parTraversable rseq))
                   LiftIO action -> action >>= yield
diff --git a/test/DiffSpec.hs b/test/DiffSpec.hs
index f2f531666..03330a681 100644
--- a/test/DiffSpec.hs
+++ b/test/DiffSpec.hs
@@ -23,14 +23,14 @@ spec = parallel $ do
 
   prop "equal terms produce identity diffs" $
     \ a -> let term = decorate (a :: Term Syntax (Record '[Category])) in
-      diffCost (diffTerms (pure term)) `shouldBe` 0
+      diffCost (diffTerms term term) `shouldBe` 0
 
   describe "beforeTerm" $ do
     prop "recovers the before term" $
-      \ a b -> let diff = diffTerms (both a b :: Both (Term Syntax (Record '[Category]))) in
+      \ a b -> let diff = diffTerms a b :: Diff Syntax (Record '[Category]) in
         beforeTerm diff `shouldBe` Just a
 
   describe "afterTerm" $ do
     prop "recovers the after term" $
-      \ a b -> let diff = diffTerms (both a b :: Both (Term Syntax (Record '[Category]))) in
+      \ a b -> let diff = diffTerms a b :: Diff Syntax (Record '[Category]) in
         afterTerm diff `shouldBe` Just b
diff --git a/test/InterpreterSpec.hs b/test/InterpreterSpec.hs
index 7ee205282..32d0827a2 100644
--- a/test/InterpreterSpec.hs
+++ b/test/InterpreterSpec.hs
@@ -20,18 +20,17 @@ spec = parallel $ do
     it "returns a replacement when comparing two unicode equivalent terms" $
       let termA = Term $ (StringLiteral :. Nil) `In` Leaf "t\776"
           termB = Term $ (StringLiteral :. Nil) `In` Leaf "\7831" in
-          diffTerms (both termA termB) `shouldBe` replacing termA termB
+          diffTerms termA termB `shouldBe` replacing termA termB
 
     prop "produces correct diffs" $
-      \ a b -> let diff = diffTerms (unListableF <$> both a b :: Both (Term Syntax (Record '[Category]))) in
-                   (beforeTerm diff, afterTerm diff) `shouldBe` (Just (unListableF a), Just (unListableF b))
+      \ a b -> let diff = diffTerms a b :: Diff Syntax (Record '[Category]) in
+                   (beforeTerm diff, afterTerm diff) `shouldBe` (Just a, Just b)
 
     prop "constructs zero-cost diffs of equal terms" $
-      \ a -> let term = (unListableF a :: Term Syntax (Record '[Category]))
-                 diff = diffTerms (pure term) in
+      \ a -> let diff = diffTerms a a :: Diff Syntax (Record '[Category]) in
                  diffCost diff `shouldBe` 0
 
     it "produces unbiased insertions within branches" $
       let term s = Term ((StringLiteral :. Nil) `In` Indexed [ Term ((StringLiteral :. Nil) `In` Leaf s) ]) :: Term Syntax (Record '[Category])
           root = termIn (Program :. Nil) . Indexed in
-      diffTerms (both (root [ term "b" ]) (root [ term "a", term "b" ])) `shouldBe` merge ((Program :. Nil, Program :. Nil)) (Indexed [ inserting (term "a"), cata (\ (In a r) -> merge (a, a) r) (term "b") ])
+      diffTerms (root [ term "b" ]) (root [ term "a", term "b" ]) `shouldBe` merge ((Program :. Nil, Program :. Nil)) (Indexed [ inserting (term "a"), cata (\ (In a r) -> merge (a, a) r) (term "b") ])
diff --git a/test/SemanticSpec.hs b/test/SemanticSpec.hs
index 74166f726..456db2a1e 100644
--- a/test/SemanticSpec.hs
+++ b/test/SemanticSpec.hs
@@ -31,11 +31,11 @@ spec = parallel $ do
 
   describe "diffTermPair" $ do
     it "produces an Insert when the first blob is missing" $ do
-      result <- runTask (diffTermPair (both (emptyBlob "/foo") (sourceBlob "/foo" Nothing "")) (runBothWith replacing) (pure (termIn () [])))
+      result <- runTask (diffTermPair (both (emptyBlob "/foo") (sourceBlob "/foo" Nothing "")) replacing (termIn () []) (termIn () []))
       result `shouldBe` Diff (Patch (Insert (In () [])))
 
     it "produces a Delete when the second blob is missing" $ do
-      result <- runTask (diffTermPair (both (sourceBlob "/foo" Nothing "") (emptyBlob "/foo")) (runBothWith replacing) (pure (termIn () [])))
+      result <- runTask (diffTermPair (both (sourceBlob "/foo" Nothing "") (emptyBlob "/foo")) replacing (termIn () []) (termIn () []))
       result `shouldBe` Diff (Patch (Delete (In () [])))
 
   where
diff --git a/test/TOCSpec.hs b/test/TOCSpec.hs
index 98f47a0dd..bcf460478 100644
--- a/test/TOCSpec.hs
+++ b/test/TOCSpec.hs
@@ -47,7 +47,7 @@ spec = parallel $ do
       \ diff -> let diff' = (diff :: Diff Syntax ()) in entryPayload <$> tableOfContentsBy (const (Just ())) diff' `shouldBe` replicate (diffSize diff') ()
 
     prop "produces an unchanged entry for identity diffs" $
-      \ term -> let term' = (term :: Term Syntax (Record '[Category])) in tableOfContentsBy (Just . termAnnotation) (diffTerms (pure term')) `shouldBe` [Unchanged (lastValue term')]
+      \ term -> tableOfContentsBy (Just . termAnnotation) (diffTerms term term) `shouldBe` [Unchanged (lastValue (term :: Term Syntax (Record '[Category])))]
 
     prop "produces inserted/deleted/replaced entries for relevant nodes within patches" $
       \ patch -> let patch' = (patch :: Patch (Term Syntax Int)) in tableOfContentsBy (Just . termAnnotation) (these deleting inserting replacing (unPatch patch')) `shouldBe` these (fmap Deleted) (fmap Inserted) (const (fmap Replaced)) (unPatch (foldMap pure <$> patch'))
@@ -132,7 +132,7 @@ spec = parallel $ do
 
     prop "equal terms produce identity diffs" $
       \a -> let term = defaultFeatureVectorDecorator (Info.category . termAnnotation) (a :: Term') in
-        diffTOC (diffTerms (pure term)) `shouldBe` []
+        diffTOC (diffTerms term term) `shouldBe` []
 
   describe "JSONSummary" $ do
     it "encodes modified summaries to JSON" $ do

From 42b83b0e6d8be2023132e87254d684e367913eb4 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 13 Sep 2017 20:42:02 -0400
Subject: [PATCH 06/65] Add a second annotation type parameter to Algorithm.

---
 src/Algorithm.hs   | 46 +++++++++++++++++++++++-----------------------
 src/Data/Syntax.hs |  6 +++---
 src/Interpreter.hs |  6 +++---
 3 files changed, 29 insertions(+), 29 deletions(-)

diff --git a/src/Algorithm.hs b/src/Algorithm.hs
index 7af88df53..83f44515b 100644
--- a/src/Algorithm.hs
+++ b/src/Algorithm.hs
@@ -16,36 +16,36 @@ import GHC.Generics
 import Term
 
 -- | A single step in a diffing algorithm, parameterized by the types of terms, diffs, and the result of the applicable algorithm.
-data AlgorithmF term diff ann result where
+data AlgorithmF term diff ann1 ann2 result where
   -- | Diff two terms with the choice of algorithm left to the interpreter’s discretion.
-  Diff :: term ann -> term ann -> AlgorithmF term diff ann (diff ann)
+  Diff :: term ann -> term ann -> AlgorithmF term diff ann ann (diff ann)
   -- | Diff two terms recursively in O(n) time, resulting in a single diff node.
-  Linear :: term ann -> term ann -> AlgorithmF term diff ann (diff ann)
+  Linear :: term ann -> term ann -> AlgorithmF term diff ann ann (diff ann)
   -- | Diff two lists of terms by each element’s similarity in O(n³ log n), resulting in a list of diffs.
-  RWS :: [term ann] -> [term ann] -> AlgorithmF term diff ann [diff ann]
+  RWS :: [term ann] -> [term ann] -> AlgorithmF term diff ann ann [diff ann]
   -- | Delete a term..
-  Delete :: term ann -> AlgorithmF term diff ann (diff ann)
+  Delete :: term ann -> AlgorithmF term diff ann ann (diff ann)
   -- | Insert a term.
-  Insert :: term ann -> AlgorithmF term diff ann (diff ann)
+  Insert :: term ann -> AlgorithmF term diff ann ann (diff ann)
   -- | Replace one term with another.
-  Replace :: term ann -> term ann -> AlgorithmF term diff ann (diff ann)
+  Replace :: term ann -> term ann -> AlgorithmF term diff ann ann (diff ann)
 
 -- | The free applicative for 'AlgorithmF'. This enables us to construct diff values using <$> and <*> notation.
-type Algorithm term diff ann = Freer (AlgorithmF term diff ann)
+type Algorithm term diff ann1 ann2 = Freer (AlgorithmF term diff ann1 ann2)
 
 
 -- DSL
 
 -- | Diff two terms without specifying the algorithm to be used.
-diff :: term ann -> term ann -> Algorithm term diff ann (diff ann)
+diff :: term ann -> term ann -> Algorithm term diff ann ann (diff ann)
 diff = (liftF .) . Algorithm.Diff
 
 -- | Diff a These of terms without specifying the algorithm to be used.
-diffThese :: These (term ann) (term ann) -> Algorithm term diff ann (diff ann)
+diffThese :: These (term ann) (term ann) -> Algorithm term diff ann ann (diff ann)
 diffThese = these byDeleting byInserting diff
 
 -- | Diff a pair of optional terms without specifying the algorithm to be used.
-diffMaybe :: Maybe (term ann) -> Maybe (term ann) -> Algorithm term diff ann (Maybe (diff ann))
+diffMaybe :: Maybe (term ann) -> Maybe (term ann) -> Algorithm term diff ann ann (Maybe (diff ann))
 diffMaybe a b = case (a, b) of
   (Just a, Just b) -> Just <$> diff a b
   (Just a, _) -> Just <$> byDeleting a
@@ -53,27 +53,27 @@ diffMaybe a b = case (a, b) of
   _ -> pure Nothing
 
 -- | Diff two terms linearly.
-linearly :: term ann -> term ann -> Algorithm term diff ann (diff ann)
+linearly :: term ann -> term ann -> Algorithm term diff ann ann (diff ann)
 linearly a b = liftF (Linear a b)
 
 -- | Diff two terms using RWS.
-byRWS :: [term ann] -> [term ann] -> Algorithm term diff ann [diff ann]
+byRWS :: [term ann] -> [term ann] -> Algorithm term diff ann ann [diff ann]
 byRWS a b = liftF (RWS a b)
 
 -- | Delete a term.
-byDeleting :: term ann -> Algorithm term diff ann (diff ann)
+byDeleting :: term ann -> Algorithm term diff ann ann (diff ann)
 byDeleting = liftF . Delete
 
 -- | Insert a term.
-byInserting :: term ann -> Algorithm term diff ann (diff ann)
+byInserting :: term ann -> Algorithm term diff ann ann (diff ann)
 byInserting = liftF . Insert
 
 -- | Replace one term with another.
-byReplacing :: term ann -> term ann -> Algorithm term diff ann (diff ann)
+byReplacing :: term ann -> term ann -> Algorithm term diff ann ann (diff ann)
 byReplacing = (liftF .) . Replace
 
 
-instance (Show1 term, Show ann) => Show1 (AlgorithmF term diff ann) where
+instance (Show1 term, Show ann) => Show1 (AlgorithmF term diff ann ann) where
   liftShowsPrec _ _ d algorithm = case algorithm of
     Algorithm.Diff t1 t2 -> showsBinaryWith showsTerm showsTerm "Diff" d t1 t2
     Linear t1 t2 -> showsBinaryWith showsTerm showsTerm "Linear" d t1 t2
@@ -87,20 +87,20 @@ instance (Show1 term, Show ann) => Show1 (AlgorithmF term diff ann) where
 
 -- | 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) (Diff f) a (Diff f a)
+algorithmForTerms :: (Functor f, Diffable f) => Term f a -> Term f a -> Algorithm (Term f) (Diff f) a a (Diff f a)
 algorithmForTerms t1 t2 = fromMaybe (byReplacing t1 t2) (algorithmForComparableTerms t1 t2)
 
-algorithmForComparableTerms :: (Functor f, Diffable f) => Term f a -> Term f a -> Maybe (Algorithm (Term f) (Diff f) a (Diff f a))
+algorithmForComparableTerms :: (Functor f, Diffable f) => Term f a -> Term f a -> Maybe (Algorithm (Term f) (Diff f) a a (Diff f a))
 algorithmForComparableTerms (Term (In ann1 f1)) (Term (In ann2 f2)) = fmap (merge (ann1, ann2)) <$> algorithmFor f1 f2
 
 
 -- | A type class for determining what algorithm to use for diffing two terms.
 class Diffable f where
-  algorithmFor :: f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann (f (diff ann)))
-  default algorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann (f (diff ann)))
+  algorithmFor :: f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann ann (f (diff ann)))
+  default algorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann ann (f (diff ann)))
   algorithmFor = genericAlgorithmFor
 
-genericAlgorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann (f (diff ann)))
+genericAlgorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann ann (f (diff ann)))
 genericAlgorithmFor a b = fmap to1 <$> algorithmFor' (from1 a) (from1 b)
 
 
@@ -117,7 +117,7 @@ instance Diffable [] where
 
 -- | A generic type class for diffing two terms defined by the Generic1 interface.
 class Diffable' f where
-  algorithmFor' :: f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann (f (diff ann)))
+  algorithmFor' :: f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann ann (f (diff ann)))
 
 -- | 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
diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs
index b47ca2bc7..06daa3584 100644
--- a/src/Data/Syntax.hs
+++ b/src/Data/Syntax.hs
@@ -161,19 +161,19 @@ instance Show1 Context where liftShowsPrec = genericLiftShowsPrec
 algorithmDeletingContext :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
                          => TermF Context a (Term (Union fs) a)
                          -> Term (Union fs) a
-                         -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a (TermF Context a (Diff (Union fs) a)))
+                         -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a a (TermF Context a (Diff (Union fs) a)))
 algorithmDeletingContext (In a1 (Context n1 s1)) s2 = fmap (In a1 . Context (deleting <$> n1)) <$> algorithmForComparableTerms s1 s2
 
 algorithmInsertingContext :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
                           => Term (Union fs) a
                           -> TermF Context a (Term (Union fs) a)
-                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a (TermF Context a (Diff (Union fs) a)))
+                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a a (TermF Context a (Diff (Union fs) a)))
 algorithmInsertingContext s1 (In a2 (Context n2 s2)) = fmap (In a2 . Context (inserting <$> n2)) <$> algorithmForComparableTerms s1 s2
 
 algorithmForContextUnions :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
                           => Term (Union fs) a
                           -> Term (Union fs) a
-                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a (Diff (Union fs) a))
+                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a a (Diff (Union fs) a))
 algorithmForContextUnions t1 t2
   | Just algo <- algorithmForComparableTerms t1 t2 = Just algo
   | Just c1@(In _ Context{}) <- prjTermF (unTerm t1) = fmap (deleteF . hoistTermF inj) <$> algorithmDeletingContext c1 t2
diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 29de031b7..32b459612 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -41,13 +41,13 @@ decoratingWith getLabel differ t1 t2 = stripDiff (differ (defaultFeatureVectorDe
 
 -- | Diff a pair of terms recurisvely, using the supplied continuation and 'ComparabilityRelation'.
 diffTermsWith :: forall f fields . (Traversable f, GAlign f, Eq1 f, HasField fields FeatureVector)
-              => (Term f (Record fields) -> Term f (Record fields) -> Algorithm (Term f) (Diff f) (Record fields) (Diff f (Record fields))) -- ^ A function producing syntax-directed continuations of the algorithm.
+              => (Term f (Record fields) -> Term f (Record fields) -> Algorithm (Term f) (Diff f) (Record fields) (Record fields) (Diff f (Record fields))) -- ^ A function producing syntax-directed continuations of the algorithm.
               -> ComparabilityRelation f fields -- ^ A relation on terms used to determine comparability and equality.
               -> Term f (Record fields) -- ^ A term representing the old state.
               -> Term f (Record fields) -- ^ A term representing the new state.
               -> Diff f (Record fields) -- ^ The resulting diff.
 diffTermsWith refine comparable t1 t2 = runFreer decompose (diff t1 t2)
-  where decompose :: AlgorithmF (Term f) (Diff f) (Record fields) result -> Algorithm (Term f) (Diff f) (Record fields) result
+  where decompose :: AlgorithmF (Term f) (Diff f) (Record fields) (Record fields) result -> Algorithm (Term f) (Diff f) (Record fields) (Record fields) result
         decompose step = case step of
           Algorithm.Diff t1 t2 -> refine t1 t2
           Linear t1 t2 -> case galignWith diffThese (unwrap t1) (unwrap t2) of
@@ -68,7 +68,7 @@ getLabel (In h t) = (Info.category h, case t of
 -- | Construct an algorithm to diff a pair of terms.
 algorithmWithTerms :: Term Syntax (Record fields)
                    -> Term Syntax (Record fields)
-                   -> Algorithm (Term Syntax) (Diff Syntax) (Record fields) (Diff Syntax (Record fields))
+                   -> Algorithm (Term Syntax) (Diff Syntax) (Record fields) (Record fields) (Diff Syntax (Record fields))
 algorithmWithTerms t1 t2 = case (unwrap t1, unwrap t2) of
   (Indexed a, Indexed b) ->
     annotate . Indexed <$> byRWS a b

From f6f61d4b3acba6ec49f6bb07c3c0d3afc5ab2ebb Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 13 Sep 2017 21:36:59 -0400
Subject: [PATCH 07/65] :fire: mapPatch.

---
 src/Patch.hs | 6 ------
 1 file changed, 6 deletions(-)

diff --git a/src/Patch.hs b/src/Patch.hs
index 85479601f..96ea642cd 100644
--- a/src/Patch.hs
+++ b/src/Patch.hs
@@ -7,7 +7,6 @@ module Patch
 , unPatch
 , maybeFst
 , maybeSnd
-, mapPatch
 ) where
 
 import Data.Aeson
@@ -40,11 +39,6 @@ unPatch (Replace a b) = These a b
 unPatch (Insert b) = That b
 unPatch (Delete a) = This a
 
-mapPatch :: (a -> b) -> (a -> b) -> Patch a -> Patch b
-mapPatch f _ (Delete  a  ) = Delete  (f a)
-mapPatch _ g (Insert    b) = Insert  (g b)
-mapPatch f g (Replace a b) = Replace (f a) (g b)
-
 -- | Return Just the value in This, or the first value in These, if any.
 maybeFst :: These a b -> Maybe a
 maybeFst = these Just (const Nothing) ((Just .) . const)

From cf9d752d43ef78460af4e408781e7aa432a041a2 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 13 Sep 2017 21:37:23 -0400
Subject: [PATCH 08/65] Parameterize Patch by before and after types.

---
 src/Alignment.hs              |  2 +-
 src/Diff.hs                   | 37 +++++++++++++---------
 src/Patch.hs                  | 59 +++++++++++++++++++++++++----------
 src/Renderer/TOC.hs           |  4 +--
 test/Data/Functor/Listable.hs | 10 +++---
 test/TOCSpec.hs               |  5 ++-
 6 files changed, 78 insertions(+), 39 deletions(-)

diff --git a/src/Alignment.hs b/src/Alignment.hs
index c98b3844d..4e9f6253a 100644
--- a/src/Alignment.hs
+++ b/src/Alignment.hs
@@ -52,7 +52,7 @@ alignDiff sources = cata $ \ diff -> case diff of
   Merge (In (ann1, ann2) syntax) -> alignSyntax (runBothWith ((Join .) . These)) wrap getRange sources (In (both ann1 ann2) syntax)
 
 -- | Align the contents of a patch into a list of lines on the corresponding side(s) of the diff.
-alignPatch :: forall fields f. (Traversable f, HasField fields Range) => Both Source -> Patch (TermF f (Record fields) [Join These (SplitDiff [] (Record fields))]) -> [Join These (SplitDiff [] (Record fields))]
+alignPatch :: forall fields f. (Traversable f, HasField fields Range) => Both Source -> Patch (TermF f (Record fields) [Join These (SplitDiff [] (Record fields))]) (TermF f (Record fields) [Join These (SplitDiff [] (Record fields))]) -> [Join These (SplitDiff [] (Record fields))]
 alignPatch sources patch = case patch of
   Delete term -> fmap (pure . SplitDelete) <$> alignSyntax' this (fst sources) term
   Insert term -> fmap (pure . SplitInsert) <$> alignSyntax' that (snd sources) term
diff --git a/src/Diff.hs b/src/Diff.hs
index 9bc1d2976..a72c0750e 100644
--- a/src/Diff.hs
+++ b/src/Diff.hs
@@ -21,10 +21,10 @@ newtype Diff syntax ann = Diff { unDiff :: DiffF syntax ann (Diff syntax ann) }
 -- | A single entry within a recursive 'Diff'.
 data DiffF syntax ann recur
   -- | A changed node, represented as 'Insert'ed, 'Delete'd, or 'Replace'd 'TermF's, consisting of syntax labelled with an annotation.
-  = Patch (Patch (TermF syntax       ann  recur))
+  = Patch (Patch (TermF syntax       ann  recur)
+                 (TermF syntax       ann  recur))
   -- | An unchanged node, consisting of syntax labelled with both the original annotations.
   | Merge        (TermF syntax (ann, ann) recur)
-  deriving (Foldable, Functor, Traversable)
 
 -- | Constructs a 'Diff' replacing one 'Term' with another recursively.
 replacing :: Functor syntax => Term syntax ann -> Term syntax ann -> Diff syntax ann
@@ -51,7 +51,7 @@ merge :: (ann, ann) -> syntax (Diff syntax ann) -> Diff syntax ann
 merge = (Diff .) . (Merge .) . In
 
 
-diffSum :: (Foldable syntax, Functor syntax) => (forall a. Patch a -> Int) -> Diff syntax ann -> Int
+diffSum :: (Foldable syntax, Functor syntax) => (forall a b. Patch a b -> Int) -> Diff syntax ann -> Int
 diffSum patchCost = cata $ \ diff -> case diff of
   Patch patch -> patchCost patch + sum (sum <$> patch)
   Merge merge -> sum merge
@@ -61,15 +61,15 @@ diffCost :: (Foldable syntax, Functor syntax) => Diff syntax ann -> Int
 diffCost = diffSum (const 1)
 
 
-diffPatch :: Diff syntax ann -> Maybe (Patch (TermF syntax ann (Diff syntax ann)))
+diffPatch :: Diff syntax ann -> Maybe (Patch (TermF syntax ann (Diff syntax ann)) (TermF syntax ann (Diff syntax ann)))
 diffPatch diff = case unDiff diff of
   Patch patch -> Just patch
   _ -> Nothing
 
-diffPatches :: (Foldable syntax, Functor syntax) => Diff syntax ann -> [Patch (TermF syntax ann (Diff syntax ann))]
+diffPatches :: (Foldable syntax, Functor syntax) => Diff syntax ann -> [Patch (TermF syntax ann (Diff syntax ann)) (TermF syntax ann (Diff syntax ann))]
 diffPatches = para $ \ diff -> case diff of
-  Patch patch -> fmap (fmap fst) patch : foldMap (foldMap (toList . diffPatch . fst)) patch
-  Merge merge ->                                  foldMap (toList . diffPatch . fst)  merge
+  Patch patch -> bimap (fmap fst) (fmap fst) patch : foldMap (foldMap (toList . diffPatch . fst)) patch
+  Merge merge ->                                              foldMap (toList . diffPatch . fst)  merge
 
 
 -- | Merge a diff using a function to provide the Term (in Maybe, to simplify recovery of the before/after state) for every Patch.
@@ -110,7 +110,7 @@ instance (Eq1 f, Eq a) => Eq (Diff f a) where
 
 instance Eq1 f => Eq2 (DiffF f) where
   liftEq2 eqA eqB d1 d2 = case (d1, d2) of
-    (Patch p1, Patch p2) -> liftEq (liftEq2 eqA eqB) p1 p2
+    (Patch p1, Patch p2) -> liftEq2 (liftEq2 eqA eqB) (liftEq2 eqA eqB) p1 p2
     (Merge t1, Merge t2) -> liftEq2 (liftEq2 eqA eqA) eqB t1 t2
     _ -> False
 
@@ -129,7 +129,7 @@ instance (Show1 f, Show a) => Show (Diff f a) where
 
 instance Show1 f => Show2 (DiffF f) where
   liftShowsPrec2 spA slA spB slB d diff = case diff of
-    Patch patch -> showsUnaryWith (liftShowsPrec (liftShowsPrec2 spA slA spB slB) (liftShowList2 spA slA spB slB)) "Patch" d patch
+    Patch patch -> showsUnaryWith (liftShowsPrec2 (liftShowsPrec2 spA slA spB slB) (liftShowList2 spA slA spB slB) (liftShowsPrec2 spA slA spB slB) (liftShowList2 spA slA spB slB)) "Patch" d patch
     Merge term  -> showsUnaryWith (liftShowsPrec2 spBoth slBoth spB slB) "Merge" d term
     where spBoth = liftShowsPrec2 spA slA spA slA
           slBoth = liftShowList2 spA slA spA slA
@@ -151,16 +151,25 @@ instance Traversable f => Traversable (Diff f) where
   traverse f = go where go = fmap Diff . bitraverse f go . unDiff
 
 
+instance Functor syntax => Functor (DiffF syntax ann) where
+  fmap = second
+
 instance Functor syntax => Bifunctor (DiffF syntax) where
-  bimap f g (Patch patch) = Patch (bimap f g <$> patch)
+  bimap f g (Patch patch) = Patch (bimap (bimap f g) (bimap f g) patch)
   bimap f g (Merge term)  = Merge (bimap (bimap f f) g term)
 
-instance Foldable f => Bifoldable (DiffF f) where
-  bifoldMap f g (Patch patch) = foldMap (bifoldMap f g) patch
+instance Foldable syntax => Foldable (DiffF syntax ann) where
+  foldMap = bifoldMap (const mempty)
+
+instance Foldable syntax => Bifoldable (DiffF syntax) where
+  bifoldMap f g (Patch patch) = bifoldMap (bifoldMap f g) (bifoldMap f g) patch
   bifoldMap f g (Merge term)  = bifoldMap (bifoldMap f f) g term
 
-instance Traversable f => Bitraversable (DiffF f) where
-  bitraverse f g (Patch patch) = Patch <$> traverse (bitraverse f g) patch
+instance Traversable syntax => Traversable (DiffF syntax ann) where
+  traverse = bitraverse pure
+
+instance Traversable syntax => Bitraversable (DiffF syntax) where
+  bitraverse f g (Patch patch) = Patch <$> bitraverse (bitraverse f g) (bitraverse f g) patch
   bitraverse f g (Merge term)  = Merge <$> bitraverse (bitraverse f f) g term
 
 
diff --git a/src/Patch.hs b/src/Patch.hs
index 96ea642cd..771ebf2f3 100644
--- a/src/Patch.hs
+++ b/src/Patch.hs
@@ -11,30 +11,32 @@ module Patch
 
 import Data.Aeson
 import Data.Align
-import Data.Functor.Classes.Eq.Generic
-import Data.Functor.Classes.Show.Generic
+import Data.Bifoldable
+import Data.Bifunctor
+import Data.Bitraversable
+import Data.Functor.Classes
 import Data.JSON.Fields
 import Data.These
 import GHC.Generics
 
 -- | An operation to replace, insert, or delete an item.
-data Patch a
-  = Replace a a
-  | Insert a
-  | Delete a
+data Patch a b
+  = Delete a
+  | Insert b
+  | Replace a b
   deriving (Eq, Foldable, Functor, Generic, Generic1, Ord, Show, Traversable)
 
 
 -- | Return the item from the after side of the patch.
-after :: Patch a -> Maybe a
+after :: Patch before after -> Maybe after
 after = maybeSnd . unPatch
 
 -- | Return the item from the before side of the patch.
-before :: Patch a -> Maybe a
+before :: Patch before after -> Maybe before
 before = maybeFst . unPatch
 
 -- | Return both sides of a patch.
-unPatch :: Patch a -> These a a
+unPatch :: Patch before after -> These before after
 unPatch (Replace a b) = These a b
 unPatch (Insert b) = That b
 unPatch (Delete a) = This a
@@ -50,16 +52,41 @@ maybeSnd = these (const Nothing) Just ((Just .) . flip const)
 
 -- Instances
 
-instance Crosswalk Patch where
-  crosswalk f (Replace a b) = alignWith (these Delete Insert Replace) (f a) (f b)
-  crosswalk f (Insert b) = Insert <$> f b
-  crosswalk f (Delete a) = Delete <$> f a
+instance Bifunctor Patch where
+  bimap f _ (Delete a) = Delete (f a)
+  bimap _ g (Insert b) = Insert (g b)
+  bimap f g (Replace a b) = Replace (f a) (g b)
 
-instance Eq1 Patch where liftEq = genericLiftEq
-instance Show1 Patch where liftShowsPrec = genericLiftShowsPrec
+instance Bifoldable Patch where
+  bifoldMap f _ (Delete a) = f a
+  bifoldMap _ g (Insert b) = g b
+  bifoldMap f g (Replace a b) = f a `mappend` g b
+
+instance Bitraversable Patch where
+  bitraverse f _ (Delete a) = Delete <$> f a
+  bitraverse _ g (Insert b) = Insert <$> g b
+  bitraverse f g (Replace a b) = Replace <$> f a <*> g b
+
+instance Bicrosswalk Patch where
+  bicrosswalk f _ (Delete a) = Delete <$> f a
+  bicrosswalk _ g (Insert b) = Insert <$> g b
+  bicrosswalk f g (Replace a b) = alignWith (these Delete Insert Replace) (f a) (g b)
+
+instance Eq2 Patch where
+  liftEq2 eqBefore eqAfter p1 p2 = case (p1, p2) of
+    (Delete a1, Delete a2) -> eqBefore a1 a2
+    (Insert b1, Insert b2) -> eqAfter b1 b2
+    (Replace a1 b1, Replace a2 b2) -> eqBefore a1 a2 && eqAfter b1 b2
+    _ -> False
+
+instance Show2 Patch where
+  liftShowsPrec2 spBefore _ spAfter _ d p = case p of
+    Delete a -> showsUnaryWith spBefore "Delete" d a
+    Insert b -> showsUnaryWith spAfter "Insert" d b
+    Replace a b -> showsBinaryWith spBefore spAfter "Replace" d a b
 
 
-instance ToJSONFields a => ToJSONFields (Patch a) where
+instance (ToJSONFields a, ToJSONFields b) => ToJSONFields (Patch a b) where
   toJSONFields (Insert a)    = [ "insert" .= object (toJSONFields a) ]
   toJSONFields (Delete a)    = [ "delete" .= object (toJSONFields a) ]
   toJSONFields (Replace a b) = [ "replace" .= [object (toJSONFields a), object (toJSONFields b)] ]
diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs
index 4fea7f57f..73eb255b5 100644
--- a/src/Renderer/TOC.hs
+++ b/src/Renderer/TOC.hs
@@ -18,7 +18,7 @@ module Renderer.TOC
 ) where
 
 import Data.Aeson
-import Data.Align (crosswalk)
+import Data.Align (bicrosswalk)
 import Data.Bifunctor (bimap)
 import Data.Blob
 import Data.ByteString.Lazy (toStrict)
@@ -150,7 +150,7 @@ tableOfContentsBy :: (Foldable f, Functor f)
                   -> Diff f annotation                           -- ^ The diff to compute the table of contents for.
                   -> [Entry a]                                   -- ^ A list of entries for relevant changed and unchanged nodes in the diff.
 tableOfContentsBy selector = fromMaybe [] . cata (\ r -> case r of
-  Patch patch -> (pure . patchEntry <$> crosswalk selector patch) <> foldMap fold patch <> Just []
+  Patch patch -> (pure . patchEntry <$> bicrosswalk selector selector patch) <> foldMap fold patch <> Just []
   Merge (In (_, ann2) r) -> case (selector (In ann2 r), fold r) of
     (Just a, Nothing) -> Just [Unchanged a]
     (Just a, Just []) -> Just [Changed a]
diff --git a/test/Data/Functor/Listable.hs b/test/Data/Functor/Listable.hs
index 62c775544..70b769e5f 100644
--- a/test/Data/Functor/Listable.hs
+++ b/test/Data/Functor/Listable.hs
@@ -167,7 +167,7 @@ instance (Listable1 f, Listable a) => Listable (Term f a) where
 
 instance Listable1 f => Listable2 (DiffF f) where
   liftTiers2 annTiers recurTiers
-    =  liftCons1 (liftTiers (liftTiers2 annTiers recurTiers)) Patch
+    =  liftCons1 (liftTiers2 (liftTiers2 annTiers recurTiers) (liftTiers2 annTiers recurTiers)) Patch
     \/ liftCons1 (liftTiers2 (liftTiers2 annTiers annTiers) recurTiers) Merge
 
 instance (Listable1 f, Listable a) => Listable1 (DiffF f a) where
@@ -211,11 +211,11 @@ instance Listable Category.Category where
        \/ cons0 Category.SingletonMethod
 
 
-instance Listable1 Patch where
-  liftTiers t = liftCons1 t Insert \/ liftCons1 t Delete \/ liftCons2 t t Replace
+instance Listable2 Patch where
+  liftTiers2 t1 t2 = liftCons1 t2 Insert \/ liftCons1 t1 Delete \/ liftCons2 t1 t2 Replace
 
-instance Listable a => Listable (Patch a) where
-  tiers = tiers1
+instance (Listable a, Listable b) => Listable (Patch a b) where
+  tiers = tiers2
 
 
 instance Listable1 Syntax where
diff --git a/test/TOCSpec.hs b/test/TOCSpec.hs
index bcf460478..656f8a525 100644
--- a/test/TOCSpec.hs
+++ b/test/TOCSpec.hs
@@ -4,6 +4,7 @@ module TOCSpec where
 
 import Category as C
 import Data.Aeson
+import Data.Bifunctor
 import Data.Blob
 import Data.ByteString (ByteString)
 import Data.Functor.Both
@@ -50,7 +51,9 @@ spec = parallel $ do
       \ term -> tableOfContentsBy (Just . termAnnotation) (diffTerms term term) `shouldBe` [Unchanged (lastValue (term :: Term Syntax (Record '[Category])))]
 
     prop "produces inserted/deleted/replaced entries for relevant nodes within patches" $
-      \ patch -> let patch' = (patch :: Patch (Term Syntax Int)) in tableOfContentsBy (Just . termAnnotation) (these deleting inserting replacing (unPatch patch')) `shouldBe` these (fmap Deleted) (fmap Inserted) (const (fmap Replaced)) (unPatch (foldMap pure <$> patch'))
+      \ patch -> tableOfContentsBy (Just . termAnnotation) (these deleting inserting replacing (unPatch patch))
+      `shouldBe`
+      these (fmap Deleted) (fmap Inserted) (const (fmap Replaced)) (unPatch (bimap (foldMap pure) (foldMap pure) (patch :: Patch (Term Syntax Int) (Term Syntax Int))))
 
     prop "produces changed entries for relevant nodes containing irrelevant patches" $
       \ diff -> let diff' = merge (0, 0) (Indexed [1 <$ (diff :: Diff Syntax Int)]) in

From 547da73009b14ad65d7a68d5a1d719720b51fd33 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 13 Sep 2017 21:55:41 -0400
Subject: [PATCH 09/65] Define a patch helper to eliminate Patches.

---
 src/Patch.hs          | 24 +++++++-----------------
 src/Renderer/Patch.hs |  4 +++-
 src/Renderer/TOC.hs   |  2 +-
 test/TOCSpec.hs       |  4 ++--
 4 files changed, 13 insertions(+), 21 deletions(-)

diff --git a/src/Patch.hs b/src/Patch.hs
index 771ebf2f3..ef55c4250 100644
--- a/src/Patch.hs
+++ b/src/Patch.hs
@@ -4,9 +4,7 @@ module Patch
 ( Patch(..)
 , after
 , before
-, unPatch
-, maybeFst
-, maybeSnd
+, patch
 ) where
 
 import Data.Aeson
@@ -29,25 +27,17 @@ data Patch a b
 
 -- | Return the item from the after side of the patch.
 after :: Patch before after -> Maybe after
-after = maybeSnd . unPatch
+after = patch (const Nothing) Just (\ _ b -> Just b)
 
 -- | Return the item from the before side of the patch.
 before :: Patch before after -> Maybe before
-before = maybeFst . unPatch
+before = patch Just (const Nothing) (\ a _ -> Just a)
 
 -- | Return both sides of a patch.
-unPatch :: Patch before after -> These before after
-unPatch (Replace a b) = These a b
-unPatch (Insert b) = That b
-unPatch (Delete a) = This a
-
--- | Return Just the value in This, or the first value in These, if any.
-maybeFst :: These a b -> Maybe a
-maybeFst = these Just (const Nothing) ((Just .) . const)
-
--- | Return Just the value in That, or the second value in These, if any.
-maybeSnd :: These a b -> Maybe b
-maybeSnd = these (const Nothing) Just ((Just .) . flip const)
+patch :: (before -> result) -> (after -> result) -> (before -> after -> result) -> Patch before after -> result
+patch ifDelete _ _ (Delete a) = ifDelete a
+patch _ ifInsert _ (Insert b) = ifInsert b
+patch _ _ ifReplace (Replace a b) = ifReplace a b
 
 
 -- Instances
diff --git a/src/Renderer/Patch.hs b/src/Renderer/Patch.hs
index f5d52f348..7fcfe14a0 100644
--- a/src/Renderer/Patch.hs
+++ b/src/Renderer/Patch.hs
@@ -23,7 +23,6 @@ import Data.Semigroup ((<>))
 import Data.Source
 import Data.These
 import Diff
-import Patch
 import Prelude hiding (fst, snd)
 import SplitDiff
 
@@ -181,3 +180,6 @@ changeIncludingContext leadingContext rows = case changes of
 -- | Whether a row has changes on either side.
 rowHasChanges :: (Foldable f, Functor f) => Join These (SplitDiff f annotation) -> Bool
 rowHasChanges row = or (hasChanges <$> row)
+
+maybeSnd :: These a b -> Maybe b
+maybeSnd = these (const Nothing) Just (\ _ a -> Just a)
diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs
index 73eb255b5..cd26ba93d 100644
--- a/src/Renderer/TOC.hs
+++ b/src/Renderer/TOC.hs
@@ -156,7 +156,7 @@ tableOfContentsBy selector = fromMaybe [] . cata (\ r -> case r of
     (Just a, Just []) -> Just [Changed a]
     (_     , entries) -> entries)
 
-  where patchEntry = these Deleted Inserted (const Replaced) . unPatch
+  where patchEntry = patch Deleted Inserted (const Replaced)
 
 termTableOfContentsBy :: (Foldable f, Functor f)
                       => (forall b. TermF f annotation b -> Maybe a)
diff --git a/test/TOCSpec.hs b/test/TOCSpec.hs
index 656f8a525..94a623fcb 100644
--- a/test/TOCSpec.hs
+++ b/test/TOCSpec.hs
@@ -51,9 +51,9 @@ spec = parallel $ do
       \ term -> tableOfContentsBy (Just . termAnnotation) (diffTerms term term) `shouldBe` [Unchanged (lastValue (term :: Term Syntax (Record '[Category])))]
 
     prop "produces inserted/deleted/replaced entries for relevant nodes within patches" $
-      \ patch -> tableOfContentsBy (Just . termAnnotation) (these deleting inserting replacing (unPatch patch))
+      \ p -> tableOfContentsBy (Just . termAnnotation) (patch deleting inserting replacing p)
       `shouldBe`
-      these (fmap Deleted) (fmap Inserted) (const (fmap Replaced)) (unPatch (bimap (foldMap pure) (foldMap pure) (patch :: Patch (Term Syntax Int) (Term Syntax Int))))
+      patch (fmap Deleted) (fmap Inserted) (const (fmap Replaced)) (bimap (foldMap pure) (foldMap pure) (p :: Patch (Term Syntax Int) (Term Syntax Int)))
 
     prop "produces changed entries for relevant nodes containing irrelevant patches" $
       \ diff -> let diff' = merge (0, 0) (Indexed [1 <$ (diff :: Diff Syntax Int)]) in

From b20ec9dddf8ea8cc9d0e6d2495fa299b8f723140 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 13 Sep 2017 22:14:02 -0400
Subject: [PATCH 10/65] Reformat a couple of type signatures.

---
 src/Algorithm.hs | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/src/Algorithm.hs b/src/Algorithm.hs
index 83f44515b..a31c80db8 100644
--- a/src/Algorithm.hs
+++ b/src/Algorithm.hs
@@ -87,10 +87,16 @@ instance (Show1 term, Show ann) => Show1 (AlgorithmF term diff ann ann) where
 
 -- | 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) (Diff f) a a (Diff f a)
+algorithmForTerms :: (Functor syntax, Diffable syntax)
+                  => Term syntax ann
+                  -> Term syntax ann
+                  -> Algorithm (Term syntax) (Diff syntax) ann ann (Diff syntax ann)
 algorithmForTerms t1 t2 = fromMaybe (byReplacing t1 t2) (algorithmForComparableTerms t1 t2)
 
-algorithmForComparableTerms :: (Functor f, Diffable f) => Term f a -> Term f a -> Maybe (Algorithm (Term f) (Diff f) a a (Diff f a))
+algorithmForComparableTerms :: (Functor syntax, Diffable syntax)
+                            => Term syntax ann
+                            -> Term syntax ann
+                            -> Maybe (Algorithm (Term syntax) (Diff syntax) ann ann (Diff syntax ann))
 algorithmForComparableTerms (Term (In ann1 f1)) (Term (In ann2 f2)) = fmap (merge (ann1, ann2)) <$> algorithmFor f1 f2
 
 

From bfc0b9d0b04be47d6a37344b6886bbd7859ebd95 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 09:41:52 -0400
Subject: [PATCH 11/65] Give Diff a pair of type parameters for the annotation
 types.

---
 src/Algorithm.hs              |  54 +++++------
 src/Alignment.hs              |   2 +-
 src/Data/Syntax.hs            |   6 +-
 src/Diff.hs                   | 177 +++++++++++++++++++---------------
 src/Interpreter.hs            |  12 +--
 src/Renderer.hs               |   2 +-
 src/Renderer/Patch.hs         |   4 +-
 src/Renderer/SExpression.hs   |   8 +-
 src/Renderer/TOC.hs           |  11 +--
 src/Semantic.hs               |  15 +--
 src/Semantic/Task.hs          |   6 +-
 test/AlignmentSpec.hs         |   2 +-
 test/Data/Functor/Listable.hs |  30 +++---
 test/DiffSpec.hs              |   7 +-
 test/InterpreterSpec.hs       |   4 +-
 test/TOCSpec.hs               |   8 +-
 16 files changed, 187 insertions(+), 161 deletions(-)

diff --git a/src/Algorithm.hs b/src/Algorithm.hs
index a31c80db8..0a17048a7 100644
--- a/src/Algorithm.hs
+++ b/src/Algorithm.hs
@@ -18,17 +18,17 @@ import Term
 -- | A single step in a diffing algorithm, parameterized by the types of terms, diffs, and the result of the applicable algorithm.
 data AlgorithmF term diff ann1 ann2 result where
   -- | Diff two terms with the choice of algorithm left to the interpreter’s discretion.
-  Diff :: term ann -> term ann -> AlgorithmF term diff ann ann (diff ann)
+  Diff :: term ann1 -> term ann2 -> AlgorithmF term diff ann1 ann2 (diff ann1 ann2)
   -- | Diff two terms recursively in O(n) time, resulting in a single diff node.
-  Linear :: term ann -> term ann -> AlgorithmF term diff ann ann (diff ann)
+  Linear :: term ann1 -> term ann2 -> AlgorithmF term diff ann1 ann2 (diff ann1 ann2)
   -- | Diff two lists of terms by each element’s similarity in O(n³ log n), resulting in a list of diffs.
-  RWS :: [term ann] -> [term ann] -> AlgorithmF term diff ann ann [diff ann]
+  RWS :: [term ann1] -> [term ann2] -> AlgorithmF term diff ann1 ann2 [diff ann1 ann2]
   -- | Delete a term..
-  Delete :: term ann -> AlgorithmF term diff ann ann (diff ann)
+  Delete :: term ann1 -> AlgorithmF term diff ann1 ann2 (diff ann1 ann2)
   -- | Insert a term.
-  Insert :: term ann -> AlgorithmF term diff ann ann (diff ann)
+  Insert :: term ann2 -> AlgorithmF term diff ann1 ann2 (diff ann1 ann2)
   -- | Replace one term with another.
-  Replace :: term ann -> term ann -> AlgorithmF term diff ann ann (diff ann)
+  Replace :: term ann1 -> term ann2 -> AlgorithmF term diff ann1 ann2 (diff ann1 ann2)
 
 -- | The free applicative for 'AlgorithmF'. This enables us to construct diff values using <$> and <*> notation.
 type Algorithm term diff ann1 ann2 = Freer (AlgorithmF term diff ann1 ann2)
@@ -37,15 +37,15 @@ type Algorithm term diff ann1 ann2 = Freer (AlgorithmF term diff ann1 ann2)
 -- DSL
 
 -- | Diff two terms without specifying the algorithm to be used.
-diff :: term ann -> term ann -> Algorithm term diff ann ann (diff ann)
+diff :: term ann1 -> term ann2 -> Algorithm term diff ann1 ann2 (diff ann1 ann2)
 diff = (liftF .) . Algorithm.Diff
 
 -- | Diff a These of terms without specifying the algorithm to be used.
-diffThese :: These (term ann) (term ann) -> Algorithm term diff ann ann (diff ann)
+diffThese :: These (term ann1) (term ann2) -> Algorithm term diff ann1 ann2 (diff ann1 ann2)
 diffThese = these byDeleting byInserting diff
 
 -- | Diff a pair of optional terms without specifying the algorithm to be used.
-diffMaybe :: Maybe (term ann) -> Maybe (term ann) -> Algorithm term diff ann ann (Maybe (diff ann))
+diffMaybe :: Maybe (term ann1) -> Maybe (term ann2) -> Algorithm term diff ann1 ann2 (Maybe (diff ann1 ann2))
 diffMaybe a b = case (a, b) of
   (Just a, Just b) -> Just <$> diff a b
   (Just a, _) -> Just <$> byDeleting a
@@ -53,27 +53,27 @@ diffMaybe a b = case (a, b) of
   _ -> pure Nothing
 
 -- | Diff two terms linearly.
-linearly :: term ann -> term ann -> Algorithm term diff ann ann (diff ann)
+linearly :: term ann1 -> term ann2 -> Algorithm term diff ann1 ann2 (diff ann1 ann2)
 linearly a b = liftF (Linear a b)
 
 -- | Diff two terms using RWS.
-byRWS :: [term ann] -> [term ann] -> Algorithm term diff ann ann [diff ann]
+byRWS :: [term ann1] -> [term ann2] -> Algorithm term diff ann1 ann2 [diff ann1 ann2]
 byRWS a b = liftF (RWS a b)
 
 -- | Delete a term.
-byDeleting :: term ann -> Algorithm term diff ann ann (diff ann)
+byDeleting :: term ann1 -> Algorithm term diff ann1 ann2 (diff ann1 ann2)
 byDeleting = liftF . Delete
 
 -- | Insert a term.
-byInserting :: term ann -> Algorithm term diff ann ann (diff ann)
+byInserting :: term ann2 -> Algorithm term diff ann1 ann2 (diff ann1 ann2)
 byInserting = liftF . Insert
 
 -- | Replace one term with another.
-byReplacing :: term ann -> term ann -> Algorithm term diff ann ann (diff ann)
+byReplacing :: term ann1 -> term ann2 -> Algorithm term diff ann1 ann2 (diff ann1 ann2)
 byReplacing = (liftF .) . Replace
 
 
-instance (Show1 term, Show ann) => Show1 (AlgorithmF term diff ann ann) where
+instance (Show1 term, Show ann1, Show ann2) => Show1 (AlgorithmF term diff ann1 ann2) where
   liftShowsPrec _ _ d algorithm = case algorithm of
     Algorithm.Diff t1 t2 -> showsBinaryWith showsTerm showsTerm "Diff" d t1 t2
     Linear t1 t2 -> showsBinaryWith showsTerm showsTerm "Linear" d t1 t2
@@ -81,32 +81,32 @@ instance (Show1 term, Show ann) => Show1 (AlgorithmF term diff ann ann) where
     Delete t1 -> showsUnaryWith showsTerm "Delete" d t1
     Insert t2 -> showsUnaryWith showsTerm "Insert" d t2
     Replace t1 t2 -> showsBinaryWith showsTerm showsTerm "Replace" d t1 t2
-    where showsTerm :: Int -> term ann -> ShowS
+    where showsTerm :: Show ann => Int -> term ann -> ShowS
           showsTerm = liftShowsPrec showsPrec showList
 
 
 -- | 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 syntax, Diffable syntax)
-                  => Term syntax ann
-                  -> Term syntax ann
-                  -> Algorithm (Term syntax) (Diff syntax) ann ann (Diff syntax ann)
+                  => Term syntax ann1
+                  -> Term syntax ann2
+                  -> Algorithm (Term syntax) (Diff syntax) ann1 ann2 (Diff syntax ann1 ann2)
 algorithmForTerms t1 t2 = fromMaybe (byReplacing t1 t2) (algorithmForComparableTerms t1 t2)
 
 algorithmForComparableTerms :: (Functor syntax, Diffable syntax)
-                            => Term syntax ann
-                            -> Term syntax ann
-                            -> Maybe (Algorithm (Term syntax) (Diff syntax) ann ann (Diff syntax ann))
+                            => Term syntax ann1
+                            -> Term syntax ann2
+                            -> Maybe (Algorithm (Term syntax) (Diff syntax) ann1 ann2 (Diff syntax ann1 ann2))
 algorithmForComparableTerms (Term (In ann1 f1)) (Term (In ann2 f2)) = fmap (merge (ann1, ann2)) <$> algorithmFor f1 f2
 
 
 -- | A type class for determining what algorithm to use for diffing two terms.
 class Diffable f where
-  algorithmFor :: f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann ann (f (diff ann)))
-  default algorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann ann (f (diff ann)))
+  algorithmFor :: f (term ann1) -> f (term ann2) -> Maybe (Algorithm term diff ann1 ann2 (f (diff ann1 ann2)))
+  default algorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann1) -> f (term ann2) -> Maybe (Algorithm term diff ann1 ann2 (f (diff ann1 ann2)))
   algorithmFor = genericAlgorithmFor
 
-genericAlgorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann ann (f (diff ann)))
+genericAlgorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann1) -> f (term ann2) -> Maybe (Algorithm term diff ann1 ann2 (f (diff ann1 ann2)))
 genericAlgorithmFor a b = fmap to1 <$> algorithmFor' (from1 a) (from1 b)
 
 
@@ -123,7 +123,7 @@ instance Diffable [] where
 
 -- | A generic type class for diffing two terms defined by the Generic1 interface.
 class Diffable' f where
-  algorithmFor' :: f (term ann) -> f (term ann) -> Maybe (Algorithm term diff ann ann (f (diff ann)))
+  algorithmFor' :: f (term ann1) -> f (term ann2) -> Maybe (Algorithm term diff ann1 ann2 (f (diff ann1 ann2)))
 
 -- | 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
@@ -158,7 +158,7 @@ instance Diffable' U1 where
 
 -- | Diff two lists of parameters.
 instance Diffable' (Rec1 []) where
-  algorithmFor' a b = fmap Rec1 <$> Just ((byRWS `on` unRec1) a b)
+  algorithmFor' a b = Just (Rec1 <$> byRWS (unRec1 a) (unRec1 b))
 
 -- | Diff two non-empty lists of parameters.
 instance Diffable' (Rec1 NonEmpty) where
diff --git a/src/Alignment.hs b/src/Alignment.hs
index 4e9f6253a..18e6cf342 100644
--- a/src/Alignment.hs
+++ b/src/Alignment.hs
@@ -46,7 +46,7 @@ hasChanges :: (Foldable f, Functor f) => SplitDiff f annotation -> Bool
 hasChanges = or . (True <$)
 
 -- | Align a Diff into a list of Join These SplitDiffs representing the (possibly blank) lines on either side.
-alignDiff :: (HasField fields Range, Traversable f) => Both Source -> Diff f (Record fields) -> [Join These (SplitDiff [] (Record fields))]
+alignDiff :: (HasField fields Range, Traversable f) => Both Source -> Diff f (Record fields) (Record fields) -> [Join These (SplitDiff [] (Record fields))]
 alignDiff sources = cata $ \ diff -> case diff of
   Patch patch                    -> alignPatch sources patch
   Merge (In (ann1, ann2) syntax) -> alignSyntax (runBothWith ((Join .) . These)) wrap getRange sources (In (both ann1 ann2) syntax)
diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs
index 06daa3584..b096d6d29 100644
--- a/src/Data/Syntax.hs
+++ b/src/Data/Syntax.hs
@@ -161,19 +161,19 @@ instance Show1 Context where liftShowsPrec = genericLiftShowsPrec
 algorithmDeletingContext :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
                          => TermF Context a (Term (Union fs) a)
                          -> Term (Union fs) a
-                         -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a a (TermF Context a (Diff (Union fs) a)))
+                         -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a a (TermF Context a (Diff (Union fs) a a)))
 algorithmDeletingContext (In a1 (Context n1 s1)) s2 = fmap (In a1 . Context (deleting <$> n1)) <$> algorithmForComparableTerms s1 s2
 
 algorithmInsertingContext :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
                           => Term (Union fs) a
                           -> TermF Context a (Term (Union fs) a)
-                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a a (TermF Context a (Diff (Union fs) a)))
+                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a a (TermF Context a (Diff (Union fs) a a)))
 algorithmInsertingContext s1 (In a2 (Context n2 s2)) = fmap (In a2 . Context (inserting <$> n2)) <$> algorithmForComparableTerms s1 s2
 
 algorithmForContextUnions :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
                           => Term (Union fs) a
                           -> Term (Union fs) a
-                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a a (Diff (Union fs) a))
+                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a a (Diff (Union fs) a a))
 algorithmForContextUnions t1 t2
   | Just algo <- algorithmForComparableTerms t1 t2 = Just algo
   | Just c1@(In _ Context{}) <- prjTermF (unTerm t1) = fmap (deleteF . hoistTermF inj) <$> algorithmDeletingContext c1 t2
diff --git a/src/Diff.hs b/src/Diff.hs
index a72c0750e..2512f42cf 100644
--- a/src/Diff.hs
+++ b/src/Diff.hs
@@ -16,177 +16,200 @@ import Term
 import Text.Show
 
 -- | A recursive structure indicating the changed & unchanged portions of a labelled tree.
-newtype Diff syntax ann = Diff { unDiff :: DiffF syntax ann (Diff syntax ann) }
+newtype Diff syntax ann1 ann2 = Diff { unDiff :: DiffF syntax ann1 ann2 (Diff syntax ann1 ann2) }
 
 -- | A single entry within a recursive 'Diff'.
-data DiffF syntax ann recur
+data DiffF syntax ann1 ann2 recur
   -- | A changed node, represented as 'Insert'ed, 'Delete'd, or 'Replace'd 'TermF's, consisting of syntax labelled with an annotation.
-  = Patch (Patch (TermF syntax       ann  recur)
-                 (TermF syntax       ann  recur))
+  = Patch (Patch (TermF syntax  ann1        recur)
+                 (TermF syntax        ann2  recur))
   -- | An unchanged node, consisting of syntax labelled with both the original annotations.
-  | Merge        (TermF syntax (ann, ann) recur)
+  | Merge        (TermF syntax (ann1, ann2) recur)
 
 -- | Constructs a 'Diff' replacing one 'Term' with another recursively.
-replacing :: Functor syntax => Term syntax ann -> Term syntax ann -> Diff syntax ann
+replacing :: Functor syntax => Term syntax ann1 -> Term syntax ann2 -> Diff syntax ann1 ann2
 replacing (Term (In a1 r1)) (Term (In a2 r2)) = Diff (Patch (Replace (In a1 (deleting <$> r1)) (In a2 (inserting <$> r2))))
 
 -- | Constructs a 'Diff' inserting a 'Term' recursively.
-inserting :: Functor syntax => Term syntax ann -> Diff syntax ann
+inserting :: Functor syntax => Term syntax ann2 -> Diff syntax ann1 ann2
 inserting = cata insertF
 
 -- | Constructs a 'Diff' inserting a single 'TermF' populated by further 'Diff's.
-insertF :: TermF syntax ann (Diff syntax ann) -> Diff syntax ann
+insertF :: TermF syntax ann2 (Diff syntax ann1 ann2) -> Diff syntax ann1 ann2
 insertF = Diff . Patch . Insert
 
 -- | Constructs a 'Diff' deleting a 'Term' recursively.
-deleting :: Functor syntax => Term syntax ann -> Diff syntax ann
+deleting :: Functor syntax => Term syntax ann1 -> Diff syntax ann1 ann2
 deleting = cata deleteF
 
 -- | Constructs a 'Diff' deleting a single 'TermF' populated by further 'Diff's.
-deleteF :: TermF syntax ann (Diff syntax ann) -> Diff syntax ann
+deleteF :: TermF syntax ann1 (Diff syntax ann1 ann2) -> Diff syntax ann1 ann2
 deleteF = Diff . Patch . Delete
 
 -- | Constructs a 'Diff' merging two annotations for a single syntax functor populated by further 'Diff's.
-merge :: (ann, ann) -> syntax (Diff syntax ann) -> Diff syntax ann
+merge :: (ann1, ann2) -> syntax (Diff syntax ann1 ann2) -> Diff syntax ann1 ann2
 merge = (Diff .) . (Merge .) . In
 
 
-diffSum :: (Foldable syntax, Functor syntax) => (forall a b. Patch a b -> Int) -> Diff syntax ann -> Int
+diffSum :: (Foldable syntax, Functor syntax) => (forall a b. Patch a b -> Int) -> Diff syntax ann1 ann2 -> Int
 diffSum patchCost = cata $ \ diff -> case diff of
   Patch patch -> patchCost patch + sum (sum <$> patch)
   Merge merge -> sum merge
 
 -- | The sum of the node count of the diff’s patches.
-diffCost :: (Foldable syntax, Functor syntax) => Diff syntax ann -> Int
+diffCost :: (Foldable syntax, Functor syntax) => Diff syntax ann1 ann2 -> Int
 diffCost = diffSum (const 1)
 
 
-diffPatch :: Diff syntax ann -> Maybe (Patch (TermF syntax ann (Diff syntax ann)) (TermF syntax ann (Diff syntax ann)))
+diffPatch :: Diff syntax ann1 ann2 -> Maybe (Patch (TermF syntax ann1 (Diff syntax ann1 ann2)) (TermF syntax ann2 (Diff syntax ann1 ann2)))
 diffPatch diff = case unDiff diff of
   Patch patch -> Just patch
   _ -> Nothing
 
-diffPatches :: (Foldable syntax, Functor syntax) => Diff syntax ann -> [Patch (TermF syntax ann (Diff syntax ann)) (TermF syntax ann (Diff syntax ann))]
+diffPatches :: (Foldable syntax, Functor syntax) => Diff syntax ann1 ann2 -> [Patch (TermF syntax ann1 (Diff syntax ann1 ann2)) (TermF syntax ann2 (Diff syntax ann1 ann2))]
 diffPatches = para $ \ diff -> case diff of
   Patch patch -> bimap (fmap fst) (fmap fst) patch : foldMap (foldMap (toList . diffPatch . fst)) patch
   Merge merge ->                                              foldMap (toList . diffPatch . fst)  merge
 
 
 -- | Merge a diff using a function to provide the Term (in Maybe, to simplify recovery of the before/after state) for every Patch.
-mergeMaybe :: (Mergeable syntax, Traversable syntax) => (DiffF syntax ann (Maybe (Term syntax ann)) -> Maybe (Term syntax ann)) -> Diff syntax ann -> Maybe (Term syntax ann)
+mergeMaybe :: (Mergeable syntax, Traversable syntax) => (DiffF syntax ann1 ann2 (Maybe (Term syntax combined)) -> Maybe (Term syntax combined)) -> Diff syntax ann1 ann2 -> Maybe (Term syntax combined)
 mergeMaybe = cata
 
 -- | Recover the before state of a diff.
-beforeTerm :: (Mergeable syntax, Traversable syntax) => Diff syntax ann -> Maybe (Term syntax ann)
+beforeTerm :: (Mergeable syntax, Traversable syntax) => Diff syntax ann1 ann2 -> Maybe (Term syntax ann1)
 beforeTerm = mergeMaybe $ \ diff -> case diff of
   Patch patch -> before patch >>= \ (In a l) -> termIn a <$> sequenceAlt l
   Merge  (In (a, _) l) -> termIn a <$> sequenceAlt l
 
 -- | Recover the after state of a diff.
-afterTerm :: (Mergeable syntax, Traversable syntax) => Diff syntax ann -> Maybe (Term syntax ann)
+afterTerm :: (Mergeable syntax, Traversable syntax) => Diff syntax ann1 ann2 -> Maybe (Term syntax ann2)
 afterTerm = mergeMaybe $ \ diff -> case diff of
   Patch patch -> after patch >>= \ (In b r) -> termIn b <$> sequenceAlt r
   Merge  (In (_, b) r) -> termIn b <$> sequenceAlt r
 
 
 -- | Strips the head annotation off a diff annotated with non-empty records.
-stripDiff :: Functor f
-          => Diff f (Record (h ': t))
-          -> Diff f (Record t)
-stripDiff = fmap rtail
+stripDiff :: Functor syntax
+          => Diff syntax (Record (h1 ': t1)) (Record (h2 ': t2))
+          -> Diff syntax (Record        t1)  (Record        t2)
+stripDiff = bimap rtail rtail
 
 
-type instance Base (Diff syntax ann) = DiffF syntax ann
+type instance Base (Diff syntax ann1 ann2) = DiffF syntax ann1 ann2
 
-instance Functor syntax => Recursive   (Diff syntax ann) where project = unDiff
-instance Functor syntax => Corecursive (Diff syntax ann) where embed = Diff
+instance Functor syntax => Recursive   (Diff syntax ann1 ann2) where project = unDiff
+instance Functor syntax => Corecursive (Diff syntax ann1 ann2) where embed = Diff
 
 
-instance Eq1 f => Eq1 (Diff f) where
-  liftEq eqA = go where go (Diff d1) (Diff d2) = liftEq2 eqA go d1 d2
+instance Eq1 syntax => Eq2 (Diff syntax) where
+  liftEq2 eq1 eq2 = go where go (Diff d1) (Diff d2) = liftEq3 eq1 eq2 go d1 d2
 
-instance (Eq1 f, Eq a) => Eq (Diff f a) where
-  (==) = eq1
+instance (Eq1 syntax, Eq ann1, Eq ann2) => Eq (Diff syntax ann1 ann2) where
+  (==) = eq2
 
-instance Eq1 f => Eq2 (DiffF f) where
-  liftEq2 eqA eqB d1 d2 = case (d1, d2) of
-    (Patch p1, Patch p2) -> liftEq2 (liftEq2 eqA eqB) (liftEq2 eqA eqB) p1 p2
-    (Merge t1, Merge t2) -> liftEq2 (liftEq2 eqA eqA) eqB t1 t2
+instance Eq1 syntax => Eq3 (DiffF syntax) where
+  liftEq3 eq1 eq2 eqRecur d1 d2 = case (d1, d2) of
+    (Patch p1, Patch p2) -> liftEq2 (liftEq2 eq1 eqRecur) (liftEq2 eq2 eqRecur) p1 p2
+    (Merge t1, Merge t2) -> liftEq2 (liftEq2 eq1 eq2) eqRecur t1 t2
     _ -> False
 
-instance (Eq1 f, Eq a) => Eq1 (DiffF f a) where
-  liftEq = liftEq2 (==)
+instance (Eq1 syntax, Eq ann1, Eq ann2) => Eq1 (DiffF syntax ann1 ann2) where
+  liftEq = liftEq3 (==) (==)
 
-instance (Eq1 f, Eq a, Eq b) => Eq (DiffF f a b) where
-  (==) = eq1
+instance (Eq1 syntax, Eq ann1, Eq ann2, Eq recur) => Eq (DiffF syntax ann1 ann2 recur) where
+  (==) = eq3
 
 
-instance Show1 f => Show1 (Diff f) where
-  liftShowsPrec sp sl = go where go d = showsUnaryWith (liftShowsPrec2 sp sl go (showListWith (go 0))) "Diff" d . unDiff
+instance Show1 syntax => Show2 (Diff syntax) where
+  liftShowsPrec2 sp1 sl1 sp2 sl2 = go where go d = showsUnaryWith (liftShowsPrec3 sp1 sl1 sp2 sl2 go (showListWith (go 0))) "Diff" d . unDiff
 
-instance (Show1 f, Show a) => Show (Diff f a) where
-  showsPrec = showsPrec1
+instance (Show1 syntax, Show ann1, Show ann2) => Show (Diff syntax ann1 ann2) where
+  showsPrec = showsPrec2
 
-instance Show1 f => Show2 (DiffF f) where
-  liftShowsPrec2 spA slA spB slB d diff = case diff of
-    Patch patch -> showsUnaryWith (liftShowsPrec2 (liftShowsPrec2 spA slA spB slB) (liftShowList2 spA slA spB slB) (liftShowsPrec2 spA slA spB slB) (liftShowList2 spA slA spB slB)) "Patch" d patch
-    Merge term  -> showsUnaryWith (liftShowsPrec2 spBoth slBoth spB slB) "Merge" d term
-    where spBoth = liftShowsPrec2 spA slA spA slA
-          slBoth = liftShowList2 spA slA spA slA
+instance Show1 syntax => Show3 (DiffF syntax) where
+  liftShowsPrec3 sp1 sl1 sp2 sl2 spRecur slRecur d diff = case diff of
+    Patch patch -> showsUnaryWith (liftShowsPrec2 (liftShowsPrec2 sp1 sl1 spRecur slRecur) (liftShowList2 sp1 sl1 spRecur slRecur) (liftShowsPrec2 sp2 sl2 spRecur slRecur) (liftShowList2 sp2 sl2 spRecur slRecur)) "Patch" d patch
+    Merge term  -> showsUnaryWith (liftShowsPrec2 spBoth slBoth spRecur slRecur) "Merge" d term
+    where spBoth = liftShowsPrec2 sp1 sl1 sp2 sl2
+          slBoth = liftShowList2 sp1 sl1 sp2 sl2
 
-instance (Show1 f, Show a) => Show1 (DiffF f a) where
-  liftShowsPrec = liftShowsPrec2 showsPrec showList
+instance (Show1 syntax, Show ann1, Show ann2) => Show1 (DiffF syntax ann1 ann2) where
+  liftShowsPrec = liftShowsPrec3 showsPrec showList showsPrec showList
 
-instance (Show1 f, Show a, Show b) => Show (DiffF f a b) where
-  showsPrec = showsPrec1
+instance (Show1 syntax, Show ann1, Show ann2, Show recur) => Show (DiffF syntax ann1 ann2 recur) where
+  showsPrec = showsPrec3
 
 
-instance Functor f => Functor (Diff f) where
-  fmap f = go where go = Diff . bimap f go . unDiff
+instance Functor syntax => Bifunctor (Diff syntax) where
+  bimap f g = go where go = Diff . trimap f g go . unDiff
 
-instance Foldable f => Foldable (Diff f) where
-  foldMap f = go where go = bifoldMap f go . unDiff
+instance Foldable syntax => Bifoldable (Diff syntax) where
+  bifoldMap f g = go where go = trifoldMap f g go . unDiff
 
-instance Traversable f => Traversable (Diff f) where
-  traverse f = go where go = fmap Diff . bitraverse f go . unDiff
+instance Traversable syntax => Bitraversable (Diff syntax) where
+  bitraverse f g = go where go = fmap Diff . tritraverse f g go . unDiff
 
 
-instance Functor syntax => Functor (DiffF syntax ann) where
-  fmap = second
+instance Functor syntax => Functor (DiffF syntax ann1 ann2) where
+  fmap = trimap id id
 
-instance Functor syntax => Bifunctor (DiffF syntax) where
-  bimap f g (Patch patch) = Patch (bimap (bimap f g) (bimap f g) patch)
-  bimap f g (Merge term)  = Merge (bimap (bimap f f) g term)
+instance Functor syntax => Trifunctor (DiffF syntax) where
+  trimap f g h (Patch patch) = Patch (bimap (bimap f h) (bimap g h) patch)
+  trimap f g h (Merge term)  = Merge (bimap (bimap f g) h term)
 
-instance Foldable syntax => Foldable (DiffF syntax ann) where
-  foldMap = bifoldMap (const mempty)
+instance Foldable syntax => Foldable (DiffF syntax ann1 ann2) where
+  foldMap = trifoldMap (const mempty) (const mempty)
 
-instance Foldable syntax => Bifoldable (DiffF syntax) where
-  bifoldMap f g (Patch patch) = bifoldMap (bifoldMap f g) (bifoldMap f g) patch
-  bifoldMap f g (Merge term)  = bifoldMap (bifoldMap f f) g term
+instance Foldable syntax => Trifoldable (DiffF syntax) where
+  trifoldMap f g h (Patch patch) = bifoldMap (bifoldMap f h) (bifoldMap g h) patch
+  trifoldMap f g h (Merge term)  = bifoldMap (bifoldMap f g) h term
 
-instance Traversable syntax => Traversable (DiffF syntax ann) where
-  traverse = bitraverse pure
+instance Traversable syntax => Traversable (DiffF syntax ann1 ann2) where
+  traverse = tritraverse pure pure
 
-instance Traversable syntax => Bitraversable (DiffF syntax) where
-  bitraverse f g (Patch patch) = Patch <$> bitraverse (bitraverse f g) (bitraverse f g) patch
-  bitraverse f g (Merge term)  = Merge <$> bitraverse (bitraverse f f) g term
+instance Traversable syntax => Tritraversable (DiffF syntax) where
+  tritraverse f g h (Patch patch) = Patch <$> bitraverse (bitraverse f h) (bitraverse g h) patch
+  tritraverse f g h (Merge term)  = Merge <$> bitraverse (bitraverse f g) h term
 
 
-instance (ToJSONFields a, ToJSONFields1 f) => ToJSON (Diff f a) where
+instance (ToJSONFields1 syntax, ToJSONFields ann1, ToJSONFields ann2) => ToJSON (Diff syntax ann1 ann2) where
   toJSON = object . toJSONFields
   toEncoding = pairs . mconcat . toJSONFields
 
-instance (ToJSONFields a, ToJSONFields1 f) => ToJSONFields (Diff f a) where
+instance (ToJSONFields1 syntax, ToJSONFields ann1, ToJSONFields ann2) => ToJSONFields (Diff syntax ann1 ann2) where
   toJSONFields = toJSONFields . unDiff
 
-instance (ToJSONFields a, ToJSONFields1 f) => ToJSONFields1 (DiffF f a) where
+instance (ToJSONFields1 syntax, ToJSONFields ann1, ToJSONFields ann2) => ToJSONFields1 (DiffF syntax ann1 ann2) where
   toJSONFields1 (Patch patch) = [ "patch" .= JSONFields patch ]
   toJSONFields1 (Merge term)  = [ "merge" .= JSONFields term ]
 
-instance (ToJSONFields1 f, ToJSONFields a, ToJSON b) => ToJSONFields (DiffF f a b) where
+instance (ToJSONFields1 syntax, ToJSONFields ann1, ToJSONFields ann2, ToJSON recur) => ToJSONFields (DiffF syntax ann1 ann2 recur) where
   toJSONFields = toJSONFields1
 
-instance (ToJSON b, ToJSONFields a, ToJSONFields1 f) => ToJSON (DiffF f a b) where
+instance (ToJSONFields1 syntax, ToJSONFields ann1, ToJSONFields ann2, ToJSON recur) => ToJSON (DiffF syntax ann1 ann2 recur) where
   toJSON = object . toJSONFields
   toEncoding = pairs . mconcat . toJSONFields
+
+
+class Eq3 f where
+  liftEq3 :: (a1 -> a2 -> Bool) -> (b1 -> b2 -> Bool) -> (c1 -> c2 -> Bool) -> f a1 b1 c1 -> f a2 b2 c2 -> Bool
+
+eq3 :: (Eq3 f, Eq a, Eq b, Eq c) => f a b c -> f a b c -> Bool
+eq3 = liftEq3 (==) (==) (==)
+
+
+class Show3 f where
+  liftShowsPrec3 :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> (Int -> c -> ShowS) -> ([c] -> ShowS) -> Int -> f a b c -> ShowS
+
+showsPrec3 :: (Show3 f, Show a, Show b, Show c) => Int -> f a b c -> ShowS
+showsPrec3 = liftShowsPrec3 showsPrec showList showsPrec showList showsPrec showList
+
+class Trifunctor f where
+  trimap :: (a -> a') -> (b -> b') -> (c -> c') -> f a b c -> f a' b' c'
+
+class Trifoldable f where
+  trifoldMap :: Monoid m => (a -> m) -> (b -> m) -> (c -> m) -> f a b c -> m
+
+class Tritraversable f where
+  tritraverse :: Applicative g => (a -> g a') -> (b -> g b') -> (c -> g c') -> f a b c -> g (f a' b' c')
diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 32b459612..550d90402 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -27,25 +27,25 @@ import Term
 diffTerms :: HasField fields Category
           => Term Syntax (Record fields) -- ^ A term representing the old state.
           -> Term Syntax (Record fields) -- ^ A term representing the new state.
-          -> Diff Syntax (Record fields)
+          -> Diff Syntax (Record fields) (Record fields)
 diffTerms = decoratingWith getLabel (diffTermsWith algorithmWithTerms comparableByCategory)
 
 -- | Diff two terms by decorating with feature vectors computed using the supplied labelling algebra, and stripping the feature vectors from the resulting diff.
 decoratingWith :: (Hashable label, Traversable f)
                => (forall a. TermF f (Record fields) a -> label)
-               -> (Term f (Record (FeatureVector ': fields)) -> Term f (Record (FeatureVector ': fields)) -> Diff f (Record (FeatureVector ': fields)))
+               -> (Term f (Record (FeatureVector ': fields)) -> Term f (Record (FeatureVector ': fields)) -> Diff f (Record (FeatureVector ': fields)) (Record (FeatureVector ': fields)))
                -> Term f (Record fields)
                -> Term f (Record fields)
-               -> Diff f (Record fields)
+               -> Diff f (Record fields) (Record fields)
 decoratingWith getLabel differ t1 t2 = stripDiff (differ (defaultFeatureVectorDecorator getLabel t1) (defaultFeatureVectorDecorator getLabel t2))
 
 -- | Diff a pair of terms recurisvely, using the supplied continuation and 'ComparabilityRelation'.
 diffTermsWith :: forall f fields . (Traversable f, GAlign f, Eq1 f, HasField fields FeatureVector)
-              => (Term f (Record fields) -> Term f (Record fields) -> Algorithm (Term f) (Diff f) (Record fields) (Record fields) (Diff f (Record fields))) -- ^ A function producing syntax-directed continuations of the algorithm.
+              => (Term f (Record fields) -> Term f (Record fields) -> Algorithm (Term f) (Diff f) (Record fields) (Record fields) (Diff f (Record fields) (Record fields))) -- ^ A function producing syntax-directed continuations of the algorithm.
               -> ComparabilityRelation f fields -- ^ A relation on terms used to determine comparability and equality.
               -> Term f (Record fields) -- ^ A term representing the old state.
               -> Term f (Record fields) -- ^ A term representing the new state.
-              -> Diff f (Record fields) -- ^ The resulting diff.
+              -> Diff f (Record fields) (Record fields) -- ^ The resulting diff.
 diffTermsWith refine comparable t1 t2 = runFreer decompose (diff t1 t2)
   where decompose :: AlgorithmF (Term f) (Diff f) (Record fields) (Record fields) result -> Algorithm (Term f) (Diff f) (Record fields) (Record fields) result
         decompose step = case step of
@@ -68,7 +68,7 @@ getLabel (In h t) = (Info.category h, case t of
 -- | Construct an algorithm to diff a pair of terms.
 algorithmWithTerms :: Term Syntax (Record fields)
                    -> Term Syntax (Record fields)
-                   -> Algorithm (Term Syntax) (Diff Syntax) (Record fields) (Record fields) (Diff Syntax (Record fields))
+                   -> Algorithm (Term Syntax) (Diff Syntax) (Record fields) (Record fields) (Diff Syntax (Record fields) (Record fields))
 algorithmWithTerms t1 t2 = case (unwrap t1, unwrap t2) of
   (Indexed a, Indexed b) ->
     annotate . Indexed <$> byRWS a b
diff --git a/src/Renderer.hs b/src/Renderer.hs
index 38f4941a7..d746ca7d9 100644
--- a/src/Renderer.hs
+++ b/src/Renderer.hs
@@ -47,7 +47,7 @@ data DiffRenderer output where
   -- | Render to a 'ByteString' formatted as nested s-expressions with patches indicated.
   SExpressionDiffRenderer :: DiffRenderer ByteString
   -- | “Render” by returning the computed 'Diff'. This renderer is not surfaced in the command-line interface, and is intended strictly for tests. Further, as it cannot render à la carte terms, it should be regarded as a (very) short-term hack until such time as we have a better idea for TOCSpec.hs.
-  IdentityDiffRenderer :: DiffRenderer (Maybe (Diff Syntax (Record (Maybe Declaration ': DefaultFields))))
+  IdentityDiffRenderer :: DiffRenderer (Maybe (Diff Syntax (Record (Maybe Declaration ': DefaultFields)) (Record (Maybe Declaration ': DefaultFields))))
 
 deriving instance Eq (DiffRenderer output)
 deriving instance Show (DiffRenderer output)
diff --git a/src/Renderer/Patch.hs b/src/Renderer/Patch.hs
index 7fcfe14a0..07c858185 100644
--- a/src/Renderer/Patch.hs
+++ b/src/Renderer/Patch.hs
@@ -31,7 +31,7 @@ truncatePatch :: Both Blob -> ByteString
 truncatePatch blobs = header blobs <> "#timed_out\nTruncating diff: timeout reached.\n"
 
 -- | Render a diff in the traditional patch format.
-renderPatch :: (HasField fields Range, Traversable f) => Both Blob -> Diff f (Record fields) -> File
+renderPatch :: (HasField fields Range, Traversable f) => Both Blob -> Diff f (Record fields) (Record fields) -> File
 renderPatch blobs diff = File $ if not (ByteString.null text) && ByteString.last text /= '\n'
   then text <> "\n\\ No newline at end of file\n"
   else text
@@ -132,7 +132,7 @@ emptyHunk :: Hunk (SplitDiff a annotation)
 emptyHunk = Hunk { offset = mempty, changes = [], trailingContext = [] }
 
 -- | Render a diff as a series of hunks.
-hunks :: (Traversable f, HasField fields Range) => Diff f (Record fields) -> Both Blob -> [Hunk (SplitDiff [] (Record fields))]
+hunks :: (Traversable f, HasField fields Range) => Diff f (Record fields) (Record fields) -> Both Blob -> [Hunk (SplitDiff [] (Record fields))]
 hunks _ blobs | sources <- blobSource <$> blobs
               , sourcesEqual <- runBothWith (==) sources
               , sourcesNull <- runBothWith (&&) (nullSource <$> sources)
diff --git a/src/Renderer/SExpression.hs b/src/Renderer/SExpression.hs
index 7f0a8cf8f..15bca1df2 100644
--- a/src/Renderer/SExpression.hs
+++ b/src/Renderer/SExpression.hs
@@ -14,14 +14,14 @@ import Prelude hiding (replicate)
 import Term
 
 -- | Returns a ByteString SExpression formatted diff.
-renderSExpressionDiff :: (ConstrainAll Show fields, Foldable f, Functor f) => Diff f (Record fields) -> ByteString
+renderSExpressionDiff :: (ConstrainAll Show fields, Foldable syntax, Functor syntax) => Diff syntax (Record fields) (Record fields) -> ByteString
 renderSExpressionDiff diff = cata printDiffF diff 0 <> "\n"
 
 -- | Returns a ByteString SExpression formatted term.
-renderSExpressionTerm :: (ConstrainAll Show fields, Foldable f, Functor f) => Term f (Record fields) -> ByteString
+renderSExpressionTerm :: (ConstrainAll Show fields, Foldable syntax, Functor syntax) => Term syntax (Record fields) -> ByteString
 renderSExpressionTerm term = cata (\ term n -> nl n <> replicate (2 * n) ' ' <> printTermF term n) term 0 <> "\n"
 
-printDiffF :: (ConstrainAll Show fields, Foldable f, Functor f) => DiffF f (Record fields) (Int -> ByteString) -> Int -> ByteString
+printDiffF :: (ConstrainAll Show fields, Foldable syntax, Functor syntax) => DiffF syntax (Record fields) (Record fields) (Int -> ByteString) -> Int -> ByteString
 printDiffF diff n = case diff of
   Patch (Delete term) -> nl n <> pad (n - 1) <> "{-" <> printTermF term n <> "-}"
   Patch (Insert term) -> nl n <> pad (n - 1) <> "{+" <> printTermF term n <> "+}"
@@ -29,7 +29,7 @@ printDiffF diff n = case diff of
                               <> nl (n + 1) <> pad (n - 1) <> "->" <> printTermF term2 n <> " }"
   Merge (In (_, ann) syntax) -> nl n <> pad n <> "(" <> showAnnotation ann <> foldMap (\ d -> d (n + 1)) syntax <> ")"
 
-printTermF :: (ConstrainAll Show fields, Foldable f, Functor f) => TermF f (Record fields) (Int -> ByteString) -> Int -> ByteString
+printTermF :: (ConstrainAll Show fields, Foldable syntax, Functor syntax) => TermF syntax (Record fields) (Int -> ByteString) -> Int -> ByteString
 printTermF (In annotation syntax) n = "(" <> showAnnotation annotation <> foldMap (\t -> t (n + 1)) syntax <> ")"
 
 nl :: Int -> ByteString
diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs
index cd26ba93d..d0a16a8a5 100644
--- a/src/Renderer/TOC.hs
+++ b/src/Renderer/TOC.hs
@@ -35,7 +35,6 @@ import Data.Semigroup ((<>), sconcat)
 import Data.Source as Source
 import Data.Text (toLower)
 import qualified Data.Text as T
-import Data.These
 import Data.Union
 import Diff
 import GHC.Generics
@@ -146,9 +145,9 @@ data Entry a
 
 -- | Compute a table of contents for a diff characterized by a function mapping relevant nodes onto values in Maybe.
 tableOfContentsBy :: (Foldable f, Functor f)
-                  => (forall b. TermF f annotation b -> Maybe a) -- ^ A function mapping relevant nodes onto values in Maybe.
-                  -> Diff f annotation                           -- ^ The diff to compute the table of contents for.
-                  -> [Entry a]                                   -- ^ A list of entries for relevant changed and unchanged nodes in the diff.
+                  => (forall b. TermF f ann b -> Maybe a) -- ^ A function mapping relevant nodes onto values in Maybe.
+                  -> Diff f ann ann                       -- ^ The diff to compute the table of contents for.
+                  -> [Entry a]                            -- ^ A list of entries for relevant changed and unchanged nodes in the diff.
 tableOfContentsBy selector = fromMaybe [] . cata (\ r -> case r of
   Patch patch -> (pure . patchEntry <$> bicrosswalk selector selector patch) <> foldMap fold patch <> Just []
   Merge (In (_, ann2) r) -> case (selector (In ann2 r), fold r) of
@@ -195,7 +194,7 @@ recordSummary record = case getDeclaration record of
   Just declaration -> Just . JSONSummary (toCategoryName declaration) (declarationIdentifier declaration) (sourceSpan record)
   Nothing -> const Nothing
 
-renderToCDiff :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Both Blob -> Diff f (Record fields) -> Summaries
+renderToCDiff :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Both Blob -> Diff f (Record fields) (Record fields) -> Summaries
 renderToCDiff blobs = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . diffTOC
   where toMap [] = mempty
         toMap as = Map.singleton summaryKey (toJSON <$> as)
@@ -210,7 +209,7 @@ renderToCTerm Blob{..} = uncurry Summaries . bimap toMap toMap . List.partition
   where toMap [] = mempty
         toMap as = Map.singleton (T.pack blobPath) (toJSON <$> as)
 
-diffTOC :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Diff f (Record fields) -> [JSONSummary]
+diffTOC :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Diff f (Record fields) (Record fields) -> [JSONSummary]
 diffTOC = mapMaybe entrySummary . dedupe . tableOfContentsBy declaration
 
 termToC :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Term f (Record fields) -> [JSONSummary]
diff --git a/src/Semantic.hs b/src/Semantic.hs
index b66115fb6..c22dee76b 100644
--- a/src/Semantic.hs
+++ b/src/Semantic.hs
@@ -11,6 +11,7 @@ import Algorithm hiding (diff)
 import Control.Applicative ((<|>))
 import Control.Monad ((<=<))
 import Data.Align.Generic (GAlign)
+import Data.Bifunctor
 import Data.Blob
 import Data.ByteString (ByteString)
 import Data.Functor.Both as Both
@@ -80,22 +81,22 @@ diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of
   (PatchDiffRenderer, Just Language.Markdown) -> run (parse markdownParser) diffRecursively (renderPatch blobs)
   (PatchDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffRecursively (renderPatch blobs)
   (PatchDiffRenderer, _) -> run (parse syntaxParser) diffTerms (renderPatch blobs)
-  (SExpressionDiffRenderer, Just Language.JSON) -> run (decorate constructorLabel <=< parse jsonParser) diffRecursively (renderSExpressionDiff . fmap keepConstructorLabel)
-  (SExpressionDiffRenderer, Just Language.Markdown) -> run (decorate constructorLabel <=< parse markdownParser) diffRecursively (renderSExpressionDiff . fmap keepConstructorLabel)
-  (SExpressionDiffRenderer, Just Language.Python) -> run (decorate constructorLabel <=< parse pythonParser) diffRecursively (renderSExpressionDiff . fmap keepConstructorLabel)
-  (SExpressionDiffRenderer, _) -> run (parse syntaxParser) diffTerms (renderSExpressionDiff . fmap keepCategory)
+  (SExpressionDiffRenderer, Just Language.JSON) -> run (decorate constructorLabel <=< parse jsonParser) diffRecursively (renderSExpressionDiff . bimap keepConstructorLabel keepConstructorLabel)
+  (SExpressionDiffRenderer, Just Language.Markdown) -> run (decorate constructorLabel <=< parse markdownParser) diffRecursively (renderSExpressionDiff . bimap keepConstructorLabel keepConstructorLabel)
+  (SExpressionDiffRenderer, Just Language.Python) -> run (decorate constructorLabel <=< parse pythonParser) diffRecursively (renderSExpressionDiff . bimap keepConstructorLabel keepConstructorLabel)
+  (SExpressionDiffRenderer, _) -> run (parse syntaxParser) diffTerms (renderSExpressionDiff . bimap keepCategory keepCategory)
   (IdentityDiffRenderer, _) -> run (\ blob -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob)) diffTerms Just
   where effectiveLanguage = runBothWith (<|>) (blobLanguage <$> blobs)
         syntaxParser = parserForLanguage effectiveLanguage
 
-        run :: Functor f => (Blob -> Task (Term f a)) -> (Term f a -> Term f a -> Diff f a) -> (Diff f a -> output) -> Task output
+        run :: Functor syntax => (Blob -> Task (Term syntax ann)) -> (Term syntax ann -> Term syntax ann -> Diff syntax ann ann) -> (Diff syntax ann ann -> output) -> Task output
         run parse diff renderer = distributeFor blobs parse >>= runBothWith (diffTermPair blobs diff) >>= render renderer
 
-        diffRecursively :: (Eq1 f, GAlign f, Show1 f, Traversable f, Diffable f) => Term f (Record fields) -> Term f (Record fields) -> Diff f (Record fields)
+        diffRecursively :: (Eq1 syntax, GAlign syntax, Show1 syntax, Traversable syntax, Diffable syntax) => Term syntax (Record fields) -> Term syntax (Record fields) -> Diff syntax (Record fields) (Record fields)
         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 -> Term f a -> Term f a -> Task (Diff f a)
+diffTermPair :: Functor syntax => Both Blob -> Differ syntax ann1 ann2 -> Term syntax ann1 -> Term syntax ann2 -> Task (Diff syntax ann1 ann2)
 diffTermPair blobs differ t1 t2 = case runJoin (blobExists <$> blobs) of
   (True, False) -> pure (deleting t1)
   (False, True) -> pure (inserting t2)
diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs
index 1ca726dcf..6dfd52442 100644
--- a/src/Semantic/Task.hs
+++ b/src/Semantic/Task.hs
@@ -67,7 +67,7 @@ data TaskF output where
   Time :: String -> [(String, String)] -> Task output -> TaskF output
   Parse :: Parser term -> Blob -> TaskF term
   Decorate :: Functor f => RAlgebra (TermF f (Record fields)) (Term f (Record fields)) field -> Term f (Record fields) -> TaskF (Term f (Record (field ': fields)))
-  Diff :: Differ f a -> Term f a -> Term f a -> TaskF (Diff f a)
+  Diff :: Differ syntax ann1 ann2 -> Term syntax ann1 -> Term syntax ann2 -> TaskF (Diff syntax ann1 ann2)
   Render :: Renderer input output -> input -> TaskF output
   Distribute :: Traversable t => t (Task output) -> TaskF (t output)
 
@@ -82,7 +82,7 @@ data TaskF output where
 type Task = Freer TaskF
 
 -- | A function to compute the 'Diff' for a pair of 'Term's with arbitrary syntax functor & annotation types.
-type Differ f a = Term f a -> Term f a -> Diff f a
+type Differ syntax ann1 ann2 = Term syntax ann1 -> Term syntax ann2 -> Diff syntax ann1 ann2
 
 -- | A function to render terms or diffs.
 type Renderer i o = i -> o
@@ -117,7 +117,7 @@ decorate :: Functor f => RAlgebra (TermF f (Record fields)) (Term f (Record fiel
 decorate algebra term = Decorate algebra term `Then` return
 
 -- | A 'Task' which diffs a pair of terms using the supplied 'Differ' function.
-diff :: Differ f a -> Term f a -> Term f a -> Task (Diff f a)
+diff :: Differ syntax ann1 ann2 -> Term syntax ann1 -> Term syntax ann2 -> Task (Diff syntax ann1 ann2)
 diff differ term1 term2 = Semantic.Task.Diff differ term1 term2 `Then` return
 
 -- | A 'Task' which renders some input using the supplied 'Renderer' function.
diff --git a/test/AlignmentSpec.hs b/test/AlignmentSpec.hs
index c90a82318..73bbb48a1 100644
--- a/test/AlignmentSpec.hs
+++ b/test/AlignmentSpec.hs
@@ -258,7 +258,7 @@ instance Listable BranchElement where
 counts :: [Join These (Int, a)] -> Both Int
 counts numbered = fromMaybe 0 . getLast . mconcat . fmap Last <$> Join (unalign (runJoin . fmap fst <$> numbered))
 
-align :: Both Source.Source -> Diff Syntax (Record '[Range]) -> PrettyDiff (SplitDiff [] (Record '[Range]))
+align :: Both Source.Source -> Diff Syntax (Record '[Range]) (Record '[Range]) -> PrettyDiff (SplitDiff [] (Record '[Range]))
 align sources = PrettyDiff sources . fmap (fmap (getRange &&& id)) . alignDiff sources
 
 info :: Int -> Int -> Record '[Range]
diff --git a/test/Data/Functor/Listable.hs b/test/Data/Functor/Listable.hs
index 70b769e5f..39e1de161 100644
--- a/test/Data/Functor/Listable.hs
+++ b/test/Data/Functor/Listable.hs
@@ -70,6 +70,13 @@ tiers2 :: (Listable a, Listable b, Listable2 l) => [Tier (l a b)]
 tiers2 = liftTiers2 tiers tiers
 
 
+class Listable3 l where
+  liftTiers3 :: [Tier a] -> [Tier b] -> [Tier c] -> [Tier (l a b c)]
+
+tiers3 :: (Listable3 l, Listable a, Listable b, Listable c) => [Tier (l a b c)]
+tiers3 = liftTiers3 tiers tiers tiers
+
+
 -- | Lifts a unary constructor to a list of tiers, given a list of tiers for its argument.
 --
 --   Commonly used in the definition of 'Listable1' and 'Listable2' instances.
@@ -165,22 +172,19 @@ instance (Listable1 f, Listable a) => Listable (Term f a) where
   tiers = tiers1
 
 
-instance Listable1 f => Listable2 (DiffF f) where
-  liftTiers2 annTiers recurTiers
-    =  liftCons1 (liftTiers2 (liftTiers2 annTiers recurTiers) (liftTiers2 annTiers recurTiers)) Patch
-    \/ liftCons1 (liftTiers2 (liftTiers2 annTiers annTiers) recurTiers) Merge
+instance (Listable1 syntax) => Listable3 (DiffF syntax) where
+  liftTiers3 ann1Tiers ann2Tiers recurTiers
+    =  liftCons1 (liftTiers2 (liftTiers2 ann1Tiers recurTiers) (liftTiers2 ann2Tiers recurTiers)) Patch
+    \/ liftCons1 (liftTiers2 (liftTiers2 ann1Tiers ann2Tiers) recurTiers) Merge
 
-instance (Listable1 f, Listable a) => Listable1 (DiffF f a) where
-  liftTiers = liftTiers2 tiers
+instance (Listable1 syntax, Listable ann1, Listable ann2, Listable recur) => Listable (DiffF syntax ann1 ann2 recur) where
+  tiers = tiers3
 
-instance (Listable1 f, Listable a, Listable b) => Listable (DiffF f a b) where
-  tiers = tiers1
+instance Listable1 f => Listable2 (Diff f) where
+  liftTiers2 annTiers1 annTiers2 = go where go = liftCons1 (liftTiers3 annTiers1 annTiers2 go) Diff
 
-instance Listable1 f => Listable1 (Diff f) where
-  liftTiers annTiers = go where go = liftCons1 (liftTiers2 annTiers go) Diff
-
-instance (Listable1 f, Listable a) => Listable (Diff f a) where
-  tiers = tiers1
+instance (Listable1 syntax, Listable ann1, Listable ann2) => Listable (Diff syntax ann1 ann2) where
+  tiers = tiers2
 
 
 instance (Listable head, Listable (Record tail)) => Listable (Record (head ': tail)) where
diff --git a/test/DiffSpec.hs b/test/DiffSpec.hs
index 03330a681..3f956d8c7 100644
--- a/test/DiffSpec.hs
+++ b/test/DiffSpec.hs
@@ -18,8 +18,7 @@ spec :: Spec
 spec = parallel $ do
   let decorate = defaultFeatureVectorDecorator (category . termAnnotation)
   prop "equality is reflexive" $
-    \ a -> let diff = a :: Term Syntax (Record '[Category]) in
-      diff `shouldBe` diff
+    \ diff -> diff `shouldBe` (diff :: Diff Syntax (Record '[Category]) (Record '[Category]))
 
   prop "equal terms produce identity diffs" $
     \ a -> let term = decorate (a :: Term Syntax (Record '[Category])) in
@@ -27,10 +26,10 @@ spec = parallel $ do
 
   describe "beforeTerm" $ do
     prop "recovers the before term" $
-      \ a b -> let diff = diffTerms a b :: Diff Syntax (Record '[Category]) in
+      \ a b -> let diff = diffTerms a b :: Diff Syntax (Record '[Category]) (Record '[Category]) in
         beforeTerm diff `shouldBe` Just a
 
   describe "afterTerm" $ do
     prop "recovers the after term" $
-      \ a b -> let diff = diffTerms a b :: Diff Syntax (Record '[Category]) in
+      \ a b -> let diff = diffTerms a b :: Diff Syntax (Record '[Category]) (Record '[Category]) in
         afterTerm diff `shouldBe` Just b
diff --git a/test/InterpreterSpec.hs b/test/InterpreterSpec.hs
index 32d0827a2..e55bbc6cd 100644
--- a/test/InterpreterSpec.hs
+++ b/test/InterpreterSpec.hs
@@ -23,11 +23,11 @@ spec = parallel $ do
           diffTerms termA termB `shouldBe` replacing termA termB
 
     prop "produces correct diffs" $
-      \ a b -> let diff = diffTerms a b :: Diff Syntax (Record '[Category]) in
+      \ a b -> let diff = diffTerms a b :: Diff Syntax (Record '[Category]) (Record '[Category]) in
                    (beforeTerm diff, afterTerm diff) `shouldBe` (Just a, Just b)
 
     prop "constructs zero-cost diffs of equal terms" $
-      \ a -> let diff = diffTerms a a :: Diff Syntax (Record '[Category]) in
+      \ a -> let diff = diffTerms a a :: Diff Syntax (Record '[Category]) (Record '[Category]) in
                  diffCost diff `shouldBe` 0
 
     it "produces unbiased insertions within branches" $
diff --git a/test/TOCSpec.hs b/test/TOCSpec.hs
index 94a623fcb..5f1ed880f 100644
--- a/test/TOCSpec.hs
+++ b/test/TOCSpec.hs
@@ -40,12 +40,12 @@ spec :: Spec
 spec = parallel $ do
   describe "tableOfContentsBy" $ do
     prop "drops all nodes with the constant Nothing function" $
-      \ diff -> tableOfContentsBy (const Nothing :: a -> Maybe ()) (diff :: Diff Syntax ()) `shouldBe` []
+      \ diff -> tableOfContentsBy (const Nothing :: a -> Maybe ()) (diff :: Diff Syntax () ()) `shouldBe` []
 
     let diffSize = max 1 . length . diffPatches
     let lastValue a = fromMaybe (extract a) (getLast (foldMap (Last . Just) a))
     prop "includes all nodes with a constant Just function" $
-      \ diff -> let diff' = (diff :: Diff Syntax ()) in entryPayload <$> tableOfContentsBy (const (Just ())) diff' `shouldBe` replicate (diffSize diff') ()
+      \ diff -> let diff' = (diff :: Diff Syntax () ()) in entryPayload <$> tableOfContentsBy (const (Just ())) diff' `shouldBe` replicate (diffSize diff') ()
 
     prop "produces an unchanged entry for identity diffs" $
       \ term -> tableOfContentsBy (Just . termAnnotation) (diffTerms term term) `shouldBe` [Unchanged (lastValue (term :: Term Syntax (Record '[Category])))]
@@ -56,7 +56,7 @@ spec = parallel $ do
       patch (fmap Deleted) (fmap Inserted) (const (fmap Replaced)) (bimap (foldMap pure) (foldMap pure) (p :: Patch (Term Syntax Int) (Term Syntax Int)))
 
     prop "produces changed entries for relevant nodes containing irrelevant patches" $
-      \ diff -> let diff' = merge (0, 0) (Indexed [1 <$ (diff :: Diff Syntax Int)]) in
+      \ diff -> let diff' = merge (0, 0) (Indexed [bimap (const 1) (const 1) (diff :: Diff Syntax Int Int)]) in
         tableOfContentsBy (\ (n `In` _) -> if n == (0 :: Int) then Just n else Nothing) diff' `shouldBe`
         if null (diffPatches diff') then [Unchanged 0]
                                     else replicate (length (diffPatches diff')) (Changed 0)
@@ -163,7 +163,7 @@ spec = parallel $ do
       toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/markdown/headings.A.md -> test/fixtures/toc/markdown/headings.B.md\":[{\"span\":{\"start\":[5,1],\"end\":[7,10]},\"category\":\"Heading 2\",\"term\":\"Two\",\"changeType\":\"added\"},{\"span\":{\"start\":[9,1],\"end\":[10,4]},\"category\":\"Heading 1\",\"term\":\"Final\",\"changeType\":\"added\"}]},\"errors\":{}}\n" :: ByteString)
 
 
-type Diff' = Diff Syntax (Record (Maybe Declaration ': DefaultFields))
+type Diff' = Diff Syntax (Record (Maybe Declaration ': DefaultFields)) (Record (Maybe Declaration ': DefaultFields))
 type Term' = Term Syntax (Record (Maybe Declaration ': DefaultFields))
 
 numTocSummaries :: Diff' -> Int

From e624cbd562016d3f52d09b8816d03dd414abc33b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 09:44:37 -0400
Subject: [PATCH 12/65] Rename the syntax type parameter in RWS.

---
 src/RWS.hs | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index a526c889f..cdf80bd90 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -40,7 +40,7 @@ type Label f fields label = forall b. TermF f (Record fields) b -> label
 -- | A relation on 'Term's, guaranteed constant-time in the size of the 'Term' by parametricity.
 --
 --   This is used both to determine whether two root terms can be compared in O(1), and, recursively, to determine whether two nodes are equal in O(n); thus, comparability is defined s.t. two terms are equal if they are recursively comparable subterm-wise.
-type ComparabilityRelation f fields = forall a b. TermF f (Record fields) a -> TermF f (Record fields) b -> Bool
+type ComparabilityRelation syntax fields = forall a b. TermF syntax (Record fields) a -> TermF syntax (Record fields) b -> Bool
 
 type FeatureVector = UArray Int Double
 
@@ -54,12 +54,12 @@ data UnmappedTerm f fields = UnmappedTerm {
 -- | Either a `term`, an index of a matched term, or nil.
 data TermOrIndexOrNone term = Term term | Index {-# UNPACK #-} !Int | None
 
-rws :: (HasField fields FeatureVector, Functor f, Eq1 f)
-    => (Diff f fields -> Int)
-    -> ComparabilityRelation f fields
-    -> [Term f (Record fields)]
-    -> [Term f (Record fields)]
-    -> RWSEditScript f fields
+rws :: (HasField fields FeatureVector, Functor syntax, Eq1 syntax)
+    => (Diff syntax fields -> Int)
+    -> ComparabilityRelation syntax fields
+    -> [Term syntax (Record fields)]
+    -> [Term syntax (Record fields)]
+    -> RWSEditScript syntax fields
 rws _            _          as [] = This <$> as
 rws _            _          [] bs = That <$> bs
 rws _            canCompare [a] [b] = if canCompareTerms canCompare a b then [These a b] else [That b, This a]

From 9cd9071f7034acc58e316e9b1facc172979b0093 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 09:49:06 -0400
Subject: [PATCH 13/65] Abstract ComparabilityRelation over the annotation
 types.

---
 src/Interpreter.hs |  6 ++---
 src/RWS.hs         | 58 +++++++++++++++++++++++-----------------------
 2 files changed, 32 insertions(+), 32 deletions(-)

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 550d90402..4bfced236 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -42,7 +42,7 @@ decoratingWith getLabel differ t1 t2 = stripDiff (differ (defaultFeatureVectorDe
 -- | Diff a pair of terms recurisvely, using the supplied continuation and 'ComparabilityRelation'.
 diffTermsWith :: forall f fields . (Traversable f, GAlign f, Eq1 f, HasField fields FeatureVector)
               => (Term f (Record fields) -> Term f (Record fields) -> Algorithm (Term f) (Diff f) (Record fields) (Record fields) (Diff f (Record fields) (Record fields))) -- ^ A function producing syntax-directed continuations of the algorithm.
-              -> ComparabilityRelation f fields -- ^ A relation on terms used to determine comparability and equality.
+              -> ComparabilityRelation f (Record fields) (Record fields) -- ^ A relation on terms used to determine comparability and equality.
               -> Term f (Record fields) -- ^ A term representing the old state.
               -> Term f (Record fields) -- ^ A term representing the new state.
               -> Diff f (Record fields) (Record fields) -- ^ The resulting diff.
@@ -110,11 +110,11 @@ algorithmWithTerms t1 t2 = case (unwrap t1, unwrap t2) of
 
 
 -- | Test whether two terms are comparable by their Category.
-comparableByCategory :: HasField fields Category => ComparabilityRelation f fields
+comparableByCategory :: HasField fields Category => ComparabilityRelation syntax (Record fields) (Record fields)
 comparableByCategory (In a _) (In b _) = category a == category b
 
 -- | Test whether two terms are comparable by their constructor.
-comparableByConstructor :: GAlign f => ComparabilityRelation f fields
+comparableByConstructor :: GAlign syntax => ComparabilityRelation syntax (Record fields) (Record fields)
 comparableByConstructor (In _ a) (In _ b) = isJust (galign a b)
 
 
diff --git a/src/RWS.hs b/src/RWS.hs
index cdf80bd90..d4760d6be 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -40,7 +40,7 @@ type Label f fields label = forall b. TermF f (Record fields) b -> label
 -- | A relation on 'Term's, guaranteed constant-time in the size of the 'Term' by parametricity.
 --
 --   This is used both to determine whether two root terms can be compared in O(1), and, recursively, to determine whether two nodes are equal in O(n); thus, comparability is defined s.t. two terms are equal if they are recursively comparable subterm-wise.
-type ComparabilityRelation syntax fields = forall a b. TermF syntax (Record fields) a -> TermF syntax (Record fields) b -> Bool
+type ComparabilityRelation syntax ann1 ann2 = forall a b. TermF syntax ann1 a -> TermF syntax ann2 b -> Bool
 
 type FeatureVector = UArray Int Double
 
@@ -56,7 +56,7 @@ data TermOrIndexOrNone term = Term term | Index {-# UNPACK #-} !Int | None
 
 rws :: (HasField fields FeatureVector, Functor syntax, Eq1 syntax)
     => (Diff syntax fields -> Int)
-    -> ComparabilityRelation syntax fields
+    -> ComparabilityRelation syntax (Record fields) (Record fields)
     -> [Term syntax (Record fields)]
     -> [Term syntax (Record fields)]
     -> RWSEditScript syntax fields
@@ -117,12 +117,12 @@ insertDiff a@(ij1, _) (b@(ij2, _):rest) = case (ij1, ij2) of
       That j2 -> if i2 <= j2 then (before, each : after) else (each : before, after)
       These _ _ -> (before, after)
 
-findNearestNeighboursToDiff :: (These (Term f (Record fields)) (Term f (Record fields)) -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
-                           -> ComparabilityRelation f fields -- ^ A relation determining whether two terms can be compared.
-                           -> [TermOrIndexOrNone (UnmappedTerm f fields)]
-                           -> [UnmappedTerm f fields]
-                           -> [UnmappedTerm f fields]
-                           -> ([(These Int Int, These (Term f (Record fields)) (Term f (Record fields)))], UnmappedTerms f fields)
+findNearestNeighboursToDiff :: (These (Term syntax (Record fields)) (Term syntax (Record fields)) -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
+                           -> ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
+                           -> [TermOrIndexOrNone (UnmappedTerm syntax fields)]
+                           -> [UnmappedTerm syntax fields]
+                           -> [UnmappedTerm syntax fields]
+                           -> ([(These Int Int, These (Term syntax (Record fields)) (Term syntax (Record fields)))], UnmappedTerms syntax fields)
 findNearestNeighboursToDiff editDistance canCompare allDiffs featureAs featureBs = (diffs, remaining)
   where
     (diffs, (_, remaining, _)) =
@@ -130,24 +130,24 @@ findNearestNeighboursToDiff editDistance canCompare allDiffs featureAs featureBs
       fmap catMaybes &
       (`runState` (minimumTermIndex featureAs, toMap featureAs, toMap featureBs))
 
-findNearestNeighbourToDiff' :: (Diff f fields -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
-                           -> ComparabilityRelation f fields -- ^ A relation determining whether two terms can be compared.
-                           -> Both.Both (KdTree Double (UnmappedTerm f fields))
-                           -> TermOrIndexOrNone (UnmappedTerm f fields)
-                           -> State (Int, UnmappedTerms f fields, UnmappedTerms f fields)
-                                    (Maybe (MappedDiff f fields))
+findNearestNeighbourToDiff' :: (Diff syntax fields -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
+                           -> ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
+                           -> Both.Both (KdTree Double (UnmappedTerm syntax fields))
+                           -> TermOrIndexOrNone (UnmappedTerm syntax fields)
+                           -> State (Int, UnmappedTerms syntax fields, UnmappedTerms syntax fields)
+                                    (Maybe (MappedDiff syntax fields))
 findNearestNeighbourToDiff' editDistance canCompare kdTrees termThing = case termThing of
   None -> pure Nothing
   RWS.Term term -> Just <$> findNearestNeighbourTo editDistance canCompare kdTrees term
   Index i -> modify' (\ (_, unA, unB) -> (i, unA, unB)) >> pure Nothing
 
 -- | Construct a diff for a term in B by matching it against the most similar eligible term in A (if any), marking both as ineligible for future matches.
-findNearestNeighbourTo :: (Diff f fields -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
-                       -> ComparabilityRelation f fields -- ^ A relation determining whether two terms can be compared.
-                       -> Both.Both (KdTree Double (UnmappedTerm f fields))
-                       -> UnmappedTerm f fields
-                       -> State (Int, UnmappedTerms f fields, UnmappedTerms f fields)
-                                (MappedDiff f fields)
+findNearestNeighbourTo :: (Diff syntax fields -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
+                       -> ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
+                       -> Both.Both (KdTree Double (UnmappedTerm syntax fields))
+                       -> UnmappedTerm syntax fields
+                       -> State (Int, UnmappedTerms syntax fields, UnmappedTerms syntax fields)
+                                (MappedDiff syntax fields)
 findNearestNeighbourTo editDistance canCompare kdTrees term@(UnmappedTerm j _ b) = do
   (previous, unmappedA, unmappedB) <- get
   fromMaybe (insertion previous unmappedA unmappedB term) $ do
@@ -172,15 +172,15 @@ isInMoveBounds previous i = previous < i && i < previous + defaultMoveBound
 --
 -- cf §4.2 of RWS-Diff
 nearestUnmapped
-  :: (Diff f fields -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
-  -> ComparabilityRelation f fields -- ^ A relation determining whether two terms can be compared.
-  -> UnmappedTerms f fields -- ^ A set of terms eligible for matching against.
-  -> KdTree Double (UnmappedTerm f fields) -- ^ The k-d tree to look up nearest neighbours within.
-  -> UnmappedTerm f fields -- ^ The term to find the nearest neighbour to.
-  -> Maybe (UnmappedTerm f fields) -- ^ The most similar unmapped term, if any.
+  :: (Diff syntax fields -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
+  -> ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
+  -> UnmappedTerms syntax fields -- ^ A set of terms eligible for matching against.
+  -> KdTree Double (UnmappedTerm syntax fields) -- ^ The k-d tree to look up nearest neighbours within.
+  -> UnmappedTerm syntax fields -- ^ The term to find the nearest neighbour to.
+  -> Maybe (UnmappedTerm syntax fields) -- ^ The most similar unmapped term, if any.
 nearestUnmapped editDistance canCompare unmapped tree key = getFirst $ foldMap (First . Just) (sortOn (editDistanceIfComparable editDistance canCompare (term key) . term) (toList (IntMap.intersection unmapped (toMap (kNearest tree defaultL key)))))
 
-editDistanceIfComparable :: Bounded t => (These (Term f (Record fields)) (Term f (Record fields)) -> t) -> ComparabilityRelation f fields -> Term f (Record fields) -> Term f (Record fields) -> t
+editDistanceIfComparable :: Bounded t => (These (Term syntax (Record fields)) (Term syntax (Record fields)) -> t) -> ComparabilityRelation syntax (Record fields) (Record fields) -> Term syntax (Record fields) -> Term syntax (Record fields) -> t
 editDistanceIfComparable editDistance canCompare a b = if canCompareTerms canCompare a b
   then editDistance (These a b)
   else maxBound
@@ -296,11 +296,11 @@ unitVector d hash = listArray (0, d - 1) ((* invMagnitude) <$> components)
     components = evalRand (sequenceA (replicate d (liftRand randomDouble))) (pureMT (fromIntegral hash))
 
 -- | Test the comparability of two root 'Term's in O(1).
-canCompareTerms :: ComparabilityRelation f fields -> Term f (Record fields) -> Term f (Record fields) -> Bool
+canCompareTerms :: ComparabilityRelation syntax (Record fields) (Record fields) -> Term syntax (Record fields) -> Term syntax (Record fields) -> Bool
 canCompareTerms canCompare = canCompare `on` unTerm
 
 -- | Recursively test the equality of two 'Term's in O(n).
-equalTerms :: Eq1 f => ComparabilityRelation f fields -> Term f (Record fields) -> Term f (Record fields) -> Bool
+equalTerms :: Eq1 syntax => ComparabilityRelation syntax (Record fields) (Record fields) -> Term syntax (Record fields) -> Term syntax (Record fields) -> Bool
 equalTerms canCompare = go
   where go a b = canCompareTerms canCompare a b && liftEq go (termOut (unTerm a)) (termOut (unTerm b))
 

From 650fe721aebddad2d255200df304d9dd2edbf393 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 09:50:07 -0400
Subject: [PATCH 14/65] :fire: a redundant import.

---
 src/Algorithm.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/Algorithm.hs b/src/Algorithm.hs
index 0a17048a7..023347356 100644
--- a/src/Algorithm.hs
+++ b/src/Algorithm.hs
@@ -4,7 +4,6 @@ module Algorithm where
 import Control.Applicative (liftA2)
 import Control.Monad (guard, join)
 import Control.Monad.Free.Freer
-import Data.Function (on)
 import Data.Functor.Classes
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Maybe

From aef9c4c48688eff26d534d81eeb691acc0cd0a86 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 09:53:03 -0400
Subject: [PATCH 15/65] Abstract the Diff synonym in RWS over the annotation
 types.

---
 src/RWS.hs | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index d4760d6be..f914a8682 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -45,17 +45,17 @@ type ComparabilityRelation syntax ann1 ann2 = forall a b. TermF syntax ann1 a ->
 type FeatureVector = UArray Int Double
 
 -- | A term which has not yet been mapped by `rws`, along with its feature vector summary & index.
-data UnmappedTerm f fields = UnmappedTerm {
+data UnmappedTerm syntax fields = UnmappedTerm {
     termIndex :: {-# UNPACK #-} !Int -- ^ The index of the term within its root term.
   , feature   :: {-# UNPACK #-} !FeatureVector -- ^ Feature vector
-  , term      :: Term f (Record fields) -- ^ The unmapped term
+  , term      :: Term syntax (Record fields) -- ^ The unmapped term
 }
 
 -- | Either a `term`, an index of a matched term, or nil.
 data TermOrIndexOrNone term = Term term | Index {-# UNPACK #-} !Int | None
 
 rws :: (HasField fields FeatureVector, Functor syntax, Eq1 syntax)
-    => (Diff syntax fields -> Int)
+    => (Diff syntax (Record fields) (Record fields) -> Int)
     -> ComparabilityRelation syntax (Record fields) (Record fields)
     -> [Term syntax (Record fields)]
     -> [Term syntax (Record fields)]
@@ -72,14 +72,14 @@ rws editDistance canCompare as bs =
   in fmap snd rwsDiffs
 
 -- | An IntMap of unmapped terms keyed by their position in a list of terms.
-type UnmappedTerms f fields = IntMap.IntMap (UnmappedTerm f fields)
+type UnmappedTerms syntax fields = IntMap.IntMap (UnmappedTerm syntax fields)
 
-type Diff f fields = These (Term f (Record fields)) (Term f (Record fields))
+type Diff syntax ann1 ann2 = These (Term syntax ann1) (Term syntax ann2)
 
 -- A Diff paired with both its indices
-type MappedDiff f fields = (These Int Int, Diff f fields)
+type MappedDiff syntax fields = (These Int Int, Diff syntax (Record fields) (Record fields))
 
-type RWSEditScript f fields = [Diff f fields]
+type RWSEditScript syntax fields = [Diff syntax (Record fields) (Record fields)]
 
 insertMapped :: Foldable t => t (MappedDiff f fields) -> [MappedDiff f fields] -> [MappedDiff f fields]
 insertMapped diffs into = foldl' (flip insertDiff) into diffs
@@ -130,7 +130,7 @@ findNearestNeighboursToDiff editDistance canCompare allDiffs featureAs featureBs
       fmap catMaybes &
       (`runState` (minimumTermIndex featureAs, toMap featureAs, toMap featureBs))
 
-findNearestNeighbourToDiff' :: (Diff syntax fields -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
+findNearestNeighbourToDiff' :: (Diff syntax (Record fields) (Record fields) -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
                            -> ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
                            -> Both.Both (KdTree Double (UnmappedTerm syntax fields))
                            -> TermOrIndexOrNone (UnmappedTerm syntax fields)
@@ -142,7 +142,7 @@ findNearestNeighbourToDiff' editDistance canCompare kdTrees termThing = case ter
   Index i -> modify' (\ (_, unA, unB) -> (i, unA, unB)) >> pure Nothing
 
 -- | Construct a diff for a term in B by matching it against the most similar eligible term in A (if any), marking both as ineligible for future matches.
-findNearestNeighbourTo :: (Diff syntax fields -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
+findNearestNeighbourTo :: (Diff syntax (Record fields) (Record fields) -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
                        -> ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
                        -> Both.Both (KdTree Double (UnmappedTerm syntax fields))
                        -> UnmappedTerm syntax fields
@@ -172,7 +172,7 @@ isInMoveBounds previous i = previous < i && i < previous + defaultMoveBound
 --
 -- cf §4.2 of RWS-Diff
 nearestUnmapped
-  :: (Diff syntax fields -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
+  :: (Diff syntax (Record fields) (Record fields) -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
   -> ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
   -> UnmappedTerms syntax fields -- ^ A set of terms eligible for matching against.
   -> KdTree Double (UnmappedTerm syntax fields) -- ^ The k-d tree to look up nearest neighbours within.

From db88041a18313d480e18745db75b9d7b6770c8f8 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 09:54:18 -0400
Subject: [PATCH 16/65] Abstract the RWSEditScript synonym over the annotation
 types.

---
 src/RWS.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index f914a8682..0f95ff7cb 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -59,7 +59,7 @@ rws :: (HasField fields FeatureVector, Functor syntax, Eq1 syntax)
     -> ComparabilityRelation syntax (Record fields) (Record fields)
     -> [Term syntax (Record fields)]
     -> [Term syntax (Record fields)]
-    -> RWSEditScript syntax fields
+    -> RWSEditScript syntax (Record fields) (Record fields)
 rws _            _          as [] = This <$> as
 rws _            _          [] bs = That <$> bs
 rws _            canCompare [a] [b] = if canCompareTerms canCompare a b then [These a b] else [That b, This a]
@@ -79,7 +79,7 @@ type Diff syntax ann1 ann2 = These (Term syntax ann1) (Term syntax ann2)
 -- A Diff paired with both its indices
 type MappedDiff syntax fields = (These Int Int, Diff syntax (Record fields) (Record fields))
 
-type RWSEditScript syntax fields = [Diff syntax (Record fields) (Record fields)]
+type RWSEditScript syntax ann1 ann2 = [Diff syntax ann1 ann2]
 
 insertMapped :: Foldable t => t (MappedDiff f fields) -> [MappedDiff f fields] -> [MappedDiff f fields]
 insertMapped diffs into = foldl' (flip insertDiff) into diffs
@@ -205,9 +205,9 @@ insertion previous unmappedA unmappedB (UnmappedTerm j _ b) = do
   put (previous, unmappedA, IntMap.delete j unmappedB)
   pure (That j, That b)
 
-genFeaturizedTermsAndDiffs :: (Functor f, HasField fields FeatureVector)
-                           => RWSEditScript f fields
-                           -> ([UnmappedTerm f fields], [UnmappedTerm f fields], [MappedDiff f fields], [TermOrIndexOrNone (UnmappedTerm f fields)])
+genFeaturizedTermsAndDiffs :: (Functor syntax, HasField fields FeatureVector)
+                           => RWSEditScript syntax (Record fields) (Record fields)
+                           -> ([UnmappedTerm syntax fields], [UnmappedTerm syntax fields], [MappedDiff syntax fields], [TermOrIndexOrNone (UnmappedTerm syntax fields)])
 genFeaturizedTermsAndDiffs sesDiffs = let Mapping _ _ a b c d = foldl' combine (Mapping 0 0 [] [] [] []) sesDiffs in (reverse a, reverse b, reverse c, reverse d)
   where combine (Mapping counterA counterB as bs mappedDiffs allDiffs) diff = case diff of
           This term -> Mapping (succ counterA) counterB (featurize counterA term : as) bs mappedDiffs (None : allDiffs)

From 17fd98fb9a55a856aa82d7e4d16a859f7c17c4e5 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 09:56:57 -0400
Subject: [PATCH 17/65] Abstract the MappedDiff synonym over the annotation
 types.

---
 src/RWS.hs | 34 +++++++++++++++++-----------------
 1 file changed, 17 insertions(+), 17 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index 0f95ff7cb..c8acee7f0 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -77,24 +77,24 @@ type UnmappedTerms syntax fields = IntMap.IntMap (UnmappedTerm syntax fields)
 type Diff syntax ann1 ann2 = These (Term syntax ann1) (Term syntax ann2)
 
 -- A Diff paired with both its indices
-type MappedDiff syntax fields = (These Int Int, Diff syntax (Record fields) (Record fields))
+type MappedDiff syntax ann1 ann2 = (These Int Int, Diff syntax ann1 ann2)
 
 type RWSEditScript syntax ann1 ann2 = [Diff syntax ann1 ann2]
 
-insertMapped :: Foldable t => t (MappedDiff f fields) -> [MappedDiff f fields] -> [MappedDiff f fields]
+insertMapped :: Foldable t => t (MappedDiff syntax (Record fields) (Record fields)) -> [MappedDiff syntax (Record fields) (Record fields)] -> [MappedDiff syntax (Record fields) (Record fields)]
 insertMapped diffs into = foldl' (flip insertDiff) into diffs
 
 deleteRemaining :: (Traversable t)
-                => [MappedDiff f fields]
-                -> t (UnmappedTerm f fields)
-                -> [MappedDiff f fields]
+                => [MappedDiff syntax (Record fields) (Record fields)]
+                -> t (UnmappedTerm syntax fields)
+                -> [MappedDiff syntax (Record fields) (Record fields)]
 deleteRemaining diffs unmappedAs =
   foldl' (flip insertDiff) diffs ((This . termIndex &&& This . term) <$> unmappedAs)
 
 -- | Inserts an index and diff pair into a list of indices and diffs.
-insertDiff :: MappedDiff f fields
-           -> [MappedDiff f fields]
-           -> [MappedDiff f fields]
+insertDiff :: MappedDiff syntax (Record fields) (Record fields)
+           -> [MappedDiff syntax (Record fields) (Record fields)]
+           -> [MappedDiff syntax (Record fields) (Record fields)]
 insertDiff inserted [] = [ inserted ]
 insertDiff a@(ij1, _) (b@(ij2, _):rest) = case (ij1, ij2) of
   (These i1 i2, These j1 j2) -> if i1 <= j1 && i2 <= j2 then a : b : rest else b : insertDiff a rest
@@ -135,7 +135,7 @@ findNearestNeighbourToDiff' :: (Diff syntax (Record fields) (Record fields) -> I
                            -> Both.Both (KdTree Double (UnmappedTerm syntax fields))
                            -> TermOrIndexOrNone (UnmappedTerm syntax fields)
                            -> State (Int, UnmappedTerms syntax fields, UnmappedTerms syntax fields)
-                                    (Maybe (MappedDiff syntax fields))
+                                    (Maybe (MappedDiff syntax (Record fields) (Record fields)))
 findNearestNeighbourToDiff' editDistance canCompare kdTrees termThing = case termThing of
   None -> pure Nothing
   RWS.Term term -> Just <$> findNearestNeighbourTo editDistance canCompare kdTrees term
@@ -147,7 +147,7 @@ findNearestNeighbourTo :: (Diff syntax (Record fields) (Record fields) -> Int) -
                        -> Both.Both (KdTree Double (UnmappedTerm syntax fields))
                        -> UnmappedTerm syntax fields
                        -> State (Int, UnmappedTerms syntax fields, UnmappedTerms syntax fields)
-                                (MappedDiff syntax fields)
+                                (MappedDiff syntax (Record fields) (Record fields))
 findNearestNeighbourTo editDistance canCompare kdTrees term@(UnmappedTerm j _ b) = do
   (previous, unmappedA, unmappedB) <- get
   fromMaybe (insertion previous unmappedA unmappedB term) $ do
@@ -196,25 +196,25 @@ defaultMoveBound = 2
 -- Returns a state (insertion index, old unmapped terms, new unmapped terms), and value of (index, inserted diff),
 -- given a previous index, two sets of umapped terms, and an unmapped term to insert.
 insertion :: Int
-             -> UnmappedTerms f fields
-             -> UnmappedTerms f fields
-             -> UnmappedTerm f fields
-             -> State (Int, UnmappedTerms f fields, UnmappedTerms f fields)
-                      (MappedDiff f fields)
+             -> UnmappedTerms syntax fields
+             -> UnmappedTerms syntax fields
+             -> UnmappedTerm syntax fields
+             -> State (Int, UnmappedTerms syntax fields, UnmappedTerms syntax fields)
+                      (MappedDiff syntax (Record fields) (Record fields))
 insertion previous unmappedA unmappedB (UnmappedTerm j _ b) = do
   put (previous, unmappedA, IntMap.delete j unmappedB)
   pure (That j, That b)
 
 genFeaturizedTermsAndDiffs :: (Functor syntax, HasField fields FeatureVector)
                            => RWSEditScript syntax (Record fields) (Record fields)
-                           -> ([UnmappedTerm syntax fields], [UnmappedTerm syntax fields], [MappedDiff syntax fields], [TermOrIndexOrNone (UnmappedTerm syntax fields)])
+                           -> ([UnmappedTerm syntax fields], [UnmappedTerm syntax fields], [MappedDiff syntax (Record fields) (Record fields)], [TermOrIndexOrNone (UnmappedTerm syntax fields)])
 genFeaturizedTermsAndDiffs sesDiffs = let Mapping _ _ a b c d = foldl' combine (Mapping 0 0 [] [] [] []) sesDiffs in (reverse a, reverse b, reverse c, reverse d)
   where combine (Mapping counterA counterB as bs mappedDiffs allDiffs) diff = case diff of
           This term -> Mapping (succ counterA) counterB (featurize counterA term : as) bs mappedDiffs (None : allDiffs)
           That term -> Mapping counterA (succ counterB) as (featurize counterB term : bs) mappedDiffs (RWS.Term (featurize counterB term) : allDiffs)
           These a b -> Mapping (succ counterA) (succ counterB) as bs ((These counterA counterB, These a b) : mappedDiffs) (Index counterA : allDiffs)
 
-data Mapping f fields = Mapping {-# UNPACK #-} !Int {-# UNPACK #-} !Int ![UnmappedTerm f fields] ![UnmappedTerm f fields] ![MappedDiff f fields] ![TermOrIndexOrNone (UnmappedTerm f fields)]
+data Mapping syntax fields = Mapping {-# UNPACK #-} !Int {-# UNPACK #-} !Int ![UnmappedTerm syntax fields] ![UnmappedTerm syntax fields] ![MappedDiff syntax (Record fields) (Record fields)] ![TermOrIndexOrNone (UnmappedTerm syntax fields)]
 
 featurize :: (HasField fields FeatureVector, Functor f) => Int -> Term f (Record fields) -> UnmappedTerm f fields
 featurize index term = UnmappedTerm index (getField (extract term)) (eraseFeatureVector term)

From 3df93e09dd3d7fbf9b7824df957735bfa379da7d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 09:59:24 -0400
Subject: [PATCH 18/65] Abstract UnmappedTerm & UnmappedTerms over the
 annotation type.

---
 src/RWS.hs | 50 +++++++++++++++++++++++++-------------------------
 1 file changed, 25 insertions(+), 25 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index c8acee7f0..cc7444ebe 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -45,10 +45,10 @@ type ComparabilityRelation syntax ann1 ann2 = forall a b. TermF syntax ann1 a ->
 type FeatureVector = UArray Int Double
 
 -- | A term which has not yet been mapped by `rws`, along with its feature vector summary & index.
-data UnmappedTerm syntax fields = UnmappedTerm {
+data UnmappedTerm syntax ann = UnmappedTerm {
     termIndex :: {-# UNPACK #-} !Int -- ^ The index of the term within its root term.
   , feature   :: {-# UNPACK #-} !FeatureVector -- ^ Feature vector
-  , term      :: Term syntax (Record fields) -- ^ The unmapped term
+  , term      :: Term syntax ann -- ^ The unmapped term
 }
 
 -- | Either a `term`, an index of a matched term, or nil.
@@ -72,7 +72,7 @@ rws editDistance canCompare as bs =
   in fmap snd rwsDiffs
 
 -- | An IntMap of unmapped terms keyed by their position in a list of terms.
-type UnmappedTerms syntax fields = IntMap.IntMap (UnmappedTerm syntax fields)
+type UnmappedTerms syntax ann = IntMap.IntMap (UnmappedTerm syntax ann)
 
 type Diff syntax ann1 ann2 = These (Term syntax ann1) (Term syntax ann2)
 
@@ -86,7 +86,7 @@ insertMapped diffs into = foldl' (flip insertDiff) into diffs
 
 deleteRemaining :: (Traversable t)
                 => [MappedDiff syntax (Record fields) (Record fields)]
-                -> t (UnmappedTerm syntax fields)
+                -> t (UnmappedTerm syntax (Record fields))
                 -> [MappedDiff syntax (Record fields) (Record fields)]
 deleteRemaining diffs unmappedAs =
   foldl' (flip insertDiff) diffs ((This . termIndex &&& This . term) <$> unmappedAs)
@@ -119,10 +119,10 @@ insertDiff a@(ij1, _) (b@(ij2, _):rest) = case (ij1, ij2) of
 
 findNearestNeighboursToDiff :: (These (Term syntax (Record fields)) (Term syntax (Record fields)) -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
                            -> ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
-                           -> [TermOrIndexOrNone (UnmappedTerm syntax fields)]
-                           -> [UnmappedTerm syntax fields]
-                           -> [UnmappedTerm syntax fields]
-                           -> ([(These Int Int, These (Term syntax (Record fields)) (Term syntax (Record fields)))], UnmappedTerms syntax fields)
+                           -> [TermOrIndexOrNone (UnmappedTerm syntax (Record fields))]
+                           -> [UnmappedTerm syntax (Record fields)]
+                           -> [UnmappedTerm syntax (Record fields)]
+                           -> ([(These Int Int, These (Term syntax (Record fields)) (Term syntax (Record fields)))], UnmappedTerms syntax (Record fields))
 findNearestNeighboursToDiff editDistance canCompare allDiffs featureAs featureBs = (diffs, remaining)
   where
     (diffs, (_, remaining, _)) =
@@ -132,9 +132,9 @@ findNearestNeighboursToDiff editDistance canCompare allDiffs featureAs featureBs
 
 findNearestNeighbourToDiff' :: (Diff syntax (Record fields) (Record fields) -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
                            -> ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
-                           -> Both.Both (KdTree Double (UnmappedTerm syntax fields))
-                           -> TermOrIndexOrNone (UnmappedTerm syntax fields)
-                           -> State (Int, UnmappedTerms syntax fields, UnmappedTerms syntax fields)
+                           -> Both.Both (KdTree Double (UnmappedTerm syntax (Record fields)))
+                           -> TermOrIndexOrNone (UnmappedTerm syntax (Record fields))
+                           -> State (Int, UnmappedTerms syntax (Record fields), UnmappedTerms syntax (Record fields))
                                     (Maybe (MappedDiff syntax (Record fields) (Record fields)))
 findNearestNeighbourToDiff' editDistance canCompare kdTrees termThing = case termThing of
   None -> pure Nothing
@@ -144,9 +144,9 @@ findNearestNeighbourToDiff' editDistance canCompare kdTrees termThing = case ter
 -- | Construct a diff for a term in B by matching it against the most similar eligible term in A (if any), marking both as ineligible for future matches.
 findNearestNeighbourTo :: (Diff syntax (Record fields) (Record fields) -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
                        -> ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
-                       -> Both.Both (KdTree Double (UnmappedTerm syntax fields))
-                       -> UnmappedTerm syntax fields
-                       -> State (Int, UnmappedTerms syntax fields, UnmappedTerms syntax fields)
+                       -> Both.Both (KdTree Double (UnmappedTerm syntax (Record fields)))
+                       -> UnmappedTerm syntax (Record fields)
+                       -> State (Int, UnmappedTerms syntax (Record fields), UnmappedTerms syntax (Record fields))
                                 (MappedDiff syntax (Record fields) (Record fields))
 findNearestNeighbourTo editDistance canCompare kdTrees term@(UnmappedTerm j _ b) = do
   (previous, unmappedA, unmappedB) <- get
@@ -174,10 +174,10 @@ isInMoveBounds previous i = previous < i && i < previous + defaultMoveBound
 nearestUnmapped
   :: (Diff syntax (Record fields) (Record fields) -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
   -> ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
-  -> UnmappedTerms syntax fields -- ^ A set of terms eligible for matching against.
-  -> KdTree Double (UnmappedTerm syntax fields) -- ^ The k-d tree to look up nearest neighbours within.
-  -> UnmappedTerm syntax fields -- ^ The term to find the nearest neighbour to.
-  -> Maybe (UnmappedTerm syntax fields) -- ^ The most similar unmapped term, if any.
+  -> UnmappedTerms syntax (Record fields) -- ^ A set of terms eligible for matching against.
+  -> KdTree Double (UnmappedTerm syntax (Record fields)) -- ^ The k-d tree to look up nearest neighbours within.
+  -> UnmappedTerm syntax (Record fields) -- ^ The term to find the nearest neighbour to.
+  -> Maybe (UnmappedTerm syntax (Record fields)) -- ^ The most similar unmapped term, if any.
 nearestUnmapped editDistance canCompare unmapped tree key = getFirst $ foldMap (First . Just) (sortOn (editDistanceIfComparable editDistance canCompare (term key) . term) (toList (IntMap.intersection unmapped (toMap (kNearest tree defaultL key)))))
 
 editDistanceIfComparable :: Bounded t => (These (Term syntax (Record fields)) (Term syntax (Record fields)) -> t) -> ComparabilityRelation syntax (Record fields) (Record fields) -> Term syntax (Record fields) -> Term syntax (Record fields) -> t
@@ -196,10 +196,10 @@ defaultMoveBound = 2
 -- Returns a state (insertion index, old unmapped terms, new unmapped terms), and value of (index, inserted diff),
 -- given a previous index, two sets of umapped terms, and an unmapped term to insert.
 insertion :: Int
-             -> UnmappedTerms syntax fields
-             -> UnmappedTerms syntax fields
-             -> UnmappedTerm syntax fields
-             -> State (Int, UnmappedTerms syntax fields, UnmappedTerms syntax fields)
+             -> UnmappedTerms syntax (Record fields)
+             -> UnmappedTerms syntax (Record fields)
+             -> UnmappedTerm syntax (Record fields)
+             -> State (Int, UnmappedTerms syntax (Record fields), UnmappedTerms syntax (Record fields))
                       (MappedDiff syntax (Record fields) (Record fields))
 insertion previous unmappedA unmappedB (UnmappedTerm j _ b) = do
   put (previous, unmappedA, IntMap.delete j unmappedB)
@@ -207,16 +207,16 @@ insertion previous unmappedA unmappedB (UnmappedTerm j _ b) = do
 
 genFeaturizedTermsAndDiffs :: (Functor syntax, HasField fields FeatureVector)
                            => RWSEditScript syntax (Record fields) (Record fields)
-                           -> ([UnmappedTerm syntax fields], [UnmappedTerm syntax fields], [MappedDiff syntax (Record fields) (Record fields)], [TermOrIndexOrNone (UnmappedTerm syntax fields)])
+                           -> ([UnmappedTerm syntax (Record fields)], [UnmappedTerm syntax (Record fields)], [MappedDiff syntax (Record fields) (Record fields)], [TermOrIndexOrNone (UnmappedTerm syntax (Record fields))])
 genFeaturizedTermsAndDiffs sesDiffs = let Mapping _ _ a b c d = foldl' combine (Mapping 0 0 [] [] [] []) sesDiffs in (reverse a, reverse b, reverse c, reverse d)
   where combine (Mapping counterA counterB as bs mappedDiffs allDiffs) diff = case diff of
           This term -> Mapping (succ counterA) counterB (featurize counterA term : as) bs mappedDiffs (None : allDiffs)
           That term -> Mapping counterA (succ counterB) as (featurize counterB term : bs) mappedDiffs (RWS.Term (featurize counterB term) : allDiffs)
           These a b -> Mapping (succ counterA) (succ counterB) as bs ((These counterA counterB, These a b) : mappedDiffs) (Index counterA : allDiffs)
 
-data Mapping syntax fields = Mapping {-# UNPACK #-} !Int {-# UNPACK #-} !Int ![UnmappedTerm syntax fields] ![UnmappedTerm syntax fields] ![MappedDiff syntax (Record fields) (Record fields)] ![TermOrIndexOrNone (UnmappedTerm syntax fields)]
+data Mapping syntax fields = Mapping {-# UNPACK #-} !Int {-# UNPACK #-} !Int ![UnmappedTerm syntax (Record fields)] ![UnmappedTerm syntax (Record fields)] ![MappedDiff syntax (Record fields) (Record fields)] ![TermOrIndexOrNone (UnmappedTerm syntax (Record fields))]
 
-featurize :: (HasField fields FeatureVector, Functor f) => Int -> Term f (Record fields) -> UnmappedTerm f fields
+featurize :: (HasField fields FeatureVector, Functor syntax) => Int -> Term syntax (Record fields) -> UnmappedTerm syntax (Record fields)
 featurize index term = UnmappedTerm index (getField (extract term)) (eraseFeatureVector term)
 
 eraseFeatureVector :: (Functor f, HasField fields FeatureVector) => Term f (Record fields) -> Term f (Record fields)

From 0c95006f37d367e0f68c9f5e21903c8701616ba5 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 10:00:15 -0400
Subject: [PATCH 19/65] Rename some type parameters.

---
 src/RWS.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index cc7444ebe..b7b2071df 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -228,13 +228,13 @@ nullFeatureVector = listArray (0, 0) [0]
 setFeatureVector :: HasField fields FeatureVector => Record fields -> FeatureVector -> Record fields
 setFeatureVector = setField
 
-minimumTermIndex :: [RWS.UnmappedTerm f fields] -> Int
+minimumTermIndex :: [UnmappedTerm syntax ann] -> Int
 minimumTermIndex = pred . maybe 0 getMin . getOption . foldMap (Option . Just . Min . termIndex)
 
-toMap :: [UnmappedTerm f fields] -> IntMap.IntMap (UnmappedTerm f fields)
+toMap :: [UnmappedTerm syntax ann] -> IntMap.IntMap (UnmappedTerm syntax ann)
 toMap = IntMap.fromList . fmap (termIndex &&& id)
 
-toKdTree :: [UnmappedTerm f fields] -> KdTree Double (UnmappedTerm f fields)
+toKdTree :: [UnmappedTerm syntax ann] -> KdTree Double (UnmappedTerm syntax ann)
 toKdTree = build (elems . feature)
 
 -- | A `Gram` is a fixed-size view of some portion of a tree, consisting of a `stem` of _p_ labels for parent nodes, and a `base` of _q_ labels of sibling nodes. Collectively, the bag of `Gram`s for each node of a tree (e.g. as computed by `pqGrams`) form a summary of the tree.

From 840a15982cd515ef5f3d169ddf74eb83d8c78c60 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 10:00:48 -0400
Subject: [PATCH 20/65] Reindent insertion.

---
 src/RWS.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index b7b2071df..5cbd794e2 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -196,11 +196,11 @@ defaultMoveBound = 2
 -- Returns a state (insertion index, old unmapped terms, new unmapped terms), and value of (index, inserted diff),
 -- given a previous index, two sets of umapped terms, and an unmapped term to insert.
 insertion :: Int
-             -> UnmappedTerms syntax (Record fields)
-             -> UnmappedTerms syntax (Record fields)
-             -> UnmappedTerm syntax (Record fields)
-             -> State (Int, UnmappedTerms syntax (Record fields), UnmappedTerms syntax (Record fields))
-                      (MappedDiff syntax (Record fields) (Record fields))
+          -> UnmappedTerms syntax (Record fields)
+          -> UnmappedTerms syntax (Record fields)
+          -> UnmappedTerm syntax (Record fields)
+          -> State (Int, UnmappedTerms syntax (Record fields), UnmappedTerms syntax (Record fields))
+                   (MappedDiff syntax (Record fields) (Record fields))
 insertion previous unmappedA unmappedB (UnmappedTerm j _ b) = do
   put (previous, unmappedA, IntMap.delete j unmappedB)
   pure (That j, That b)

From 334c43796b1ddb32c100321f61ce8412f24a658c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 10:01:34 -0400
Subject: [PATCH 21/65] Generalize insertion over the annotation types.

---
 src/RWS.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index 5cbd794e2..e0d23dea7 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -196,11 +196,11 @@ defaultMoveBound = 2
 -- Returns a state (insertion index, old unmapped terms, new unmapped terms), and value of (index, inserted diff),
 -- given a previous index, two sets of umapped terms, and an unmapped term to insert.
 insertion :: Int
-          -> UnmappedTerms syntax (Record fields)
-          -> UnmappedTerms syntax (Record fields)
-          -> UnmappedTerm syntax (Record fields)
-          -> State (Int, UnmappedTerms syntax (Record fields), UnmappedTerms syntax (Record fields))
-                   (MappedDiff syntax (Record fields) (Record fields))
+          -> UnmappedTerms syntax ann1
+          -> UnmappedTerms syntax ann2
+          -> UnmappedTerm syntax ann2
+          -> State (Int, UnmappedTerms syntax ann1, UnmappedTerms syntax ann2)
+                   (MappedDiff syntax ann1 ann2)
 insertion previous unmappedA unmappedB (UnmappedTerm j _ b) = do
   put (previous, unmappedA, IntMap.delete j unmappedB)
   pure (That j, That b)

From 404b51b70e5eff89c12f41371c148e397d7d2dee Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 10:02:07 -0400
Subject: [PATCH 22/65] =?UTF-8?q?Reformat=20editDistanceIfComparable?=
 =?UTF-8?q?=E2=80=99s=20type=20signature.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/RWS.hs | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index e0d23dea7..2bfd99552 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -180,7 +180,12 @@ nearestUnmapped
   -> Maybe (UnmappedTerm syntax (Record fields)) -- ^ The most similar unmapped term, if any.
 nearestUnmapped editDistance canCompare unmapped tree key = getFirst $ foldMap (First . Just) (sortOn (editDistanceIfComparable editDistance canCompare (term key) . term) (toList (IntMap.intersection unmapped (toMap (kNearest tree defaultL key)))))
 
-editDistanceIfComparable :: Bounded t => (These (Term syntax (Record fields)) (Term syntax (Record fields)) -> t) -> ComparabilityRelation syntax (Record fields) (Record fields) -> Term syntax (Record fields) -> Term syntax (Record fields) -> t
+editDistanceIfComparable :: Bounded t
+                         => (These (Term syntax (Record fields)) (Term syntax (Record fields)) -> t)
+                         -> ComparabilityRelation syntax (Record fields) (Record fields)
+                         -> Term syntax (Record fields)
+                         -> Term syntax (Record fields)
+                         -> t
 editDistanceIfComparable editDistance canCompare a b = if canCompareTerms canCompare a b
   then editDistance (These a b)
   else maxBound

From cb9235749af495bac2d91a37e4546b671a3e2774 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 10:03:37 -0400
Subject: [PATCH 23/65] Generalize canCompareTerms over the annotation types.

---
 src/RWS.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index 2bfd99552..3e05e6c81 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -14,7 +14,7 @@ import Control.Applicative (empty)
 import Control.Arrow ((&&&))
 import Control.Monad.State.Strict
 import Data.Foldable
-import Data.Function ((&), on)
+import Data.Function ((&))
 import Data.Functor.Foldable
 import Data.Hashable
 import Data.List (sortOn)
@@ -301,8 +301,8 @@ unitVector d hash = listArray (0, d - 1) ((* invMagnitude) <$> components)
     components = evalRand (sequenceA (replicate d (liftRand randomDouble))) (pureMT (fromIntegral hash))
 
 -- | Test the comparability of two root 'Term's in O(1).
-canCompareTerms :: ComparabilityRelation syntax (Record fields) (Record fields) -> Term syntax (Record fields) -> Term syntax (Record fields) -> Bool
-canCompareTerms canCompare = canCompare `on` unTerm
+canCompareTerms :: ComparabilityRelation syntax ann1 ann2 -> Term syntax ann1 -> Term syntax ann2 -> Bool
+canCompareTerms canCompare t1 t2 = canCompare (unTerm t1) (unTerm t2)
 
 -- | Recursively test the equality of two 'Term's in O(n).
 equalTerms :: Eq1 syntax => ComparabilityRelation syntax (Record fields) (Record fields) -> Term syntax (Record fields) -> Term syntax (Record fields) -> Bool

From c0b3cf0556e3582792937a16f6afd68352210388 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 10:03:46 -0400
Subject: [PATCH 24/65] Generalize equalTerms over the annotation types.

---
 src/RWS.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index 3e05e6c81..7f7a87b04 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -305,7 +305,7 @@ canCompareTerms :: ComparabilityRelation syntax ann1 ann2 -> Term syntax ann1 ->
 canCompareTerms canCompare t1 t2 = canCompare (unTerm t1) (unTerm t2)
 
 -- | Recursively test the equality of two 'Term's in O(n).
-equalTerms :: Eq1 syntax => ComparabilityRelation syntax (Record fields) (Record fields) -> Term syntax (Record fields) -> Term syntax (Record fields) -> Bool
+equalTerms :: Eq1 syntax => ComparabilityRelation syntax ann1 ann2 -> Term syntax ann1 -> Term syntax ann2 -> Bool
 equalTerms canCompare = go
   where go a b = canCompareTerms canCompare a b && liftEq go (termOut (unTerm a)) (termOut (unTerm b))
 

From 85350898605178b819753eef102166a1b952a654 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 10:03:54 -0400
Subject: [PATCH 25/65] Generalize editDistanceIfComparable over the annotation
 types.

---
 src/RWS.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index 7f7a87b04..10be1ca06 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -181,10 +181,10 @@ nearestUnmapped
 nearestUnmapped editDistance canCompare unmapped tree key = getFirst $ foldMap (First . Just) (sortOn (editDistanceIfComparable editDistance canCompare (term key) . term) (toList (IntMap.intersection unmapped (toMap (kNearest tree defaultL key)))))
 
 editDistanceIfComparable :: Bounded t
-                         => (These (Term syntax (Record fields)) (Term syntax (Record fields)) -> t)
-                         -> ComparabilityRelation syntax (Record fields) (Record fields)
-                         -> Term syntax (Record fields)
-                         -> Term syntax (Record fields)
+                         => (These (Term syntax ann1) (Term syntax ann2) -> t)
+                         -> ComparabilityRelation syntax ann1 ann2
+                         -> Term syntax ann1
+                         -> Term syntax ann2
                          -> t
 editDistanceIfComparable editDistance canCompare a b = if canCompareTerms canCompare a b
   then editDistance (These a b)

From 535933ff675dda393e9ca20933cef9b7d888a300 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 10:06:11 -0400
Subject: [PATCH 26/65] Generalize nearestUnmapped over the annotation types.

---
 src/RWS.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index 10be1ca06..d399359a9 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -172,12 +172,12 @@ isInMoveBounds previous i = previous < i && i < previous + defaultMoveBound
 --
 -- cf §4.2 of RWS-Diff
 nearestUnmapped
-  :: (Diff syntax (Record fields) (Record fields) -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
-  -> ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
-  -> UnmappedTerms syntax (Record fields) -- ^ A set of terms eligible for matching against.
-  -> KdTree Double (UnmappedTerm syntax (Record fields)) -- ^ The k-d tree to look up nearest neighbours within.
-  -> UnmappedTerm syntax (Record fields) -- ^ The term to find the nearest neighbour to.
-  -> Maybe (UnmappedTerm syntax (Record fields)) -- ^ The most similar unmapped term, if any.
+  :: (Diff syntax ann1 ann2 -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
+  -> ComparabilityRelation syntax ann1 ann2 -- ^ A relation determining whether two terms can be compared.
+  -> UnmappedTerms syntax ann2 -- ^ A set of terms eligible for matching against.
+  -> KdTree Double (UnmappedTerm syntax ann1) -- ^ The k-d tree to look up nearest neighbours within.
+  -> UnmappedTerm syntax ann1 -- ^ The term to find the nearest neighbour to.
+  -> Maybe (UnmappedTerm syntax ann2) -- ^ The most similar unmapped term, if any.
 nearestUnmapped editDistance canCompare unmapped tree key = getFirst $ foldMap (First . Just) (sortOn (editDistanceIfComparable editDistance canCompare (term key) . term) (toList (IntMap.intersection unmapped (toMap (kNearest tree defaultL key)))))
 
 editDistanceIfComparable :: Bounded t

From 58d6002f52d71e6b53ee0a66bb814af2832cd3be Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 10:08:12 -0400
Subject: [PATCH 27/65] Pass the k-d trees around separately.

---
 src/RWS.hs | 19 ++++++++++---------
 1 file changed, 10 insertions(+), 9 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index d399359a9..093ce7d25 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -28,7 +28,6 @@ import Term
 import Data.Array.Unboxed
 import Data.Functor.Classes
 import SES
-import qualified Data.Functor.Both as Both
 import Data.KdTree.Static hiding (empty, toList)
 import qualified Data.IntMap as IntMap
 
@@ -126,35 +125,37 @@ findNearestNeighboursToDiff :: (These (Term syntax (Record fields)) (Term syntax
 findNearestNeighboursToDiff editDistance canCompare allDiffs featureAs featureBs = (diffs, remaining)
   where
     (diffs, (_, remaining, _)) =
-      traverse (findNearestNeighbourToDiff' editDistance canCompare (toKdTree <$> Both.both featureAs featureBs)) allDiffs &
+      traverse (findNearestNeighbourToDiff' editDistance canCompare (toKdTree featureAs) (toKdTree featureBs)) allDiffs &
       fmap catMaybes &
       (`runState` (minimumTermIndex featureAs, toMap featureAs, toMap featureBs))
 
 findNearestNeighbourToDiff' :: (Diff syntax (Record fields) (Record fields) -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
                            -> ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
-                           -> Both.Both (KdTree Double (UnmappedTerm syntax (Record fields)))
+                           -> KdTree Double (UnmappedTerm syntax (Record fields))
+                           -> KdTree Double (UnmappedTerm syntax (Record fields))
                            -> TermOrIndexOrNone (UnmappedTerm syntax (Record fields))
                            -> State (Int, UnmappedTerms syntax (Record fields), UnmappedTerms syntax (Record fields))
                                     (Maybe (MappedDiff syntax (Record fields) (Record fields)))
-findNearestNeighbourToDiff' editDistance canCompare kdTrees termThing = case termThing of
+findNearestNeighbourToDiff' editDistance canCompare kdTreeA kdTreeB termThing = case termThing of
   None -> pure Nothing
-  RWS.Term term -> Just <$> findNearestNeighbourTo editDistance canCompare kdTrees term
+  RWS.Term term -> Just <$> findNearestNeighbourTo editDistance canCompare kdTreeA kdTreeB term
   Index i -> modify' (\ (_, unA, unB) -> (i, unA, unB)) >> pure Nothing
 
 -- | Construct a diff for a term in B by matching it against the most similar eligible term in A (if any), marking both as ineligible for future matches.
 findNearestNeighbourTo :: (Diff syntax (Record fields) (Record fields) -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
                        -> ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
-                       -> Both.Both (KdTree Double (UnmappedTerm syntax (Record fields)))
+                       -> KdTree Double (UnmappedTerm syntax (Record fields))
+                       -> KdTree Double (UnmappedTerm syntax (Record fields))
                        -> UnmappedTerm syntax (Record fields)
                        -> State (Int, UnmappedTerms syntax (Record fields), UnmappedTerms syntax (Record fields))
                                 (MappedDiff syntax (Record fields) (Record fields))
-findNearestNeighbourTo editDistance canCompare kdTrees term@(UnmappedTerm j _ b) = do
+findNearestNeighbourTo editDistance canCompare kdTreeA kdTreeB term@(UnmappedTerm j _ b) = do
   (previous, unmappedA, unmappedB) <- get
   fromMaybe (insertion previous unmappedA unmappedB term) $ do
     -- Look up the nearest unmapped term in `unmappedA`.
-    foundA@(UnmappedTerm i _ a) <- nearestUnmapped editDistance canCompare (termsWithinMoveBoundsFrom previous unmappedA) (Both.fst kdTrees) term
+    foundA@(UnmappedTerm i _ a) <- nearestUnmapped editDistance canCompare (termsWithinMoveBoundsFrom previous unmappedA) kdTreeA term
     -- Look up the nearest `foundA` in `unmappedB`
-    UnmappedTerm j' _ _ <- nearestUnmapped editDistance canCompare (termsWithinMoveBoundsFrom (pred j) unmappedB) (Both.snd kdTrees) foundA
+    UnmappedTerm j' _ _ <- nearestUnmapped editDistance canCompare (termsWithinMoveBoundsFrom (pred j) unmappedB) kdTreeB foundA
     -- Return Nothing if their indices don't match
     guard (j == j')
     guard (canCompareTerms canCompare a b)

From 3629d9114b880c94835519a51b6ac48d03b20f7f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 10:15:23 -0400
Subject: [PATCH 28/65] Generalize editDistanceUpTo over the annotation types.

---
 src/Interpreter.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 4bfced236..ca8bb5c02 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -124,7 +124,7 @@ defaultM = 10
 
 -- | Return an edit distance as the sum of it's term sizes, given an cutoff and a syntax of terms 'f a'.
 -- | Computes a constant-time approximation to the edit distance of a diff. This is done by comparing at most _m_ nodes, & assuming the rest are zero-cost.
-editDistanceUpTo :: (GAlign f, Foldable f, Functor f) => Integer -> These (Term f (Record fields)) (Term f (Record fields)) -> Int
+editDistanceUpTo :: (GAlign syntax, Foldable syntax, Functor syntax) => Integer -> These (Term syntax ann1) (Term syntax ann2) -> Int
 editDistanceUpTo m = these termSize termSize (\ a b -> diffCost m (approximateDiff a b))
   where diffCost = flip . cata $ \ diff m -> case diff of
           _ | m <= 0 -> 0

From 7bf7fd551e1e88e6e999337ae4b47b0bced59f7d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 10:17:02 -0400
Subject: [PATCH 29/65] Generalize the constant-time edit distance
 approximation function.

---
 src/RWS.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index 093ce7d25..fa33f232a 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -54,7 +54,7 @@ data UnmappedTerm syntax ann = UnmappedTerm {
 data TermOrIndexOrNone term = Term term | Index {-# UNPACK #-} !Int | None
 
 rws :: (HasField fields FeatureVector, Functor syntax, Eq1 syntax)
-    => (Diff syntax (Record fields) (Record fields) -> Int)
+    => (forall a b. Diff syntax a b -> Int)
     -> ComparabilityRelation syntax (Record fields) (Record fields)
     -> [Term syntax (Record fields)]
     -> [Term syntax (Record fields)]
@@ -116,7 +116,7 @@ insertDiff a@(ij1, _) (b@(ij2, _):rest) = case (ij1, ij2) of
       That j2 -> if i2 <= j2 then (before, each : after) else (each : before, after)
       These _ _ -> (before, after)
 
-findNearestNeighboursToDiff :: (These (Term syntax (Record fields)) (Term syntax (Record fields)) -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
+findNearestNeighboursToDiff :: (forall a b. These (Term syntax a) (Term syntax b) -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
                            -> ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
                            -> [TermOrIndexOrNone (UnmappedTerm syntax (Record fields))]
                            -> [UnmappedTerm syntax (Record fields)]
@@ -129,7 +129,7 @@ findNearestNeighboursToDiff editDistance canCompare allDiffs featureAs featureBs
       fmap catMaybes &
       (`runState` (minimumTermIndex featureAs, toMap featureAs, toMap featureBs))
 
-findNearestNeighbourToDiff' :: (Diff syntax (Record fields) (Record fields) -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
+findNearestNeighbourToDiff' :: (forall a b. Diff syntax a b -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
                            -> ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
                            -> KdTree Double (UnmappedTerm syntax (Record fields))
                            -> KdTree Double (UnmappedTerm syntax (Record fields))
@@ -142,7 +142,7 @@ findNearestNeighbourToDiff' editDistance canCompare kdTreeA kdTreeB termThing =
   Index i -> modify' (\ (_, unA, unB) -> (i, unA, unB)) >> pure Nothing
 
 -- | Construct a diff for a term in B by matching it against the most similar eligible term in A (if any), marking both as ineligible for future matches.
-findNearestNeighbourTo :: (Diff syntax (Record fields) (Record fields) -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
+findNearestNeighbourTo :: (forall a b. Diff syntax a b -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
                        -> ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
                        -> KdTree Double (UnmappedTerm syntax (Record fields))
                        -> KdTree Double (UnmappedTerm syntax (Record fields))
@@ -173,7 +173,7 @@ isInMoveBounds previous i = previous < i && i < previous + defaultMoveBound
 --
 -- cf §4.2 of RWS-Diff
 nearestUnmapped
-  :: (Diff syntax ann1 ann2 -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
+  :: (forall a b. Diff syntax a b -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
   -> ComparabilityRelation syntax ann1 ann2 -- ^ A relation determining whether two terms can be compared.
   -> UnmappedTerms syntax ann2 -- ^ A set of terms eligible for matching against.
   -> KdTree Double (UnmappedTerm syntax ann1) -- ^ The k-d tree to look up nearest neighbours within.

From 43a3970c30c70bece21d26671ca4c2bd46dd98c4 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 10:23:00 -0400
Subject: [PATCH 30/65] Move the constant-time edit distance approximation into
 RWS.

---
 src/Interpreter.hs | 19 +---------
 src/RWS.hs         | 91 +++++++++++++++++++++++++++-------------------
 2 files changed, 54 insertions(+), 56 deletions(-)

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index ca8bb5c02..b8d17684e 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -9,13 +9,11 @@ module Interpreter
 import Algorithm
 import Control.Monad.Free.Freer
 import Data.Align.Generic
-import Data.Functor.Foldable (cata)
 import Data.Functor.Classes (Eq1)
 import Data.Hashable (Hashable)
 import Data.Maybe (isJust)
 import Data.Record
 import Data.Text (Text)
-import Data.These
 import Diff
 import Info hiding (Return)
 import RWS
@@ -53,7 +51,7 @@ diffTermsWith refine comparable t1 t2 = runFreer decompose (diff t1 t2)
           Linear t1 t2 -> case galignWith diffThese (unwrap t1) (unwrap t2) of
             Just result -> merge (extract t1, extract t2) <$> sequenceA result
             _ -> byReplacing t1 t2
-          RWS as bs -> traverse diffThese (rws (editDistanceUpTo defaultM) comparable as bs)
+          RWS as bs -> traverse diffThese (rws comparable as bs)
           Delete a -> pure (deleting a)
           Insert b -> pure (inserting b)
           Replace a b -> pure (replacing a b)
@@ -116,18 +114,3 @@ comparableByCategory (In a _) (In b _) = category a == category b
 -- | Test whether two terms are comparable by their constructor.
 comparableByConstructor :: GAlign syntax => ComparabilityRelation syntax (Record fields) (Record fields)
 comparableByConstructor (In _ a) (In _ b) = isJust (galign a b)
-
-
--- | How many nodes to consider for our constant-time approximation to tree edit distance.
-defaultM :: Integer
-defaultM = 10
-
--- | Return an edit distance as the sum of it's term sizes, given an cutoff and a syntax of terms 'f a'.
--- | Computes a constant-time approximation to the edit distance of a diff. This is done by comparing at most _m_ nodes, & assuming the rest are zero-cost.
-editDistanceUpTo :: (GAlign syntax, Foldable syntax, Functor syntax) => Integer -> These (Term syntax ann1) (Term syntax ann2) -> Int
-editDistanceUpTo m = these termSize termSize (\ a b -> diffCost m (approximateDiff a b))
-  where diffCost = flip . cata $ \ diff m -> case diff of
-          _ | m <= 0 -> 0
-          Merge body -> sum (fmap ($ pred m) body)
-          body -> succ (sum (fmap ($ pred m) body))
-        approximateDiff a b = maybe (replacing a b) (merge (extract a, extract b)) (galignWith (these deleting inserting approximateDiff) (unwrap a) (unwrap b))
diff --git a/src/RWS.hs b/src/RWS.hs
index fa33f232a..07ae92ad0 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -13,6 +13,7 @@ module RWS (
 import Control.Applicative (empty)
 import Control.Arrow ((&&&))
 import Control.Monad.State.Strict
+import Data.Align.Generic
 import Data.Foldable
 import Data.Function ((&))
 import Data.Functor.Foldable
@@ -27,6 +28,7 @@ import Data.Traversable
 import Term
 import Data.Array.Unboxed
 import Data.Functor.Classes
+import Diff (DiffF(..), deleting, inserting, merge, replacing)
 import SES
 import Data.KdTree.Static hiding (empty, toList)
 import qualified Data.IntMap as IntMap
@@ -53,19 +55,18 @@ data UnmappedTerm syntax ann = UnmappedTerm {
 -- | Either a `term`, an index of a matched term, or nil.
 data TermOrIndexOrNone term = Term term | Index {-# UNPACK #-} !Int | None
 
-rws :: (HasField fields FeatureVector, Functor syntax, Eq1 syntax)
-    => (forall a b. Diff syntax a b -> Int)
-    -> ComparabilityRelation syntax (Record fields) (Record fields)
+rws :: (HasField fields FeatureVector, Eq1 syntax, Foldable syntax, Functor syntax, GAlign syntax)
+    => ComparabilityRelation syntax (Record fields) (Record fields)
     -> [Term syntax (Record fields)]
     -> [Term syntax (Record fields)]
     -> RWSEditScript syntax (Record fields) (Record fields)
-rws _            _          as [] = This <$> as
-rws _            _          [] bs = That <$> bs
-rws _            canCompare [a] [b] = if canCompareTerms canCompare a b then [These a b] else [That b, This a]
-rws editDistance canCompare as bs =
+rws _          as [] = This <$> as
+rws _          [] bs = That <$> bs
+rws canCompare [a] [b] = if canCompareTerms canCompare a b then [These a b] else [That b, This a]
+rws canCompare as bs =
   let sesDiffs = ses (equalTerms canCompare) as bs
       (featureAs, featureBs, mappedDiffs, allDiffs) = genFeaturizedTermsAndDiffs sesDiffs
-      (diffs, remaining) = findNearestNeighboursToDiff editDistance canCompare allDiffs featureAs featureBs
+      (diffs, remaining) = findNearestNeighboursToDiff canCompare allDiffs featureAs featureBs
       diffs' = deleteRemaining diffs remaining
       rwsDiffs = insertMapped mappedDiffs diffs'
   in fmap snd rwsDiffs
@@ -116,46 +117,46 @@ insertDiff a@(ij1, _) (b@(ij2, _):rest) = case (ij1, ij2) of
       That j2 -> if i2 <= j2 then (before, each : after) else (each : before, after)
       These _ _ -> (before, after)
 
-findNearestNeighboursToDiff :: (forall a b. These (Term syntax a) (Term syntax b) -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
-                           -> ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
-                           -> [TermOrIndexOrNone (UnmappedTerm syntax (Record fields))]
-                           -> [UnmappedTerm syntax (Record fields)]
-                           -> [UnmappedTerm syntax (Record fields)]
-                           -> ([(These Int Int, These (Term syntax (Record fields)) (Term syntax (Record fields)))], UnmappedTerms syntax (Record fields))
-findNearestNeighboursToDiff editDistance canCompare allDiffs featureAs featureBs = (diffs, remaining)
+findNearestNeighboursToDiff :: (Foldable syntax, Functor syntax, GAlign syntax)
+                            => ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
+                            -> [TermOrIndexOrNone (UnmappedTerm syntax (Record fields))]
+                            -> [UnmappedTerm syntax (Record fields)]
+                            -> [UnmappedTerm syntax (Record fields)]
+                            -> ([(These Int Int, These (Term syntax (Record fields)) (Term syntax (Record fields)))], UnmappedTerms syntax (Record fields))
+findNearestNeighboursToDiff canCompare allDiffs featureAs featureBs = (diffs, remaining)
   where
     (diffs, (_, remaining, _)) =
-      traverse (findNearestNeighbourToDiff' editDistance canCompare (toKdTree featureAs) (toKdTree featureBs)) allDiffs &
+      traverse (findNearestNeighbourToDiff' canCompare (toKdTree featureAs) (toKdTree featureBs)) allDiffs &
       fmap catMaybes &
       (`runState` (minimumTermIndex featureAs, toMap featureAs, toMap featureBs))
 
-findNearestNeighbourToDiff' :: (forall a b. Diff syntax a b -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
-                           -> ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
-                           -> KdTree Double (UnmappedTerm syntax (Record fields))
-                           -> KdTree Double (UnmappedTerm syntax (Record fields))
-                           -> TermOrIndexOrNone (UnmappedTerm syntax (Record fields))
-                           -> State (Int, UnmappedTerms syntax (Record fields), UnmappedTerms syntax (Record fields))
+findNearestNeighbourToDiff' :: (Foldable syntax, Functor syntax, GAlign syntax)
+                            => ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
+                            -> KdTree Double (UnmappedTerm syntax (Record fields))
+                            -> KdTree Double (UnmappedTerm syntax (Record fields))
+                            -> TermOrIndexOrNone (UnmappedTerm syntax (Record fields))
+                            -> State (Int, UnmappedTerms syntax (Record fields), UnmappedTerms syntax (Record fields))
                                     (Maybe (MappedDiff syntax (Record fields) (Record fields)))
-findNearestNeighbourToDiff' editDistance canCompare kdTreeA kdTreeB termThing = case termThing of
+findNearestNeighbourToDiff' canCompare kdTreeA kdTreeB termThing = case termThing of
   None -> pure Nothing
-  RWS.Term term -> Just <$> findNearestNeighbourTo editDistance canCompare kdTreeA kdTreeB term
+  RWS.Term term -> Just <$> findNearestNeighbourTo canCompare kdTreeA kdTreeB term
   Index i -> modify' (\ (_, unA, unB) -> (i, unA, unB)) >> pure Nothing
 
 -- | Construct a diff for a term in B by matching it against the most similar eligible term in A (if any), marking both as ineligible for future matches.
-findNearestNeighbourTo :: (forall a b. Diff syntax a b -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
-                       -> ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
+findNearestNeighbourTo :: (Foldable syntax, Functor syntax, GAlign syntax)
+                       => ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
                        -> KdTree Double (UnmappedTerm syntax (Record fields))
                        -> KdTree Double (UnmappedTerm syntax (Record fields))
                        -> UnmappedTerm syntax (Record fields)
                        -> State (Int, UnmappedTerms syntax (Record fields), UnmappedTerms syntax (Record fields))
                                 (MappedDiff syntax (Record fields) (Record fields))
-findNearestNeighbourTo editDistance canCompare kdTreeA kdTreeB term@(UnmappedTerm j _ b) = do
+findNearestNeighbourTo canCompare kdTreeA kdTreeB term@(UnmappedTerm j _ b) = do
   (previous, unmappedA, unmappedB) <- get
   fromMaybe (insertion previous unmappedA unmappedB term) $ do
     -- Look up the nearest unmapped term in `unmappedA`.
-    foundA@(UnmappedTerm i _ a) <- nearestUnmapped editDistance canCompare (termsWithinMoveBoundsFrom previous unmappedA) kdTreeA term
+    foundA@(UnmappedTerm i _ a) <- nearestUnmapped canCompare (termsWithinMoveBoundsFrom previous unmappedA) kdTreeA term
     -- Look up the nearest `foundA` in `unmappedB`
-    UnmappedTerm j' _ _ <- nearestUnmapped editDistance canCompare (termsWithinMoveBoundsFrom (pred j) unmappedB) kdTreeB foundA
+    UnmappedTerm j' _ _ <- nearestUnmapped canCompare (termsWithinMoveBoundsFrom (pred j) unmappedB) kdTreeB foundA
     -- Return Nothing if their indices don't match
     guard (j == j')
     guard (canCompareTerms canCompare a b)
@@ -173,22 +174,21 @@ isInMoveBounds previous i = previous < i && i < previous + defaultMoveBound
 --
 -- cf §4.2 of RWS-Diff
 nearestUnmapped
-  :: (forall a b. Diff syntax a b -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
-  -> ComparabilityRelation syntax ann1 ann2 -- ^ A relation determining whether two terms can be compared.
+  :: (Foldable syntax, Functor syntax, GAlign syntax)
+  => ComparabilityRelation syntax ann1 ann2 -- ^ A relation determining whether two terms can be compared.
   -> UnmappedTerms syntax ann2 -- ^ A set of terms eligible for matching against.
   -> KdTree Double (UnmappedTerm syntax ann1) -- ^ The k-d tree to look up nearest neighbours within.
   -> UnmappedTerm syntax ann1 -- ^ The term to find the nearest neighbour to.
   -> Maybe (UnmappedTerm syntax ann2) -- ^ The most similar unmapped term, if any.
-nearestUnmapped editDistance canCompare unmapped tree key = getFirst $ foldMap (First . Just) (sortOn (editDistanceIfComparable editDistance canCompare (term key) . term) (toList (IntMap.intersection unmapped (toMap (kNearest tree defaultL key)))))
+nearestUnmapped canCompare unmapped tree key = getFirst $ foldMap (First . Just) (sortOn (editDistanceIfComparable canCompare (term key) . term) (toList (IntMap.intersection unmapped (toMap (kNearest tree defaultL key)))))
 
-editDistanceIfComparable :: Bounded t
-                         => (These (Term syntax ann1) (Term syntax ann2) -> t)
-                         -> ComparabilityRelation syntax ann1 ann2
+editDistanceIfComparable :: (Foldable syntax, Functor syntax, GAlign syntax)
+                         => ComparabilityRelation syntax ann1 ann2
                          -> Term syntax ann1
                          -> Term syntax ann2
-                         -> t
-editDistanceIfComparable editDistance canCompare a b = if canCompareTerms canCompare a b
-  then editDistance (These a b)
+                         -> Int
+editDistanceIfComparable canCompare a b = if canCompareTerms canCompare a b
+  then editDistanceUpTo defaultM (These a b)
   else maxBound
 
 defaultD, defaultL, defaultP, defaultQ, defaultMoveBound :: Int
@@ -311,6 +311,21 @@ equalTerms canCompare = go
   where go a b = canCompareTerms canCompare a b && liftEq go (termOut (unTerm a)) (termOut (unTerm b))
 
 
+-- | How many nodes to consider for our constant-time approximation to tree edit distance.
+defaultM :: Integer
+defaultM = 10
+
+-- | Return an edit distance as the sum of it's term sizes, given an cutoff and a syntax of terms 'f a'.
+-- | Computes a constant-time approximation to the edit distance of a diff. This is done by comparing at most _m_ nodes, & assuming the rest are zero-cost.
+editDistanceUpTo :: (GAlign syntax, Foldable syntax, Functor syntax) => Integer -> These (Term syntax ann1) (Term syntax ann2) -> Int
+editDistanceUpTo m = these termSize termSize (\ a b -> diffCost m (approximateDiff a b))
+  where diffCost = flip . cata $ \ diff m -> case diff of
+          _ | m <= 0 -> 0
+          Merge body -> sum (fmap ($ pred m) body)
+          body -> succ (sum (fmap ($ pred m) body))
+        approximateDiff a b = maybe (replacing a b) (merge (extract a, extract b)) (galignWith (these deleting inserting approximateDiff) (unwrap a) (unwrap b))
+
+
 -- Instances
 
 instance Hashable label => Hashable (Gram label) where

From 6640e4ebcb1b52409e6e3f4470e7f71f20a38bbe Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 10:23:35 -0400
Subject: [PATCH 31/65] Realign the type signature for nearestUnmapped.

---
 src/RWS.hs | 13 ++++++-------
 1 file changed, 6 insertions(+), 7 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index 07ae92ad0..2e405ee7a 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -173,13 +173,12 @@ isInMoveBounds previous i = previous < i && i < previous + defaultMoveBound
 -- RWS can produce false positives in the case of e.g. hash collisions. Therefore, we find the _l_ nearest candidates, filter out any which have already been mapped, and select the minimum of the remaining by (a constant-time approximation of) edit distance.
 --
 -- cf §4.2 of RWS-Diff
-nearestUnmapped
-  :: (Foldable syntax, Functor syntax, GAlign syntax)
-  => ComparabilityRelation syntax ann1 ann2 -- ^ A relation determining whether two terms can be compared.
-  -> UnmappedTerms syntax ann2 -- ^ A set of terms eligible for matching against.
-  -> KdTree Double (UnmappedTerm syntax ann1) -- ^ The k-d tree to look up nearest neighbours within.
-  -> UnmappedTerm syntax ann1 -- ^ The term to find the nearest neighbour to.
-  -> Maybe (UnmappedTerm syntax ann2) -- ^ The most similar unmapped term, if any.
+nearestUnmapped :: (Foldable syntax, Functor syntax, GAlign syntax)
+                => ComparabilityRelation syntax ann1 ann2 -- ^ A relation determining whether two terms can be compared.
+                -> UnmappedTerms syntax ann2 -- ^ A set of terms eligible for matching against.
+                -> KdTree Double (UnmappedTerm syntax ann1) -- ^ The k-d tree to look up nearest neighbours within.
+                -> UnmappedTerm syntax ann1 -- ^ The term to find the nearest neighbour to.
+                -> Maybe (UnmappedTerm syntax ann2) -- ^ The most similar unmapped term, if any.
 nearestUnmapped canCompare unmapped tree key = getFirst $ foldMap (First . Just) (sortOn (editDistanceIfComparable canCompare (term key) . term) (toList (IntMap.intersection unmapped (toMap (kNearest tree defaultL key)))))
 
 editDistanceIfComparable :: (Foldable syntax, Functor syntax, GAlign syntax)

From 7fb25ffdc27bdf59f2b269cdbfabda79fab6742e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 10:30:10 -0400
Subject: [PATCH 32/65] Simplify the selection of the first result.

---
 src/RWS.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index 2e405ee7a..9055cfc79 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -20,7 +20,6 @@ import Data.Functor.Foldable
 import Data.Hashable
 import Data.List (sortOn)
 import Data.Maybe
-import Data.Monoid (First(..))
 import Data.Record
 import Data.Semigroup hiding (First(..))
 import Data.These
@@ -179,7 +178,7 @@ nearestUnmapped :: (Foldable syntax, Functor syntax, GAlign syntax)
                 -> KdTree Double (UnmappedTerm syntax ann1) -- ^ The k-d tree to look up nearest neighbours within.
                 -> UnmappedTerm syntax ann1 -- ^ The term to find the nearest neighbour to.
                 -> Maybe (UnmappedTerm syntax ann2) -- ^ The most similar unmapped term, if any.
-nearestUnmapped canCompare unmapped tree key = getFirst $ foldMap (First . Just) (sortOn (editDistanceIfComparable canCompare (term key) . term) (toList (IntMap.intersection unmapped (toMap (kNearest tree defaultL key)))))
+nearestUnmapped canCompare unmapped tree key = listToMaybe (sortOn (editDistanceIfComparable canCompare (term key) . term) (toList (IntMap.intersection unmapped (toMap (kNearest tree defaultL key)))))
 
 editDistanceIfComparable :: (Foldable syntax, Functor syntax, GAlign syntax)
                          => ComparabilityRelation syntax ann1 ann2

From 83ab58b0d7a706dbb49ca5fab996446c1a781289 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 10:50:12 -0400
Subject: [PATCH 33/65] Build k-d maps instead of trees, allowing indexing from
 the other side.

---
 src/RWS.hs | 28 +++++++++++++++-------------
 1 file changed, 15 insertions(+), 13 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index 9055cfc79..1ff40e8ba 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -29,7 +29,7 @@ import Data.Array.Unboxed
 import Data.Functor.Classes
 import Diff (DiffF(..), deleting, inserting, merge, replacing)
 import SES
-import Data.KdTree.Static hiding (empty, toList)
+import Data.KdMap.Static hiding (elems, empty)
 import qualified Data.IntMap as IntMap
 
 import Control.Monad.Random
@@ -125,14 +125,14 @@ findNearestNeighboursToDiff :: (Foldable syntax, Functor syntax, GAlign syntax)
 findNearestNeighboursToDiff canCompare allDiffs featureAs featureBs = (diffs, remaining)
   where
     (diffs, (_, remaining, _)) =
-      traverse (findNearestNeighbourToDiff' canCompare (toKdTree featureAs) (toKdTree featureBs)) allDiffs &
+      traverse (findNearestNeighbourToDiff' canCompare (toKdMap featureAs) (toKdMap featureBs)) allDiffs &
       fmap catMaybes &
       (`runState` (minimumTermIndex featureAs, toMap featureAs, toMap featureBs))
 
 findNearestNeighbourToDiff' :: (Foldable syntax, Functor syntax, GAlign syntax)
                             => ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
-                            -> KdTree Double (UnmappedTerm syntax (Record fields))
-                            -> KdTree Double (UnmappedTerm syntax (Record fields))
+                            -> KdMap Double FeatureVector (UnmappedTerm syntax (Record fields))
+                            -> KdMap Double FeatureVector (UnmappedTerm syntax (Record fields))
                             -> TermOrIndexOrNone (UnmappedTerm syntax (Record fields))
                             -> State (Int, UnmappedTerms syntax (Record fields), UnmappedTerms syntax (Record fields))
                                     (Maybe (MappedDiff syntax (Record fields) (Record fields)))
@@ -144,8 +144,8 @@ findNearestNeighbourToDiff' canCompare kdTreeA kdTreeB termThing = case termThin
 -- | Construct a diff for a term in B by matching it against the most similar eligible term in A (if any), marking both as ineligible for future matches.
 findNearestNeighbourTo :: (Foldable syntax, Functor syntax, GAlign syntax)
                        => ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
-                       -> KdTree Double (UnmappedTerm syntax (Record fields))
-                       -> KdTree Double (UnmappedTerm syntax (Record fields))
+                       -> KdMap Double FeatureVector (UnmappedTerm syntax (Record fields))
+                       -> KdMap Double FeatureVector (UnmappedTerm syntax (Record fields))
                        -> UnmappedTerm syntax (Record fields)
                        -> State (Int, UnmappedTerms syntax (Record fields), UnmappedTerms syntax (Record fields))
                                 (MappedDiff syntax (Record fields) (Record fields))
@@ -174,11 +174,13 @@ isInMoveBounds previous i = previous < i && i < previous + defaultMoveBound
 -- cf §4.2 of RWS-Diff
 nearestUnmapped :: (Foldable syntax, Functor syntax, GAlign syntax)
                 => ComparabilityRelation syntax ann1 ann2 -- ^ A relation determining whether two terms can be compared.
-                -> UnmappedTerms syntax ann2 -- ^ A set of terms eligible for matching against.
-                -> KdTree Double (UnmappedTerm syntax ann1) -- ^ The k-d tree to look up nearest neighbours within.
-                -> UnmappedTerm syntax ann1 -- ^ The term to find the nearest neighbour to.
-                -> Maybe (UnmappedTerm syntax ann2) -- ^ The most similar unmapped term, if any.
-nearestUnmapped canCompare unmapped tree key = listToMaybe (sortOn (editDistanceIfComparable canCompare (term key) . term) (toList (IntMap.intersection unmapped (toMap (kNearest tree defaultL key)))))
+                -> UnmappedTerms syntax ann1 -- ^ A set of terms eligible for matching against.
+                -> KdMap Double FeatureVector (UnmappedTerm syntax ann1) -- ^ The k-d tree to look up nearest neighbours within.
+                -> UnmappedTerm syntax ann2 -- ^ The term to find the nearest neighbour to.
+                -> Maybe (UnmappedTerm syntax ann1) -- ^ The most similar unmapped term, if any.
+nearestUnmapped canCompare unmapped tree key = listToMaybe (sortOn approximateEditDistance candidates)
+  where candidates = toList (IntMap.intersection unmapped (toMap (fmap snd (kNearest tree defaultL (feature key)))))
+        approximateEditDistance = editDistanceIfComparable (flip canCompare) (term key) . term
 
 editDistanceIfComparable :: (Foldable syntax, Functor syntax, GAlign syntax)
                          => ComparabilityRelation syntax ann1 ann2
@@ -238,8 +240,8 @@ minimumTermIndex = pred . maybe 0 getMin . getOption . foldMap (Option . Just .
 toMap :: [UnmappedTerm syntax ann] -> IntMap.IntMap (UnmappedTerm syntax ann)
 toMap = IntMap.fromList . fmap (termIndex &&& id)
 
-toKdTree :: [UnmappedTerm syntax ann] -> KdTree Double (UnmappedTerm syntax ann)
-toKdTree = build (elems . feature)
+toKdMap :: [UnmappedTerm syntax ann] -> KdMap Double FeatureVector (UnmappedTerm syntax ann)
+toKdMap = build elems . fmap (feature &&& id)
 
 -- | A `Gram` is a fixed-size view of some portion of a tree, consisting of a `stem` of _p_ labels for parent nodes, and a `base` of _q_ labels of sibling nodes. Collectively, the bag of `Gram`s for each node of a tree (e.g. as computed by `pqGrams`) form a summary of the tree.
 data Gram label = Gram { stem :: [Maybe label], base :: [Maybe label] }

From eb0700352916b99e513c9e09b8e3a437c1e0d7a7 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 10:50:30 -0400
Subject: [PATCH 34/65] Generalize findNearestNeighbourTo over the annotation
 types.

---
 src/RWS.hs | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index 1ff40e8ba..d6ac074d3 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -143,19 +143,19 @@ findNearestNeighbourToDiff' canCompare kdTreeA kdTreeB termThing = case termThin
 
 -- | Construct a diff for a term in B by matching it against the most similar eligible term in A (if any), marking both as ineligible for future matches.
 findNearestNeighbourTo :: (Foldable syntax, Functor syntax, GAlign syntax)
-                       => ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
-                       -> KdMap Double FeatureVector (UnmappedTerm syntax (Record fields))
-                       -> KdMap Double FeatureVector (UnmappedTerm syntax (Record fields))
-                       -> UnmappedTerm syntax (Record fields)
-                       -> State (Int, UnmappedTerms syntax (Record fields), UnmappedTerms syntax (Record fields))
-                                (MappedDiff syntax (Record fields) (Record fields))
+                       => ComparabilityRelation syntax ann1 ann2 -- ^ A relation determining whether two terms can be compared.
+                       -> KdMap Double FeatureVector (UnmappedTerm syntax ann1)
+                       -> KdMap Double FeatureVector (UnmappedTerm syntax ann2)
+                       -> UnmappedTerm syntax ann2
+                       -> State (Int, UnmappedTerms syntax ann1, UnmappedTerms syntax ann2)
+                                (MappedDiff syntax ann1 ann2)
 findNearestNeighbourTo canCompare kdTreeA kdTreeB term@(UnmappedTerm j _ b) = do
   (previous, unmappedA, unmappedB) <- get
   fromMaybe (insertion previous unmappedA unmappedB term) $ do
     -- Look up the nearest unmapped term in `unmappedA`.
     foundA@(UnmappedTerm i _ a) <- nearestUnmapped canCompare (termsWithinMoveBoundsFrom previous unmappedA) kdTreeA term
     -- Look up the nearest `foundA` in `unmappedB`
-    UnmappedTerm j' _ _ <- nearestUnmapped canCompare (termsWithinMoveBoundsFrom (pred j) unmappedB) kdTreeB foundA
+    UnmappedTerm j' _ _ <- nearestUnmapped (flip canCompare) (termsWithinMoveBoundsFrom (pred j) unmappedB) kdTreeB foundA
     -- Return Nothing if their indices don't match
     guard (j == j')
     guard (canCompareTerms canCompare a b)

From bfb6565502116d0ffc7a71fb4ac3cc2af0fb1a56 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 10:54:45 -0400
Subject: [PATCH 35/65] Define FeatureVector as a newtype.

---
 src/RWS.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index d6ac074d3..0efb8a6bd 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -42,7 +42,7 @@ type Label f fields label = forall b. TermF f (Record fields) b -> label
 --   This is used both to determine whether two root terms can be compared in O(1), and, recursively, to determine whether two nodes are equal in O(n); thus, comparability is defined s.t. two terms are equal if they are recursively comparable subterm-wise.
 type ComparabilityRelation syntax ann1 ann2 = forall a b. TermF syntax ann1 a -> TermF syntax ann2 b -> Bool
 
-type FeatureVector = UArray Int Double
+newtype FeatureVector = FV { unFV :: UArray Int Double }
 
 -- | A term which has not yet been mapped by `rws`, along with its feature vector summary & index.
 data UnmappedTerm syntax ann = UnmappedTerm {
@@ -229,7 +229,7 @@ eraseFeatureVector :: (Functor f, HasField fields FeatureVector) => Term f (Reco
 eraseFeatureVector (Term.Term (In record functor)) = termIn (setFeatureVector record nullFeatureVector) functor
 
 nullFeatureVector :: FeatureVector
-nullFeatureVector = listArray (0, 0) [0]
+nullFeatureVector = FV $ listArray (0, 0) [0]
 
 setFeatureVector :: HasField fields FeatureVector => Record fields -> FeatureVector -> Record fields
 setFeatureVector = setField
@@ -241,7 +241,7 @@ toMap :: [UnmappedTerm syntax ann] -> IntMap.IntMap (UnmappedTerm syntax ann)
 toMap = IntMap.fromList . fmap (termIndex &&& id)
 
 toKdMap :: [UnmappedTerm syntax ann] -> KdMap Double FeatureVector (UnmappedTerm syntax ann)
-toKdMap = build elems . fmap (feature &&& id)
+toKdMap = build (elems . unFV) . fmap (feature &&& id)
 
 -- | A `Gram` is a fixed-size view of some portion of a tree, consisting of a `stem` of _p_ labels for parent nodes, and a `base` of _q_ labels of sibling nodes. Collectively, the bag of `Gram`s for each node of a tree (e.g. as computed by `pqGrams`) form a summary of the tree.
 data Gram label = Gram { stem :: [Maybe label], base :: [Maybe label] }
@@ -264,8 +264,8 @@ featureVectorDecorator getLabel p q d
        addSubtermVector :: Functor f => FeatureVector -> Term f (Record (FeatureVector ': fields)) -> FeatureVector
        addSubtermVector v term = addVectors v (rhead (extract term))
 
-       addVectors :: UArray Int Double -> UArray Int Double -> UArray Int Double
-       addVectors as bs = listArray (0, d - 1) (fmap (\ i -> as ! i + bs ! i) [0..(d - 1)])
+       addVectors :: FeatureVector -> FeatureVector -> FeatureVector
+       addVectors (FV as) (FV bs) = FV $ listArray (0, d - 1) (fmap (\ i -> as ! i + bs ! i) [0..(d - 1)])
 
 -- | Annotates a term with the corresponding p,q-gram at each node.
 pqGramDecorator
@@ -296,7 +296,7 @@ pqGramDecorator getLabel p q = cata algebra
 
 -- | Computes a unit vector of the specified dimension from a hash.
 unitVector :: Int -> Int -> FeatureVector
-unitVector d hash = listArray (0, d - 1) ((* invMagnitude) <$> components)
+unitVector d hash = FV $ listArray (0, d - 1) ((* invMagnitude) <$> components)
   where
     invMagnitude = 1 / sqrt (sum (fmap (** 2) components))
     components = evalRand (sequenceA (replicate d (liftRand randomDouble))) (pureMT (fromIntegral hash))

From feb064e58905e4bc34f70c1eeacc58cb0512afc9 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 10:59:19 -0400
Subject: [PATCH 36/65] Reformat UnmappedTerm.

---
 src/RWS.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index 0efb8a6bd..113c89b6d 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -45,11 +45,11 @@ type ComparabilityRelation syntax ann1 ann2 = forall a b. TermF syntax ann1 a ->
 newtype FeatureVector = FV { unFV :: UArray Int Double }
 
 -- | A term which has not yet been mapped by `rws`, along with its feature vector summary & index.
-data UnmappedTerm syntax ann = UnmappedTerm {
-    termIndex :: {-# UNPACK #-} !Int -- ^ The index of the term within its root term.
+data UnmappedTerm syntax ann = UnmappedTerm
+  { termIndex :: {-# UNPACK #-} !Int -- ^ The index of the term within its root term.
   , feature   :: {-# UNPACK #-} !FeatureVector -- ^ Feature vector
   , term      :: Term syntax ann -- ^ The unmapped term
-}
+  }
 
 -- | Either a `term`, an index of a matched term, or nil.
 data TermOrIndexOrNone term = Term term | Index {-# UNPACK #-} !Int | None

From c4978b567e46274d9c0226ffc7a4018adeabfeb9 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:03:54 -0400
Subject: [PATCH 37/65] Generalize findNearestNeighbourToDiff' over the
 annotation types.

---
 src/RWS.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index 113c89b6d..467e3f816 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -130,12 +130,12 @@ findNearestNeighboursToDiff canCompare allDiffs featureAs featureBs = (diffs, re
       (`runState` (minimumTermIndex featureAs, toMap featureAs, toMap featureBs))
 
 findNearestNeighbourToDiff' :: (Foldable syntax, Functor syntax, GAlign syntax)
-                            => ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
-                            -> KdMap Double FeatureVector (UnmappedTerm syntax (Record fields))
-                            -> KdMap Double FeatureVector (UnmappedTerm syntax (Record fields))
-                            -> TermOrIndexOrNone (UnmappedTerm syntax (Record fields))
-                            -> State (Int, UnmappedTerms syntax (Record fields), UnmappedTerms syntax (Record fields))
-                                    (Maybe (MappedDiff syntax (Record fields) (Record fields)))
+                            => ComparabilityRelation syntax ann1 ann2 -- ^ A relation determining whether two terms can be compared.
+                            -> KdMap Double FeatureVector (UnmappedTerm syntax ann1)
+                            -> KdMap Double FeatureVector (UnmappedTerm syntax ann2)
+                            -> TermOrIndexOrNone (UnmappedTerm syntax ann2)
+                            -> State (Int, UnmappedTerms syntax ann1, UnmappedTerms syntax ann2)
+                                     (Maybe (MappedDiff syntax ann1 ann2))
 findNearestNeighbourToDiff' canCompare kdTreeA kdTreeB termThing = case termThing of
   None -> pure Nothing
   RWS.Term term -> Just <$> findNearestNeighbourTo canCompare kdTreeA kdTreeB term

From 2c337a6c3514add7c7122bd6fa5745a7486f626c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:04:32 -0400
Subject: [PATCH 38/65] Generalize findNearestNeighboursToDiff over the
 annotations.

---
 src/RWS.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index 467e3f816..86f88802b 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -117,11 +117,11 @@ insertDiff a@(ij1, _) (b@(ij2, _):rest) = case (ij1, ij2) of
       These _ _ -> (before, after)
 
 findNearestNeighboursToDiff :: (Foldable syntax, Functor syntax, GAlign syntax)
-                            => ComparabilityRelation syntax (Record fields) (Record fields) -- ^ A relation determining whether two terms can be compared.
-                            -> [TermOrIndexOrNone (UnmappedTerm syntax (Record fields))]
-                            -> [UnmappedTerm syntax (Record fields)]
-                            -> [UnmappedTerm syntax (Record fields)]
-                            -> ([(These Int Int, These (Term syntax (Record fields)) (Term syntax (Record fields)))], UnmappedTerms syntax (Record fields))
+                            => ComparabilityRelation syntax ann1 ann2 -- ^ A relation determining whether two terms can be compared.
+                            -> [TermOrIndexOrNone (UnmappedTerm syntax ann2)]
+                            -> [UnmappedTerm syntax ann1]
+                            -> [UnmappedTerm syntax ann2]
+                            -> ([(These Int Int, These (Term syntax ann1) (Term syntax ann2))], UnmappedTerms syntax ann1)
 findNearestNeighboursToDiff canCompare allDiffs featureAs featureBs = (diffs, remaining)
   where
     (diffs, (_, remaining, _)) =

From e74f888ef2b7b54a4df3828e4e3434e4bbf9ee11 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:04:49 -0400
Subject: [PATCH 39/65] Generalize insertDiff over the annotation types.

---
 src/RWS.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index 86f88802b..a11cbe810 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -91,9 +91,9 @@ deleteRemaining diffs unmappedAs =
   foldl' (flip insertDiff) diffs ((This . termIndex &&& This . term) <$> unmappedAs)
 
 -- | Inserts an index and diff pair into a list of indices and diffs.
-insertDiff :: MappedDiff syntax (Record fields) (Record fields)
-           -> [MappedDiff syntax (Record fields) (Record fields)]
-           -> [MappedDiff syntax (Record fields) (Record fields)]
+insertDiff :: MappedDiff syntax ann1 ann2
+           -> [MappedDiff syntax ann1 ann2]
+           -> [MappedDiff syntax ann1 ann2]
 insertDiff inserted [] = [ inserted ]
 insertDiff a@(ij1, _) (b@(ij2, _):rest) = case (ij1, ij2) of
   (These i1 i2, These j1 j2) -> if i1 <= j1 && i2 <= j2 then a : b : rest else b : insertDiff a rest

From 3d1e3ffec7182161e55cbaa9e1b149d1e12759e4 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:05:16 -0400
Subject: [PATCH 40/65] Generalize deleteRemaining over the annotation types.

---
 src/RWS.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index a11cbe810..deb68fffd 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -83,10 +83,10 @@ type RWSEditScript syntax ann1 ann2 = [Diff syntax ann1 ann2]
 insertMapped :: Foldable t => t (MappedDiff syntax (Record fields) (Record fields)) -> [MappedDiff syntax (Record fields) (Record fields)] -> [MappedDiff syntax (Record fields) (Record fields)]
 insertMapped diffs into = foldl' (flip insertDiff) into diffs
 
-deleteRemaining :: (Traversable t)
-                => [MappedDiff syntax (Record fields) (Record fields)]
-                -> t (UnmappedTerm syntax (Record fields))
-                -> [MappedDiff syntax (Record fields) (Record fields)]
+deleteRemaining :: Traversable t
+                => [MappedDiff syntax ann1 ann2]
+                -> t (UnmappedTerm syntax ann1)
+                -> [MappedDiff syntax ann1 ann2]
 deleteRemaining diffs unmappedAs =
   foldl' (flip insertDiff) diffs ((This . termIndex &&& This . term) <$> unmappedAs)
 

From 7f405662d34e09d6469023a716f81386ee28ba8b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:05:43 -0400
Subject: [PATCH 41/65] Generalize insertMapped over the annotation types.

---
 src/RWS.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index deb68fffd..e9ec86182 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -80,7 +80,10 @@ type MappedDiff syntax ann1 ann2 = (These Int Int, Diff syntax ann1 ann2)
 
 type RWSEditScript syntax ann1 ann2 = [Diff syntax ann1 ann2]
 
-insertMapped :: Foldable t => t (MappedDiff syntax (Record fields) (Record fields)) -> [MappedDiff syntax (Record fields) (Record fields)] -> [MappedDiff syntax (Record fields) (Record fields)]
+insertMapped :: Foldable t
+             => t (MappedDiff syntax ann1 ann2)
+             -> [MappedDiff syntax ann1 ann2]
+             -> [MappedDiff syntax ann1 ann2]
 insertMapped diffs into = foldl' (flip insertDiff) into diffs
 
 deleteRemaining :: Traversable t

From bbf9d745d370dedce50468e7c21590e8676f1ea6 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:06:22 -0400
Subject: [PATCH 42/65] Use the MappedDiff synonym in
 findNearestNeighboursToDiff.

---
 src/RWS.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index e9ec86182..e6b8c9a87 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -124,7 +124,7 @@ findNearestNeighboursToDiff :: (Foldable syntax, Functor syntax, GAlign syntax)
                             -> [TermOrIndexOrNone (UnmappedTerm syntax ann2)]
                             -> [UnmappedTerm syntax ann1]
                             -> [UnmappedTerm syntax ann2]
-                            -> ([(These Int Int, These (Term syntax ann1) (Term syntax ann2))], UnmappedTerms syntax ann1)
+                            -> ([MappedDiff syntax ann1 ann2], UnmappedTerms syntax ann1)
 findNearestNeighboursToDiff canCompare allDiffs featureAs featureBs = (diffs, remaining)
   where
     (diffs, (_, remaining, _)) =

From 8e8ff0a32efa61ea47630051603d29222b53d7b5 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:06:57 -0400
Subject: [PATCH 43/65] Use the Diff synonym in editDistanceUpTo.

---
 src/RWS.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index e6b8c9a87..dad8530da 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -320,7 +320,7 @@ defaultM = 10
 
 -- | Return an edit distance as the sum of it's term sizes, given an cutoff and a syntax of terms 'f a'.
 -- | Computes a constant-time approximation to the edit distance of a diff. This is done by comparing at most _m_ nodes, & assuming the rest are zero-cost.
-editDistanceUpTo :: (GAlign syntax, Foldable syntax, Functor syntax) => Integer -> These (Term syntax ann1) (Term syntax ann2) -> Int
+editDistanceUpTo :: (GAlign syntax, Foldable syntax, Functor syntax) => Integer -> Diff syntax ann1 ann2 -> Int
 editDistanceUpTo m = these termSize termSize (\ a b -> diffCost m (approximateDiff a b))
   where diffCost = flip . cata $ \ diff m -> case diff of
           _ | m <= 0 -> 0

From 6a2afd8114adf93fb6f8d815c226f9be9f043eea Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:07:51 -0400
Subject: [PATCH 44/65] Rename the Diff synonym to Edit.

---
 src/RWS.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index dad8530da..99748773a 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -73,12 +73,12 @@ rws canCompare as bs =
 -- | An IntMap of unmapped terms keyed by their position in a list of terms.
 type UnmappedTerms syntax ann = IntMap.IntMap (UnmappedTerm syntax ann)
 
-type Diff syntax ann1 ann2 = These (Term syntax ann1) (Term syntax ann2)
+type Edit syntax ann1 ann2 = These (Term syntax ann1) (Term syntax ann2)
 
 -- A Diff paired with both its indices
-type MappedDiff syntax ann1 ann2 = (These Int Int, Diff syntax ann1 ann2)
+type MappedDiff syntax ann1 ann2 = (These Int Int, Edit syntax ann1 ann2)
 
-type RWSEditScript syntax ann1 ann2 = [Diff syntax ann1 ann2]
+type RWSEditScript syntax ann1 ann2 = [Edit syntax ann1 ann2]
 
 insertMapped :: Foldable t
              => t (MappedDiff syntax ann1 ann2)
@@ -320,7 +320,7 @@ defaultM = 10
 
 -- | Return an edit distance as the sum of it's term sizes, given an cutoff and a syntax of terms 'f a'.
 -- | Computes a constant-time approximation to the edit distance of a diff. This is done by comparing at most _m_ nodes, & assuming the rest are zero-cost.
-editDistanceUpTo :: (GAlign syntax, Foldable syntax, Functor syntax) => Integer -> Diff syntax ann1 ann2 -> Int
+editDistanceUpTo :: (GAlign syntax, Foldable syntax, Functor syntax) => Integer -> Edit syntax ann1 ann2 -> Int
 editDistanceUpTo m = these termSize termSize (\ a b -> diffCost m (approximateDiff a b))
   where diffCost = flip . cata $ \ diff m -> case diff of
           _ | m <= 0 -> 0

From 5d8bc38e4bb9e33cb1c0be5fc3fedf0258b9531b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:11:00 -0400
Subject: [PATCH 45/65] Reformat Mapping across multiple lines.

---
 src/RWS.hs | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index 99748773a..f6d1ce1d8 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -223,7 +223,14 @@ genFeaturizedTermsAndDiffs sesDiffs = let Mapping _ _ a b c d = foldl' combine (
           That term -> Mapping counterA (succ counterB) as (featurize counterB term : bs) mappedDiffs (RWS.Term (featurize counterB term) : allDiffs)
           These a b -> Mapping (succ counterA) (succ counterB) as bs ((These counterA counterB, These a b) : mappedDiffs) (Index counterA : allDiffs)
 
-data Mapping syntax fields = Mapping {-# UNPACK #-} !Int {-# UNPACK #-} !Int ![UnmappedTerm syntax (Record fields)] ![UnmappedTerm syntax (Record fields)] ![MappedDiff syntax (Record fields) (Record fields)] ![TermOrIndexOrNone (UnmappedTerm syntax (Record fields))]
+data Mapping syntax fields
+  = Mapping
+    {-# UNPACK #-} !Int
+    {-# UNPACK #-} !Int
+    ![UnmappedTerm syntax (Record fields)]
+    ![UnmappedTerm syntax (Record fields)]
+    ![MappedDiff syntax (Record fields) (Record fields)]
+    ![TermOrIndexOrNone (UnmappedTerm syntax (Record fields))]
 
 featurize :: (HasField fields FeatureVector, Functor syntax) => Int -> Term syntax (Record fields) -> UnmappedTerm syntax (Record fields)
 featurize index term = UnmappedTerm index (getField (extract term)) (eraseFeatureVector term)

From 5d09c824febe78ea87deba78200c2a3f1565f252 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:11:23 -0400
Subject: [PATCH 46/65] Generalize Mapping over the annotation types.

---
 src/RWS.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index f6d1ce1d8..adc0b66ea 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -223,14 +223,14 @@ genFeaturizedTermsAndDiffs sesDiffs = let Mapping _ _ a b c d = foldl' combine (
           That term -> Mapping counterA (succ counterB) as (featurize counterB term : bs) mappedDiffs (RWS.Term (featurize counterB term) : allDiffs)
           These a b -> Mapping (succ counterA) (succ counterB) as bs ((These counterA counterB, These a b) : mappedDiffs) (Index counterA : allDiffs)
 
-data Mapping syntax fields
+data Mapping syntax ann1 ann2
   = Mapping
     {-# UNPACK #-} !Int
     {-# UNPACK #-} !Int
-    ![UnmappedTerm syntax (Record fields)]
-    ![UnmappedTerm syntax (Record fields)]
-    ![MappedDiff syntax (Record fields) (Record fields)]
-    ![TermOrIndexOrNone (UnmappedTerm syntax (Record fields))]
+    ![UnmappedTerm syntax ann1]
+    ![UnmappedTerm syntax ann2]
+    ![MappedDiff syntax ann1 ann2]
+    ![TermOrIndexOrNone (UnmappedTerm syntax ann2)]
 
 featurize :: (HasField fields FeatureVector, Functor syntax) => Int -> Term syntax (Record fields) -> UnmappedTerm syntax (Record fields)
 featurize index term = UnmappedTerm index (getField (extract term)) (eraseFeatureVector term)

From bf0b959df1bcb2bb3eaf2223d606f59405238ff6 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:11:33 -0400
Subject: [PATCH 47/65] Generalize genFeaturizedTermsAndDiffs over the record
 types.

---
 src/RWS.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index adc0b66ea..4d1db49f4 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -214,9 +214,9 @@ insertion previous unmappedA unmappedB (UnmappedTerm j _ b) = do
   put (previous, unmappedA, IntMap.delete j unmappedB)
   pure (That j, That b)
 
-genFeaturizedTermsAndDiffs :: (Functor syntax, HasField fields FeatureVector)
-                           => RWSEditScript syntax (Record fields) (Record fields)
-                           -> ([UnmappedTerm syntax (Record fields)], [UnmappedTerm syntax (Record fields)], [MappedDiff syntax (Record fields) (Record fields)], [TermOrIndexOrNone (UnmappedTerm syntax (Record fields))])
+genFeaturizedTermsAndDiffs :: (Functor syntax, HasField fields1 FeatureVector, HasField fields2 FeatureVector)
+                           => RWSEditScript syntax (Record fields1) (Record fields2)
+                           -> ([UnmappedTerm syntax (Record fields1)], [UnmappedTerm syntax (Record fields2)], [MappedDiff syntax (Record fields1) (Record fields2)], [TermOrIndexOrNone (UnmappedTerm syntax (Record fields2))])
 genFeaturizedTermsAndDiffs sesDiffs = let Mapping _ _ a b c d = foldl' combine (Mapping 0 0 [] [] [] []) sesDiffs in (reverse a, reverse b, reverse c, reverse d)
   where combine (Mapping counterA counterB as bs mappedDiffs allDiffs) diff = case diff of
           This term -> Mapping (succ counterA) counterB (featurize counterA term : as) bs mappedDiffs (None : allDiffs)

From 9b95df85d7853ebaca87b88985101916f5035b77 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:13:37 -0400
Subject: [PATCH 48/65] Reformat the return type of genFeaturizedTermsAndDiffs.

---
 src/RWS.hs | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index 4d1db49f4..db1f77aba 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -216,7 +216,11 @@ insertion previous unmappedA unmappedB (UnmappedTerm j _ b) = do
 
 genFeaturizedTermsAndDiffs :: (Functor syntax, HasField fields1 FeatureVector, HasField fields2 FeatureVector)
                            => RWSEditScript syntax (Record fields1) (Record fields2)
-                           -> ([UnmappedTerm syntax (Record fields1)], [UnmappedTerm syntax (Record fields2)], [MappedDiff syntax (Record fields1) (Record fields2)], [TermOrIndexOrNone (UnmappedTerm syntax (Record fields2))])
+                           -> ( [UnmappedTerm syntax (Record fields1)]
+                              , [UnmappedTerm syntax (Record fields2)]
+                              , [MappedDiff syntax (Record fields1) (Record fields2)]
+                              , [TermOrIndexOrNone (UnmappedTerm syntax (Record fields2))]
+                              )
 genFeaturizedTermsAndDiffs sesDiffs = let Mapping _ _ a b c d = foldl' combine (Mapping 0 0 [] [] [] []) sesDiffs in (reverse a, reverse b, reverse c, reverse d)
   where combine (Mapping counterA counterB as bs mappedDiffs allDiffs) diff = case diff of
           This term -> Mapping (succ counterA) counterB (featurize counterA term : as) bs mappedDiffs (None : allDiffs)

From 7f7f39c2e04ebaeb3b713a785423a7901cb35e7e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:17:46 -0400
Subject: [PATCH 49/65] Require the FeatureVector to be the first field.

---
 src/Interpreter.hs | 27 ++++++++++++++-------------
 src/RWS.hs         | 28 ++++++++++++++--------------
 2 files changed, 28 insertions(+), 27 deletions(-)

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index b8d17684e..66adf3e1a 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -29,23 +29,24 @@ diffTerms :: HasField fields Category
 diffTerms = decoratingWith getLabel (diffTermsWith algorithmWithTerms comparableByCategory)
 
 -- | Diff two terms by decorating with feature vectors computed using the supplied labelling algebra, and stripping the feature vectors from the resulting diff.
-decoratingWith :: (Hashable label, Traversable f)
-               => (forall a. TermF f (Record fields) a -> label)
-               -> (Term f (Record (FeatureVector ': fields)) -> Term f (Record (FeatureVector ': fields)) -> Diff f (Record (FeatureVector ': fields)) (Record (FeatureVector ': fields)))
-               -> Term f (Record fields)
-               -> Term f (Record fields)
-               -> Diff f (Record fields) (Record fields)
+decoratingWith :: (Hashable label, Traversable syntax)
+               => (forall a. TermF syntax (Record fields) a -> label)
+               -> (Term syntax (Record (FeatureVector ': fields)) -> Term syntax (Record (FeatureVector ': fields)) -> Diff syntax (Record (FeatureVector ': fields)) (Record (FeatureVector ': fields)))
+               -> Term syntax (Record fields)
+               -> Term syntax (Record fields)
+               -> Diff syntax (Record fields) (Record fields)
 decoratingWith getLabel differ t1 t2 = stripDiff (differ (defaultFeatureVectorDecorator getLabel t1) (defaultFeatureVectorDecorator getLabel t2))
 
 -- | Diff a pair of terms recurisvely, using the supplied continuation and 'ComparabilityRelation'.
-diffTermsWith :: forall f fields . (Traversable f, GAlign f, Eq1 f, HasField fields FeatureVector)
-              => (Term f (Record fields) -> Term f (Record fields) -> Algorithm (Term f) (Diff f) (Record fields) (Record fields) (Diff f (Record fields) (Record fields))) -- ^ A function producing syntax-directed continuations of the algorithm.
-              -> ComparabilityRelation f (Record fields) (Record fields) -- ^ A relation on terms used to determine comparability and equality.
-              -> Term f (Record fields) -- ^ A term representing the old state.
-              -> Term f (Record fields) -- ^ A term representing the new state.
-              -> Diff f (Record fields) (Record fields) -- ^ The resulting diff.
+diffTermsWith :: forall syntax fields
+              .  (Eq1 syntax, GAlign syntax, Traversable syntax)
+              => (Term syntax (Record (FeatureVector ': fields)) -> Term syntax (Record (FeatureVector ': fields)) -> Algorithm (Term syntax) (Diff syntax) (Record (FeatureVector ': fields)) (Record (FeatureVector ': fields)) (Diff syntax (Record (FeatureVector ': fields)) (Record (FeatureVector ': fields)))) -- ^ A function producing syntax-directed continuations of the algorithm.
+              -> ComparabilityRelation syntax (Record (FeatureVector ': fields)) (Record (FeatureVector ': fields)) -- ^ A relation on terms used to determine comparability and equality.
+              -> Term syntax (Record (FeatureVector ': fields)) -- ^ A term representing the old state.
+              -> Term syntax (Record (FeatureVector ': fields)) -- ^ A term representing the new state.
+              -> Diff syntax (Record (FeatureVector ': fields)) (Record (FeatureVector ': fields)) -- ^ The resulting diff.
 diffTermsWith refine comparable t1 t2 = runFreer decompose (diff t1 t2)
-  where decompose :: AlgorithmF (Term f) (Diff f) (Record fields) (Record fields) result -> Algorithm (Term f) (Diff f) (Record fields) (Record fields) result
+  where decompose :: AlgorithmF (Term syntax) (Diff syntax) (Record (FeatureVector ': fields)) (Record (FeatureVector ': fields)) result -> Algorithm (Term syntax) (Diff syntax) (Record (FeatureVector ': fields)) (Record (FeatureVector ': fields)) result
         decompose step = case step of
           Algorithm.Diff t1 t2 -> refine t1 t2
           Linear t1 t2 -> case galignWith diffThese (unwrap t1) (unwrap t2) of
diff --git a/src/RWS.hs b/src/RWS.hs
index db1f77aba..255471a95 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -54,11 +54,11 @@ data UnmappedTerm syntax ann = UnmappedTerm
 -- | Either a `term`, an index of a matched term, or nil.
 data TermOrIndexOrNone term = Term term | Index {-# UNPACK #-} !Int | None
 
-rws :: (HasField fields FeatureVector, Eq1 syntax, Foldable syntax, Functor syntax, GAlign syntax)
-    => ComparabilityRelation syntax (Record fields) (Record fields)
-    -> [Term syntax (Record fields)]
-    -> [Term syntax (Record fields)]
-    -> RWSEditScript syntax (Record fields) (Record fields)
+rws :: (Eq1 syntax, Foldable syntax, Functor syntax, GAlign syntax)
+    => ComparabilityRelation syntax (Record (FeatureVector ': fields)) (Record (FeatureVector ': fields))
+    -> [Term syntax (Record (FeatureVector ': fields))]
+    -> [Term syntax (Record (FeatureVector ': fields))]
+    -> RWSEditScript syntax (Record (FeatureVector ': fields)) (Record (FeatureVector ': fields))
 rws _          as [] = This <$> as
 rws _          [] bs = That <$> bs
 rws canCompare [a] [b] = if canCompareTerms canCompare a b then [These a b] else [That b, This a]
@@ -214,12 +214,12 @@ insertion previous unmappedA unmappedB (UnmappedTerm j _ b) = do
   put (previous, unmappedA, IntMap.delete j unmappedB)
   pure (That j, That b)
 
-genFeaturizedTermsAndDiffs :: (Functor syntax, HasField fields1 FeatureVector, HasField fields2 FeatureVector)
-                           => RWSEditScript syntax (Record fields1) (Record fields2)
-                           -> ( [UnmappedTerm syntax (Record fields1)]
-                              , [UnmappedTerm syntax (Record fields2)]
-                              , [MappedDiff syntax (Record fields1) (Record fields2)]
-                              , [TermOrIndexOrNone (UnmappedTerm syntax (Record fields2))]
+genFeaturizedTermsAndDiffs :: Functor syntax
+                           => RWSEditScript syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2))
+                           -> ( [UnmappedTerm syntax (Record (FeatureVector ': fields1))]
+                              , [UnmappedTerm syntax (Record (FeatureVector ': fields2))]
+                              , [MappedDiff syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2))]
+                              , [TermOrIndexOrNone (UnmappedTerm syntax (Record (FeatureVector ': fields2)))]
                               )
 genFeaturizedTermsAndDiffs sesDiffs = let Mapping _ _ a b c d = foldl' combine (Mapping 0 0 [] [] [] []) sesDiffs in (reverse a, reverse b, reverse c, reverse d)
   where combine (Mapping counterA counterB as bs mappedDiffs allDiffs) diff = case diff of
@@ -236,16 +236,16 @@ data Mapping syntax ann1 ann2
     ![MappedDiff syntax ann1 ann2]
     ![TermOrIndexOrNone (UnmappedTerm syntax ann2)]
 
-featurize :: (HasField fields FeatureVector, Functor syntax) => Int -> Term syntax (Record fields) -> UnmappedTerm syntax (Record fields)
+featurize :: Functor syntax => Int -> Term syntax (Record (FeatureVector ': fields)) -> UnmappedTerm syntax (Record (FeatureVector ': fields))
 featurize index term = UnmappedTerm index (getField (extract term)) (eraseFeatureVector term)
 
-eraseFeatureVector :: (Functor f, HasField fields FeatureVector) => Term f (Record fields) -> Term f (Record fields)
+eraseFeatureVector :: Functor syntax => Term syntax (Record (FeatureVector ': fields)) -> Term syntax (Record (FeatureVector ': fields))
 eraseFeatureVector (Term.Term (In record functor)) = termIn (setFeatureVector record nullFeatureVector) functor
 
 nullFeatureVector :: FeatureVector
 nullFeatureVector = FV $ listArray (0, 0) [0]
 
-setFeatureVector :: HasField fields FeatureVector => Record fields -> FeatureVector -> Record fields
+setFeatureVector :: Record (FeatureVector ': fields) -> FeatureVector -> Record (FeatureVector ': fields)
 setFeatureVector = setField
 
 minimumTermIndex :: [UnmappedTerm syntax ann] -> Int

From e0d36dc8e5a19cc789a32cbff4bc743496e3fe2b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:18:22 -0400
Subject: [PATCH 50/65] Generalize algorithmWithTerms over the annotation
 types.

---
 src/Interpreter.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 66adf3e1a..8046a0d29 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -65,9 +65,9 @@ getLabel (In h t) = (Info.category h, case t of
 
 
 -- | Construct an algorithm to diff a pair of terms.
-algorithmWithTerms :: Term Syntax (Record fields)
-                   -> Term Syntax (Record fields)
-                   -> Algorithm (Term Syntax) (Diff Syntax) (Record fields) (Record fields) (Diff Syntax (Record fields) (Record fields))
+algorithmWithTerms :: Term Syntax ann1
+                   -> Term Syntax ann2
+                   -> Algorithm (Term Syntax) (Diff Syntax) ann1 ann2 (Diff Syntax ann1 ann2)
 algorithmWithTerms t1 t2 = case (unwrap t1, unwrap t2) of
   (Indexed a, Indexed b) ->
     annotate . Indexed <$> byRWS a b

From 67c6b12bb8ecb798cab87c3908f93bc5def7bb74 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:18:41 -0400
Subject: [PATCH 51/65] Generalize comparableByConstructor over the annotation
 types.

---
 src/Interpreter.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 8046a0d29..5ff880528 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -113,5 +113,5 @@ comparableByCategory :: HasField fields Category => ComparabilityRelation syntax
 comparableByCategory (In a _) (In b _) = category a == category b
 
 -- | Test whether two terms are comparable by their constructor.
-comparableByConstructor :: GAlign syntax => ComparabilityRelation syntax (Record fields) (Record fields)
+comparableByConstructor :: GAlign syntax => ComparabilityRelation syntax ann1 ann2
 comparableByConstructor (In _ a) (In _ b) = isJust (galign a b)

From d2bd5db53912b63c906caf08dda5c3da44a04e2c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:19:29 -0400
Subject: [PATCH 52/65] Generalize rws over the annotation types.

---
 src/RWS.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index 255471a95..7415176d5 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -55,10 +55,10 @@ data UnmappedTerm syntax ann = UnmappedTerm
 data TermOrIndexOrNone term = Term term | Index {-# UNPACK #-} !Int | None
 
 rws :: (Eq1 syntax, Foldable syntax, Functor syntax, GAlign syntax)
-    => ComparabilityRelation syntax (Record (FeatureVector ': fields)) (Record (FeatureVector ': fields))
-    -> [Term syntax (Record (FeatureVector ': fields))]
-    -> [Term syntax (Record (FeatureVector ': fields))]
-    -> RWSEditScript syntax (Record (FeatureVector ': fields)) (Record (FeatureVector ': fields))
+    => ComparabilityRelation syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2))
+    -> [Term syntax (Record (FeatureVector ': fields1))]
+    -> [Term syntax (Record (FeatureVector ': fields2))]
+    -> RWSEditScript syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2))
 rws _          as [] = This <$> as
 rws _          [] bs = That <$> bs
 rws canCompare [a] [b] = if canCompareTerms canCompare a b then [These a b] else [That b, This a]

From 578ccb01c2d98197922a0f2cd57dbbe477f2a1b3 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:21:29 -0400
Subject: [PATCH 53/65] Generalize decoratingWith over the annotation types.

---
 src/Interpreter.hs | 15 ++++++++-------
 src/Semantic.hs    |  2 +-
 2 files changed, 9 insertions(+), 8 deletions(-)

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 5ff880528..519480e88 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -26,16 +26,17 @@ diffTerms :: HasField fields Category
           => Term Syntax (Record fields) -- ^ A term representing the old state.
           -> Term Syntax (Record fields) -- ^ A term representing the new state.
           -> Diff Syntax (Record fields) (Record fields)
-diffTerms = decoratingWith getLabel (diffTermsWith algorithmWithTerms comparableByCategory)
+diffTerms = decoratingWith getLabel getLabel (diffTermsWith algorithmWithTerms comparableByCategory)
 
 -- | Diff two terms by decorating with feature vectors computed using the supplied labelling algebra, and stripping the feature vectors from the resulting diff.
 decoratingWith :: (Hashable label, Traversable syntax)
-               => (forall a. TermF syntax (Record fields) a -> label)
-               -> (Term syntax (Record (FeatureVector ': fields)) -> Term syntax (Record (FeatureVector ': fields)) -> Diff syntax (Record (FeatureVector ': fields)) (Record (FeatureVector ': fields)))
-               -> Term syntax (Record fields)
-               -> Term syntax (Record fields)
-               -> Diff syntax (Record fields) (Record fields)
-decoratingWith getLabel differ t1 t2 = stripDiff (differ (defaultFeatureVectorDecorator getLabel t1) (defaultFeatureVectorDecorator getLabel t2))
+               => (forall a. TermF syntax (Record fields1) a -> label)
+               -> (forall a. TermF syntax (Record fields2) a -> label)
+               -> (Term syntax (Record (FeatureVector ': fields1)) -> Term syntax (Record (FeatureVector ': fields2)) -> Diff syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)))
+               -> Term syntax (Record fields1)
+               -> Term syntax (Record fields2)
+               -> Diff syntax (Record fields1) (Record fields2)
+decoratingWith getLabel1 getLabel2 differ t1 t2 = stripDiff (differ (defaultFeatureVectorDecorator getLabel1 t1) (defaultFeatureVectorDecorator getLabel2 t2))
 
 -- | Diff a pair of terms recurisvely, using the supplied continuation and 'ComparabilityRelation'.
 diffTermsWith :: forall syntax fields
diff --git a/src/Semantic.hs b/src/Semantic.hs
index c22dee76b..0dc27ffba 100644
--- a/src/Semantic.hs
+++ b/src/Semantic.hs
@@ -93,7 +93,7 @@ diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of
         run parse diff renderer = distributeFor blobs parse >>= runBothWith (diffTermPair blobs diff) >>= render renderer
 
         diffRecursively :: (Eq1 syntax, GAlign syntax, Show1 syntax, Traversable syntax, Diffable syntax) => Term syntax (Record fields) -> Term syntax (Record fields) -> Diff syntax (Record fields) (Record fields)
-        diffRecursively = decoratingWith constructorNameAndConstantFields (diffTermsWith algorithmForTerms comparableByConstructor)
+        diffRecursively = decoratingWith constructorNameAndConstantFields 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 syntax => Both Blob -> Differ syntax ann1 ann2 -> Term syntax ann1 -> Term syntax ann2 -> Task (Diff syntax ann1 ann2)

From cb36d9f8f772cba01fd03a3a08704d1442a4c4e1 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:23:50 -0400
Subject: [PATCH 54/65] Generalize diffTerms over the annotation types.

---
 src/Interpreter.hs | 24 ++++++++++++------------
 1 file changed, 12 insertions(+), 12 deletions(-)

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 519480e88..fa6cfdc61 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -22,10 +22,10 @@ import Term
 
 
 -- | Diff two terms recursively, given functions characterizing the diffing.
-diffTerms :: HasField fields Category
-          => Term Syntax (Record fields) -- ^ A term representing the old state.
-          -> Term Syntax (Record fields) -- ^ A term representing the new state.
-          -> Diff Syntax (Record fields) (Record fields)
+diffTerms :: (HasField fields1 Category, HasField fields2 Category)
+          => Term Syntax (Record fields1) -- ^ A term representing the old state.
+          -> Term Syntax (Record fields2) -- ^ A term representing the new state.
+          -> Diff Syntax (Record fields1) (Record fields2)
 diffTerms = decoratingWith getLabel getLabel (diffTermsWith algorithmWithTerms comparableByCategory)
 
 -- | Diff two terms by decorating with feature vectors computed using the supplied labelling algebra, and stripping the feature vectors from the resulting diff.
@@ -39,15 +39,15 @@ decoratingWith :: (Hashable label, Traversable syntax)
 decoratingWith getLabel1 getLabel2 differ t1 t2 = stripDiff (differ (defaultFeatureVectorDecorator getLabel1 t1) (defaultFeatureVectorDecorator getLabel2 t2))
 
 -- | Diff a pair of terms recurisvely, using the supplied continuation and 'ComparabilityRelation'.
-diffTermsWith :: forall syntax fields
+diffTermsWith :: forall syntax fields1 fields2
               .  (Eq1 syntax, GAlign syntax, Traversable syntax)
-              => (Term syntax (Record (FeatureVector ': fields)) -> Term syntax (Record (FeatureVector ': fields)) -> Algorithm (Term syntax) (Diff syntax) (Record (FeatureVector ': fields)) (Record (FeatureVector ': fields)) (Diff syntax (Record (FeatureVector ': fields)) (Record (FeatureVector ': fields)))) -- ^ A function producing syntax-directed continuations of the algorithm.
-              -> ComparabilityRelation syntax (Record (FeatureVector ': fields)) (Record (FeatureVector ': fields)) -- ^ A relation on terms used to determine comparability and equality.
-              -> Term syntax (Record (FeatureVector ': fields)) -- ^ A term representing the old state.
-              -> Term syntax (Record (FeatureVector ': fields)) -- ^ A term representing the new state.
-              -> Diff syntax (Record (FeatureVector ': fields)) (Record (FeatureVector ': fields)) -- ^ The resulting diff.
+              => (Term syntax (Record (FeatureVector ': fields1)) -> Term syntax (Record (FeatureVector ': fields2)) -> Algorithm (Term syntax) (Diff syntax) (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)) (Diff syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)))) -- ^ A function producing syntax-directed continuations of the algorithm.
+              -> ComparabilityRelation syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)) -- ^ A relation on terms used to determine comparability and equality.
+              -> Term syntax (Record (FeatureVector ': fields1)) -- ^ A term representing the old state.
+              -> Term syntax (Record (FeatureVector ': fields2)) -- ^ A term representing the new state.
+              -> Diff syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)) -- ^ The resulting diff.
 diffTermsWith refine comparable t1 t2 = runFreer decompose (diff t1 t2)
-  where decompose :: AlgorithmF (Term syntax) (Diff syntax) (Record (FeatureVector ': fields)) (Record (FeatureVector ': fields)) result -> Algorithm (Term syntax) (Diff syntax) (Record (FeatureVector ': fields)) (Record (FeatureVector ': fields)) result
+  where decompose :: AlgorithmF (Term syntax) (Diff syntax) (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)) result -> Algorithm (Term syntax) (Diff syntax) (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)) result
         decompose step = case step of
           Algorithm.Diff t1 t2 -> refine t1 t2
           Linear t1 t2 -> case galignWith diffThese (unwrap t1) (unwrap t2) of
@@ -110,7 +110,7 @@ algorithmWithTerms t1 t2 = case (unwrap t1, unwrap t2) of
 
 
 -- | Test whether two terms are comparable by their Category.
-comparableByCategory :: HasField fields Category => ComparabilityRelation syntax (Record fields) (Record fields)
+comparableByCategory :: (HasField fields1 Category, HasField fields2 Category) => ComparabilityRelation syntax (Record fields1) (Record fields2)
 comparableByCategory (In a _) (In b _) = category a == category b
 
 -- | Test whether two terms are comparable by their constructor.

From 21401f6730c167d5526c2b629779be2754fbc17f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:24:17 -0400
Subject: [PATCH 55/65] Generalize diffRecursively over the annotation types.

---
 src/Semantic.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Semantic.hs b/src/Semantic.hs
index 0dc27ffba..799999207 100644
--- a/src/Semantic.hs
+++ b/src/Semantic.hs
@@ -92,7 +92,7 @@ diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of
         run :: Functor syntax => (Blob -> Task (Term syntax ann)) -> (Term syntax ann -> Term syntax ann -> Diff syntax ann ann) -> (Diff syntax ann ann -> output) -> Task output
         run parse diff renderer = distributeFor blobs parse >>= runBothWith (diffTermPair blobs diff) >>= render renderer
 
-        diffRecursively :: (Eq1 syntax, GAlign syntax, Show1 syntax, Traversable syntax, Diffable syntax) => Term syntax (Record fields) -> Term syntax (Record fields) -> Diff syntax (Record fields) (Record fields)
+        diffRecursively :: (Eq1 syntax, GAlign syntax, Show1 syntax, Traversable syntax, Diffable syntax) => Term syntax (Record fields1) -> Term syntax (Record fields2) -> Diff syntax (Record fields1) (Record fields2)
         diffRecursively = decoratingWith constructorNameAndConstantFields constructorNameAndConstantFields (diffTermsWith algorithmForTerms comparableByConstructor)
 
 -- | A task to diff a pair of 'Term's, producing insertion/deletion 'Patch'es for non-existent 'Blob's.

From cd3d579bd0492e290937b97769eed6499465da36 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:48:06 -0400
Subject: [PATCH 56/65] Export the FeatureVector constructor/selector.

---
 src/RWS.hs | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

diff --git a/src/RWS.hs b/src/RWS.hs
index 7415176d5..bcd0337c7 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -1,14 +1,14 @@
 {-# LANGUAGE GADTs, DataKinds, RankNTypes, TypeOperators #-}
-module RWS (
-    rws
-  , ComparabilityRelation
-  , FeatureVector
-  , defaultFeatureVectorDecorator
-  , featureVectorDecorator
-  , pqGramDecorator
-  , Gram(..)
-  , defaultD
-  ) where
+module RWS
+( rws
+, ComparabilityRelation
+, FeatureVector(..)
+, defaultFeatureVectorDecorator
+, featureVectorDecorator
+, pqGramDecorator
+, Gram(..)
+, defaultD
+) where
 
 import Control.Applicative (empty)
 import Control.Arrow ((&&&))

From f12675667251d1caf63a1f8c6b5ec6b9a035f523 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:49:41 -0400
Subject: [PATCH 57/65] Derive Eq, Ord, & Show instances for FeatureVector.

---
 src/RWS.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/RWS.hs b/src/RWS.hs
index bcd0337c7..be4124968 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -43,6 +43,7 @@ type Label f fields label = forall b. TermF f (Record fields) b -> label
 type ComparabilityRelation syntax ann1 ann2 = forall a b. TermF syntax ann1 a -> TermF syntax ann2 b -> Bool
 
 newtype FeatureVector = FV { unFV :: UArray Int Double }
+  deriving (Eq, Ord, Show)
 
 -- | A term which has not yet been mapped by `rws`, along with its feature vector summary & index.
 data UnmappedTerm syntax ann = UnmappedTerm

From 7789e83875e50909fa20ee19063cc23b354f8430 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:49:57 -0400
Subject: [PATCH 58/65] Correct the RWS tests.

---
 test/Data/RandomWalkSimilarity/Spec.hs | 8 +++-----
 1 file changed, 3 insertions(+), 5 deletions(-)

diff --git a/test/Data/RandomWalkSimilarity/Spec.hs b/test/Data/RandomWalkSimilarity/Spec.hs
index d0b36bb5d..f9d8a1f11 100644
--- a/test/Data/RandomWalkSimilarity/Spec.hs
+++ b/test/Data/RandomWalkSimilarity/Spec.hs
@@ -27,19 +27,19 @@ spec = parallel $ do
 
   describe "featureVectorDecorator" $ do
     prop "produces a vector of the specified dimension" $
-      \ (term, p, q, d) -> featureVectorDecorator (rhead . termAnnotation) (positively p) (positively q) (positively d) (term :: Term Syntax (Record '[Category])) `shouldSatisfy` all ((== (0, abs d)) . bounds . rhead)
+      \ (term, p, q, d) -> featureVectorDecorator (rhead . termAnnotation) (positively p) (positively q) (positively d) (term :: Term Syntax (Record '[Category])) `shouldSatisfy` all ((== (0, abs d)) . bounds . unFV . rhead)
 
   describe "rws" $ do
     prop "produces correct diffs" $
       \ (as, bs) -> let tas = decorate <$> (as :: [Term Syntax (Record '[Category])])
                         tbs = decorate <$> (bs :: [Term Syntax (Record '[Category])])
                         root = termIn (Program :. Nil) . Indexed
-                        diff = merge ((Program :. Nil, Program :. Nil)) (Indexed (stripDiff . diffThese <$> rws editDistance canCompare tas tbs)) in
+                        diff = merge ((Program :. Nil, Program :. Nil)) (Indexed (stripDiff . diffThese <$> rws canCompare tas tbs)) in
         (beforeTerm diff, afterTerm diff) `shouldBe` (Just (root (stripTerm <$> tas)), Just (root (stripTerm <$> tbs)))
 
     it "produces unbiased insertions within branches" $
       let (a, b) = (decorate (Term ((StringLiteral :. Nil) `In` Indexed [ Term ((StringLiteral :. Nil) `In` Leaf "a") ])), decorate (Term ((StringLiteral :. Nil) `In` Indexed [ Term ((StringLiteral :. Nil) `In` Leaf "b") ]))) in
-      fmap (bimap stripTerm stripTerm) (rws editDistance canCompare [ b ] [ a, b ]) `shouldBe` fmap (bimap stripTerm stripTerm) [ That a, These b b ]
+      fmap (bimap stripTerm stripTerm) (rws canCompare [ b ] [ a, b ]) `shouldBe` fmap (bimap stripTerm stripTerm) [ That a, These b b ]
 
   where canCompare a b = termAnnotation a == termAnnotation b
 
@@ -47,5 +47,3 @@ spec = parallel $ do
         decorate = defaultFeatureVectorDecorator (category . termAnnotation)
 
         diffThese = these deleting inserting replacing
-
-        editDistance = these (const 1) (const 1) (const (const 0))

From be481f7a718d17f600916ed7aa81eff1c9389b1e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 11:53:02 -0400
Subject: [PATCH 59/65] Rename SES.Myers to SES.

---
 semantic-diff.cabal          |  3 +-
 src/SES.hs                   | 72 +++++++++++++++++++++++++++++++++---
 src/SES/Myers.hs             | 70 -----------------------------------
 test/SES/{Myers => }/Spec.hs |  4 +-
 test/Spec.hs                 |  4 +-
 5 files changed, 71 insertions(+), 82 deletions(-)
 delete mode 100644 src/SES/Myers.hs
 rename test/SES/{Myers => }/Spec.hs (95%)

diff --git a/semantic-diff.cabal b/semantic-diff.cabal
index 3b2a141b0..9c555407d 100644
--- a/semantic-diff.cabal
+++ b/semantic-diff.cabal
@@ -76,7 +76,6 @@ library
                      , Semantic.Util
                      , SemanticCmdLine
                      , SES
-                     , SES.Myers
                      , SplitDiff
                      , Syntax
                      , Term
@@ -153,7 +152,7 @@ test-suite test
                      , SemanticCmdLineSpec
                      , InterpreterSpec
                      , PatchOutputSpec
-                     , SES.Myers.Spec
+                     , SES.Spec
                      , SourceSpec
                      , SpecHelpers
                      , TermSpec
diff --git a/src/SES.hs b/src/SES.hs
index f44a255fe..eabe419dd 100644
--- a/src/SES.hs
+++ b/src/SES.hs
@@ -1,10 +1,70 @@
-{-# LANGUAGE Strict #-}
+{-# LANGUAGE BangPatterns, GADTs, ImplicitParams, MultiParamTypeClasses, ScopedTypeVariables #-}
 module SES
-( Comparable
-, Myers.ses
+( EditScript
+, ses
 ) where
 
-import qualified SES.Myers as Myers
+import Data.Array ((!))
+import qualified Data.Array as Array
+import Data.Foldable (find, toList)
+import Data.Ix
+import Data.These
 
--- | Edit constructor for two terms, if comparable. Otherwise returns Nothing.
-type Comparable term = term -> term -> Bool
+-- | An edit script, i.e. a sequence of changes/copies of elements.
+type EditScript a b = [These a b]
+
+data Endpoint a b = Endpoint { x :: {-# UNPACK #-} !Int, _y :: {-# UNPACK #-} !Int, _script :: EditScript a b }
+  deriving (Eq, Show)
+
+
+-- | Compute the shortest edit script using Myers’ algorithm.
+ses :: (Foldable t, Foldable u) => (a -> b -> Bool) -> t a -> u b -> EditScript a b
+ses eq as' bs'
+  | null bs = This <$> toList as
+  | null as = That <$> toList bs
+  | otherwise = reverse (searchUpToD 0 (Array.array (1, 1) [(1, Endpoint 0 (-1) [])]))
+  where (as, bs) = (Array.listArray (0, pred n) (toList as'), Array.listArray (0, pred m) (toList bs'))
+        (!n, !m) = (length as', length bs')
+
+        -- Search an edit graph for the shortest edit script up to a given proposed edit distance, building on the results of previous searches.
+        searchUpToD !d !v =
+          let !endpoints = slideFrom . searchAlongK <$> [ k | k <- [-d, -d + 2 .. d], inRange (-m, n) k ] in
+          case find isComplete endpoints of
+            Just (Endpoint _ _ script) -> script
+            _ -> searchUpToD (succ d) (Array.array (-d, d) ((\ e@(Endpoint x y _) -> (x - y, e)) <$> endpoints))
+          where isComplete (Endpoint x y _) = x >= n && y >= m
+
+                -- Search an edit graph for the shortest edit script along a specific diagonal, moving onto a given diagonal from one of its in-bounds adjacent diagonals (if any).
+                searchAlongK !k
+                  | k == -d = moveDownFrom (v ! succ k)
+                  | k ==  d = moveRightFrom (v ! pred k)
+                  | k == -m = moveDownFrom (v ! succ k)
+                  | k ==  n = moveRightFrom (v ! pred k)
+                  | otherwise =
+                    let left = v ! pred k
+                        up   = v ! succ k in
+                    if x left < x up then
+                      moveDownFrom up
+                    else
+                      moveRightFrom left
+
+        -- | Move downward from a given vertex, inserting the element for the corresponding row.
+        moveDownFrom  (Endpoint x y script) = Endpoint       x (succ y) $ maybe script ((: script) . That) (bs !? y)
+        {-# INLINE moveDownFrom #-}
+
+        -- | Move rightward from a given vertex, deleting the element for the corresponding column.
+        moveRightFrom (Endpoint x y script) = Endpoint (succ x)      y  $ maybe script ((: script) . This) (as !? x)
+        {-# INLINE moveRightFrom #-}
+
+        -- | Slide down any diagonal edges from a given vertex.
+        slideFrom (Endpoint x y script)
+          | Just a <- as !? x
+          , Just b <- bs !? y
+          , a `eq` b  = slideFrom (Endpoint (succ x) (succ y) (These a b : script))
+          | otherwise =            Endpoint       x        y               script
+
+
+(!?) :: Ix i => Array.Array i a -> i -> Maybe a
+(!?) v i | inRange (Array.bounds v) i, !a <- v ! i = Just a
+         | otherwise = Nothing
+{-# INLINE (!?) #-}
diff --git a/src/SES/Myers.hs b/src/SES/Myers.hs
deleted file mode 100644
index ba2058529..000000000
--- a/src/SES/Myers.hs
+++ /dev/null
@@ -1,70 +0,0 @@
-{-# LANGUAGE BangPatterns, GADTs, ImplicitParams, MultiParamTypeClasses, ScopedTypeVariables #-}
-module SES.Myers
-( EditScript
-, ses
-) where
-
-import Data.Array ((!))
-import qualified Data.Array as Array
-import Data.Foldable (find, toList)
-import Data.Ix
-import Data.These
-
--- | An edit script, i.e. a sequence of changes/copies of elements.
-type EditScript a b = [These a b]
-
-data Endpoint a b = Endpoint { x :: {-# UNPACK #-} !Int, _y :: {-# UNPACK #-} !Int, _script :: EditScript a b }
-  deriving (Eq, Show)
-
-
--- | Compute the shortest edit script using Myers’ algorithm.
-ses :: (Foldable t, Foldable u) => (a -> b -> Bool) -> t a -> u b -> EditScript a b
-ses eq as' bs'
-  | null bs = This <$> toList as
-  | null as = That <$> toList bs
-  | otherwise = reverse (searchUpToD 0 (Array.array (1, 1) [(1, Endpoint 0 (-1) [])]))
-  where (as, bs) = (Array.listArray (0, pred n) (toList as'), Array.listArray (0, pred m) (toList bs'))
-        (!n, !m) = (length as', length bs')
-
-        -- Search an edit graph for the shortest edit script up to a given proposed edit distance, building on the results of previous searches.
-        searchUpToD !d !v =
-          let !endpoints = slideFrom . searchAlongK <$> [ k | k <- [-d, -d + 2 .. d], inRange (-m, n) k ] in
-          case find isComplete endpoints of
-            Just (Endpoint _ _ script) -> script
-            _ -> searchUpToD (succ d) (Array.array (-d, d) ((\ e@(Endpoint x y _) -> (x - y, e)) <$> endpoints))
-          where isComplete (Endpoint x y _) = x >= n && y >= m
-
-                -- Search an edit graph for the shortest edit script along a specific diagonal, moving onto a given diagonal from one of its in-bounds adjacent diagonals (if any).
-                searchAlongK !k
-                  | k == -d = moveDownFrom (v ! succ k)
-                  | k ==  d = moveRightFrom (v ! pred k)
-                  | k == -m = moveDownFrom (v ! succ k)
-                  | k ==  n = moveRightFrom (v ! pred k)
-                  | otherwise =
-                    let left = v ! pred k
-                        up   = v ! succ k in
-                    if x left < x up then
-                      moveDownFrom up
-                    else
-                      moveRightFrom left
-
-        -- | Move downward from a given vertex, inserting the element for the corresponding row.
-        moveDownFrom  (Endpoint x y script) = Endpoint       x (succ y) $ maybe script ((: script) . That) (bs !? y)
-        {-# INLINE moveDownFrom #-}
-
-        -- | Move rightward from a given vertex, deleting the element for the corresponding column.
-        moveRightFrom (Endpoint x y script) = Endpoint (succ x)      y  $ maybe script ((: script) . This) (as !? x)
-        {-# INLINE moveRightFrom #-}
-
-        -- | Slide down any diagonal edges from a given vertex.
-        slideFrom (Endpoint x y script)
-          | Just a <- as !? x
-          , Just b <- bs !? y
-          , a `eq` b  = slideFrom (Endpoint (succ x) (succ y) (These a b : script))
-          | otherwise =            Endpoint       x        y               script
-
-
-(!?) :: Ix i => Array.Array i a -> i -> Maybe a
-(!?) v i | inRange (Array.bounds v) i, !a <- v ! i = Just a
-         | otherwise = Nothing
-{-# INLINE (!?) #-}
diff --git a/test/SES/Myers/Spec.hs b/test/SES/Spec.hs
similarity index 95%
rename from test/SES/Myers/Spec.hs
rename to test/SES/Spec.hs
index 47bf29850..78ac24501 100644
--- a/test/SES/Myers/Spec.hs
+++ b/test/SES/Spec.hs
@@ -1,7 +1,7 @@
-module SES.Myers.Spec where
+module SES.Spec where
 
 import Data.These
-import SES.Myers
+import SES
 import Test.Hspec
 import Test.Hspec.LeanCheck
 
diff --git a/test/Spec.hs b/test/Spec.hs
index 5290f0ef1..f4b58786c 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -8,7 +8,7 @@ import qualified Data.Syntax.Assignment.Spec
 import qualified DiffSpec
 import qualified InterpreterSpec
 import qualified PatchOutputSpec
-import qualified SES.Myers.Spec
+import qualified SES.Spec
 import qualified SourceSpec
 import qualified TermSpec
 import qualified TOCSpec
@@ -28,7 +28,7 @@ main = hspec $ do
     describe "Diff" DiffSpec.spec
     describe "Interpreter" InterpreterSpec.spec
     describe "PatchOutput" PatchOutputSpec.spec
-    describe "SES.Myers" SES.Myers.Spec.spec
+    describe "SES" SES.Spec.spec
     describe "Source" SourceSpec.spec
     describe "Term" TermSpec.spec
     describe "Semantic" SemanticSpec.spec

From 4645df37ba0aba0fef3a1f67f5e9fe02cd0aaee7 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 14:56:45 -0400
Subject: [PATCH 60/65] Fold over both sides of the patch.

---
 src/Renderer/TOC.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs
index d0a16a8a5..2755a548e 100644
--- a/src/Renderer/TOC.hs
+++ b/src/Renderer/TOC.hs
@@ -19,6 +19,7 @@ module Renderer.TOC
 
 import Data.Aeson
 import Data.Align (bicrosswalk)
+import Data.Bifoldable (bifoldMap)
 import Data.Bifunctor (bimap)
 import Data.Blob
 import Data.ByteString.Lazy (toStrict)
@@ -149,7 +150,7 @@ tableOfContentsBy :: (Foldable f, Functor f)
                   -> Diff f ann ann                       -- ^ The diff to compute the table of contents for.
                   -> [Entry a]                            -- ^ A list of entries for relevant changed and unchanged nodes in the diff.
 tableOfContentsBy selector = fromMaybe [] . cata (\ r -> case r of
-  Patch patch -> (pure . patchEntry <$> bicrosswalk selector selector patch) <> foldMap fold patch <> Just []
+  Patch patch -> (pure . patchEntry <$> bicrosswalk selector selector patch) <> bifoldMap fold fold patch <> Just []
   Merge (In (_, ann2) r) -> case (selector (In ann2 r), fold r) of
     (Just a, Nothing) -> Just [Unchanged a]
     (Just a, Just []) -> Just [Changed a]

From 2d66cf6d9f8fd880612959777849d5bd6fef64d2 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 14:58:24 -0400
Subject: [PATCH 61/65] Fold over both sides of the patch some more.

---
 src/Diff.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Diff.hs b/src/Diff.hs
index 2512f42cf..3757d76fd 100644
--- a/src/Diff.hs
+++ b/src/Diff.hs
@@ -68,8 +68,8 @@ diffPatch diff = case unDiff diff of
 
 diffPatches :: (Foldable syntax, Functor syntax) => Diff syntax ann1 ann2 -> [Patch (TermF syntax ann1 (Diff syntax ann1 ann2)) (TermF syntax ann2 (Diff syntax ann1 ann2))]
 diffPatches = para $ \ diff -> case diff of
-  Patch patch -> bimap (fmap fst) (fmap fst) patch : foldMap (foldMap (toList . diffPatch . fst)) patch
-  Merge merge ->                                              foldMap (toList . diffPatch . fst)  merge
+  Patch patch -> bimap (fmap fst) (fmap fst) patch : bifoldMap (foldMap (toList . diffPatch . fst)) (foldMap (toList . diffPatch . fst)) patch
+  Merge merge ->                                                foldMap (toList . diffPatch . fst)  merge
 
 
 -- | Merge a diff using a function to provide the Term (in Maybe, to simplify recovery of the before/after state) for every Patch.

From e4fbdc395642991aa2f34ba64b8777c524daec0c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 15:06:17 -0400
Subject: [PATCH 62/65] Generalize the context algorithms over the annotation
 types.

---
 src/Data/Syntax.hs | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs
index b096d6d29..58082a44e 100644
--- a/src/Data/Syntax.hs
+++ b/src/Data/Syntax.hs
@@ -159,21 +159,21 @@ instance Eq1 Context where liftEq = genericLiftEq
 instance Show1 Context where liftShowsPrec = genericLiftShowsPrec
 
 algorithmDeletingContext :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
-                         => TermF Context a (Term (Union fs) a)
-                         -> Term (Union fs) a
-                         -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a a (TermF Context a (Diff (Union fs) a a)))
+                         => TermF Context ann1 (Term (Union fs) ann1)
+                         -> Term (Union fs) ann2
+                         -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) ann1 ann2 (TermF Context ann1 (Diff (Union fs) ann1 ann2)))
 algorithmDeletingContext (In a1 (Context n1 s1)) s2 = fmap (In a1 . Context (deleting <$> n1)) <$> algorithmForComparableTerms s1 s2
 
 algorithmInsertingContext :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
-                          => Term (Union fs) a
-                          -> TermF Context a (Term (Union fs) a)
-                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a a (TermF Context a (Diff (Union fs) a a)))
+                          => Term (Union fs) ann1
+                          -> TermF Context ann2 (Term (Union fs) ann2)
+                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) ann1 ann2 (TermF Context ann2 (Diff (Union fs) ann1 ann2)))
 algorithmInsertingContext s1 (In a2 (Context n2 s2)) = fmap (In a2 . Context (inserting <$> n2)) <$> algorithmForComparableTerms s1 s2
 
 algorithmForContextUnions :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
-                          => Term (Union fs) a
-                          -> Term (Union fs) a
-                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) a a (Diff (Union fs) a a))
+                          => Term (Union fs) ann1
+                          -> Term (Union fs) ann2
+                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) ann1 ann2 (Diff (Union fs) ann1 ann2))
 algorithmForContextUnions t1 t2
   | Just algo <- algorithmForComparableTerms t1 t2 = Just algo
   | Just c1@(In _ Context{}) <- prjTermF (unTerm t1) = fmap (deleteF . hoistTermF inj) <$> algorithmDeletingContext c1 t2

From 8bf3b6fb90951c35a20822b2824f09a525151e25 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 15:08:43 -0400
Subject: [PATCH 63/65] :fire: ScopedTypeVariables.

---
 src/Algorithm.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Algorithm.hs b/src/Algorithm.hs
index 023347356..1a5cc6da9 100644
--- a/src/Algorithm.hs
+++ b/src/Algorithm.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, DefaultSignatures, GADTs, RankNTypes, ScopedTypeVariables, TypeOperators #-}
+{-# LANGUAGE DataKinds, DefaultSignatures, GADTs, RankNTypes, TypeOperators #-}
 module Algorithm where
 
 import Control.Applicative (liftA2)
@@ -80,7 +80,7 @@ instance (Show1 term, Show ann1, Show ann2) => Show1 (AlgorithmF term diff ann1
     Delete t1 -> showsUnaryWith showsTerm "Delete" d t1
     Insert t2 -> showsUnaryWith showsTerm "Insert" d t2
     Replace t1 t2 -> showsBinaryWith showsTerm showsTerm "Replace" d t1 t2
-    where showsTerm :: Show ann => Int -> term ann -> ShowS
+    where showsTerm :: (Show1 term, Show ann) => Int -> term ann -> ShowS
           showsTerm = liftShowsPrec showsPrec showList
 
 

From 8e6c2e2789c9774c020a6b122230a4c3196762c9 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 15:09:30 -0400
Subject: [PATCH 64/65] Rename Diffable'/algorithmFor' to
 GDiffable/galgorithmFor.

---
 src/Algorithm.hs | 46 +++++++++++++++++++++++-----------------------
 1 file changed, 23 insertions(+), 23 deletions(-)

diff --git a/src/Algorithm.hs b/src/Algorithm.hs
index 1a5cc6da9..d423b0eaa 100644
--- a/src/Algorithm.hs
+++ b/src/Algorithm.hs
@@ -102,11 +102,11 @@ algorithmForComparableTerms (Term (In ann1 f1)) (Term (In ann2 f2)) = fmap (merg
 -- | A type class for determining what algorithm to use for diffing two terms.
 class Diffable f where
   algorithmFor :: f (term ann1) -> f (term ann2) -> Maybe (Algorithm term diff ann1 ann2 (f (diff ann1 ann2)))
-  default algorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann1) -> f (term ann2) -> Maybe (Algorithm term diff ann1 ann2 (f (diff ann1 ann2)))
+  default algorithmFor :: (Generic1 f, GDiffable (Rep1 f)) => f (term ann1) -> f (term ann2) -> Maybe (Algorithm term diff ann1 ann2 (f (diff ann1 ann2)))
   algorithmFor = genericAlgorithmFor
 
-genericAlgorithmFor :: (Generic1 f, Diffable' (Rep1 f)) => f (term ann1) -> f (term ann2) -> Maybe (Algorithm term diff ann1 ann2 (f (diff ann1 ann2)))
-genericAlgorithmFor a b = fmap to1 <$> algorithmFor' (from1 a) (from1 b)
+genericAlgorithmFor :: (Generic1 f, GDiffable (Rep1 f)) => f (term ann1) -> f (term ann2) -> Maybe (Algorithm term diff ann1 ann2 (f (diff ann1 ann2)))
+genericAlgorithmFor a b = fmap to1 <$> galgorithmFor (from1 a) (from1 b)
 
 
 -- | Diff a Union of Syntax terms. Left is the "rest" of the Syntax terms in the Union,
@@ -121,46 +121,46 @@ instance Diffable [] where
   algorithmFor a b = Just (byRWS a b)
 
 -- | A generic type class for diffing two terms defined by the Generic1 interface.
-class Diffable' f where
-  algorithmFor' :: f (term ann1) -> f (term ann2) -> Maybe (Algorithm term diff ann1 ann2 (f (diff ann1 ann2)))
+class GDiffable f where
+  galgorithmFor :: f (term ann1) -> f (term ann2) -> Maybe (Algorithm term diff ann1 ann2 (f (diff ann1 ann2)))
 
 -- | 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
+instance GDiffable f => GDiffable (M1 i c f) where
+  galgorithmFor (M1 a) (M1 b) = fmap M1 <$> galgorithmFor 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
+instance (GDiffable f, GDiffable g) => GDiffable (f :*: g) where
+  galgorithmFor (a1 :*: b1) (a2 :*: b2) = liftA2 (:*:) <$> galgorithmFor a1 a2 <*> galgorithmFor 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
+instance (GDiffable f, GDiffable g) => GDiffable (f :+: g) where
+  galgorithmFor (L1 a) (L1 b) = fmap L1 <$> galgorithmFor a b
+  galgorithmFor (R1 a) (R1 b) = fmap R1 <$> galgorithmFor a b
+  galgorithmFor _ _ = 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)
+instance GDiffable Par1 where
+  galgorithmFor (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))
+instance Eq c => GDiffable (K1 i c) where
+  galgorithmFor (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)
+instance GDiffable U1 where
+  galgorithmFor _ _ = Just (pure U1)
 
 -- | Diff two lists of parameters.
-instance Diffable' (Rec1 []) where
-  algorithmFor' a b = Just (Rec1 <$> byRWS (unRec1 a) (unRec1 b))
+instance GDiffable (Rec1 []) where
+  galgorithmFor a b = Just (Rec1 <$> byRWS (unRec1 a) (unRec1 b))
 
 -- | Diff two non-empty lists of parameters.
-instance Diffable' (Rec1 NonEmpty) where
-  algorithmFor' (Rec1 (a:|as)) (Rec1 (b:|bs)) = Just $ do
+instance GDiffable (Rec1 NonEmpty) where
+  galgorithmFor (Rec1 (a:|as)) (Rec1 (b:|bs)) = Just $ do
     d:ds <- byRWS (a:as) (b:bs)
     pure (Rec1 (d :| ds))

From 995bcd6deaf914d20c65afee6a74125e57b5e09e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 14 Sep 2017 15:17:22 -0400
Subject: [PATCH 65/65] Fully apply the diff parameter.

---
 src/Algorithm.hs   | 46 +++++++++++++++++++++++-----------------------
 src/Data/Syntax.hs |  6 +++---
 src/Interpreter.hs |  6 +++---
 3 files changed, 29 insertions(+), 29 deletions(-)

diff --git a/src/Algorithm.hs b/src/Algorithm.hs
index d423b0eaa..73e4fddc9 100644
--- a/src/Algorithm.hs
+++ b/src/Algorithm.hs
@@ -15,36 +15,36 @@ import GHC.Generics
 import Term
 
 -- | A single step in a diffing algorithm, parameterized by the types of terms, diffs, and the result of the applicable algorithm.
-data AlgorithmF term diff ann1 ann2 result where
+data AlgorithmF term diff result where
   -- | Diff two terms with the choice of algorithm left to the interpreter’s discretion.
-  Diff :: term ann1 -> term ann2 -> AlgorithmF term diff ann1 ann2 (diff ann1 ann2)
+  Diff :: term ann1 -> term ann2 -> AlgorithmF term (diff ann1 ann2) (diff ann1 ann2)
   -- | Diff two terms recursively in O(n) time, resulting in a single diff node.
-  Linear :: term ann1 -> term ann2 -> AlgorithmF term diff ann1 ann2 (diff ann1 ann2)
+  Linear :: term ann1 -> term ann2 -> AlgorithmF term (diff ann1 ann2) (diff ann1 ann2)
   -- | Diff two lists of terms by each element’s similarity in O(n³ log n), resulting in a list of diffs.
-  RWS :: [term ann1] -> [term ann2] -> AlgorithmF term diff ann1 ann2 [diff ann1 ann2]
+  RWS :: [term ann1] -> [term ann2] -> AlgorithmF term (diff ann1 ann2) [diff ann1 ann2]
   -- | Delete a term..
-  Delete :: term ann1 -> AlgorithmF term diff ann1 ann2 (diff ann1 ann2)
+  Delete :: term ann1 -> AlgorithmF term (diff ann1 ann2) (diff ann1 ann2)
   -- | Insert a term.
-  Insert :: term ann2 -> AlgorithmF term diff ann1 ann2 (diff ann1 ann2)
+  Insert :: term ann2 -> AlgorithmF term (diff ann1 ann2) (diff ann1 ann2)
   -- | Replace one term with another.
-  Replace :: term ann1 -> term ann2 -> AlgorithmF term diff ann1 ann2 (diff ann1 ann2)
+  Replace :: term ann1 -> term ann2 -> AlgorithmF term (diff ann1 ann2) (diff ann1 ann2)
 
 -- | The free applicative for 'AlgorithmF'. This enables us to construct diff values using <$> and <*> notation.
-type Algorithm term diff ann1 ann2 = Freer (AlgorithmF term diff ann1 ann2)
+type Algorithm term diff = Freer (AlgorithmF term diff)
 
 
 -- DSL
 
 -- | Diff two terms without specifying the algorithm to be used.
-diff :: term ann1 -> term ann2 -> Algorithm term diff ann1 ann2 (diff ann1 ann2)
+diff :: term ann1 -> term ann2 -> Algorithm term (diff ann1 ann2) (diff ann1 ann2)
 diff = (liftF .) . Algorithm.Diff
 
 -- | Diff a These of terms without specifying the algorithm to be used.
-diffThese :: These (term ann1) (term ann2) -> Algorithm term diff ann1 ann2 (diff ann1 ann2)
+diffThese :: These (term ann1) (term ann2) -> Algorithm term (diff ann1 ann2) (diff ann1 ann2)
 diffThese = these byDeleting byInserting diff
 
 -- | Diff a pair of optional terms without specifying the algorithm to be used.
-diffMaybe :: Maybe (term ann1) -> Maybe (term ann2) -> Algorithm term diff ann1 ann2 (Maybe (diff ann1 ann2))
+diffMaybe :: Maybe (term ann1) -> Maybe (term ann2) -> Algorithm term (diff ann1 ann2) (Maybe (diff ann1 ann2))
 diffMaybe a b = case (a, b) of
   (Just a, Just b) -> Just <$> diff a b
   (Just a, _) -> Just <$> byDeleting a
@@ -52,27 +52,27 @@ diffMaybe a b = case (a, b) of
   _ -> pure Nothing
 
 -- | Diff two terms linearly.
-linearly :: term ann1 -> term ann2 -> Algorithm term diff ann1 ann2 (diff ann1 ann2)
+linearly :: term ann1 -> term ann2 -> Algorithm term (diff ann1 ann2) (diff ann1 ann2)
 linearly a b = liftF (Linear a b)
 
 -- | Diff two terms using RWS.
-byRWS :: [term ann1] -> [term ann2] -> Algorithm term diff ann1 ann2 [diff ann1 ann2]
+byRWS :: [term ann1] -> [term ann2] -> Algorithm term (diff ann1 ann2) [diff ann1 ann2]
 byRWS a b = liftF (RWS a b)
 
 -- | Delete a term.
-byDeleting :: term ann1 -> Algorithm term diff ann1 ann2 (diff ann1 ann2)
+byDeleting :: term ann1 -> Algorithm term (diff ann1 ann2) (diff ann1 ann2)
 byDeleting = liftF . Delete
 
 -- | Insert a term.
-byInserting :: term ann2 -> Algorithm term diff ann1 ann2 (diff ann1 ann2)
+byInserting :: term ann2 -> Algorithm term (diff ann1 ann2) (diff ann1 ann2)
 byInserting = liftF . Insert
 
 -- | Replace one term with another.
-byReplacing :: term ann1 -> term ann2 -> Algorithm term diff ann1 ann2 (diff ann1 ann2)
+byReplacing :: term ann1 -> term ann2 -> Algorithm term (diff ann1 ann2) (diff ann1 ann2)
 byReplacing = (liftF .) . Replace
 
 
-instance (Show1 term, Show ann1, Show ann2) => Show1 (AlgorithmF term diff ann1 ann2) where
+instance (Show1 term, Show ann1, Show ann2) => Show1 (AlgorithmF term (diff ann1 ann2)) where
   liftShowsPrec _ _ d algorithm = case algorithm of
     Algorithm.Diff t1 t2 -> showsBinaryWith showsTerm showsTerm "Diff" d t1 t2
     Linear t1 t2 -> showsBinaryWith showsTerm showsTerm "Linear" d t1 t2
@@ -89,23 +89,23 @@ instance (Show1 term, Show ann1, Show ann2) => Show1 (AlgorithmF term diff ann1
 algorithmForTerms :: (Functor syntax, Diffable syntax)
                   => Term syntax ann1
                   -> Term syntax ann2
-                  -> Algorithm (Term syntax) (Diff syntax) ann1 ann2 (Diff syntax ann1 ann2)
+                  -> Algorithm (Term syntax) (Diff syntax ann1 ann2) (Diff syntax ann1 ann2)
 algorithmForTerms t1 t2 = fromMaybe (byReplacing t1 t2) (algorithmForComparableTerms t1 t2)
 
 algorithmForComparableTerms :: (Functor syntax, Diffable syntax)
                             => Term syntax ann1
                             -> Term syntax ann2
-                            -> Maybe (Algorithm (Term syntax) (Diff syntax) ann1 ann2 (Diff syntax ann1 ann2))
+                            -> Maybe (Algorithm (Term syntax) (Diff syntax ann1 ann2) (Diff syntax ann1 ann2))
 algorithmForComparableTerms (Term (In ann1 f1)) (Term (In ann2 f2)) = fmap (merge (ann1, ann2)) <$> algorithmFor f1 f2
 
 
 -- | A type class for determining what algorithm to use for diffing two terms.
 class Diffable f where
-  algorithmFor :: f (term ann1) -> f (term ann2) -> Maybe (Algorithm term diff ann1 ann2 (f (diff ann1 ann2)))
-  default algorithmFor :: (Generic1 f, GDiffable (Rep1 f)) => f (term ann1) -> f (term ann2) -> Maybe (Algorithm term diff ann1 ann2 (f (diff ann1 ann2)))
+  algorithmFor :: f (term ann1) -> f (term ann2) -> Maybe (Algorithm term (diff ann1 ann2) (f (diff ann1 ann2)))
+  default algorithmFor :: (Generic1 f, GDiffable (Rep1 f)) => f (term ann1) -> f (term ann2) -> Maybe (Algorithm term (diff ann1 ann2) (f (diff ann1 ann2)))
   algorithmFor = genericAlgorithmFor
 
-genericAlgorithmFor :: (Generic1 f, GDiffable (Rep1 f)) => f (term ann1) -> f (term ann2) -> Maybe (Algorithm term diff ann1 ann2 (f (diff ann1 ann2)))
+genericAlgorithmFor :: (Generic1 f, GDiffable (Rep1 f)) => f (term ann1) -> f (term ann2) -> Maybe (Algorithm term (diff ann1 ann2) (f (diff ann1 ann2)))
 genericAlgorithmFor a b = fmap to1 <$> galgorithmFor (from1 a) (from1 b)
 
 
@@ -122,7 +122,7 @@ instance Diffable [] where
 
 -- | A generic type class for diffing two terms defined by the Generic1 interface.
 class GDiffable f where
-  galgorithmFor :: f (term ann1) -> f (term ann2) -> Maybe (Algorithm term diff ann1 ann2 (f (diff ann1 ann2)))
+  galgorithmFor :: f (term ann1) -> f (term ann2) -> Maybe (Algorithm term (diff ann1 ann2) (f (diff ann1 ann2)))
 
 -- | Diff two constructors (M1 is the Generic1 newtype for meta-information (possibly related to type constructors, record selectors, and data types))
 instance GDiffable f => GDiffable (M1 i c f) where
diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs
index 58082a44e..88e2bd5f4 100644
--- a/src/Data/Syntax.hs
+++ b/src/Data/Syntax.hs
@@ -161,19 +161,19 @@ instance Show1 Context where liftShowsPrec = genericLiftShowsPrec
 algorithmDeletingContext :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
                          => TermF Context ann1 (Term (Union fs) ann1)
                          -> Term (Union fs) ann2
-                         -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) ann1 ann2 (TermF Context ann1 (Diff (Union fs) ann1 ann2)))
+                         -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs) ann1 ann2) (TermF Context ann1 (Diff (Union fs) ann1 ann2)))
 algorithmDeletingContext (In a1 (Context n1 s1)) s2 = fmap (In a1 . Context (deleting <$> n1)) <$> algorithmForComparableTerms s1 s2
 
 algorithmInsertingContext :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
                           => Term (Union fs) ann1
                           -> TermF Context ann2 (Term (Union fs) ann2)
-                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) ann1 ann2 (TermF Context ann2 (Diff (Union fs) ann1 ann2)))
+                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs) ann1 ann2) (TermF Context ann2 (Diff (Union fs) ann1 ann2)))
 algorithmInsertingContext s1 (In a2 (Context n2 s2)) = fmap (In a2 . Context (inserting <$> n2)) <$> algorithmForComparableTerms s1 s2
 
 algorithmForContextUnions :: (Apply1 Diffable fs, Apply1 Functor fs, Context :< fs)
                           => Term (Union fs) ann1
                           -> Term (Union fs) ann2
-                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs)) ann1 ann2 (Diff (Union fs) ann1 ann2))
+                          -> Maybe (Algorithm (Term (Union fs)) (Diff (Union fs) ann1 ann2) (Diff (Union fs) ann1 ann2))
 algorithmForContextUnions t1 t2
   | Just algo <- algorithmForComparableTerms t1 t2 = Just algo
   | Just c1@(In _ Context{}) <- prjTermF (unTerm t1) = fmap (deleteF . hoistTermF inj) <$> algorithmDeletingContext c1 t2
diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index fa6cfdc61..d6f84d2e7 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -41,13 +41,13 @@ decoratingWith getLabel1 getLabel2 differ t1 t2 = stripDiff (differ (defaultFeat
 -- | Diff a pair of terms recurisvely, using the supplied continuation and 'ComparabilityRelation'.
 diffTermsWith :: forall syntax fields1 fields2
               .  (Eq1 syntax, GAlign syntax, Traversable syntax)
-              => (Term syntax (Record (FeatureVector ': fields1)) -> Term syntax (Record (FeatureVector ': fields2)) -> Algorithm (Term syntax) (Diff syntax) (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)) (Diff syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)))) -- ^ A function producing syntax-directed continuations of the algorithm.
+              => (Term syntax (Record (FeatureVector ': fields1)) -> Term syntax (Record (FeatureVector ': fields2)) -> Algorithm (Term syntax) (Diff syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2))) (Diff syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)))) -- ^ A function producing syntax-directed continuations of the algorithm.
               -> ComparabilityRelation syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)) -- ^ A relation on terms used to determine comparability and equality.
               -> Term syntax (Record (FeatureVector ': fields1)) -- ^ A term representing the old state.
               -> Term syntax (Record (FeatureVector ': fields2)) -- ^ A term representing the new state.
               -> Diff syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)) -- ^ The resulting diff.
 diffTermsWith refine comparable t1 t2 = runFreer decompose (diff t1 t2)
-  where decompose :: AlgorithmF (Term syntax) (Diff syntax) (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)) result -> Algorithm (Term syntax) (Diff syntax) (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)) result
+  where decompose :: AlgorithmF (Term syntax) (Diff syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2))) result -> Algorithm (Term syntax) (Diff syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2))) result
         decompose step = case step of
           Algorithm.Diff t1 t2 -> refine t1 t2
           Linear t1 t2 -> case galignWith diffThese (unwrap t1) (unwrap t2) of
@@ -68,7 +68,7 @@ getLabel (In h t) = (Info.category h, case t of
 -- | Construct an algorithm to diff a pair of terms.
 algorithmWithTerms :: Term Syntax ann1
                    -> Term Syntax ann2
-                   -> Algorithm (Term Syntax) (Diff Syntax) ann1 ann2 (Diff Syntax ann1 ann2)
+                   -> Algorithm (Term Syntax) (Diff Syntax ann1 ann2) (Diff Syntax ann1 ann2)
 algorithmWithTerms t1 t2 = case (unwrap t1, unwrap t2) of
   (Indexed a, Indexed b) ->
     annotate . Indexed <$> byRWS a b