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/24] :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/24] 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/24] 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/24] 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/24] 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/24] :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/24] 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/24] 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/24] 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/24] 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/24] 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/24] 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/24] =?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/24] :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/24] 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/24] 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/24] =?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/24] 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/24] 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/24] 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/24] 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 2b4d4a0e856d7b2a60b3544099be43b7dc741e2d Mon Sep 17 00:00:00 2001
From: Timothy Clem <timothy.clem@gmail.com>
Date: Fri, 5 May 2017 09:08:58 -0700
Subject: [PATCH 22/24] Bring back original json structure with 'sourceRange'
 and identifier only on specific nodes

---
 src/Renderer.hs             | 28 +++++++++++++----
 src/Renderer/JSON.hs        | 63 ++-----------------------------------
 src/Syntax.hs               | 18 -----------
 test/SemanticCmdLineSpec.hs | 11 ++++---
 4 files changed, 31 insertions(+), 89 deletions(-)

diff --git a/src/Renderer.hs b/src/Renderer.hs
index 426d5a9d8..c02a854e8 100644
--- a/src/Renderer.hs
+++ b/src/Renderer.hs
@@ -11,14 +11,14 @@ module Renderer
 ) where
 
 import Data.Aeson (Value, (.=))
-import Data.Functor.Both
+import Data.Functor.Both hiding (fst, snd)
 import Data.Functor.Classes
 import Text.Show
 import Data.Map as Map hiding (null)
 import Data.Record
 import Diff
 import Info hiding (Identifier)
-import Language.Ruby.Syntax (decoratorWithAlgebra, fToR)
+import Language.Ruby.Syntax (RAlgebra, decoratorWithAlgebra)
 import Prologue
 import Renderer.JSON as R
 import Renderer.Patch as R
@@ -26,7 +26,7 @@ import Renderer.SExpression as R
 import Renderer.Summary as R
 import Renderer.TOC as R
 import Source (SourceBlob(..))
-import Syntax
+import Syntax as S
 import Term
 
 
@@ -56,11 +56,27 @@ data ParseTreeRenderer fields output where
 resolveParseTreeRenderer :: (Monoid output, StringConv output ByteString) => ParseTreeRenderer fields output -> SourceBlob -> Term (Syntax Text) (Record fields) -> output
 resolveParseTreeRenderer renderer blob = case renderer of
   SExpressionParseTreeRenderer format -> R.sExpressionParseTree format blob
-  JSONParseTreeRenderer -> R.jsonFile blob . decoratorWithAlgebra (fToR identifierAlg)
-  where identifierAlg = fmap Identifier . maybeIdentifier . fmap (fmap unIdentifier)
+  JSONParseTreeRenderer -> R.jsonFile blob . decoratorWithAlgebra identifierAlg
+  where identifierAlg :: RAlgebra (CofreeF (Syntax Text) a) (Cofree (Syntax Text) a) (Maybe Identifier)
+        identifierAlg (_ :< syntax) = case syntax of
+          S.Assignment f _ -> identifier f
+          S.Class f _ _ -> identifier f
+          S.Export f _ -> f >>= identifier
+          S.Function f _ _ -> identifier f
+          S.FunctionCall f _ _ -> identifier f
+          S.Import f _ -> identifier f
+          S.Method _ f _ _ _ -> identifier f
+          S.MethodCall _ f _ _ -> identifier f
+          S.Module f _ -> identifier f
+          S.OperatorAssignment f _ -> identifier f
+          S.SubscriptAccess f _  -> identifier f
+          S.TypeDecl f _ -> identifier f
+          S.VarAssignment f _ -> asum $ identifier <$> f
+          _ -> Nothing
+          where identifier = fmap Identifier . extractLeafValue . unwrap . fst
 
 
-newtype Identifier = Identifier { unIdentifier :: Text }
+newtype Identifier = Identifier Text
   deriving (Eq, Show)
 
 instance ToJSONFields Identifier where
diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs
index 68481baa2..7d80dcab8 100644
--- a/src/Renderer/JSON.hs
+++ b/src/Renderer/JSON.hs
@@ -13,7 +13,7 @@ import Data.Bifunctor.Join
 import Data.Functor.Both
 import Data.Record
 import Data.These
