From 11ca3a902ba5a8988492eeb2797c6efe2bf7cdc8 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 13:55:18 -0400
Subject: [PATCH 01/31] :fire: a redundant constraint.

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

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 216241ac3..a81a347de 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -121,7 +121,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, HasField fields Category) => Integer -> These (Term f (Record fields)) (Term f (Record fields)) -> Int
+editDistanceUpTo :: (GAlign f, Foldable f, Functor f) => Integer -> These (Term f (Record fields)) (Term f (Record fields)) -> Int
 editDistanceUpTo m = these termSize termSize (\ a b -> diffSum (patchSum termSize) (cutoff m (approximateDiff a b)))
   where diffSum patchCost = sum . fmap (maybe 0 patchCost)
         approximateDiff a b = maybe (replacing a b) wrap (galignWith (these deleting inserting approximateDiff) (unwrap a) (unwrap b))

From cb7a5a7b57817c1c3ffff0287881bf154bf3fdd9 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 14:35:54 -0400
Subject: [PATCH 02/31] runStep returns the continuation without wrapping in
 Either.

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

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index a81a347de..06a47804b 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -33,16 +33,16 @@ runSteps :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVe
     => Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result
     -> [Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result]
 runSteps algorithm = case runStep algorithm of
-  Left a -> [Return a]
-  Right next -> next : runSteps next
+  Return a -> [Return a]
+  next -> next : runSteps next
 
--- | Run a single step of an Algorithm, returning Either its result if it has finished, or the next step otherwise.
+-- | Run a single step of an Algorithm, returning its result if it has finished, or the next step otherwise.
 runStep :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector))
         => Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result
-        -> Either result (Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result)
+        -> Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result
 runStep step = case step of
-  Return a -> Left a
-  algorithm `Then` cont -> Right $ decompose algorithm >>= cont
+  Return a -> Return a
+  algorithm `Then` cont -> decompose algorithm >>= cont
 
 
 -- | Decompose a step of an algorithm into the next steps to perform.

From 77bdda7b7edba045c60d7d90f72d020ab787ed9f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 14:38:11 -0400
Subject: [PATCH 03/31] s/run/runAlgorithm/.

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

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 06a47804b..3be018fa1 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE GADTs, RankNTypes #-}
-module Interpreter (diffTerms, run, runSteps, runStep) where
+module Interpreter (diffTerms, runAlgorithm, runAlgorithmSteps, runAlgorithmStep) where
 
 import Algorithm
 import Control.Monad.Free.Freer
@@ -20,27 +20,27 @@ diffTerms :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureV
   => SyntaxTerm leaf fields -- ^ A term representing the old state.
   -> SyntaxTerm leaf fields -- ^ A term representing the new state.
   -> SyntaxDiff leaf fields
-diffTerms = (run .) . diff
+diffTerms = (runAlgorithm .) . diff
 
 -- | Run an Algorithm to completion, returning its result.
-run :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector))
+runAlgorithm :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector))
     => Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result
     -> result
-run = iterFreer (\ algorithm cont -> cont (run (decompose algorithm)))
+runAlgorithm = iterFreer (\ algorithm cont -> cont (runAlgorithm (decompose algorithm)))
 
 -- | Run an Algorithm to completion, returning the list of steps taken.
-runSteps :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector))
+runAlgorithmSteps :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector))
     => Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result
     -> [Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result]
-runSteps algorithm = case runStep algorithm of
+runAlgorithmSteps algorithm = case runAlgorithmStep algorithm of
   Return a -> [Return a]
-  next -> next : runSteps next
+  next -> next : runAlgorithmSteps next
 
 -- | Run a single step of an Algorithm, returning its result if it has finished, or the next step otherwise.
-runStep :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector))
+runAlgorithmStep :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector))
         => Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result
         -> Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result
-runStep step = case step of
+runAlgorithmStep step = case step of
   Return a -> Return a
   algorithm `Then` cont -> decompose algorithm >>= cont
 

From 2e2ff9d614ced24809d95a9204ac00fb0ca6f8b1 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 14:45:46 -0400
Subject: [PATCH 04/31] runAlgorithm is parameterized by the decomposition
 operation.

---
 src/Interpreter.hs | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 3be018fa1..b25d8eb9d 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs, RankNTypes #-}
+{-# LANGUAGE GADTs, RankNTypes, ScopedTypeVariables #-}
 module Interpreter (diffTerms, runAlgorithm, runAlgorithmSteps, runAlgorithmStep) where
 
 import Algorithm
@@ -20,13 +20,16 @@ diffTerms :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureV
   => SyntaxTerm leaf fields -- ^ A term representing the old state.
   -> SyntaxTerm leaf fields -- ^ A term representing the new state.
   -> SyntaxDiff leaf fields
-diffTerms = (runAlgorithm .) . diff
+diffTerms = (runAlgorithm decompose .) . diff
 
--- | Run an Algorithm to completion, returning its result.
-runAlgorithm :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector))
-    => Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result
-    -> result
-runAlgorithm = iterFreer (\ algorithm cont -> cont (runAlgorithm (decompose algorithm)))
+-- | Run an Algorithm to completion by repeated application of a stepping operation and return its result.
+runAlgorithm :: forall f a result
+  .  (forall x. AlgorithmF (Term f a) (Diff f a) x -> Algorithm (Term f a) (Diff f a) x)
+  -> Algorithm (Term f a) (Diff f a) result
+  -> result
+runAlgorithm decompose = go
+  where go :: Algorithm (Term f a) (Diff f a) x -> x
+        go = iterFreer (\ algorithm cont -> cont (go (decompose algorithm)))
 
 -- | Run an Algorithm to completion, returning the list of steps taken.
 runAlgorithmSteps :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector))

From 34807f26bb0b88341c8537cdbdce7b861991e7bd Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 14:50:10 -0400
Subject: [PATCH 05/31] runAlgorithmSteps is parameterized by the decomposition
 operation.

---
 src/Interpreter.hs | 16 +++++++++-------
 1 file changed, 9 insertions(+), 7 deletions(-)

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index b25d8eb9d..0d4b00816 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -31,13 +31,15 @@ runAlgorithm decompose = go
   where go :: Algorithm (Term f a) (Diff f a) x -> x
         go = iterFreer (\ algorithm cont -> cont (go (decompose algorithm)))
 
--- | Run an Algorithm to completion, returning the list of steps taken.
-runAlgorithmSteps :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector))
-    => Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result
-    -> [Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result]
-runAlgorithmSteps algorithm = case runAlgorithmStep algorithm of
-  Return a -> [Return a]
-  next -> next : runAlgorithmSteps next
+-- | Run an Algorithm to completion by repeated application of a stepping operation, returning the list of steps taken up to and including the final result.
+runAlgorithmSteps :: forall f a result
+    . (forall x. AlgorithmF (Term f a) (Diff f a) x -> Algorithm (Term f a) (Diff f a) x)
+    -> Algorithm (Term f a) (Diff f a) result
+    -> [Algorithm (Term f a) (Diff f a) result]
+runAlgorithmSteps decompose = go
+  where go algorithm = case algorithm of
+          Return a -> [Return a]
+          step `Then` yield -> algorithm : go (decompose step >>= yield)
 
 -- | Run a single step of an Algorithm, returning its result if it has finished, or the next step otherwise.
 runAlgorithmStep :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector))

From b7d5f03a1be69f999b721dcbd48f77365b3bab29 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 14:50:23 -0400
Subject: [PATCH 06/31] :fire: runAlgorithmStep.

---
 src/Interpreter.hs | 11 +----------
 1 file changed, 1 insertion(+), 10 deletions(-)

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 0d4b00816..5b5af9ab8 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE GADTs, RankNTypes, ScopedTypeVariables #-}
-module Interpreter (diffTerms, runAlgorithm, runAlgorithmSteps, runAlgorithmStep) where
+module Interpreter (diffTerms, runAlgorithm, runAlgorithmSteps) where
 
 import Algorithm
 import Control.Monad.Free.Freer
@@ -41,15 +41,6 @@ runAlgorithmSteps decompose = go
           Return a -> [Return a]
           step `Then` yield -> algorithm : go (decompose step >>= yield)
 