-import Data.Vector as Vector
+import Data.Vector as Vector hiding (toList)
 import Diff
 import Info
 import Prologue hiding ((++))
@@ -74,7 +74,7 @@ instance ToJSONFields (Record '[]) where
   toJSONFields _ = []
 
 instance ToJSONFields Range where
-  toJSONFields Range{..} = ["range" .= [ start, end ]]
+  toJSONFields Range{..} = ["sourceRange" .= [ start, end ]]
 
 instance ToJSONFields Category where
   toJSONFields c = ["category" .= case c of { Other s -> s ; _ -> toS c }]
@@ -107,64 +107,7 @@ instance ToJSON a => ToJSONFields (SplitPatch a) where
   toJSONFields (SplitReplace a) = [ "replace" .= a ]
 
 instance ToJSON recur => ToJSONFields (Syntax leaf recur) where
-  toJSONFields syntax = case syntax of
-    Leaf _ -> []
-    Indexed c -> childrenFields c
-    Fixed c -> childrenFields c
-    S.FunctionCall identifier typeParameters parameters -> [ "identifier" .= identifier, "typeArguments" .= typeParameters, "parameters" .= parameters ]
-    S.Ternary expression cases -> [ "expression" .= expression, "cases" .= cases ]
-    S.AnonymousFunction callSignature c -> "callSignature" .= callSignature : childrenFields c
-    S.Function identifier callSignature c -> "identifier" .= identifier : "callSignature" .= callSignature : childrenFields c
-    S.Assignment assignmentId value -> [ "identifier" .= assignmentId, "value" .= value ]
-    S.OperatorAssignment identifier value -> [ "identifier" .= identifier, "value" .= value ]
-    S.MemberAccess identifier value -> [ "identifier" .= identifier, "value" .= value ]
-    S.MethodCall identifier methodIdentifier typeParameters parameters -> [ "identifier" .= identifier, "methodIdentifier" .= methodIdentifier, "typeParameters" .= typeParameters, "parameters" .= parameters ]
-    S.Operator syntaxes -> [ "operatorSyntaxes" .= syntaxes ]
-    S.VarDecl children -> childrenFields children
-    S.VarAssignment identifier value -> [ "identifier" .= identifier, "value" .= value ]
-    S.SubscriptAccess identifier property -> [ "identifier" .= identifier, "property" .= property ]
-    S.Switch expression cases -> [ "expression" .= expression, "cases" .= cases ]
-    S.Case expression statements -> [ "expression" .= expression, "statements" .= statements ]
-    S.Object ty keyValuePairs -> "type" .= ty : childrenFields keyValuePairs
-    S.Pair a b -> childrenFields [a, b]
-    S.Comment _ -> []
-    S.Commented comments child -> childrenFields (comments <> maybeToList child)
-    S.ParseError c -> childrenFields c
-    S.For expressions body -> [ "expressions" .= expressions, "body" .= body ]
-    S.DoWhile expression body -> [ "expression" .= expression, "body" .= body ]
-    S.While expression body -> [ "expression" .= expression, "body" .= body ]
-    S.Return expression -> [ "expression" .= expression ]
-    S.Throw c -> [ "expression" .= c ]
-    S.Constructor expression -> [ "expression" .= expression ]
-    S.Try body catchExpression elseExpression finallyExpression -> [ "body" .= body, "catchExpression" .= catchExpression, "elseExpression" .= elseExpression, "finallyExpression" .= finallyExpression ]
-    S.Array ty c -> "type" .= ty : childrenFields c
-    S.Class identifier superclass definitions -> [ "identifier" .= identifier, "superclass" .= superclass, "definitions" .= definitions ]
-    S.Method clauses identifier receiver callSignature definitions -> [ "clauses" .= clauses, "identifier" .= identifier, "receiver" .= receiver, "callSignature" .= callSignature, "definitions" .= definitions ]
-    S.If expression clauses -> "expression" .= expression : childrenFields clauses
-    S.Module identifier definitions -> [ "identifier" .= identifier, "definitions" .= definitions ]
-    S.Namespace identifier definitions -> [ "identifier" .= identifier, "definitions" .= definitions ]
-    S.Interface identifier clauses definitions -> [ "identifier" .= identifier, "clauses" .= clauses, "definitions" .= definitions ]
-    S.Import identifier statements -> [ "identifier" .= identifier, "statements" .= statements ]
-    S.Export identifier statements -> [ "identifier" .= identifier, "statements" .= statements ]
-    S.Yield expr -> [ "yieldExpression" .= expr ]
-    S.Negate expr -> [ "negate" .= expr ]
-    S.Rescue args expressions -> "args" .= args : childrenFields expressions
-    S.Select cases -> childrenFields cases
-    S.Go cases -> childrenFields cases
-    S.Defer cases -> childrenFields cases
-    S.TypeAssertion a b -> childrenFields [a, b]
-    S.TypeConversion a b -> childrenFields [a, b]
-    S.Struct ty fields -> "type" .= ty : childrenFields fields
-    S.Break expr -> [ "expression" .= expr ]
-    S.Continue expr -> [ "expression" .= expr ]
-    S.BlockStatement c -> childrenFields c
-    S.ParameterDecl ty field -> [ "type" .= ty, "identifier" .= field ]
-    S.DefaultCase c -> childrenFields c
-    S.TypeDecl id ty -> [ "type" .= ty, "identifier" .= id ]
-    S.FieldDecl children -> childrenFields children
-    S.Ty ty -> [ "type" .= ty ]
-    S.Send channel expr -> [ "channel" .= channel, "expression" .= expr ]
-    where childrenFields c = [ "children" .= c ]
+  toJSONFields syntax = [ "children" .= toList syntax ]
 
 
 --
diff --git a/src/Syntax.hs b/src/Syntax.hs
index 8751b6210..ef8cd9b67 100644
--- a/src/Syntax.hs
+++ b/src/Syntax.hs
@@ -117,24 +117,6 @@ extractLeafValue syntax = case syntax of
   Leaf a -> Just a
   _ -> Nothing
 
-maybeIdentifier :: CofreeF (Syntax leaf) a (Maybe leaf) -> Maybe leaf
-maybeIdentifier (_ :< syntax) = case syntax of
-  Leaf f -> Just f
-  Assignment f _ -> f
-  Class f _ _ -> f
-  Export f _ -> join f
-  Function f _ _ -> f
-  FunctionCall f _ _ -> f
-  Import f _ -> f
-  Method _ f _ _ _ -> f
-  MethodCall _ f _ _ -> f
-  Module f _ -> f
-  OperatorAssignment f _ -> f
-  SubscriptAccess f _  -> f
-  TypeDecl f _ -> f
-  VarAssignment f _ -> asum f
-  _ -> Nothing
-
 -- Instances
 
 instance Listable2 Syntax where
diff --git a/test/SemanticCmdLineSpec.hs b/test/SemanticCmdLineSpec.hs
index ab9ecef49..de6d81977 100644
--- a/test/SemanticCmdLineSpec.hs
+++ b/test/SemanticCmdLineSpec.hs
@@ -35,7 +35,7 @@ instance Listable ParseFixture where
        \/ cons0 (ParseFixture (jsonParseTree pathMode "" []) jsonParseTreeOutput)
        \/ cons0 (ParseFixture (jsonParseTree pathMode' "" []) jsonParseTreeOutput')
        \/ cons0 (ParseFixture (sExpressionParseTree commitMode repo []) "(Program\n  (Method\n    (Identifier)))\n")
-       \/ cons0 (ParseFixture (jsonParseTree commitMode repo []) "[{\"filePath\":\"methods.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"identifier\":{\"category\":\"Identifier\",\"identifier\":\"foo\",\"range\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},\"clauses\":[],\"receiver\":null,\"range\":[0,11],\"callSignature\":[],\"definitions\":[],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}],\"range\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}}}]\n")
+       \/ cons0 (ParseFixture (jsonParseTree commitMode repo []) jsonParseTreeOutput'')
 
     where
       pathMode = ParsePaths ["test/fixtures/ruby/and-or.A.rb"]
@@ -43,8 +43,9 @@ instance Listable ParseFixture where
       commitMode = ParseCommit "2e4144eb8c44f007463ec34cb66353f0041161fe" ["methods.rb"]
 
       sExpressionParseTreeOutput = "(Program\n  (Binary\n    (Identifier)\n    (Other \"and\")\n    (Identifier)))\n"
-      jsonParseTreeOutput = "[{\"filePath\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"operatorSyntaxes\":[{\"category\":\"Identifier\",\"identifier\":\"foo\",\"range\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"and\",\"identifier\":\"and\",\"range\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"category\":\"Identifier\",\"identifier\":\"bar\",\"range\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"category\":\"Binary\",\"range\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"range\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}}}]\n"
-      jsonParseTreeOutput' = "[{\"filePath\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"operatorSyntaxes\":[{\"category\":\"Identifier\",\"identifier\":\"foo\",\"range\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"and\",\"identifier\":\"and\",\"range\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"category\":\"Identifier\",\"identifier\":\"bar\",\"range\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"category\":\"Binary\",\"range\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"range\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}}},{\"filePath\":\"test/fixtures/ruby/and-or.B.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"operatorSyntaxes\":[{\"category\":\"Identifier\",\"identifier\":\"foo\",\"range\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"or\",\"identifier\":\"or\",\"range\":[4,6],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,7]}},{\"category\":\"Identifier\",\"identifier\":\"bar\",\"range\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]}}],\"category\":\"Binary\",\"range\":[0,10],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,11]}},{\"operatorSyntaxes\":[{\"operatorSyntaxes\":[{\"category\":\"Identifier\",\"identifier\":\"a\",\"range\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]}},{\"category\":\"or\",\"identifier\":\"or\",\"range\":[13,15],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,5]}},{\"category\":\"Identifier\",\"identifier\":\"b\",\"range\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]}}],\"category\":\"Binary\",\"range\":[11,17],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,7]}},{\"category\":\"and\",\"identifier\":\"and\",\"range\":[18,21],\"sourceSpan\":{\"start\":[2,8],\"end\":[2,11]}},{\"category\":\"Identifier\",\"identifier\":\"c\",\"range\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]}}],\"category\":\"Binary\",\"range\":[11,23],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,13]}}],\"range\":[0,24],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}}}]\n"
+      jsonParseTreeOutput = "[{\"filePath\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"and\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}}}]\n"
+      jsonParseTreeOutput' = "[{\"filePath\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"and\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}}},{\"filePath\":\"test/fixtures/ruby/and-or.B.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"or\",\"children\":[],\"sourceRange\":[4,6],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,7]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]}}],\"sourceRange\":[0,10],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,11]}},{\"category\":\"Binary\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]}},{\"category\":\"or\",\"children\":[],\"sourceRange\":[13,15],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,5]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]}}],\"sourceRange\":[11,17],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,7]}},{\"category\":\"and\",\"children\":[],\"sourceRange\":[18,21],\"sourceSpan\":{\"start\":[2,8],\"end\":[2,11]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]}}],\"sourceRange\":[11,23],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,13]}}],\"sourceRange\":[0,24],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}}}]\n"
+      jsonParseTreeOutput'' = "[{\"filePath\":\"methods.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}],\"identifier\":\"foo\",\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}}}]\n"
 
 
 data DiffFixture = DiffFixture