--- | Run a single step of an Algorithm, returning its result if it has finished, or the next step otherwise.
-runAlgorithmStep :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector))
-        => Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result
-        -> Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result
-runAlgorithmStep step = case step of
-  Return a -> Return a
-  algorithm `Then` cont -> decompose algorithm >>= cont
-
-
 -- | Decompose a step of an algorithm into the next steps to perform.
 decompose :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector))
           => AlgorithmF (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result -- ^ The step in an algorithm to decompose into its next steps.

From 744f8cfe2e8f48bd17314eb5f98dec8d4c1936f9 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 14:51:58 -0400
Subject: [PATCH 07/31] Generalize the algorithm running functions over
 arbitrary term/diff types.

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

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 5b5af9ab8..5c3c6df74 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -23,19 +23,19 @@ diffTerms :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureV
 diffTerms = (runAlgorithm decompose .) . diff
 
 -- | Run an Algorithm to completion by repeated application of a stepping operation and return its result.
-runAlgorithm :: forall f a result
-  .  (forall x. AlgorithmF (Term f a) (Diff f a) x -> Algorithm (Term f a) (Diff f a) x)
-  -> Algorithm (Term f a) (Diff f a) result
+runAlgorithm :: forall term diff result
+  .  (forall x. AlgorithmF term diff x -> Algorithm term diff x)
+  -> Algorithm term diff result
   -> result
 runAlgorithm decompose = go
-  where go :: Algorithm (Term f a) (Diff f a) x -> x
+  where go :: Algorithm term diff x -> x
         go = iterFreer (\ algorithm cont -> cont (go (decompose algorithm)))
 
 -- | Run an Algorithm to completion by repeated application of a stepping operation, returning the list of steps taken up to and including the final result.
-runAlgorithmSteps :: forall f a result
-    . (forall x. AlgorithmF (Term f a) (Diff f a) x -> Algorithm (Term f a) (Diff f a) x)
-    -> Algorithm (Term f a) (Diff f a) result
-    -> [Algorithm (Term f a) (Diff f a) result]
+runAlgorithmSteps :: forall term diff result
+    .  (forall x. AlgorithmF term diff x -> Algorithm term diff x)
+    -> Algorithm term diff result
+    -> [Algorithm term diff result]
 runAlgorithmSteps decompose = go
   where go algorithm = case algorithm of
           Return a -> [Return a]

From 2e825ec90b418d46bd6283446525fffc12d42084 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 14:54:41 -0400
Subject: [PATCH 08/31] Generalize runAlgorithm and runAlgorithmSteps to
 arbitrary functors in Freer.

---
 src/Interpreter.hs | 17 ++++++++---------
 1 file changed, 8 insertions(+), 9 deletions(-)

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 5c3c6df74..252442757 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -23,19 +23,18 @@ diffTerms :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureV
 diffTerms = (runAlgorithm decompose .) . diff
 
 -- | Run an Algorithm to completion by repeated application of a stepping operation and return its result.
-runAlgorithm :: forall term diff result
-  .  (forall x. AlgorithmF term diff x -> Algorithm term diff x)
-  -> Algorithm term diff result
-  -> result
+runAlgorithm :: forall f result
+             .  (forall x. f x -> Freer f x)
+             -> Freer f result
+             -> result
 runAlgorithm decompose = go
-  where go :: Algorithm term diff x -> x
+  where go :: Freer f x -> x
         go = iterFreer (\ algorithm cont -> cont (go (decompose algorithm)))
 
 -- | Run an Algorithm to completion by repeated application of a stepping operation, returning the list of steps taken up to and including the final result.
-runAlgorithmSteps :: forall term diff result
-    .  (forall x. AlgorithmF term diff x -> Algorithm term diff x)
-    -> Algorithm term diff result
-    -> [Algorithm term diff result]
+runAlgorithmSteps :: (forall x. f x -> Freer f x)
+                  -> Freer f result
+                  -> [Freer f result]
 runAlgorithmSteps decompose = go
   where go algorithm = case algorithm of
           Return a -> [Return a]

From a212fc628d4d8304003cc9453d3c6f9684e98376 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 14:58:48 -0400
Subject: [PATCH 09/31] s/cont/yield/.

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

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 252442757..d1a054bc6 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -29,7 +29,7 @@ runAlgorithm :: forall f result
              -> result
 runAlgorithm decompose = go
   where go :: Freer f x -> x
-        go = iterFreer (\ algorithm cont -> cont (go (decompose algorithm)))
+        go = iterFreer (\ algorithm yield -> yield (go (decompose algorithm)))
 
 -- | Run an Algorithm to completion by repeated application of a stepping operation, returning the list of steps taken up to and including the final result.
 runAlgorithmSteps :: (forall x. f x -> Freer f x)

From 22e7e8ca3e4e0de511e8554764ee301f1b3c36df Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 15:17:59 -0400
Subject: [PATCH 10/31] Generalize decompose over the general term-diffing
 algorithm computation.

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

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index d1a054bc6..03cde3ba8 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -5,6 +5,7 @@ import Algorithm
 import Control.Monad.Free.Freer
 import Data.Align.Generic
 import Data.Functor.Both
+import Data.Functor.Classes (Eq1)
 import RWS
 import Data.Record
 import Data.These
@@ -20,7 +21,7 @@ diffTerms :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureV
   => SyntaxTerm leaf fields -- ^ A term representing the old state.
   -> SyntaxTerm leaf fields -- ^ A term representing the new state.
   -> SyntaxDiff leaf fields
-diffTerms = (runAlgorithm decompose .) . diff
+diffTerms = (runAlgorithm (decomposeWith algorithmWithTerms) .) . diff
 
 -- | Run an Algorithm to completion by repeated application of a stepping operation and return its result.
 runAlgorithm :: forall f result
@@ -40,11 +41,12 @@ runAlgorithmSteps decompose = go
           Return a -> [Return a]
           step `Then` yield -> algorithm : go (decompose step >>= yield)
 
--- | Decompose a step of an algorithm into the next steps to perform.
-decompose :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector))
-          => AlgorithmF (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result -- ^ The step in an algorithm to decompose into its next steps.
-          -> Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result -- ^ The sequence of next steps to undertake to continue the algorithm.
-decompose step = case step of
+-- | Decompose a step of an algorithm into the next steps to perform using a helper function.
+decomposeWith :: (Traversable f, GAlign f, Eq1 f, HasField fields (Maybe FeatureVector), HasField fields Category)
+              => (Term f (Record fields) -> Term f (Record fields) -> Algorithm (Term f (Record fields)) (Diff f (Record fields)) (Diff f (Record fields)))
+              -> AlgorithmF (Term f (Record fields)) (Diff f (Record fields)) result
+              -> Algorithm (Term f (Record fields)) (Diff f (Record fields)) result
+decomposeWith algorithmWithTerms step = case step of
   Diff t1 t2 -> algorithmWithTerms t1 t2
   Linear t1 t2 -> case galignWith diffThese (unwrap t1) (unwrap t2) of
     Just result -> wrap . (both (extract t1) (extract t2) :<) <$> sequenceA result

From be3937cc42f3a8f5e3acbe6a313f05aae56ece14 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 15:24:05 -0400
Subject: [PATCH 11/31] Reuse the canCompare parameter.

---
 src/Interpreter.hs |  3 +--
 src/RWS.hs         | 10 +++-------
 2 files changed, 4 insertions(+), 9 deletions(-)

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 03cde3ba8..731437a8b 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -5,7 +5,6 @@ import Algorithm
 import Control.Monad.Free.Freer
 import Data.Align.Generic
 import Data.Functor.Both
-import Data.Functor.Classes (Eq1)
 import RWS
 import Data.Record
 import Data.These
@@ -42,7 +41,7 @@ runAlgorithmSteps decompose = go
           step `Then` yield -> algorithm : go (decompose step >>= yield)
 
 -- | Decompose a step of an algorithm into the next steps to perform using a helper function.
-decomposeWith :: (Traversable f, GAlign f, Eq1 f, HasField fields (Maybe FeatureVector), HasField fields Category)
+decomposeWith :: (Traversable f, GAlign f, HasField fields (Maybe FeatureVector), HasField fields Category)
               => (Term f (Record fields) -> Term f (Record fields) -> Algorithm (Term f (Record fields)) (Diff f (Record fields)) (Diff f (Record fields)))
               -> AlgorithmF (Term f (Record fields)) (Diff f (Record fields)) result
               -> Algorithm (Term f (Record fields)) (Diff f (Record fields)) result
diff --git a/src/RWS.hs b/src/RWS.hs
index ae6729002..cf7bd007a 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -19,11 +19,8 @@ import Data.These
 import Patch
 import Term
 import Data.Array
-import Data.Functor.Classes
-import Info
 import SES
 import qualified Data.Functor.Both as Both
-import Data.Functor.Classes.Eq.Generic
 
 import Data.Functor.Listable
 import Data.KdTree.Static hiding (toList)
@@ -48,7 +45,7 @@ data UnmappedTerm f fields = UnmappedTerm {
 -- | Either a `term`, an index of a matched term, or nil.
 data TermOrIndexOrNone term = Term term | Index Int | None
 
-rws :: (HasField fields Category, HasField fields (Maybe FeatureVector), Foldable t, Functor f, Eq1 f)
+rws :: (HasField fields (Maybe FeatureVector), Foldable t, Functor f)
     => (Diff f fields -> Int)
     -> (Term f (Record fields) -> Term f (Record fields) -> Bool)
     -> t (Term f (Record fields))
@@ -91,7 +88,7 @@ type MappedDiff f fields = (These Int Int, Diff f fields)
 
 type RWSEditScript f fields = [Diff f fields]
 
-run :: (Eq1 f, Functor f, HasField fields Category, HasField fields (Maybe FeatureVector), Foldable t)
+run :: (Functor f, HasField fields (Maybe FeatureVector), Foldable t)
     => (Diff f fields -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
     -> (Term f (Record fields) -> Term f (Record fields) -> Bool) -- ^ A relation determining whether two terms can be compared.
     -> t (Term f (Record fields))
@@ -99,7 +96,7 @@ run :: (Eq1 f, Functor f, HasField fields Category, HasField fields (Maybe Featu
     -> Eff (RWS f fields ': e) (RWSEditScript f fields)
     -> Eff e (RWSEditScript f fields)
 run editDistance canCompare as bs = relay pure (\m q -> q $ case m of
-  SES -> ses (gliftEq (==) `on` fmap category) as bs
+  SES -> ses canCompare as bs
   (GenFeaturizedTermsAndDiffs sesDiffs) ->
     evalState (genFeaturizedTermsAndDiffs sesDiffs) (0, 0)
   (FindNearestNeighoursToDiff allDiffs featureAs featureBs) ->
@@ -391,4 +388,3 @@ instance Listable1 Gram where
 
 instance Listable a => Listable (Gram a) where
   tiers = tiers1
-

From 028d760190e2f3065f723d719751d897fccccf18 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 15:37:19 -0400
Subject: [PATCH 12/31] Revert "Reuse the canCompare parameter."

This reverts commit 2f4f50e8e41f64721f6e7cd887d22c16263b3e52.
---
 src/Interpreter.hs |  3 ++-
 src/RWS.hs         | 10 +++++++---
 2 files changed, 9 insertions(+), 4 deletions(-)

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 731437a8b..03cde3ba8 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -5,6 +5,7 @@ import Algorithm
 import Control.Monad.Free.Freer
 import Data.Align.Generic
 import Data.Functor.Both
+import Data.Functor.Classes (Eq1)
 import RWS
 import Data.Record
 import Data.These
@@ -41,7 +42,7 @@ runAlgorithmSteps decompose = go
           step `Then` yield -> algorithm : go (decompose step >>= yield)
 
 -- | Decompose a step of an algorithm into the next steps to perform using a helper function.
-decomposeWith :: (Traversable f, GAlign f, HasField fields (Maybe FeatureVector), HasField fields Category)
+decomposeWith :: (Traversable f, GAlign f, Eq1 f, HasField fields (Maybe FeatureVector), HasField fields Category)
               => (Term f (Record fields) -> Term f (Record fields) -> Algorithm (Term f (Record fields)) (Diff f (Record fields)) (Diff f (Record fields)))
               -> AlgorithmF (Term f (Record fields)) (Diff f (Record fields)) result
               -> Algorithm (Term f (Record fields)) (Diff f (Record fields)) result
diff --git a/src/RWS.hs b/src/RWS.hs
index cf7bd007a..ae6729002 100644
--- a/src/RWS.hs
+++ b/src/RWS.hs
@@ -19,8 +19,11 @@ import Data.These
 import Patch
 import Term
 import Data.Array
+import Data.Functor.Classes
+import Info
 import SES
 import qualified Data.Functor.Both as Both
+import Data.Functor.Classes.Eq.Generic
 
 import Data.Functor.Listable
 import Data.KdTree.Static hiding (toList)
@@ -45,7 +48,7 @@ data UnmappedTerm f fields = UnmappedTerm {
 -- | Either a `term`, an index of a matched term, or nil.
 data TermOrIndexOrNone term = Term term | Index Int | None
 
-rws :: (HasField fields (Maybe FeatureVector), Foldable t, Functor f)
+rws :: (HasField fields Category, HasField fields (Maybe FeatureVector), Foldable t, Functor f, Eq1 f)
     => (Diff f fields -> Int)
     -> (Term f (Record fields) -> Term f (Record fields) -> Bool)
     -> t (Term f (Record fields))
@@ -88,7 +91,7 @@ type MappedDiff f fields = (These Int Int, Diff f fields)
 
 type RWSEditScript f fields = [Diff f fields]
 
-run :: (Functor f, HasField fields (Maybe FeatureVector), Foldable t)
+run :: (Eq1 f, Functor f, HasField fields Category, HasField fields (Maybe FeatureVector), Foldable t)
     => (Diff f fields -> Int) -- ^ A function computes a constant-time approximation to the edit distance between two terms.
     -> (Term f (Record fields) -> Term f (Record fields) -> Bool) -- ^ A relation determining whether two terms can be compared.
     -> t (Term f (Record fields))
@@ -96,7 +99,7 @@ run :: (Functor f, HasField fields (Maybe FeatureVector), Foldable t)
     -> Eff (RWS f fields ': e) (RWSEditScript f fields)
     -> Eff e (RWSEditScript f fields)
 run editDistance canCompare as bs = relay pure (\m q -> q $ case m of
-  SES -> ses canCompare as bs
+  SES -> ses (gliftEq (==) `on` fmap category) as bs
   (GenFeaturizedTermsAndDiffs sesDiffs) ->
     evalState (genFeaturizedTermsAndDiffs sesDiffs) (0, 0)
   (FindNearestNeighoursToDiff allDiffs featureAs featureBs) ->
@@ -388,3 +391,4 @@ instance Listable1 Gram where
 
 instance Listable a => Listable (Gram a) where
   tiers = tiers1
+

From eb18e2ef6e94a3a98a6982918510bde4b5f7ca07 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 15:45:07 -0400
Subject: [PATCH 13/31] =?UTF-8?q?Move=20the=20GAlign=20instance=20for=20Sy?=
 =?UTF-8?q?ntax=20into=20Syntax=E2=80=99=20module.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Data/Align/Generic.hs | 6 ------
 src/Syntax.hs             | 3 +++
 2 files changed, 3 insertions(+), 6 deletions(-)

diff --git a/src/Data/Align/Generic.hs b/src/Data/Align/Generic.hs
index 2a4650c53..6dc42bac2 100644
--- a/src/Data/Align/Generic.hs
+++ b/src/Data/Align/Generic.hs
@@ -6,7 +6,6 @@ import Data.Align
 import Data.These
 import GHC.Generics
 import Prologue
-import Syntax
 
 -- | Functors which can be aligned (structure-unioning-ly zipped). The default implementation will operate generically over the constructors in the aligning type.
 class Functor f => GAlign f where
@@ -19,11 +18,6 @@ class Functor f => GAlign f where
   galignWith f = (fmap (fmap f) .) . galign
 
 
--- Generically-derived instances
-
-instance Eq a => GAlign (Syntax a)
-
-
 -- 'Data.Align.Align' instances
 
 instance GAlign [] where galign = galignAlign
diff --git a/src/Syntax.hs b/src/Syntax.hs
index 8751b6210..1674c21bb 100644
--- a/src/Syntax.hs
+++ b/src/Syntax.hs
@@ -2,6 +2,7 @@
 module Syntax where
 
 import Data.Aeson
+import Data.Align.Generic
 import Data.Functor.Classes
 import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Listable
@@ -202,3 +203,5 @@ instance (Listable leaf, Listable recur) => Listable (Syntax leaf recur) where
 
 instance Eq leaf => Eq1 (Syntax leaf) where
   liftEq = genericLiftEq
+
+instance Eq leaf => GAlign (Syntax leaf)

From ce50d2da71887c2bd462ba11b40aa03abf69b304 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 15:56:16 -0400
Subject: [PATCH 14/31] :fire: the Functor context for GAlign.

---
 src/Data/Align/Generic.hs | 28 ++++++++++++++--------------
 1 file changed, 14 insertions(+), 14 deletions(-)

diff --git a/src/Data/Align/Generic.hs b/src/Data/Align/Generic.hs
index 6dc42bac2..ede5169d3 100644
--- a/src/Data/Align/Generic.hs
+++ b/src/Data/Align/Generic.hs
@@ -8,14 +8,14 @@ import GHC.Generics
 import Prologue
 
 -- | Functors which can be aligned (structure-unioning-ly zipped). The default implementation will operate generically over the constructors in the aligning type.
-class Functor f => GAlign f where
+class GAlign f where
   galign :: f a -> f b -> Maybe (f (These a b))
-  default galign :: (Generic1 f, GAlign (Rep1 f)) => f a -> f b -> Maybe (f (These a b))
-  galign a b = to1 <$> galign (from1 a) (from1 b)
+  galign = galignWith identity
 
   -- | Perform generic alignment of values of some functor, applying the given function to alignments of elements.
   galignWith :: (These a b -> c) -> f a -> f b -> Maybe (f c)
-  galignWith f = (fmap (fmap f) .) . galign
+  default galignWith :: (Generic1 f, GAlign (Rep1 f)) => (These a b -> c) -> f a -> f b -> Maybe (f c)
+  galignWith f a b = to1 <$> galignWith f (from1 a) (from1 b)
 
 
 -- 'Data.Align.Align' instances
@@ -32,35 +32,35 @@ galignAlign a = Just . align a
 
 -- | 'GAlign' over unit constructors.
 instance GAlign U1 where
-  galign _ _ = Just U1
+  galignWith _ _ _ = Just U1
 
 -- | 'GAlign' over parameters.
 instance GAlign Par1 where
-  galign (Par1 a) (Par1 b) = Just (Par1 (These a b))
+  galignWith f (Par1 a) (Par1 b) = Just (Par1 (f (These a b)))
 
 -- | 'GAlign' over non-parameter fields. Only equal values are aligned.
 instance Eq c => GAlign (K1 i c) where
-  galign (K1 a) (K1 b) = guard (a == b) >> Just (K1 b)
+  galignWith _ (K1 a) (K1 b) = guard (a == b) >> Just (K1 b)
 
 -- | 'GAlign' over applications over parameters.
 instance GAlign f => GAlign (Rec1 f) where
-  galign (Rec1 a) (Rec1 b) = Rec1 <$> galign a b
+  galignWith f (Rec1 a) (Rec1 b) = Rec1 <$> galignWith f a b
 
 -- | 'GAlign' over metainformation (constructor names, etc).
 instance GAlign f => GAlign (M1 i c f) where
-  galign (M1 a) (M1 b) = M1 <$> galign a b
+  galignWith f (M1 a) (M1 b) = M1 <$> galignWith f a b
 
 -- | 'GAlign' over sums. Returns 'Nothing' for disjoint constructors.
 instance (GAlign f, GAlign g) => GAlign (f :+: g) where
-  galign a b = case (a, b) of
-    (L1 a, L1 b) -> L1 <$> galign a b
-    (R1 a, R1 b) -> R1 <$> galign a b
+  galignWith f a b = case (a, b) of
+    (L1 a, L1 b) -> L1 <$> galignWith f a b
+    (R1 a, R1 b) -> R1 <$> galignWith f a b
     _ -> Nothing
 
 -- | 'GAlign' over products.
 instance (GAlign f, GAlign g) => GAlign (f :*: g) where
-  galign (a1 :*: b1) (a2 :*: b2) = (:*:) <$> galign a1 a2 <*> galign b1 b2
+  galignWith f (a1 :*: b1) (a2 :*: b2) = (:*:) <$> galignWith f a1 a2 <*> galignWith f b1 b2
 
 -- | 'GAlign' over type compositions.
 instance (Traversable f, Applicative f, GAlign g) => GAlign (f :.: g) where
-  galign (Comp1 a) (Comp1 b) = Comp1 <$> sequenceA (galign <$> a <*> b)
+  galignWith f (Comp1 a) (Comp1 b) = Comp1 <$> sequenceA (galignWith f <$> a <*> b)

From 1f6d044994f73e443a4e5dbcca1d3c14998f2c8c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 15:58:27 -0400
Subject: [PATCH 15/31] Define GAlign instances for Unions.

---
 src/Data/Functor/Union.hs | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/src/Data/Functor/Union.hs b/src/Data/Functor/Union.hs
index d1e2b2660..071a325ee 100644
--- a/src/Data/Functor/Union.hs
+++ b/src/Data/Functor/Union.hs
@@ -6,6 +6,7 @@ module Data.Functor.Union
 , InUnion(..)
 ) where
 
+import Data.Align.Generic
 import Data.Functor.Classes
 import Data.Kind
 import GHC.Show
@@ -111,3 +112,11 @@ instance (Show1 f, Show1 (Union fs)) => Show1 (Union (f ': fs)) where
 
 instance Show1 (Union '[]) where
   liftShowsPrec _ _ _ _ = identity
+
+instance (GAlign f, GAlign (Union fs)) => GAlign (Union (f ': fs)) where
+  galignWith f (Here a) (Here b) = Here <$> galignWith f a b
+  galignWith f (There a) (There b) = There <$> galignWith f a b
+  galignWith _ _ _ = Nothing
+
+instance GAlign (Union '[]) where
+  galignWith _ _ _ = Nothing

From c189e786c5cf5a61b873f7e8ce528ba39495f96c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 16:00:13 -0400
Subject: [PATCH 16/31] Define a GAlign instance for Identity.

---
 src/Data/Align/Generic.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/Data/Align/Generic.hs b/src/Data/Align/Generic.hs
index ede5169d3..68dfb1ace 100644
--- a/src/Data/Align/Generic.hs
+++ b/src/Data/Align/Generic.hs
@@ -22,6 +22,8 @@ class GAlign f where
 
 instance GAlign [] where galign = galignAlign
 instance GAlign Maybe where galign = galignAlign
+instance GAlign Identity where
+  galignWith f (Identity a) (Identity b) = Just (Identity (f (These a b)))
 
 -- | Implements a function suitable for use as the definition of 'galign' for 'Align'able functors.
 galignAlign :: Align f => f a -> f b -> Maybe (f (These a b))

From 116e5b0e08cf9048c8f42532673e9b5ab42e2873 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 16:05:27 -0400
Subject: [PATCH 17/31] =?UTF-8?q?Derive=20GAlign=20instances=20for=20all?=
 =?UTF-8?q?=20of=20the=20=C3=A0=20la=20carte=20syntax=20types.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Data/Syntax.hs             | 10 ++++++----
 src/Data/Syntax/Comment.hs     |  4 +++-
 src/Data/Syntax/Declaration.hs | 12 +++++++-----
 src/Data/Syntax/Expression.hs  |  8 +++++---
 src/Data/Syntax/Literal.hs     | 21 ++++++++++----------
 src/Data/Syntax/Statement.hs   | 35 +++++++++++++++++-----------------
 src/Data/Syntax/Type.hs        | 14 +++++++++++---
 7 files changed, 61 insertions(+), 43 deletions(-)

diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs
index 60748bf9a..567ed4659 100644
--- a/src/Data/Syntax.hs
+++ b/src/Data/Syntax.hs
@@ -1,5 +1,7 @@
+{-# LANGUAGE DeriveAnyClass #-}
 module Data.Syntax where
 
+import Data.Align.Generic
 import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Classes.Show.Generic
 import GHC.Generics
@@ -9,13 +11,13 @@ import Text.Show
 -- Undifferentiated
 
 newtype Leaf a = Leaf { leafContent :: ByteString }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Leaf where liftEq = genericLiftEq
 instance Show1 Leaf where liftShowsPrec = genericLiftShowsPrec
 
 newtype Branch a = Branch { branchElements :: [a] }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Branch where liftEq = genericLiftEq
 instance Show1 Branch where liftShowsPrec = genericLiftShowsPrec
@@ -25,7 +27,7 @@ instance Show1 Branch where liftShowsPrec = genericLiftShowsPrec
 
 -- | An identifier of some other construct, whether a containing declaration (e.g. a class name) or a reference (e.g. a variable).
 newtype Identifier a = Identifier ByteString
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Identifier where liftEq = genericLiftEq
 instance Show1 Identifier where liftShowsPrec = genericLiftShowsPrec
@@ -35,7 +37,7 @@ instance Show1 Identifier where liftShowsPrec = genericLiftShowsPrec
 --
 --   This can be used to represent an implicit no-op, e.g. the alternative in an 'if' statement without an 'else'.
 data Empty a = Empty
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Empty where liftEq _ _ _ = True
 instance Show1 Empty where liftShowsPrec _ _ _ _ = showString "Empty"
diff --git a/src/Data/Syntax/Comment.hs b/src/Data/Syntax/Comment.hs
index a0d57577d..5bf4a47f9 100644
--- a/src/Data/Syntax/Comment.hs
+++ b/src/Data/Syntax/Comment.hs
@@ -1,5 +1,7 @@
+{-# LANGUAGE DeriveAnyClass #-}
 module Data.Syntax.Comment where
 
+import Data.Align.Generic
 import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Classes.Show.Generic
 import GHC.Generics
@@ -7,7 +9,7 @@ import Prologue
 
 -- | An unnested comment (line or block).
 newtype Comment a = Comment { commentContent :: ByteString }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Comment where liftEq = genericLiftEq
 instance Show1 Comment where liftShowsPrec = genericLiftShowsPrec
diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs
index 2316d9ec0..27d9ec14b 100644
--- a/src/Data/Syntax/Declaration.hs
+++ b/src/Data/Syntax/Declaration.hs
@@ -1,12 +1,14 @@
+{-# LANGUAGE DeriveAnyClass #-}
 module Data.Syntax.Declaration where
 
+import Data.Align.Generic
 import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Classes.Show.Generic
 import GHC.Generics
 import Prologue
 
 data Function a = Function { functionName :: !a, functionParameters :: ![a], functionBody :: !a }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Function where liftEq = genericLiftEq
 instance Show1 Function where liftShowsPrec = genericLiftShowsPrec
@@ -14,7 +16,7 @@ instance Show1 Function where liftShowsPrec = genericLiftShowsPrec
 -- TODO: How should we represent function types, where applicable?
 
 data Method a = Method { methodName :: !a, methodParameters :: ![a], methodBody :: !a }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Method where liftEq = genericLiftEq
 instance Show1 Method where liftShowsPrec = genericLiftShowsPrec
@@ -24,7 +26,7 @@ instance Show1 Method where liftShowsPrec = genericLiftShowsPrec
 
 
 data Class a = Class { classIdentifier :: !a, classSuperclasses :: ![a], classScope :: ![a] }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Class where liftEq = genericLiftEq
 instance Show1 Class where liftShowsPrec = genericLiftShowsPrec
@@ -34,14 +36,14 @@ instance Show1 Class where liftShowsPrec = genericLiftShowsPrec
 
 -- | An ADT, i.e. a disjoint sum of products, like 'data' in Haskell, or 'enum' in Rust or Swift.
 data Datatype a = Datatype { datatypeName :: !a, datatypeConstructors :: ![a] }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Data.Syntax.Declaration.Datatype where liftEq = genericLiftEq
 instance Show1 Data.Syntax.Declaration.Datatype where liftShowsPrec = genericLiftShowsPrec
 
 -- | A single constructor in a datatype, or equally a 'struct' in C, Rust, or Swift.
 data Constructor a = Constructor { constructorName :: !a, constructorFields :: ![a] }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Data.Syntax.Declaration.Constructor where liftEq = genericLiftEq
 instance Show1 Data.Syntax.Declaration.Constructor where liftShowsPrec = genericLiftShowsPrec
diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs
index e10a8e82f..6355308cc 100644
--- a/src/Data/Syntax/Expression.hs
+++ b/src/Data/Syntax/Expression.hs
@@ -1,5 +1,7 @@
+{-# LANGUAGE DeriveAnyClass #-}
 module Data.Syntax.Expression where
 
+import Data.Align.Generic
 import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Classes.Show.Generic
 import GHC.Generics
@@ -7,7 +9,7 @@ import Prologue
 
 -- | Typical prefix function application, like `f(x)` in many languages, or `f x` in Haskell.
 data Call a = Call { callFunction :: a, callParams :: [a] }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Call where liftEq = genericLiftEq
 instance Show1 Call where liftShowsPrec = genericLiftShowsPrec
@@ -15,7 +17,7 @@ instance Show1 Call where liftShowsPrec = genericLiftShowsPrec
 
 -- | Unary boolean negation, like '!x' in many languages.
 data Not a = Not a
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Not where liftEq = genericLiftEq
 instance Show1 Not where liftShowsPrec = genericLiftShowsPrec
@@ -23,7 +25,7 @@ instance Show1 Not where liftShowsPrec = genericLiftShowsPrec
 
 -- | Binary addition.
 data Plus a = Plus a a
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Plus where liftEq = genericLiftEq
 instance Show1 Plus where liftShowsPrec = genericLiftShowsPrec
diff --git a/src/Data/Syntax/Literal.hs b/src/Data/Syntax/Literal.hs
index 747d6854c..94badbddb 100644
--- a/src/Data/Syntax/Literal.hs
+++ b/src/Data/Syntax/Literal.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds, DeriveAnyClass, DeriveGeneric #-}
 module Data.Syntax.Literal where
 
+import Data.Align.Generic
 import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Classes.Show.Generic
 import Data.Syntax.Comment
@@ -11,7 +12,7 @@ import Prologue
 -- Boolean
 
 newtype Boolean a = Boolean Bool
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 true :: Boolean a
 true = Boolean True
@@ -27,7 +28,7 @@ instance Show1 Boolean where liftShowsPrec = genericLiftShowsPrec
 
 -- | A literal integer of unspecified width. No particular base is implied.
 newtype Integer a = Integer { integerContent :: ByteString }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Data.Syntax.Literal.Integer where liftEq = genericLiftEq
 instance Show1 Data.Syntax.Literal.Integer where liftShowsPrec = genericLiftShowsPrec
@@ -39,7 +40,7 @@ instance Show1 Data.Syntax.Literal.Integer where liftShowsPrec = genericLiftShow
 
 
 data Range a = Range { rangeStart :: a, rangeEnd :: a }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Range where liftEq = genericLiftEq
 instance Show1 Range where liftShowsPrec = genericLiftShowsPrec
@@ -48,7 +49,7 @@ instance Show1 Range where liftShowsPrec = genericLiftShowsPrec
 -- Strings, symbols
 
 newtype String a = String { stringElements :: [Union '[InterpolationElement, TextElement] a] }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 String where liftEq = genericLiftEq
 instance Show1 String where liftShowsPrec = genericLiftShowsPrec
@@ -57,7 +58,7 @@ instance Show1 String where liftShowsPrec = genericLiftShowsPrec
 
 -- | An interpolation element within a string literal.
 newtype InterpolationElement a = InterpolationElement { interpolationBody :: a }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 InterpolationElement where liftEq = genericLiftEq
 instance Show1 InterpolationElement where liftShowsPrec = genericLiftShowsPrec
@@ -65,14 +66,14 @@ instance Show1 InterpolationElement where liftShowsPrec = genericLiftShowsPrec
 
 -- | A sequence of textual contents within a string literal.
 newtype TextElement a = TextElement { textElementContent :: ByteString }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 TextElement where liftEq = genericLiftEq
 instance Show1 TextElement where liftShowsPrec = genericLiftShowsPrec
 
 
 newtype Symbol a = Symbol { symbolContent :: ByteString }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Symbol where liftEq = genericLiftEq
 instance Show1 Symbol where liftShowsPrec = genericLiftShowsPrec
@@ -85,21 +86,21 @@ instance Show1 Symbol where liftShowsPrec = genericLiftShowsPrec
 -- Collections
 
 newtype Array a = Array { arrayElements :: [Union '[Identity, Comment] a] }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Array where liftEq = genericLiftEq
 instance Show1 Array where liftShowsPrec = genericLiftShowsPrec
 
 
 newtype Hash a = Hash { hashElements :: [Union '[KeyValue, Comment] a] }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Hash where liftEq = genericLiftEq
 instance Show1 Hash where liftShowsPrec = genericLiftShowsPrec
 
 
 data KeyValue a = KeyValue { key :: !a, value :: !a }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 KeyValue where liftEq = genericLiftEq
 instance Show1 KeyValue where liftShowsPrec = genericLiftShowsPrec
diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs
index 201b323c1..d2170ea65 100644
--- a/src/Data/Syntax/Statement.hs
+++ b/src/Data/Syntax/Statement.hs
@@ -1,6 +1,7 @@
-{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveAnyClass, StandaloneDeriving #-}
 module Data.Syntax.Statement where
 
+import Data.Align.Generic
 import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Classes.Show.Generic
 import GHC.Generics
@@ -8,7 +9,7 @@ import Prologue
 
 -- | Conditional. This must have an else block, which can be filled with some default value when omitted in the source, e.g. 'pure ()' for C-style if-without-else or 'pure Nothing' for Ruby-style, in both cases assuming some appropriate Applicative context into which the If will be lifted.
 data If a = If { ifCondition :: !a, ifThenBody :: !a, ifElseBody :: !a }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 If where liftEq = genericLiftEq
 instance Show1 If where liftShowsPrec = genericLiftShowsPrec
@@ -17,14 +18,14 @@ instance Show1 If where liftShowsPrec = genericLiftShowsPrec
 
 -- | A pattern-matching or computed jump control-flow statement, like 'switch' in C or JavaScript, or 'case' in Ruby or Haskell.
 data Match with a = Match { matchSubject :: !a, matchPatterns :: ![with a] }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 with => Eq1 (Match with) where liftEq = genericLiftEq
 instance Show1 with => Show1 (Match with) where liftShowsPrec = genericLiftShowsPrec
 
 -- | A pattern in a pattern-matching or computed jump control-flow statement, like 'case' in C or JavaScript, 'when' in Ruby, or the left-hand side of '->' in the body of Haskell 'case' expressions.
 newtype Pattern a = Pattern a
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Pattern where liftEq = genericLiftEq
 instance Show1 Pattern where liftShowsPrec = genericLiftShowsPrec
@@ -34,7 +35,7 @@ instance Show1 Pattern where liftShowsPrec = genericLiftShowsPrec
 
 -- | Assignment to a variable or other lvalue.
 data Assignment a = Assignment { assignmentTarget :: !a, assignmentValue :: !a }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Assignment where liftEq = genericLiftEq
 instance Show1 Assignment where liftShowsPrec = genericLiftShowsPrec
@@ -43,25 +44,25 @@ instance Show1 Assignment where liftShowsPrec = genericLiftShowsPrec
 -- Returns
 
 newtype Return a = Return a
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Return where liftEq = genericLiftEq
 instance Show1 Return where liftShowsPrec = genericLiftShowsPrec
 
 newtype Yield a = Yield a
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Yield where liftEq = genericLiftEq
 instance Show1 Yield where liftShowsPrec = genericLiftShowsPrec
 
 newtype Break a = Break a
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Break where liftEq = genericLiftEq
 instance Show1 Break where liftShowsPrec = genericLiftShowsPrec
 
 newtype Continue a = Continue a
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Continue where liftEq = genericLiftEq
 instance Show1 Continue where liftShowsPrec = genericLiftShowsPrec
@@ -70,25 +71,25 @@ instance Show1 Continue where liftShowsPrec = genericLiftShowsPrec
 -- Loops
 
 data For a = For { forBefore :: !a, forCondition :: !a, forStep :: !a, forBody :: !a }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 For where liftEq = genericLiftEq
 instance Show1 For where liftShowsPrec = genericLiftShowsPrec
 
 data ForEach a = ForEach { forEachBinding :: !a, forEachSubject :: !a, forEachBody :: !a }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 ForEach where liftEq = genericLiftEq
 instance Show1 ForEach where liftShowsPrec = genericLiftShowsPrec
 
 data While a = While { whileCondition :: !a, whileBody :: !a }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 While where liftEq = genericLiftEq
 instance Show1 While where liftShowsPrec = genericLiftShowsPrec
 
 data DoWhile a = DoWhile { doWhileCondition :: !a, doWhileBody :: !a }
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 DoWhile where liftEq = genericLiftEq
 instance Show1 DoWhile where liftShowsPrec = genericLiftShowsPrec
@@ -97,13 +98,13 @@ instance Show1 DoWhile where liftShowsPrec = genericLiftShowsPrec
 -- Exception handling
 
 newtype Throw a = Throw a
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Throw where liftEq = genericLiftEq
 instance Show1 Throw where liftShowsPrec = genericLiftShowsPrec
 
 data Try with a = Try !a ![with a]
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 -- deriving instance (Eq a, Eq (with a)) => Eq (Try with a)
 -- deriving instance (Show a, Show (with a)) => Show (Try with a)
 
@@ -111,13 +112,13 @@ instance Eq1 with => Eq1 (Try with) where liftEq = genericLiftEq
 instance Show1 with => Show1 (Try with) where liftShowsPrec = genericLiftShowsPrec
 
 data Catch a = Catch !(Maybe a) !a
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Catch where liftEq = genericLiftEq
 instance Show1 Catch where liftShowsPrec = genericLiftShowsPrec
 
 newtype Finally a = Finally a
-  deriving (Eq, Foldable, Functor, Generic1, Show, Traversable)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Finally where liftEq = genericLiftEq
 instance Show1 Finally where liftShowsPrec = genericLiftShowsPrec
diff --git a/src/Data/Syntax/Type.hs b/src/Data/Syntax/Type.hs
index eac6499c8..3cbb03b33 100644
--- a/src/Data/Syntax/Type.hs
+++ b/src/Data/Syntax/Type.hs
@@ -1,9 +1,17 @@
+{-# LANGUAGE DeriveAnyClass #-}
 module Data.Syntax.Type where
 
-import Prologue
+import Data.Align.Generic
+import Data.Functor.Classes.Eq.Generic
+import Data.Functor.Classes.Show.Generic
+import GHC.Generics
+import Prologue hiding (Product)
 
 data Annotation a = Annotation { annotationSubject :: !a, annotationType :: !a }
-  deriving (Eq, Show)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 newtype Product a = Product { productElements :: [a] }
-  deriving (Eq, Show)
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 Product where liftEq = genericLiftEq
+instance Show1 Product where liftShowsPrec = genericLiftShowsPrec

From d524fa05bbc98b965d34b9660fc0ae86dc95b1c7 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 16:24:05 -0400
Subject: [PATCH 18/31] Define Align-based GAlign instances for [] and Maybe.

---
 src/Data/Align/Generic.hs | 11 +++++++++--
 1 file changed, 9 insertions(+), 2 deletions(-)

diff --git a/src/Data/Align/Generic.hs b/src/Data/Align/Generic.hs
index 68dfb1ace..d6df432be 100644
--- a/src/Data/Align/Generic.hs
+++ b/src/Data/Align/Generic.hs
@@ -20,8 +20,12 @@ class GAlign f where
 
 -- 'Data.Align.Align' instances
 
-instance GAlign [] where galign = galignAlign
-instance GAlign Maybe where galign = galignAlign
+instance GAlign [] where
+  galign = galignAlign
+  galignWith = galignWithAlign
+instance GAlign Maybe where
+  galign = galignAlign
+  galignWith = galignWithAlign
 instance GAlign Identity where
   galignWith f (Identity a) (Identity b) = Just (Identity (f (These a b)))
 
@@ -29,6 +33,9 @@ instance GAlign Identity where
 galignAlign :: Align f => f a -> f b -> Maybe (f (These a b))
 galignAlign a = Just . align a
 
+galignWithAlign :: Align f => (These a b -> c) -> f a -> f b -> Maybe (f c)
+galignWithAlign f a b = Just (alignWith f a b)
+
 
 -- Generics
 

From a0df4f8845bd456fb1187ee591ac992454ffab4b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 16:52:56 -0400
Subject: [PATCH 19/31] Skip wrapping in Maybe.

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

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 03cde3ba8..4f8e16891 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -61,42 +61,42 @@ decomposeWith algorithmWithTerms step = case step of
 algorithmWithTerms :: SyntaxTerm leaf fields
                    -> SyntaxTerm leaf fields
                    -> Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) (SyntaxDiff leaf fields)
-algorithmWithTerms t1 t2 = maybe (linearly t1 t2) (fmap annotate) $ case (unwrap t1, unwrap t2) of
+algorithmWithTerms t1 t2 = case (unwrap t1, unwrap t2) of
   (Indexed a, Indexed b) ->
-    Just $ Indexed <$> byRWS a b
+    annotate . Indexed <$> byRWS a b
   (S.Module idA a, S.Module idB b) ->
-    Just $ S.Module <$> linearly idA idB <*> byRWS a b
-  (S.FunctionCall identifierA typeParamsA argsA, S.FunctionCall identifierB typeParamsB argsB) -> Just $
+    (annotate .) . S.Module <$> linearly idA idB <*> byRWS a b
+  (S.FunctionCall identifierA typeParamsA argsA, S.FunctionCall identifierB typeParamsB argsB) -> fmap annotate $
     S.FunctionCall <$> linearly identifierA identifierB
                    <*> byRWS typeParamsA typeParamsB
                    <*> byRWS argsA argsB
-  (S.Switch exprA casesA, S.Switch exprB casesB) -> Just $
+  (S.Switch exprA casesA, S.Switch exprB casesB) -> fmap annotate $
     S.Switch <$> byRWS exprA exprB
              <*> byRWS casesA casesB
-  (S.Object tyA a, S.Object tyB b) -> Just $
+  (S.Object tyA a, S.Object tyB b) -> fmap annotate $
     S.Object <$> maybeLinearly tyA tyB
              <*> byRWS a b
-  (Commented commentsA a, Commented commentsB b) -> Just $
+  (Commented commentsA a, Commented commentsB b) -> fmap annotate $
     Commented <$> byRWS commentsA commentsB
               <*> maybeLinearly a b
-  (Array tyA a, Array tyB b) -> Just $
+  (Array tyA a, Array tyB b) -> fmap annotate $
     Array <$> maybeLinearly tyA tyB
           <*> byRWS a b
-  (S.Class identifierA clausesA expressionsA, S.Class identifierB clausesB expressionsB) -> Just $
+  (S.Class identifierA clausesA expressionsA, S.Class identifierB clausesB expressionsB) -> fmap annotate $
     S.Class <$> linearly identifierA identifierB
             <*> byRWS clausesA clausesB
             <*> byRWS expressionsA expressionsB
-  (S.Method clausesA identifierA receiverA paramsA expressionsA, S.Method clausesB identifierB receiverB paramsB expressionsB) -> Just $
+  (S.Method clausesA identifierA receiverA paramsA expressionsA, S.Method clausesB identifierB receiverB paramsB expressionsB) -> fmap annotate $
     S.Method <$> byRWS clausesA clausesB
              <*> linearly identifierA identifierB
              <*> maybeLinearly receiverA receiverB
              <*> byRWS paramsA paramsB
              <*> byRWS expressionsA expressionsB
-  (S.Function idA paramsA bodyA, S.Function idB paramsB bodyB) -> Just $
+  (S.Function idA paramsA bodyA, S.Function idB paramsB bodyB) -> fmap annotate $
     S.Function <$> linearly idA idB
                <*> byRWS paramsA paramsB
                <*> byRWS bodyA bodyB
-  _ -> Nothing
+  _ -> linearly t1 t2
   where
     annotate = wrap . (both (extract t1) (extract t2) :<)
 

From 45406c5c81bc25c3be7d856d6b3907199e432de3 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 16:56:15 -0400
Subject: [PATCH 20/31] Define a combinator for diffing in Maybe.

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

diff --git a/src/Algorithm.hs b/src/Algorithm.hs
index 617a69a87..fb049b0e0 100644
--- a/src/Algorithm.hs
+++ b/src/Algorithm.hs
@@ -34,6 +34,14 @@ diff = (liftF .) . Diff
 diffThese :: These term term -> Algorithm term diff diff
 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 a b = case (a, b) of
+  (Just a, Just b) -> Just <$> diff a b
+  (Just a, _) -> Just <$> byDeleting a
+  (_, Just b) -> Just <$> byInserting b
+  _ -> pure Nothing
+
 -- | Diff two terms linearly.
 linearly :: term -> term -> Algorithm term diff diff
 linearly a b = liftF (Linear a b)

From d10ca290b9e6f6f32de9c715b4da1963c615b150 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 3 May 2017 16:58:43 -0400
Subject: [PATCH 21/31] Use diffMaybe instead of maybeLinearly.

---
 src/Interpreter.hs | 14 ++++----------
 1 file changed, 4 insertions(+), 10 deletions(-)

diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 4f8e16891..e86a8ab00 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -74,13 +74,13 @@ algorithmWithTerms t1 t2 = case (unwrap t1, unwrap t2) of
     S.Switch <$> byRWS exprA exprB
              <*> byRWS casesA casesB
   (S.Object tyA a, S.Object tyB b) -> fmap annotate $
-    S.Object <$> maybeLinearly tyA tyB
+    S.Object <$> diffMaybe tyA tyB
              <*> byRWS a b
   (Commented commentsA a, Commented commentsB b) -> fmap annotate $
     Commented <$> byRWS commentsA commentsB
-              <*> maybeLinearly a b
+              <*> diffMaybe a b
   (Array tyA a, Array tyB b) -> fmap annotate $
-    Array <$> maybeLinearly tyA tyB
+    Array <$> diffMaybe tyA tyB
           <*> byRWS a b
   (S.Class identifierA clausesA expressionsA, S.Class identifierB clausesB expressionsB) -> fmap annotate $
     S.Class <$> linearly identifierA identifierB
@@ -89,7 +89,7 @@ algorithmWithTerms t1 t2 = case (unwrap t1, unwrap t2) of
   (S.Method clausesA identifierA receiverA paramsA expressionsA, S.Method clausesB identifierB receiverB paramsB expressionsB) -> fmap annotate $
     S.Method <$> byRWS clausesA clausesB
              <*> linearly identifierA identifierB
-             <*> maybeLinearly receiverA receiverB
+             <*> diffMaybe receiverA receiverB
              <*> byRWS paramsA paramsB
              <*> byRWS expressionsA expressionsB
   (S.Function idA paramsA bodyA, S.Function idB paramsB bodyB) -> fmap annotate $
@@ -100,12 +100,6 @@ algorithmWithTerms t1 t2 = case (unwrap t1, unwrap t2) of
   where
     annotate = wrap . (both (extract t1) (extract t2) :<)
 
-    maybeLinearly a b = case (a, b) of
-      (Just a, Just b) -> Just <$> linearly a b
-      (Nothing, Just b) -> Just <$> byInserting b
-      (Just a, Nothing) -> Just <$> byDeleting a
-      (Nothing, Nothing) -> pure Nothing
-
 
 -- | Test whether two terms are comparable.
 comparable :: (Functor f, HasField fields Category) => Term f (Record fields) -> Term f (Record fields) -> Bool

From 32a6901d382bd944a8d783244a7b1dc2f96fa08e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 4 May 2017 10:55:12 -0400
Subject: [PATCH 22/31] :memo: the module a bit.

---
 src/Data/Syntax/Assignment.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 5eb5d4ac7..c8c2e2b76 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -1,4 +1,7 @@
 {-# LANGUAGE DataKinds, GADTs, ScopedTypeVariables, TypeFamilies #-}
+-- | Assignment of AST onto some other structure (typically terms).
+--
+--   Parsing yields an AST represented as a Rose tree labelled with symbols in the language’s grammar and source locations (byte Range and SourceSpan). An Assignment is a tree automaton—a parser of trees, essentially—representing a (partial) map from AST nodes onto some other structure. (For our purposes, this structure is typically Terms annotated with source locations.) Assignments are able to match based on symbol, sequence, and hierarchy; thus, an Identifier occurring in one location might be mapped onto a type for variable references, while in another location it might be assigned a type for a declaration.
 module Data.Syntax.Assignment
 ( Assignment
 , Location

From 838262df2dc601a2b793f0f153d03b0ed6f88128 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 4 May 2017 11:04:42 -0400
Subject: [PATCH 23/31] Clarify the assignment-context bit.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index c8c2e2b76..48dbb627d 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE DataKinds, GADTs, ScopedTypeVariables, TypeFamilies #-}
 -- | Assignment of AST onto some other structure (typically terms).
 --
---   Parsing yields an AST represented as a Rose tree labelled with symbols in the language’s grammar and source locations (byte Range and SourceSpan). An Assignment is a tree automaton—a parser of trees, essentially—representing a (partial) map from AST nodes onto some other structure. (For our purposes, this structure is typically Terms annotated with source locations.) Assignments are able to match based on symbol, sequence, and hierarchy; thus, an Identifier occurring in one location might be mapped onto a type for variable references, while in another location it might be assigned a type for a declaration.
+--   Parsing yields an AST represented as a Rose tree labelled with symbols in the language’s grammar and source locations (byte Range and SourceSpan). An Assignment is a tree automaton—a parser of trees, essentially—representing a (partial) map from AST nodes onto some other structure. (For our purposes, this structure is typically Terms annotated with source locations.) Assignments are able to match based on symbol, sequence, and hierarchy; thus, in @x = y@, both @x@ and @y@ might have the same symbol, @Identifier@, the left can be assigned to a variable declaration, while the right can be assigned to a variable reference.
 module Data.Syntax.Assignment
 ( Assignment
 , Location

From dde29370de1614f16e2ff874386f56205c73a236 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 4 May 2017 11:06:25 -0400
Subject: [PATCH 24/31] Simplify the initial discussion of Assignments.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 48dbb627d..5303c4779 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE DataKinds, GADTs, ScopedTypeVariables, TypeFamilies #-}
 -- | Assignment of AST onto some other structure (typically terms).
 --
---   Parsing yields an AST represented as a Rose tree labelled with symbols in the language’s grammar and source locations (byte Range and SourceSpan). An Assignment is a tree automaton—a parser of trees, essentially—representing a (partial) map from AST nodes onto some other structure. (For our purposes, this structure is typically Terms annotated with source locations.) Assignments are able to match based on symbol, sequence, and hierarchy; thus, in @x = y@, both @x@ and @y@ might have the same symbol, @Identifier@, the left can be assigned to a variable declaration, while the right can be assigned to a variable reference.
+--   Parsing yields an AST represented as a Rose tree labelled with symbols in the language’s grammar and source locations (byte Range and SourceSpan). An Assignment represents a (partial) map from AST nodes onto some other structure; in essence, it’s a parser that operates over trees. (For our purposes, this structure is typically Terms annotated with source locations.) Assignments are able to match based on symbol, sequence, and hierarchy; thus, in @x = y@, both @x@ and @y@ might have the same symbol, @Identifier@, the left can be assigned to a variable declaration, while the right can be assigned to a variable reference.
 module Data.Syntax.Assignment
 ( Assignment
 , Location

From 9644561a8d7f44a18a95af03466e4157617689eb Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 4 May 2017 11:27:43 -0400
Subject: [PATCH 25/31] Document the basic primitives.

---
 src/Data/Syntax/Assignment.hs | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 5303c4779..169ccc971 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -2,6 +2,18 @@
 -- | Assignment of AST onto some other structure (typically terms).
 --
 --   Parsing yields an AST represented as a Rose tree labelled with symbols in the language’s grammar and source locations (byte Range and SourceSpan). An Assignment represents a (partial) map from AST nodes onto some other structure; in essence, it’s a parser that operates over trees. (For our purposes, this structure is typically Terms annotated with source locations.) Assignments are able to match based on symbol, sequence, and hierarchy; thus, in @x = y@, both @x@ and @y@ might have the same symbol, @Identifier@, the left can be assigned to a variable declaration, while the right can be assigned to a variable reference.
+--
+--   Assignments can be any of the following primitive rules:
+--
+--   1. 'symbol' rules match a node against a specific symbol in the source language’s grammar; they succeed iff a) there is a current node, and b) its symbol is equal to the argument symbol. Matching a 'symbol' rule does not advance past the current node, meaning that you can match a node against a symbol and also e.g. match against the node’s 'children'. This also means that some care must be taken, as repeating a symbol with 'many' or 'some' (see below) will never advance past the current node and could therefore loop forever.
+--
+--   2. 'location' rules always succeed, and produce the current node’s Location (byte Range and SourceSpan). If there is no current node (i.e. if matching has advanced past the root node or past the last child node when operating within a 'children' rule), the location is instead the end of the most recently matched node, specified as a zero-width Range and SourceSpan. 'location' rules do not advance past the current node, meaning that you can both match a node’s 'location' and other properties.
+--
+--   3. 'source' rules succeed whenever there is a current node (i.e. matching has not advanced past the root node or the last child node when operating within a 'children' rule), and produce its source as a ByteString. 'source' is intended to match leaf nodes such as e.g. comments. 'source' rules advance past the current node.
+--
+--   4. 'children' rules apply their argument (an assignment) to the children of the current node, succeeding iff a) there is a current node, b) the argument assignment matches the children, and c) there are no (regular) nodes left over (see below re: tokens), producing the result of matching the argument assignment against the children. 'children' rules can match a node with no child nodes if their argument can successfully match at the end of input.
+--
+--   5. Via the 'Alternative' instance, 'empty' assignments always fail. This can be used (in combination with the 'Monad' instance) to (for example) fail if a 'source' assignment produces an ill-formatted ByteString. However, see below re: committed choice.
 module Data.Syntax.Assignment
 ( Assignment
 , Location

From a30769167ca09342b98c462de8662953bd06dc96 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 4 May 2017 11:29:44 -0400
Subject: [PATCH 26/31] Document 'pure' assignments.

---
 src/Data/Syntax/Assignment.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 169ccc971..173fba0aa 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -14,6 +14,8 @@
 --   4. 'children' rules apply their argument (an assignment) to the children of the current node, succeeding iff a) there is a current node, b) the argument assignment matches the children, and c) there are no (regular) nodes left over (see below re: tokens), producing the result of matching the argument assignment against the children. 'children' rules can match a node with no child nodes if their argument can successfully match at the end of input.
 --
 --   5. Via the 'Alternative' instance, 'empty' assignments always fail. This can be used (in combination with the 'Monad' instance) to (for example) fail if a 'source' assignment produces an ill-formatted ByteString. However, see below re: committed choice.
+--
+--   6. Via the 'Applicative' instance, 'pure' (or via the 'Monad' instance, 'return') assignments always succeed, producing the passed value. They do not advance past the current node. In combination with the 'Alternative' instance, 'pure' can provide default values when optional syntax is not present in the AST.
 module Data.Syntax.Assignment
 ( Assignment
 , Location

From 7467fabfa4cad657a451e897867a3e9394fdff0c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 4 May 2017 12:25:05 -0400
Subject: [PATCH 27/31] Document combining assignments with the various
 instances.

---
 src/Data/Syntax/Assignment.hs | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 173fba0aa..b4fea3894 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -16,6 +16,16 @@
 --   5. Via the 'Alternative' instance, 'empty' assignments always fail. This can be used (in combination with the 'Monad' instance) to (for example) fail if a 'source' assignment produces an ill-formatted ByteString. However, see below re: committed choice.
 --
 --   6. Via the 'Applicative' instance, 'pure' (or via the 'Monad' instance, 'return') assignments always succeed, producing the passed value. They do not advance past the current node. In combination with the 'Alternative' instance, 'pure' can provide default values when optional syntax is not present in the AST.
+--
+--   Assignments can further be combined in a few different ways:
+--
+--   1. The 'Functor' instance maps values from the AST (Location, ByteString, etc.) into another structure.
+--
+--   2. The 'Applicative' instance assigns sequences of (sibling) AST nodes in order, as well as providing 'pure' assignments (see above). Most assignments of a single piece of syntax consist of an 'Applicative' chain of assignments.
+--
+--   3. The 'Alternative' instance chooses between a set of assignments, as well as providing 'empty' assignments (see above). See below re: committed choice for best practices for efficiency & error reporting when it comes to assigning multiple alternatives. Most high-level assignments (e.g. “declaration” or “statement” assignments) consist of choices among two or more 'Applicative' chains of assignments, mirroring the structure of the parser’s choices.
+--
+--   4. The 'Monad' instance allows assignments to depend on the results of earlier assignments. In general, most assignments should not be written using the 'Monad' instance; however, some specific situations require it, e.g. assigning 'x += y' to be equivalent to 'x = x + y'.
 module Data.Syntax.Assignment
 ( Assignment
 , Location

From da158b4a120e9a734df850a2fbf9af7e8d688e6f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 4 May 2017 12:58:00 -0400
Subject: [PATCH 28/31] Document committed choice.

---
 src/Data/Syntax/Assignment.hs | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index b4fea3894..20cbe3e1c 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -26,6 +26,33 @@
 --   3. The 'Alternative' instance chooses between a set of assignments, as well as providing 'empty' assignments (see above). See below re: committed choice for best practices for efficiency & error reporting when it comes to assigning multiple alternatives. Most high-level assignments (e.g. “declaration” or “statement” assignments) consist of choices among two or more 'Applicative' chains of assignments, mirroring the structure of the parser’s choices.
 --
 --   4. The 'Monad' instance allows assignments to depend on the results of earlier assignments. In general, most assignments should not be written using the 'Monad' instance; however, some specific situations require it, e.g. assigning 'x += y' to be equivalent to 'x = x + y'.
+--
+--
+--   == Best practices
+--
+--   Because of their flexibility, the same assignment can often be written in multiple different ways. The following best practices should ensure efficient assignment with clear error messages for ill-formed AST.
+--
+--   === Committed choice
+--
+--   Assignments can represent alternatives as either committed or uncommitted choices, both written with '<|>'. “Committed” in this context means that a failure in one of the alternatives will not result in backtracking followed by an attempt of one of the other alternatives; thus, committed choice is more efficient. (By the same token, it enables much better error messages since backtracking erases most of the relevant context.) Committed choices are constructed via the following rules:
+--
+--   1. 'empty' is dropped from choices:
+--   prop> empty <|> a = a -- empty is the left-identity of <|>
+--   prop> a <|> empty = a -- empty is the right-identity of <|>
+--
+--   2. 'symbol' rules construct a committed choice (with only a single alternative).
+--
+--   3. 'fmap' (and by extension '<$>' and '<$') of a committed choice is a committed choice.
+--
+--   4. '<*>' (and by extension '*>' and '<*') with a committed choice on the left is a committed choice.
+--
+--   5. '>>=' (and by extension '>>', '=<<', and '<<') of a committed choice is a committed choice. It may be helpful to think of this and the above rule for '<*>' as “sequences starting with committed choices remain committed choices.”
+--
+--   6. '<|>' of two committed choices is a committed choice.
+--
+--   Finally, if a given choice is not a committed choice, it is an uncommitted choice.
+--
+--   Distilling the above, the rule of thumb is to always start an assignment for a given piece of syntax with either a 'symbol' rule or an 'fmap' over a 'symbol' rule. When assigning multiple pieces of syntax, place any known uncommitted choices at the (rightmost) end of the chain; '<|>' is left-associative, so this guarantees that you’re adding at most one uncommitted choice on top of the ones already present.
 module Data.Syntax.Assignment
 ( Assignment
 , Location

From 64ada1c6c2b06796434df3ab4afd327fb627a402 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 4 May 2017 13:03:46 -0400
Subject: [PATCH 29/31] Document some/many repetitions.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 20cbe3e1c..133ebb08b 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -23,7 +23,7 @@
 --
 --   2. The 'Applicative' instance assigns sequences of (sibling) AST nodes in order, as well as providing 'pure' assignments (see above). Most assignments of a single piece of syntax consist of an 'Applicative' chain of assignments.
 --
---   3. The 'Alternative' instance chooses between a set of assignments, as well as providing 'empty' assignments (see above). See below re: committed choice for best practices for efficiency & error reporting when it comes to assigning multiple alternatives. Most high-level assignments (e.g. “declaration” or “statement” assignments) consist of choices among two or more 'Applicative' chains of assignments, mirroring the structure of the parser’s choices.
+--   3. The 'Alternative' instance chooses between a set of assignments, as well as providing 'empty' assignments (see above). See below re: committed choice for best practices for efficiency & error reporting when it comes to assigning multiple alternatives. Most high-level assignments (e.g. “declaration” or “statement” assignments) consist of choices among two or more 'Applicative' chains of assignments, mirroring the structure of the parser’s choices. The 'Alternative' instance also enables repetitions via the 'many' (≥ 0 repetitions) and 'some' (≥ 1 repetition) methods.
 --
 --   4. The 'Monad' instance allows assignments to depend on the results of earlier assignments. In general, most assignments should not be written using the 'Monad' instance; however, some specific situations require it, e.g. assigning 'x += y' to be equivalent to 'x = x + y'.
 --

From d62b6170e6864ac7aa246135074760390a398c16 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 4 May 2017 13:04:54 -0400
Subject: [PATCH 30/31] Document optional.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 133ebb08b..97d6959ec 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -23,7 +23,7 @@
 --
 --   2. The 'Applicative' instance assigns sequences of (sibling) AST nodes in order, as well as providing 'pure' assignments (see above). Most assignments of a single piece of syntax consist of an 'Applicative' chain of assignments.
 --
---   3. The 'Alternative' instance chooses between a set of assignments, as well as providing 'empty' assignments (see above). See below re: committed choice for best practices for efficiency & error reporting when it comes to assigning multiple alternatives. Most high-level assignments (e.g. “declaration” or “statement” assignments) consist of choices among two or more 'Applicative' chains of assignments, mirroring the structure of the parser’s choices. The 'Alternative' instance also enables repetitions via the 'many' (≥ 0 repetitions) and 'some' (≥ 1 repetition) methods.
+--   3. The 'Alternative' instance chooses between a set of assignments, as well as providing 'empty' assignments (see above). See below re: committed choice for best practices for efficiency & error reporting when it comes to assigning multiple alternatives. Most high-level assignments (e.g. “declaration” or “statement” assignments) consist of choices among two or more 'Applicative' chains of assignments, mirroring the structure of the parser’s choices. The 'Alternative' instance also enables repetitions via the 'many' (≥ 0 repetitions) and 'some' (≥ 1 repetition) methods. Finally, the 'optional' function uses the 'Alternative' instance to assign a value in 'Maybe', succeeding with 'Nothing' when unmatched.
 --
 --   4. The 'Monad' instance allows assignments to depend on the results of earlier assignments. In general, most assignments should not be written using the 'Monad' instance; however, some specific situations require it, e.g. assigning 'x += y' to be equivalent to 'x = x + y'.
 --

From 13d6b313cb173ee843466fbb7be8a419814b4b07 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 4 May 2017 13:11:09 -0400
Subject: [PATCH 31/31] Document how tokens are skipped.

---
 src/Data/Syntax/Assignment.hs | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 97d6959ec..55e29bc77 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -53,6 +53,12 @@
 --   Finally, if a given choice is not a committed choice, it is an uncommitted choice.
 --
 --   Distilling the above, the rule of thumb is to always start an assignment for a given piece of syntax with either a 'symbol' rule or an 'fmap' over a 'symbol' rule. When assigning multiple pieces of syntax, place any known uncommitted choices at the (rightmost) end of the chain; '<|>' is left-associative, so this guarantees that you’re adding at most one uncommitted choice on top of the ones already present.
+--
+--   === Matching tokens
+--
+--   AST symbols are classified by their 'symbolType' as either 'Regular', 'Anonymous', or 'Auxiliary'. 'Auxiliary' never appears in ASTs; 'Regular' is for the symbols of explicitly named productions in the grammar, and 'Anonymous' is for unnamed productions of content such as tokens. Most of the time, assignments are only concerned with the named productions, and thus will be using 'Regular' symbols. Therefore, when matching a committed choice of all-'Regular' symbols, nodes with 'Anonymous' symbols will be skipped. However, in some cases grammars don’t provide a named symbol for e.g. every kind of infix operator, and thus the only way to differentiate between them is by means of a 'symbol' rule for an 'Anonymous' token. In these cases, and before every other kind of assignment, the 'Anonymous' nodes will not be skipped so that matching can succeed.
+--
+--   Therefore, in addition to the rule of thumb for committed choices (see above), try to match 'Regular' symbols up front, and only match 'Anonymous' ones in the middle of a chain. That will ensure that you don’t have to make redundant effort to explicitly skip 'Anonymous' nodes ahead of multiple alternatives, and can instead rely on them being automatically skipped except when explicitly required.
 module Data.Syntax.Assignment
 ( Assignment
 , Location