@@ -72,8 +73,8 @@ instance Listable DiffFixture where
       patchOutput' = "diff --git a/methods.rb b/methods.rb\nnew file mode 100644\nindex 0000000000000000000000000000000000000000..ff7bbbe9495f61d9e1e58c597502d152bab1761e\n--- /dev/null\n+++ b/methods.rb\n+def foo\n+end\n\n"
       summaryOutput = "{\"changes\":{\"test/fixtures/ruby/method-declaration.A.rb -> test/fixtures/ruby/method-declaration.B.rb\":[{\"span\":{\"replace\":[{\"start\":[1,5],\"end\":[1,8]},{\"start\":[1,5],\"end\":[1,8]}]},\"summary\":\"Replaced the 'foo' identifier with the 'bar' identifier in the 'bar(\226\128\166)' method\"},{\"span\":{\"insert\":{\"start\":[1,9],\"end\":[1,10]}},\"summary\":\"Added the 'a' identifier in the 'bar(\226\128\166)' method\"},{\"span\":{\"insert\":{\"start\":[2,3],\"end\":[2,6]}},\"summary\":\"Added the 'baz' identifier in the 'bar(\226\128\166)' method\"}]},\"errors\":{}}\n"
       summaryOutput' = "{\"changes\":{\"methods.rb\":[{\"span\":{\"insert\":{\"start\":[1,1],\"end\":[2,4]}},\"summary\":\"Added the 'foo()' method\"}]},\"errors\":{}}\n"
-      jsonOutput = "{\"oids\":[\"0000000000000000000000000000000000000000\",\"0000000000000000000000000000000000000000\"],\"paths\":[\"test/fixtures/ruby/method-declaration.A.rb\",\"test/fixtures/ruby/method-declaration.B.rb\"],\"rows\":[[{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[{\"replace\":{\"category\":\"Identifier\",\"range\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}}],\"range\":[0,8],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}],\"range\":[0,8],\"number\":1,\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[{\"replace\":{\"category\":\"Identifier\",\"range\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}},{\"insert\":{\"category\":\"Params\",\"children\":[{\"category\":\"Identifier\",\"range\":[8,9],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,10]}}],\"range\":[7,11],\"sourceSpan\":{\"start\":[1,8],\"end\":[2,3]}}}],\"range\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}}],\"range\":[0,11],\"number\":1,\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}}],[{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[{\"insert\":{\"category\":\"Params\",\"children\":[],\"range\":[11,13],\"sourceSpan\":{\"start\":[1,8],\"end\":[2,3]}}},{\"insert\":{\"category\":\"Identifier\",\"range\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}],\"range\":[11,17],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}}],\"range\":[11,17],\"number\":2,\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}}],[{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[],\"range\":[8,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}],\"range\":[8,12],\"number\":2,\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[],\"range\":[17,20],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}}],\"range\":[17,21],\"number\":3,\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}}],[{\"category\":\"Program\",\"children\":[],\"range\":[12,12],\"number\":3,\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},{\"category\":\"Program\",\"children\":[],\"range\":[21,21],\"number\":4,\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}}]]}\n"
-      jsonOutput' = "{\"oids\":[\"0000000000000000000000000000000000000000\",\"ff7bbbe9495f61d9e1e58c597502d152bab1761e\"],\"paths\":[\"methods.rb\",\"methods.rb\"],\"rows\":[[{\"insert\":{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[{\"category\":\"Identifier\",\"range\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}],\"range\":[0,8],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}],\"range\":[0,8],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"number\":1}],[{\"insert\":{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[],\"range\":[8,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}],\"range\":[8,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"number\":2}],[{\"insert\":{\"category\":\"Program\",\"children\":[],\"range\":[12,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"number\":3}]]}\n"
+      jsonOutput = "{\"oids\":[\"0000000000000000000000000000000000000000\",\"0000000000000000000000000000000000000000\"],\"paths\":[\"test/fixtures/ruby/method-declaration.A.rb\",\"test/fixtures/ruby/method-declaration.B.rb\"],\"rows\":[[{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[{\"replace\":{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}}],\"sourceRange\":[0,8],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}],\"sourceRange\":[0,8],\"number\":1,\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[{\"replace\":{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}},{\"insert\":{\"category\":\"Params\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[8,9],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,10]}}],\"sourceRange\":[7,11],\"sourceSpan\":{\"start\":[1,8],\"end\":[2,3]}}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}}],\"sourceRange\":[0,11],\"number\":1,\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}}],[{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[{\"insert\":{\"category\":\"Params\",\"children\":[],\"sourceRange\":[11,13],\"sourceSpan\":{\"start\":[1,8],\"end\":[2,3]}}},{\"insert\":{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}],\"sourceRange\":[11,17],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}}],\"sourceRange\":[11,17],\"number\":2,\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}}],[{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[],\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}],\"sourceRange\":[8,12],\"number\":2,\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[],\"sourceRange\":[17,20],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}}],\"sourceRange\":[17,21],\"number\":3,\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}}],[{\"category\":\"Program\",\"children\":[],\"sourceRange\":[12,12],\"number\":3,\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},{\"category\":\"Program\",\"children\":[],\"sourceRange\":[21,21],\"number\":4,\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}}]]}\n"
+      jsonOutput' = "{\"oids\":[\"0000000000000000000000000000000000000000\",\"ff7bbbe9495f61d9e1e58c597502d152bab1761e\"],\"paths\":[\"methods.rb\",\"methods.rb\"],\"rows\":[[{\"insert\":{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}],\"sourceRange\":[0,8],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}],\"sourceRange\":[0,8],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"number\":1}],[{\"insert\":{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[],\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}],\"sourceRange\":[8,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"number\":2}],[{\"insert\":{\"category\":\"Program\",\"children\":[],\"sourceRange\":[12,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"number\":3}]]}\n"
       sExpressionOutput = "(Program\n  (Method\n  { (Identifier)\n  ->(Identifier) }\n  {+(Params\n      (Identifier))+}\n  {+(Identifier)+}))\n"
       sExpressionOutput' = "{+(Program\n  (Method\n    (Identifier)))+}\n"
       tocOutput = "{\"changes\":{\"test/fixtures/ruby/method-declaration.A.rb -> test/fixtures/ruby/method-declaration.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[3,4]},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"modified\"}]},\"errors\":{}}\n"

From 19593012048c9348d7df056cf952c234fc4591d9 Mon Sep 17 00:00:00 2001
From: Timothy Clem <timothy.clem@gmail.com>
Date: Fri, 5 May 2017 09:09:45 -0700
Subject: [PATCH 23/24] Use a list to simplify json output concatenation

---
 src/Renderer.hs      |  2 +-
 src/Renderer/JSON.hs | 15 +++------------
 2 files changed, 4 insertions(+), 13 deletions(-)

diff --git a/src/Renderer.hs b/src/Renderer.hs
index c02a854e8..05082cafc 100644
--- a/src/Renderer.hs
+++ b/src/Renderer.hs
@@ -51,7 +51,7 @@ runDiffRenderer = foldMap . uncurry . resolveDiffRenderer
 
 data ParseTreeRenderer fields output where
   SExpressionParseTreeRenderer :: (HasField fields Category, HasField fields SourceSpan) => SExpressionFormat -> ParseTreeRenderer fields ByteString
-  JSONParseTreeRenderer :: (ToJSONFields (Record fields), HasField fields Range) => ParseTreeRenderer fields Value
+  JSONParseTreeRenderer :: (ToJSONFields (Record fields), HasField fields Range) => ParseTreeRenderer fields [Value]
 
 resolveParseTreeRenderer :: (Monoid output, StringConv output ByteString) => ParseTreeRenderer fields output -> SourceBlob -> Term (Syntax Text) (Record fields) -> output
 resolveParseTreeRenderer renderer blob = case renderer of
diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs
index 7d80dcab8..9fb85729d 100644
--- a/src/Renderer/JSON.hs
+++ b/src/Renderer/JSON.hs
@@ -120,17 +120,8 @@ data File a = File { filePath :: FilePath, fileContent :: a }
 instance ToJSON a => ToJSON (File a) where
   toJSON File{..} = object [ "filePath" .= filePath, "programNode" .= fileContent ]
 
-instance Monoid Value where
-  mempty = Null
-  mappend a b | Null <- b = A.Array (singleton a)
-              | Null <- a = A.Array (singleton b)
-              | A.Array a' <- a, A.Array b' <- b = A.Array (a' ++ b')
-              | A.Array b' <- b = A.Array (singleton a ++ b')
-              | A.Array a' <- a = A.Array (a' ++ singleton b)
-              | otherwise = A.Array (fromList [a, b])
-
-instance StringConv Value ByteString where
+instance StringConv [Value] ByteString where
   strConv _ = toS . (<> "\n") . encode
 
-jsonFile :: ToJSON a => SourceBlob -> a -> Value
-jsonFile SourceBlob{..} = toJSON . File path
+jsonFile :: ToJSON a => SourceBlob -> a -> [Value]
+jsonFile SourceBlob{..} = pure . toJSON . File path

From f2f6bb45d94bab9bde43f7cca7c4bbb3fac70a40 Mon Sep 17 00:00:00 2001
From: Timothy Clem <timothy.clem@gmail.com>
Date: Fri, 5 May 2017 10:06:58 -0700
Subject: [PATCH 24/24] Don't parse blobs that don't exist

---
 src/Semantic.hs             | 2 +-
 test/SemanticCmdLineSpec.hs | 5 +++++
 2 files changed, 6 insertions(+), 1 deletion(-)

diff --git a/src/Semantic.hs b/src/Semantic.hs
index 6db70b4c0..fe191d908 100644
--- a/src/Semantic.hs
+++ b/src/Semantic.hs
@@ -76,7 +76,7 @@ diffBlobPair blobs = do
 -- | Parse a list of SourceBlobs and use the specified renderer to produce ByteString output.
 parseBlobs :: (Monoid output, StringConv output ByteString) => ParseTreeRenderer DefaultFields output -> [SourceBlob] -> IO ByteString
 parseBlobs renderer blobs = do
-  terms <- traverse go blobs
+  terms <- traverse go (filter (not . nonExistentBlob) blobs)
   toS <$> renderConcurrently (resolveParseTreeRenderer renderer) (terms `using` parTraversable (parTuple2 r0 rdeepseq))
   where
     go blob = do
diff --git a/test/SemanticCmdLineSpec.hs b/test/SemanticCmdLineSpec.hs
index de6d81977..4870e0197 100644
--- a/test/SemanticCmdLineSpec.hs
+++ b/test/SemanticCmdLineSpec.hs
@@ -36,6 +36,10 @@ instance Listable ParseFixture where
        \/ cons0 (ParseFixture (jsonParseTree pathMode' "" []) jsonParseTreeOutput')
        \/ cons0 (ParseFixture (sExpressionParseTree commitMode repo []) "(Program\n  (Method\n    (Identifier)))\n")
        \/ cons0 (ParseFixture (jsonParseTree commitMode repo []) jsonParseTreeOutput'')
+       \/ cons0 (ParseFixture (jsonParseTree (ParseCommit "2e4144eb8c44f007463ec34cb66353f0041161fe" []) repo []) emptyJsonParseTreeOutput)
+       \/ cons0 (ParseFixture (jsonParseTree (ParsePaths []) repo []) emptyJsonParseTreeOutput)
+       \/ cons0 (ParseFixture (jsonParseTree (ParseCommit "2e4144eb8c44f007463ec34cb66353f0041161fe" ["not-a-file.rb"]) repo []) emptyJsonParseTreeOutput)
+       \/ cons0 (ParseFixture (jsonParseTree (ParsePaths ["not-a-file.rb"]) repo []) emptyJsonParseTreeOutput)
 
     where
       pathMode = ParsePaths ["test/fixtures/ruby/and-or.A.rb"]
@@ -46,6 +50,7 @@ instance Listable ParseFixture where
       jsonParseTreeOutput = "[{\"filePath\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"and\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}}}]\n"
       jsonParseTreeOutput' = "[{\"filePath\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"and\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}}},{\"filePath\":\"test/fixtures/ruby/and-or.B.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"or\",\"children\":[],\"sourceRange\":[4,6],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,7]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]}}],\"sourceRange\":[0,10],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,11]}},{\"category\":\"Binary\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]}},{\"category\":\"or\",\"children\":[],\"sourceRange\":[13,15],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,5]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]}}],\"sourceRange\":[11,17],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,7]}},{\"category\":\"and\",\"children\":[],\"sourceRange\":[18,21],\"sourceSpan\":{\"start\":[2,8],\"end\":[2,11]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]}}],\"sourceRange\":[11,23],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,13]}}],\"sourceRange\":[0,24],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}}}]\n"
       jsonParseTreeOutput'' = "[{\"filePath\":\"methods.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}],\"identifier\":\"foo\",\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}}}]\n"
+      emptyJsonParseTreeOutput = "[]\n"
 
 
 data DiffFixture = DiffFixture