Merge branch 'master' into rework-io

semantic-diff.cabal

@@ -19,6 +19,7 @@ library
                      , Category
                      , Data.Align.Generic
                      , Data.Functor.Both
+                     , Data.Functor.Classes.Eq.Generic
                      , Data.Functor.Listable
                      , Data.Mergeable
                      , Data.Mergeable.Generic
@@ -75,6 +76,7 @@ library
                      , dlist
                      , filepath
                      , free
+                     , freer-cofreer
                      , gitlib
                      , gitlib-libgit2
                      , gitrev

src/Algorithm.hs

@@ -1,32 +1,55 @@
 {-# LANGUAGE GADTs, RankNTypes #-}
 module Algorithm where
 
-import Control.Applicative.Free
-import Prologue hiding (Pure)
+import Control.Monad.Free.Freer
+import Data.These
+import Prologue hiding (liftF)
 
 -- | A single step in a diffing algorithm, parameterized by the types of terms, diffs, and the result of the applicable algorithm.
 data AlgorithmF term diff result where
+  -- | Diff two terms with the choice of algorithm left to the interpreter’s discretion.
+  Diff :: term -> term -> AlgorithmF term diff diff
   -- | Diff two terms recursively in O(n) time, resulting in a single diff node.
   Linear :: term -> term -> AlgorithmF term diff diff
   -- | Diff two lists of terms by each element’s similarity in O(n³ log n), resulting in a list of diffs.
   RWS :: [term] -> [term] -> AlgorithmF term diff [diff]
+  -- | Delete a term..
+  Delete :: term -> AlgorithmF term diff diff
+  -- | Insert a term.
+  Insert :: term -> AlgorithmF term diff diff
+  -- | Replace one term with another.
+  Replace :: term -> term -> AlgorithmF term diff diff
 
 -- | The free applicative for 'AlgorithmF'. This enables us to construct diff values using <$> and <*> notation.
-type Algorithm term diff = Ap (AlgorithmF term diff)
-
--- | Tear down an Ap by iteration, given a continuation.
-iterAp :: (forall x. g x -> (x -> a) -> a) -> Ap g a -> a
-iterAp algebra = go
-  where go (Pure a) = a
-        go (Ap underlying apply) = algebra underlying (go . (apply <*>) . pure)
+type Algorithm term diff = Freer (AlgorithmF term diff)
 
 
 -- DSL
 
+-- | Diff two terms without specifying the algorithm to be used.
+diff :: term -> term -> Algorithm term diff diff
+diff = (liftF .) . Diff
+
+-- | Diff a These of terms without specifying the algorithm to be used.
+diffThese :: These term term -> Algorithm term diff diff
+diffThese = these byDeleting byInserting diff
+
 -- | Diff two terms linearly.
 linearly :: term -> term -> Algorithm term diff diff
-linearly a b = liftAp (Linear a b)
+linearly a b = liftF (Linear a b)
 
 -- | Diff two terms using RWS.
 byRWS :: [term] -> [term] -> Algorithm term diff [diff]
-byRWS a b = liftAp (RWS a b)
+byRWS a b = liftF (RWS a b)
+
+-- | Delete a term.
+byDeleting :: term -> Algorithm term diff diff
+byDeleting = liftF . Delete
+
+-- | Insert a term.
+byInserting :: term -> Algorithm term diff diff
+byInserting = liftF . Insert
+
+-- | Replace one term with another.
+byReplacing :: term -> term -> Algorithm term diff diff
+byReplacing = (liftF .) . Replace

src/Data/Align/Generic.hs

@@ -14,6 +14,10 @@ class Functor f => GAlign f where
   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)
 
+  -- | 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
+
 
 -- Generically-derived instances
 

src/Data/Functor/Classes/Eq/Generic.hs

@@ -0,0 +1,63 @@
+{-# LANGUAGE TypeOperators #-}
+module Data.Functor.Classes.Eq.Generic
+( genericLiftEq
+, gliftEq
+) where
+
+import Control.Comonad.Cofree as Cofree
+import Data.Functor.Classes
+import GHC.Generics
+import Prologue
+
+-- | Generically-derivable lifting of the 'Eq' class to unary type constructors.
+class GEq1 f where
+  -- | Lift an equality test through the type constructor.
+  --
+  --   The function will usually be applied to an equality function, but the more general type ensures that the implementation uses it to compare elements of the first container with elements of the second.
+  gliftEq :: (a -> b -> Bool) -> f a -> f b -> Bool
+
+-- | A suitable implementation of Eq1’s liftEq for Generic1 types.
+genericLiftEq :: (Generic1 f, GEq1 (Rep1 f)) => (a -> b -> Bool) -> f a -> f b -> Bool
+genericLiftEq f a b = gliftEq f (from1 a) (from1 b)
+
+
+-- Eq1 instances
+
+instance GEq1 [] where gliftEq = liftEq
+instance GEq1 Maybe where gliftEq = liftEq
+instance Eq a => GEq1 ((,) a) where gliftEq = liftEq
+instance Eq a => GEq1 (Either a) where gliftEq = liftEq
+
+instance Eq1 f => GEq1 (Cofree f) where
+  gliftEq eq = go
+    where go (a1 Cofree.:< f1) (a2 Cofree.:< f2) = eq a1 a2 && liftEq (gliftEq eq) f1 f2
+
+
+-- Generics
+
+instance GEq1 U1 where
+  gliftEq _ _ _ = True
+
+instance GEq1 Par1 where
+  gliftEq f (Par1 a) (Par1 b) = f a b
+
+instance Eq c => GEq1 (K1 i c) where
+  gliftEq _ (K1 a) (K1 b) = a == b
+
+instance GEq1 f => GEq1 (Rec1 f) where
+  gliftEq f (Rec1 a) (Rec1 b) = gliftEq f a b
+
+instance GEq1 f => GEq1 (M1 i c f) where
+  gliftEq f (M1 a) (M1 b) = gliftEq f a b
+
+instance (GEq1 f, GEq1 g) => GEq1 (f :+: g) where
+  gliftEq f a b = case (a, b) of
+    (L1 a, L1 b) -> gliftEq f a b
+    (R1 a, R1 b) -> gliftEq f a b
+    _ -> False
+
+instance (GEq1 f, GEq1 g) => GEq1 (f :*: g) where
+  gliftEq f (a1 :*: b1) (a2 :*: b2) = gliftEq f a1 a2 && gliftEq f b1 b2
+
+instance (GEq1 f, GEq1 g) => GEq1 (f :.: g) where
+  gliftEq f (Comp1 a) (Comp1 b) = gliftEq (gliftEq f) a b

src/Data/RandomWalkSimilarity.hs

@@ -5,7 +5,6 @@ module Data.RandomWalkSimilarity
 , pqGramDecorator
 , defaultFeatureVectorDecorator
 , featureVectorDecorator
-, editDistanceUpTo
 , defaultD
 , defaultP
 , defaultQ
@@ -21,6 +20,8 @@ import Control.Monad.Random
 import Control.Monad.State
 import Data.Align.Generic
 import Data.Array
+import Data.Functor.Classes
+import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Listable
 import Data.Hashable
 import qualified Data.IntMap as IntMap
@@ -34,10 +35,9 @@ import Patch
 import Prologue as P
 import qualified SES
 import System.Random.Mersenne.Pure64
-import Term (termSize, zipTerms, Term, TermF)
+import Term (Term, TermF)
 
 type Label f fields label = forall b. TermF f (Record fields) b -> label
-type DiffTerms f fields = Term f (Record fields) -> Term f (Record fields) -> Maybe (Diff f (Record fields))
 
 -- | Given a function comparing two terms recursively,
 -- a function to compute a Hashable label from an unpacked term, and two lists of terms,
@@ -46,15 +46,16 @@ type DiffTerms f fields = Term f (Record fields) -> Term f (Record fields) -> Ma
 --
 -- This implementation is based on the paper [_RWS-Diff—Flexible and Efficient Change Detection in Hierarchical Data_](https://github.com/github/semantic-diff/files/325837/RWS-Diff.Flexible.and.Efficient.Change.Detection.in.Hierarchical.Data.pdf).
 rws :: forall f fields.
-       (GAlign f, Traversable f, Eq (f (Term f Category)), HasField fields Category, HasField fields (Maybe FeatureVector))
-    => DiffTerms f fields -- ^ A function which compares a pair of terms recursively, returning 'Just' their diffed value if appropriate, or 'Nothing' if they should not be compared.
+       (GAlign f, Traversable f, Eq1 f, HasField fields Category, HasField fields (Maybe FeatureVector))
+    => SES.Cost (Term f (Record fields)) -- ^ 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.
     -> [Term f (Record fields)] -- ^ The list of old terms.
     -> [Term f (Record fields)] -- ^ The list of new terms.
-    -> [Diff f (Record fields)] -- ^ The resulting list of similarity-matched diffs.
-rws compare as bs
+    -> [These (Term f (Record fields)) (Term f (Record fields))] -- ^ The resulting list of similarity-matched diffs.
+rws editDistance canCompare as bs
   | null as, null bs = []
-  | null as = inserting . eraseFeatureVector <$> bs
-  | null bs = deleting . eraseFeatureVector <$> as
+  | null as = That . eraseFeatureVector <$> bs
+  | null bs = This . eraseFeatureVector <$> as
   | otherwise =
     -- Construct a State who's final value is a list of (Int, Diff leaf (Record fields))
     -- and who's final state is (Int, IntMap UmappedTerm, IntMap UmappedTerm)
@@ -68,21 +69,21 @@ rws compare as bs
 
   where
     minimumTermIndex = pred . maybe 0 getMin . getOption . foldMap (Option . Just . Min . termIndex)
-    sesDiffs = SES.ses replaceIfEqual cost as bs
+    sesDiffs = SES.ses (gliftEq (==) `on` fmap category) cost as bs
 
     (featurizedAs, featurizedBs, _, _, countersAndDiffs, allDiffs) =
-      foldl' (\(as, bs, counterA, counterB, diffs, allDiffs) diff -> case runFree diff of
-        Pure (Delete term) ->
+      foldl' (\(as, bs, counterA, counterB, diffs, allDiffs) diff -> case diff of
+        This term ->
           (as <> pure (featurize counterA term), bs, succ counterA, counterB, diffs, allDiffs <> pure None)
-        Pure (Insert term) ->
+        That term ->
           (as, bs <> pure (featurize counterB term), counterA, succ counterB, diffs, allDiffs <> pure (Term (featurize counterB term)))
-        _ ->
-          (as, bs, succ counterA, succ counterB, diffs <> pure (These counterA counterB, diff), allDiffs <> pure (Index counterA))
+        These a b ->
+          (as, bs, succ counterA, succ counterB, diffs <> pure (These counterA counterB, These a b), allDiffs <> pure (Index counterA))
       ) ([], [], 0, 0, [], []) sesDiffs
 
     findNearestNeighbourToDiff :: TermOrIndexOrNone (UnmappedTerm f fields)
                                -> State (Int, UnmappedTerms f fields, UnmappedTerms f fields)
-                                        (Maybe (These Int Int, Diff f (Record fields)))
+                                        (Maybe (These Int Int, These (Term f (Record fields)) (Term f (Record fields))))
     findNearestNeighbourToDiff termThing = case termThing of
       None -> pure Nothing
       Term term -> Just <$> findNearestNeighbourTo term
@@ -94,7 +95,7 @@ rws compare as bs
     -- | Construct a diff for a term in B by matching it against the most similar eligible term in A (if any), marking both as ineligible for future matches.
     findNearestNeighbourTo :: UnmappedTerm f fields
                            -> State (Int, UnmappedTerms f fields, UnmappedTerms f fields)
-                                    (These Int Int, Diff f (Record fields))
+                                    (These Int Int, These (Term f (Record fields)) (Term f (Record fields)))
     findNearestNeighbourTo term@(UnmappedTerm j _ b) = do
       (previous, unmappedA, unmappedB) <- get
       fromMaybe (insertion previous unmappedA unmappedB term) $ do
@@ -106,10 +107,10 @@ rws compare as bs
         UnmappedTerm j' _ _ <- nearestUnmapped unmappedB kdbs foundA
         -- Return Nothing if their indices don't match
         guard (j == j')
-        compared <- compare a b
+        guard (canCompare a b)
         pure $! do
           put (i, IntMap.delete i unmappedA, IntMap.delete j unmappedB)
-          pure (These i j, compared)
+          pure (These i j, These a b)
 
     -- Returns a state (insertion index, old unmapped terms, new unmapped terms), and value of (index, inserted diff),
     -- given a previous index, two sets of umapped terms, and an unmapped term to insert.
@@ -118,10 +119,10 @@ rws compare as bs
                  -> UnmappedTerms f fields
                  -> UnmappedTerm f fields
                  -> State (Int, UnmappedTerms f fields, UnmappedTerms f fields)
-                          (These Int Int, Diff f (Record fields))
+                          (These Int Int, These (Term f (Record fields)) (Term f (Record fields)))
     insertion previous unmappedA unmappedB (UnmappedTerm j _ b) = do
       put (previous, unmappedA, IntMap.delete j unmappedB)
-      pure (That j, inserting b)
+      pure (That j, That b)
 
     -- | Finds the most-similar unmapped term to the passed-in term, if any.
     --
@@ -133,7 +134,11 @@ rws compare as bs
       -> KdTree.KdTree Double (UnmappedTerm f fields) -- ^ The k-d tree to look up nearest neighbours within.
       -> UnmappedTerm f fields -- ^ The term to find the nearest neighbour to.
       -> Maybe (UnmappedTerm f fields) -- ^ The most similar unmapped term, if any.
-    nearestUnmapped unmapped tree key = getFirst $ foldMap (First . Just) (sortOn (maybe maxBound (editDistanceUpTo defaultM) . compare (term key) . term) (toList (IntMap.intersection unmapped (toMap (KdTree.kNearest tree defaultL key)))))
+    nearestUnmapped unmapped tree key = getFirst $ foldMap (First . Just) (sortOn (editDistanceIfComparable (term key) . term) (toList (IntMap.intersection unmapped (toMap (KdTree.kNearest tree defaultL key)))))
+
+    editDistanceIfComparable a b = if canCompare a b
+      then editDistance (These a b)
+      else maxBound
 
     insertMapped diffs into = foldl' (\into (i, mappedTerm) ->
         insertDiff (i, mappedTerm) into)
@@ -144,15 +149,9 @@ rws compare as bs
     deleteRemaining diffs (_, unmappedA, _) = foldl' (\into (i, deletion) ->
         insertDiff (This i, deletion) into)
       diffs
-      ((termIndex &&& deleting . term) <$> unmappedA)
+      ((termIndex &&& This . term) <$> unmappedA)
 
-    -- Possibly replace terms in a diff.
-    replaceIfEqual :: Term f (Record fields) -> Term f (Record fields) -> Maybe (Diff f (Record fields))
-    replaceIfEqual a b
-      | (category <$> a) == (category <$> b) = hylo wrap runCofree <$> zipTerms (eraseFeatureVector a) (eraseFeatureVector b)
-      | otherwise = Nothing
-
-    cost = iter (const 0) . (1 <$)
+    cost = these (const 1) (const 1) (const (const 0))
 
     kdas = KdTree.build (elems . feature) featurizedAs
     kdbs = KdTree.build (elems . feature) featurizedBs
@@ -197,12 +196,6 @@ insertDiff a@(ij1, _) (b@(ij2, _):rest) = case (ij1, ij2) of
       That j2 -> if i2 <= j2 then (before, each : after) else (each : before, after)
       These _ _ -> (before, after)
 
--- | 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 :: (Foldable f, Functor f) => Integer -> Diff f annotation -> Int
-editDistanceUpTo m = diffSum (patchSum termSize) . cutoff m
-  where diffSum patchCost = sum . fmap (maybe 0 patchCost)
-
 defaultD, defaultL, defaultP, defaultQ, defaultMoveBound :: Int
 defaultD = 15
 -- | How many of the most similar terms to consider, to rule out false positives.
@@ -211,9 +204,6 @@ defaultP = 2
 defaultQ = 3
 defaultMoveBound = 2
 
--- | How many nodes to consider for our constant-time approximation to tree edit distance.
-defaultM :: Integer
-defaultM = 10
 
 -- | A term which has not yet been mapped by `rws`, along with its feature vector summary & index.
 data UnmappedTerm f fields = UnmappedTerm {

src/Interpreter.hs

@@ -1,18 +1,18 @@
 {-# LANGUAGE GADTs, RankNTypes #-}
-module Interpreter (diffTerms) where
+module Interpreter (diffTerms, run, runSteps, runStep) where
 
 import Algorithm
+import Control.Monad.Free.Freer
 import Data.Align.Generic
-import Data.Functor.Foldable
 import Data.Functor.Both
 import Data.RandomWalkSimilarity as RWS
 import Data.Record
 import Data.These
 import Diff
-import Info
-import Patch
+import Info hiding (Return)
+import Patch (inserting, deleting, replacing, patchSum)
 import Prologue hiding (lookup)
-import Syntax as S
+import Syntax as S hiding (Return)
 import Term
 
 -- | Diff two terms recursively, given functions characterizing the diffing.
@@ -20,25 +20,50 @@ 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 a b = fromMaybe (replacing a b) $ diffComparableTerms a b
+diffTerms = (run .) . diff
+
+-- | Run an Algorithm to completion, returning its result.
+run :: (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)))
+
+-- | Run an Algorithm to completion, returning the list of steps taken.
+runSteps :: (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
+  Left a -> [Return a]
+  Right next -> next : runSteps next
+
+-- | Run a single step of an Algorithm, returning Either 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)
+runStep = \case
+  Return a -> Left a
+  algorithm `Then` cont -> Right $ 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.
+          -> Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result -- ^ The sequence of next steps to undertake to continue the algorithm.
+decompose = \case
+  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
+    _ -> byReplacing t1 t2
+  RWS as bs -> traverse diffThese (rws (editDistanceUpTo defaultM) comparable as bs)
+  Delete a -> pure (deleting a)
+  Insert b -> pure (inserting b)
+  Replace a b -> pure (replacing a b)
 
--- | Diff two terms recursively, given functions characterizing the diffing. If the terms are incomparable, returns 'Nothing'.
-diffComparableTerms :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector))
-                    => SyntaxTerm leaf fields
-                    -> SyntaxTerm leaf fields
-                    -> Maybe (SyntaxDiff leaf fields)
-diffComparableTerms = recur
-  where recur a b
-          | (category <$> a) == (category <$> b) = hylo wrap runCofree <$> zipTerms a b
-          | comparable a b = runAlgorithm recur (Just <$> algorithmWithTerms a b)
-          | otherwise = Nothing
-        comparable = (==) `on` category . extract
 
 -- | Construct an algorithm to diff a pair of terms.
-algorithmWithTerms :: MonadFree (TermF (Syntax leaf) (Both a)) diff
-                   => Term (Syntax leaf) a
-                   -> Term (Syntax leaf) a
-                   -> Algorithm (Term (Syntax leaf) a) (diff (Patch (Term (Syntax leaf) a))) (diff (Patch (Term (Syntax leaf) a)))
+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
   (Indexed a, Indexed b) ->
     Just $ Indexed <$> byRWS a b
@@ -78,20 +103,25 @@ algorithmWithTerms t1 t2 = maybe (linearly t1 t2) (fmap annotate) $ case (unwrap
   where
     annotate = wrap . (both (extract t1) (extract t2) :<)
 
-    maybeLinearly :: Applicative f => Maybe a -> Maybe a -> Algorithm a (f (Patch a)) (Maybe (f (Patch a)))
-    maybeLinearly a b = sequenceA $ case (a, b) of
-      (Just a, Just b) -> Just $ linearly a b
-      (Nothing, Just b) -> Just $ pure (inserting b)
-      (Just a, Nothing) -> Just $ pure (deleting a)
-      (Nothing, Nothing) -> Nothing
+    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
 
--- | Run an algorithm, given functions characterizing the evaluation.
-runAlgorithm :: (GAlign f, HasField fields Category, Eq (f (Cofree f Category)), Traversable f, HasField fields (Maybe FeatureVector))
-  => (Cofree f (Record fields) -> Cofree f (Record fields) -> Maybe (Free (CofreeF f (Both (Record fields))) (Patch (Cofree f (Record fields))))) -- ^ A function to diff two subterms recursively, if they are comparable, or else return 'Nothing'.
-  -> Algorithm (Cofree f (Record fields)) (Free (CofreeF f (Both (Record fields))) (Patch (Cofree f (Record fields)))) a -- ^ The algorithm to run.
-  -> a
-runAlgorithm recur = iterAp $ \ r cont -> case r of
-  Linear a b -> cont . maybe (replacing a b) (wrap . (both (extract a) (extract b) :<)) $ do
-    aligned <- galign (unwrap a) (unwrap b)
-    traverse (these (Just . deleting) (Just . inserting) recur) aligned
-  RWS as bs -> cont (rws recur as bs)
+
+-- | Test whether two terms are comparable.
+comparable :: (Functor f, HasField fields Category) => Term f (Record fields) -> Term f (Record fields) -> Bool
+comparable = (==) `on` category . extract
+
+
+-- | How many nodes to consider for our constant-time approximation to tree edit distance.
+defaultM :: Integer
+defaultM = 10
+
+-- | Return an edit distance as the sum of it's term sizes, given an cutoff and a syntax of terms 'f a'.
+-- | Computes a constant-time approximation to the edit distance of a diff. This is done by comparing at most _m_ nodes, & assuming the rest are zero-cost.
+editDistanceUpTo :: (GAlign f, Foldable f, Functor f, HasField fields Category) => 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))

src/SES.hs

@@ -2,24 +2,24 @@
 module SES where
 
 import qualified Data.Map as Map
-import Patch
+import Data.These
 import Prologue
 
 
 -- | Edit constructor for two terms, if comparable. Otherwise returns Nothing.
-type Compare term edit = term -> term -> Maybe edit
+type Comparable term = term -> term -> Bool
 
 -- | A function that computes the cost of an edit.
-type Cost edit = edit -> Int
+type Cost term = These term term -> Int
 
 -- | Find the shortest edit script (diff) between two terms given a function to compute the cost.
-ses :: Applicative edit => Compare term (edit (Patch term)) -> Cost (edit (Patch term)) -> [term] -> [term] -> [edit (Patch term)]
-ses diffTerms cost as bs = fst <$> evalState diffState Map.empty where
-  diffState = diffAt diffTerms cost (0, 0) as bs
+ses :: Comparable term -> Cost term -> [term] -> [term] -> [These term term]
+ses canCompare cost as bs = fst <$> evalState diffState Map.empty where
+  diffState = diffAt canCompare cost (0, 0) as bs
 
 -- | Find the shortest edit script between two terms at a given vertex in the edit graph.
-diffAt :: Applicative edit => Compare term (edit (Patch term)) -> Cost (edit (Patch term)) -> (Int, Int) -> [term] -> [term] -> State (Map.Map (Int, Int) [(edit (Patch term), Int)]) [(edit (Patch term), Int)]
-diffAt diffTerms cost (i, j) as bs
+diffAt :: Comparable term -> Cost term -> (Int, Int) -> [term] -> [term] -> State (Map.Map (Int, Int) [(These term term, Int)]) [(These term term, Int)]
+diffAt canCompare cost (i, j) as bs
   | (a : as) <- as, (b : bs) <- bs = do
   cachedDiffs <- get
   case Map.lookup (i, j) cachedDiffs of
@@ -27,11 +27,11 @@ diffAt diffTerms cost (i, j) as bs
     Nothing -> do
       down <- recur (i, succ j) as (b : bs)
       right <- recur (succ i, j) (a : as) bs
-      nomination <- best <$> case diffTerms a b of
-        Just diff -> do
+      nomination <- best <$> if canCompare a b
+        then do
           diagonal <- recur (succ i, succ j) as bs
-          pure [ delete a down, insert b right, consWithCost cost diff diagonal ]
-        Nothing -> pure [ delete a down, insert b right ]
+          pure [ delete a down, insert b right, consWithCost cost (These a b) diagonal ]
+        else pure [ delete a down, insert b right ]
       cachedDiffs' <- get
       put $ Map.insert (i, j) nomination cachedDiffs'
       pure nomination
@@ -39,13 +39,13 @@ diffAt diffTerms cost (i, j) as bs
   | null bs = pure $ foldr delete [] as
   | otherwise = pure []
   where
-    delete = consWithCost cost . deleting
-    insert = consWithCost cost . inserting
+    delete = consWithCost cost . This
+    insert = consWithCost cost . That
     costOf [] = 0
     costOf ((_, c) : _) = c
     best = minimumBy (comparing costOf)
-    recur = diffAt diffTerms cost
+    recur = diffAt canCompare cost
 
 -- | Prepend an edit script and the cumulative cost onto the edit script.
-consWithCost :: Cost edit -> edit -> [(edit, Int)] -> [(edit, Int)]
+consWithCost :: Cost term -> These term term -> [(These term term, Int)] -> [(These term term, Int)]
 consWithCost cost edit rest = (edit, cost edit + maybe 0 snd (fst <$> uncons rest)) : rest

src/Syntax.hs

@@ -2,6 +2,8 @@
 module Syntax where
 
 import Data.Aeson
+import Data.Functor.Classes
+import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Listable
 import Data.Mergeable
 import GHC.Generics
@@ -170,3 +172,6 @@ instance Listable leaf => Listable1 (Syntax leaf) where
 
 instance (Listable leaf, Listable recur) => Listable (Syntax leaf recur) where
   tiers = tiers1
+
+instance Eq leaf => Eq1 (Syntax leaf) where
+  liftEq = genericLiftEq

test/Data/RandomWalkSimilarity/Spec.hs

@@ -2,11 +2,12 @@
 module Data.RandomWalkSimilarity.Spec where
 
 import Category
-import Data.Functor.Both
+import Data.Bifunctor
 import Data.Functor.Listable
 import Data.RandomWalkSimilarity
 import Data.Record
 import Data.String
+import Data.These
 import Diff
 import Info
 import Patch
@@ -35,17 +36,18 @@ spec = parallel $ do
       \ (as, bs) -> let tas = decorate <$> (unListableF <$> as :: [SyntaxTerm String '[Category]])
                         tbs = decorate <$> (unListableF <$> bs :: [SyntaxTerm String '[Category]])
                         root = cofree . ((Program :. Nil) :<) . Indexed
-                        diff = wrap (pure (Program :. Nil) :< Indexed (stripDiff <$> rws compare tas tbs)) in
+                        diff = wrap (pure (Program :. Nil) :< Indexed (stripDiff . diffThese <$> rws editDistance canCompare tas tbs)) in
         (beforeTerm diff, afterTerm diff) `shouldBe` (Just (root (stripTerm <$> tas)), Just (root (stripTerm <$> tbs)))
 
     it "produces unbiased insertions within branches" $
-      let (a, b) = (decorate (cofree ((StringLiteral :. Nil) :< Indexed [ cofree ((StringLiteral :. Nil) :< Leaf ("a" :: Text)) ])), decorate (cofree ((StringLiteral :. Nil) :< Indexed [ cofree ((StringLiteral :. Nil) :< Leaf "b") ]))) in
-      fmap stripDiff (rws compare [ b ] [ a, b ]) `shouldBe` fmap stripDiff [ inserting a, copying b ]
+      let (a, b) = (decorate (cofree ((StringLiteral :. Nil) :< Indexed [ cofree ((StringLiteral :. Nil) :< Leaf ("a" :: String)) ])), decorate (cofree ((StringLiteral :. Nil) :< Indexed [ cofree ((StringLiteral :. Nil) :< Leaf "b") ]))) in
+      fmap (bimap stripTerm stripTerm) (rws editDistance canCompare [ b ] [ a, b ]) `shouldBe` fmap (bimap stripTerm stripTerm) [ That a, These b b ]
+
+  where canCompare = (==) `on` extract
 
-  where compare :: (HasField fields Category, Functor f, Eq (Cofree f Category)) => Term f (Record fields) -> Term f (Record fields) -> Maybe (Diff f (Record fields))
-        compare a b | (category <$> a) == (category <$> b) = Just (copying b)
-                    | otherwise = if ((==) `on` category . extract) a b then Just (replacing a b) else Nothing
-        copying :: Functor f => Cofree f (Record fields) -> Free (CofreeF f (Both (Record fields))) (Patch (Cofree f (Record fields)))
-        copying = cata wrap . fmap pure
         decorate :: SyntaxTerm leaf '[Category] -> SyntaxTerm leaf '[Maybe FeatureVector, Category]
         decorate = defaultFeatureVectorDecorator (category . headF)
+
+        diffThese = these deleting inserting replacing
+
+        editDistance = these (const 1) (const 1) (const (const 0))

test/fixtures/go/channel-types.diffB-A.txt

@@ -4,23 +4,15 @@
   (Function
     (Identifier)
     (Other "type_declaration"
+    { +(TypeDecl (Identifier) (ChannelTy (ChannelTy (Identifier))))+ }
       (TypeDecl
-      { (Identifier)
-      ->(Identifier) }
+        (Identifier)
         (ChannelTy
           (ChannelTy
-          { (Identifier)
-          ->(Identifier) })))
+            { (Identifier) -> (StructTy) })))
       (TypeDecl
-      { (Identifier)
-      ->(Identifier) }
+        (Identifier)
         (ChannelTy
           (ChannelTy
-            (StructTy))))
-      (TypeDecl
-      { (Identifier)
-      ->(Identifier) }
-        (ChannelTy
-          (ChannelTy
-          { (Identifier)
-          ->(Identifier) }))))))
+            { (StructTy) -> (Identifier) })))
+    { -(TypeDecl (Identifier) (ChannelTy (ChannelTy (Identifier))))- })))

test/fixtures/go/for-statements.diffB-A.txt

@@ -32,15 +32,11 @@
         (Identifier))
       (Continue
         (Identifier)))+}
-  { (For
-      (FunctionCall
-        (Identifier))
-      (Other "goto_statement"
-        (Identifier)))
-  ->(For
-      (FunctionCall
-        (Identifier))
-      (Continue)) }
+  (For
+    (FunctionCall
+      (Identifier))
+    { (Other "goto_statement"
+      (Identifier)) -> (Continue) })
     (For
       (Other "expression_list"
         (Identifier))

test/fixtures/go/modifying-struct-fields.diffA-B.txt

@@ -10,11 +10,8 @@
         (Operator
           (Other "composite_literal"
             (Identifier)
-          { (Pair
+          (Pair
+            { (Identifier) -> (Identifier) }
+            { (Identifier) -> (FunctionCall
               (Identifier)
-              (Identifier))
-          ->(Pair
-              (Identifier)
-              (FunctionCall
-                (Identifier)
-                (QualifiedIdentifier))) }))))))
+              (QualifiedIdentifier)) })))))))

test/fixtures/go/modifying-struct-fields.diffB-A.txt

@@ -10,11 +10,8 @@
         (Operator
           (Other "composite_literal"
             (Identifier)
-          { (Pair
+          (Pair
+            { (Identifier) -> (Identifier) }
+            { (FunctionCall
               (Identifier)
-              (FunctionCall
-                (Identifier)
-                (QualifiedIdentifier)))
-          ->(Pair
-              (Identifier)
-              (Identifier)) }))))))
+              (QualifiedIdentifier)) -> (Identifier) })))))))

test/fixtures/javascript/anonymous-function.diffA-B.txt

@@ -7,11 +7,7 @@
     ->(Identifier) }
       (ExpressionStatements
         (Return
-        { (MathOperator
-            (Identifier)
-            (Other "+")
-            (Identifier))
-        ->(MathOperator
-            (Identifier)
-            (Other "*")
-            (Identifier)) })))))
+          (MathOperator
+            { (Identifier) -> (Identifier) }
+            { (Other "+") -> (Other "*") }
+            { (Identifier) -> (Identifier) }))))))

test/fixtures/javascript/anonymous-function.diffB-A.txt

@@ -7,11 +7,7 @@
     ->(Identifier) }
       (ExpressionStatements
         (Return
-        { (MathOperator
-            (Identifier)
-            (Other "*")
-            (Identifier))
-        ->(MathOperator
-            (Identifier)
-            (Other "+")
-            (Identifier)) })))))
+          (MathOperator
+            { (Identifier) -> (Identifier) }
+            { (Other "*") -> (Other "+") }
+            { (Identifier) -> (Identifier) }))))))

test/fixtures/javascript/boolean-operator.diffA-B.txt

@@ -1,10 +1,6 @@
 (Program
   (ExpressionStatements
-  { (BooleanOperator
+    (BooleanOperator
       (Identifier)
-      (Other "||")
-      (Identifier))
-  ->(BooleanOperator
-      (Identifier)
-      (Other "&&")
-      (Identifier)) }))
+      { (Other "||") -> (Other "&&") }
+      (Identifier))))

test/fixtures/javascript/boolean-operator.diffB-A.txt

@@ -1,10 +1,6 @@
 (Program
   (ExpressionStatements
-  { (BooleanOperator
+    (BooleanOperator
       (Identifier)
-      (Other "&&")
-      (Identifier))
-  ->(BooleanOperator
-      (Identifier)
-      (Other "||")
-      (Identifier)) }))
+      { (Other "&&") -> (Other "||") }
+      (Identifier))))

test/fixtures/javascript/delete-operator.diffA-B.txt

@@ -1,12 +1,12 @@
 (Program
   (ExpressionStatements
-  { (Operator
+    (Operator
       (Other "delete")
+      {
       (SubscriptAccess
         (Identifier)
-        (StringLiteral)))
-  ->(Operator
-      (Other "delete")
+        (StringLiteral))
+      ->
       (MemberAccess
         (Identifier)
-        (Identifier))) }))
+        (Identifier)) })))

test/fixtures/javascript/delete-operator.diffB-A.txt

@@ -1,12 +1,12 @@
 (Program
   (ExpressionStatements
-  { (Operator
+    (Operator
       (Other "delete")
+      {
       (MemberAccess
         (Identifier)
-        (Identifier)))
-  ->(Operator
-      (Other "delete")
+        (Identifier))
+      ->
       (SubscriptAccess
         (Identifier)
-        (StringLiteral))) }))
+        (StringLiteral)) })))

test/fixtures/javascript/export.diffA-B.txt

@@ -72,26 +72,28 @@
     (Other "export_specifier"
     { (Identifier)
     ->(Identifier) }))
-{ (Export
-    (VarDecl
-      (Other "variable_declarator"
-        (Identifier)))
-    (VarDecl
-      (Other "variable_declarator"
-        (Identifier)))
-    (VarDecl
-      (Other "variable_declarator"
-        (Identifier))))
-->(Export
-    (StringLiteral)
-    (Other "export_specifier"
-      (Identifier)
-      (Identifier))
-    (Other "export_specifier"
-      (Identifier)
-      (Identifier))
-    (Other "export_specifier"
-      (Identifier))) }
+  (Export
+  { +(StringLiteral)+ }
+  {(VarDecl
+    (Other "variable_declarator"
+      (Identifier)))
+  ->
+  (Other "export_specifier"
+    (Identifier)
+    (Identifier))}
+  {(VarDecl
+    (Other "variable_declarator"
+      (Identifier)))
+  ->
+  (Other "export_specifier"
+    (Identifier)
+    (Identifier))}
+  {(VarDecl
+    (Other "variable_declarator"
+      (Identifier)))
+  ->
+  (Other "export_specifier"
+    (Identifier))}  )
 {-(Export
     (VarAssignment
       (Identifier)

test/fixtures/javascript/if.diffA-B.txt

@@ -1,19 +1,9 @@
 (Program
-{ (If
-    (Identifier)
+  (If
+    { (Identifier) -> (MemberAccess (Identifier) (Identifier)) }
     (ExpressionStatements
       (ExpressionStatements
         (FunctionCall
           (Identifier)
-          (Identifier)))))
-->(If
-    (MemberAccess
-      (Identifier)
-      (Identifier))
-    (ExpressionStatements
-      (ExpressionStatements
-        (FunctionCall
-          (Identifier)
-          (Identifier)))
-      (ExpressionStatements
-        (Identifier)))) })
+          { (Identifier) -> (Identifier) }))
+      { +(ExpressionStatements (Identifier))+ })))

test/fixtures/javascript/if.diffB-A.txt

@@ -1,19 +1,9 @@
 (Program
-{ (If
-    (MemberAccess
-      (Identifier)
-      (Identifier))
+  (If
+    { (MemberAccess (Identifier) (Identifier)) -> (Identifier) }
     (ExpressionStatements
       (ExpressionStatements
         (FunctionCall
           (Identifier)
-          (Identifier)))
-      (ExpressionStatements
-        (Identifier))))
-->(If
-    (Identifier)
-    (ExpressionStatements
-      (ExpressionStatements
-        (FunctionCall
-          (Identifier)
-          (Identifier))))) })
+          { (Identifier) -> (Identifier) }))
+      { -(ExpressionStatements (Identifier))- })))

test/fixtures/javascript/import.diffA-B.txt

@@ -38,16 +38,15 @@
       (Other "import_specifier"
         (Identifier)
         (Identifier))))+}
-{ (Import
-    (StringLiteral)
+  (Import
+    { (StringLiteral) -> (StringLiteral) }
+    {
     (Other "named_imports"
       (Other "import_specifier"
-        (Identifier))))
-->(Import
-    (StringLiteral)
-    (Identifier)
-    (Other "namespace_import"
-      (Identifier))) }
+        (Identifier)))
+    ->
+    (Identifier) }
+    { +(Other "namespace_import" (Identifier))+ })
 {+(Import
     (StringLiteral))+}
 {-(Import

test/fixtures/javascript/import.diffB-A.txt

@@ -38,16 +38,15 @@
       (Other "import_specifier"
         (Identifier)
         (Identifier))))+}
-{ (Import
-    (StringLiteral)
+  (Import
+    { (StringLiteral) -> (StringLiteral) }
+    {
     (Other "named_imports"
       (Other "import_specifier"
-        (Identifier))))
-->(Import
-    (StringLiteral)
-    (Identifier)
-    (Other "namespace_import"
-      (Identifier))) }
+        (Identifier)))
+    ->
+    (Identifier) }
+    { +(Other "namespace_import" (Identifier))+ })
 {+(Import
     (StringLiteral))+}
 {-(Import

test/fixtures/javascript/objects-with-methods.diffA-B.txt

@@ -2,16 +2,11 @@
   (ExpressionStatements
     (Object
       (Method
-      { (Identifier)
-      ->(Identifier) }
+      { (Identifier) -> (Identifier) }
         (Identifier)
         (Identifier)
         (Return
-        { (MathOperator
+          (MathOperator
             (Identifier)
-            (Other "+")
-            (Identifier))
-        ->(MathOperator
-            (Identifier)
-            (Other "-")
-            (Identifier)) })))))
+            { (Other "+") -> (Other "-") }
+            (Identifier)))))))

test/fixtures/javascript/objects-with-methods.diffB-A.txt

@@ -2,16 +2,11 @@
   (ExpressionStatements
     (Object
       (Method
-      { (Identifier)
-      ->(Identifier) }
+      { (Identifier) -> (Identifier) }
         (Identifier)
         (Identifier)
         (Return
-        { (MathOperator
+          (MathOperator
             (Identifier)
-            (Other "-")
-            (Identifier))
-        ->(MathOperator
-            (Identifier)
-            (Other "+")
-            (Identifier)) })))))
+            { (Other "-") -> (Other "+") }
+            (Identifier)))))))

test/fixtures/javascript/relational-operator.diffA-B.txt

@@ -1,10 +1,6 @@
 (Program
   (ExpressionStatements
-  { (RelationalOperator
+    (RelationalOperator
       (Identifier)
-      (Other "<")
-      (Identifier))
-  ->(RelationalOperator
-      (Identifier)
-      (Other "<=")
-      (Identifier)) }))
+      { (Other "<") -> (Other "<=") }
+      (Identifier))))

test/fixtures/javascript/relational-operator.diffB-A.txt

@@ -1,10 +1,6 @@
 (Program
   (ExpressionStatements
-  { (RelationalOperator
+    (RelationalOperator
       (Identifier)
-      (Other "<=")
-      (Identifier))
-  ->(RelationalOperator
-      (Identifier)
-      (Other "<")
-      (Identifier)) }))
+      { (Other "<=") -> (Other "<") }
+      (Identifier))))

test/fixtures/javascript/type-operator.diffA-B.txt

@@ -1,9 +1,6 @@
 (Program
   (ExpressionStatements
-  { (Operator
-      (Other "typeof")
-      (Identifier))
-  ->(Operator
-      (Identifier)
-      (Other "instanceof")
-      (Identifier)) }))
+    (Operator
+      { (Other "typeof") -> (Identifier) }
+      { (Identifier) -> (Other "instanceof") }
+      { +(Identifier)+ })))

test/fixtures/javascript/type-operator.diffB-A.txt

@@ -1,9 +1,6 @@
 (Program
   (ExpressionStatements
-  { (Operator
-      (Identifier)
-      (Other "instanceof")
-      (Identifier))
-  ->(Operator
-      (Other "typeof")
-      (Identifier)) }))
+    (Operator
+      { (Identifier) -> (Other "typeof") }
+      { (Other "instanceof") -> (Identifier) }
+      { -(Identifier)- })))

test/fixtures/javascript/yield.diffA-B.txt

@@ -7,9 +7,9 @@
           (VarAssignment
             (Identifier)
             (NumberLiteral)))
-      { (Yield
-          (Identifier))
-      ->(Yield
-          (MathOperator
-            (Identifier)
-            (Other "++"))) }))))
+      (Yield { 
+        (Identifier)
+        ->
+        (MathOperator
+          (Identifier)
+          (Other "++")) })))))

test/fixtures/javascript/yield.diffB-A.txt

@@ -7,9 +7,9 @@
           (VarAssignment
             (Identifier)
             (NumberLiteral)))
-      { (Yield
-          (MathOperator
-            (Identifier)
-            (Other "++")))
-      ->(Yield
-          (Identifier)) }))))
+      (Yield {
+        (MathOperator
+          (Identifier)
+          (Other "++"))
+        ->
+        (Identifier) })))))

test/fixtures/ruby/and-or.diffA-B.txt

@@ -1,12 +1,8 @@
 (Program
-{ (Binary
+  (Binary
     (Identifier)
-    (Other "and")
+    { (Other "and") -> (Other "or") }
     (Identifier))
-->(Binary
-    (Identifier)
-    (Other "or")
-    (Identifier)) }
 {+(Binary
     (Binary
       (Identifier)

test/fixtures/ruby/and-or.diffB-A.txt

@@ -1,12 +1,8 @@
 (Program
-{ (Binary
+  (Binary
     (Identifier)
-    (Other "or")
+    { (Other "or") -> (Other "and") }
     (Identifier))
-->(Binary
-    (Identifier)
-    (Other "and")
-    (Identifier)) }
 {-(Binary
     (Binary
       (Identifier)

test/fixtures/ruby/bitwise-operator.diffA-B.txt

@@ -1,20 +1,12 @@
 (Program
-{ (Binary
+  (Binary
     (Identifier)
-    (Other "|")
+    { (Other "|") -> (Other "&") }
     (Identifier))
-->(Binary
+  (Binary
     (Identifier)
-    (Other "&")
-    (Identifier)) }
-{ (Binary
-    (Identifier)
-    (Other ">>")
+    { (Other ">>") -> (Other "<<") }
     (Identifier))
-->(Binary
-    (Identifier)
-    (Other "<<")
-    (Identifier)) }
 {-(Binary
     (Identifier)
     (Other "^")

test/fixtures/ruby/bitwise-operator.diffB-A.txt

@@ -1,20 +1,12 @@
 (Program
-{ (Binary
+  (Binary
     (Identifier)
-    (Other "&")
+    { (Other "&") -> (Other "|") }
     (Identifier))
-->(Binary
+  (Binary
     (Identifier)
-    (Other "|")
-    (Identifier)) }
-{ (Binary
-    (Identifier)
-    (Other "<<")
+    { (Other "<<") -> (Other ">>") }
     (Identifier))
-->(Binary
-    (Identifier)
-    (Other ">>")
-    (Identifier)) }
 {+(Binary
     (Identifier)
     (Other "^")

test/fixtures/ruby/boolean-operator.diffA-B.txt

@@ -1,9 +1,6 @@
 (Program
-{ (Binary
+  (Binary
     (Identifier)
-    (Other "||")
-    (Identifier))
-->(Binary
-    (Identifier)
-    (Other "&&")
-    (Identifier)) })
+  { (Other "||")
+  ->(Other "&&") }
+    (Identifier)))

test/fixtures/ruby/boolean-operator.diffB-A.txt

@@ -1,9 +1,6 @@
 (Program
-{ (Binary
+  (Binary
     (Identifier)
-    (Other "&&")
-    (Identifier))
-->(Binary
-    (Identifier)
-    (Other "||")
-    (Identifier)) })
+  { (Other "&&")
+  ->(Other "||") }
+    (Identifier)))

test/fixtures/ruby/comparision-operator.diffA-B.txt

@@ -1,17 +1,11 @@
 (Program
-{ (Binary
+  (Binary
     (Identifier)
-    (Other "<")
+  { (Other "<")
+  ->(Other "<=") }
     (Identifier))
-->(Binary
+  (Binary
     (Identifier)
-    (Other "<=")
-    (Identifier)) }
-{ (Binary
-    (Identifier)
-    (Other ">")
-    (Identifier))
-->(Binary
-    (Identifier)
-    (Other ">=")
-    (Identifier)) })
+  { (Other ">")
+  ->(Other ">=") }
+    (Identifier)))

test/fixtures/ruby/comparision-operator.diffB-A.txt

@@ -1,17 +1,11 @@
 (Program
-{ (Binary
+  (Binary
     (Identifier)
-    (Other "<=")
+  { (Other "<=")
+  ->(Other "<") }
     (Identifier))
-->(Binary
+  (Binary
     (Identifier)
-    (Other "<")
-    (Identifier)) }
-{ (Binary
-    (Identifier)
-    (Other ">=")
-    (Identifier))
-->(Binary
-    (Identifier)
-    (Other ">")
-    (Identifier)) })
+  { (Other ">=")
+  ->(Other ">") }
+    (Identifier)))

test/fixtures/ruby/element-reference.diffA-B.txt

@@ -1,15 +1,10 @@
 (Program
-{ (SubscriptAccess
-    (Identifier)
-    (Identifier))
-->(SubscriptAccess
-    (Identifier)
-    (StringLiteral)) }
   (SubscriptAccess
-  { (Identifier)
-  ->(Identifier) }
-  { (SymbolLiteral)
-  ->(SymbolLiteral) })
+    { (Identifier) -> (Identifier) }
+    { (Identifier) -> (StringLiteral) })
+  (SubscriptAccess
+    { (Identifier) -> (Identifier) }
+    { (SymbolLiteral) -> (SymbolLiteral) })
 {-(Assignment
     (SubscriptAccess
       (Identifier)

test/fixtures/ruby/element-reference.diffB-A.txt

@@ -1,15 +1,10 @@
 (Program
-{ (SubscriptAccess
-    (Identifier)
-    (StringLiteral))
-->(SubscriptAccess
-    (Identifier)
-    (Identifier)) }
   (SubscriptAccess
-  { (Identifier)
-  ->(Identifier) }
-  { (SymbolLiteral)
-  ->(SymbolLiteral) })
+    { (Identifier) -> (Identifier) }
+    { (StringLiteral) -> (Identifier) })
+  (SubscriptAccess
+    { (Identifier) -> (Identifier) }
+    { (SymbolLiteral) -> (SymbolLiteral) })
 {+(Assignment
     (SubscriptAccess
       (Identifier)

test/fixtures/ruby/for.diffA-B.txt

@@ -1,14 +1,13 @@
 (Program
-{ (For
-    (Identifier)
-    (Identifier)
-    (Identifier))
-->(For
-    (Identifier)
-    (ArrayLiteral
+  (For
+  { (Identifier)
+  ->(Identifier) }
+  { (Identifier)
+  ->(ArrayLiteral
       (IntegerLiteral)
       (IntegerLiteral)
-      (IntegerLiteral))
-    (MethodCall
+      (IntegerLiteral)) }
+  { (Identifier)
+  ->(MethodCall
       (Identifier)
-      (Identifier))) })
+      (Identifier)) }))

test/fixtures/ruby/for.diffB-A.txt

@@ -1,14 +1,13 @@
 (Program
-{ (For
-    (Identifier)
-    (ArrayLiteral
+  (For
+  { (Identifier)
+  ->(Identifier) }
+  { (ArrayLiteral
       (IntegerLiteral)
       (IntegerLiteral)
       (IntegerLiteral))
-    (MethodCall
+  ->(Identifier) }
+  { (MethodCall
       (Identifier)
-      (Identifier)))
-->(For
-    (Identifier)
-    (Identifier)
-    (Identifier)) })
+      (Identifier))
+  ->(Identifier) }))

test/fixtures/ruby/hash.diffA-B.txt

@@ -1,11 +1,8 @@
 (Program
   (Object
-  { (Pair
-      (SymbolLiteral)
-      (StringLiteral))
-  ->(Pair
-      (Identifier)
-      (StringLiteral)) }
+    (Pair
+      { (SymbolLiteral) -> (Identifier) }
+      { (StringLiteral) -> (StringLiteral) })
   {+(Pair
       (Identifier)
       (IntegerLiteral))+}

test/fixtures/ruby/hash.diffB-A.txt

@@ -1,20 +1,14 @@
 (Program
   (Object
-  { (Pair
-      (Identifier)
-      (StringLiteral))
-  ->(Pair
-      (SymbolLiteral)
-      (StringLiteral)) }
+    (Pair
+      { (Identifier) -> (SymbolLiteral) }
+      { (StringLiteral) -> (StringLiteral) })
   {+(Pair
       (SymbolLiteral)
       (IntegerLiteral))+}
-  { (Pair
-      (Identifier)
-      (IntegerLiteral))
-  ->(Pair
-      (StringLiteral)
-      (Boolean)) }
+    (Pair
+      { (Identifier) -> (StringLiteral) }
+      { (IntegerLiteral) -> (Boolean) })
   {+(Pair
       (SymbolLiteral)
       (IntegerLiteral))+}

test/fixtures/ruby/lambda-dash-rocket.diffA-B.txt

@@ -1,9 +1,8 @@
 (Program
-{ (AnonymousFunction
-    (Identifier)
-    (Identifier)
-    (Identifier)
-    (IntegerLiteral)
-    (IntegerLiteral))
-->(AnonymousFunction
-    (Identifier)) })
+  (AnonymousFunction
+  {-(Identifier)-}
+  {-(Identifier)-}
+  {-(Identifier)-}
+  { (IntegerLiteral)
+  ->(Identifier) }
+  {-(IntegerLiteral)-}))

test/fixtures/ruby/lambda-dash-rocket.diffB-A.txt

@@ -1,9 +1,8 @@
 (Program
-{ (AnonymousFunction
-    (Identifier))
-->(AnonymousFunction
-    (Identifier)
-    (Identifier)
-    (Identifier)
-    (IntegerLiteral)
-    (IntegerLiteral)) })
+  (AnonymousFunction
+  {+(Identifier)+}
+  {+(Identifier)+}
+  {+(Identifier)+}
+  { (Identifier)
+  ->(IntegerLiteral) }
+  {+(IntegerLiteral)+}))

test/fixtures/ruby/lambda.diffA-B.txt

@@ -1,9 +1,8 @@
 (Program
-{ (AnonymousFunction
-    (Identifier))
-->(AnonymousFunction
-    (Identifier)
-    (Binary
+  (AnonymousFunction
+  {+(Identifier)+}
+  { (Identifier)
+  ->(Binary
       (Identifier)
       (Other "+")
-      (IntegerLiteral))) })
+      (IntegerLiteral)) }))

test/fixtures/ruby/lambda.diffB-A.txt

@@ -1,9 +1,8 @@
 (Program
-{ (AnonymousFunction
-    (Identifier)
-    (Binary
+  (AnonymousFunction
+  {-(Identifier)-}
+  { (Binary
       (Identifier)
       (Other "+")
-      (IntegerLiteral)))
-->(AnonymousFunction
-    (Identifier)) })
+      (IntegerLiteral))
+  ->(Identifier) }))

test/fixtures/ruby/relational-operator.diffA-B.txt

@@ -1,20 +1,14 @@
 (Program
-{ (Binary
+  (Binary
     (Identifier)
-    (Other "==")
+  { (Other "==")
+  ->(Other "<=>") }
     (Identifier))
-->(Binary
+  (Binary
     (Identifier)
-    (Other "<=>")
-    (Identifier)) }
-{ (Binary
-    (Identifier)
-    (Other "!=")
+  { (Other "!=")
+  ->(Other "=~") }
     (Identifier))
-->(Binary
-    (Identifier)
-    (Other "=~")
-    (Identifier)) }
 {+(Assignment
     (Identifier)
     (Unary

test/fixtures/ruby/relational-operator.diffB-A.txt

@@ -1,20 +1,14 @@
 (Program
-{ (Binary
+  (Binary
     (Identifier)
-    (Other "<=>")
+  { (Other "<=>")
+  ->(Other "==") }
     (Identifier))
-->(Binary
+  (Binary
     (Identifier)
-    (Other "==")
-    (Identifier)) }
-{ (Binary
-    (Identifier)
-    (Other "=~")
+  { (Other "=~")
+  ->(Other "!=") }
     (Identifier))
-->(Binary
-    (Identifier)
-    (Other "!=")
-    (Identifier)) }
 {+(Binary
     (Identifier)
     (Other "===")

test/fixtures/ruby/rescue-modifier.diffA-B.txt

@@ -1,7 +1,5 @@
 (Program
-{ (Modifier Rescue
+  (Modifier Rescue
     (Identifier)
-    (Identifier))
-->(Modifier Rescue
-    (Identifier)
-    (Boolean)) })
+  { (Identifier)
+  ->(Boolean) }))

test/fixtures/ruby/rescue-modifier.diffB-A.txt

@@ -1,7 +1,5 @@
 (Program
-{ (Modifier Rescue
+  (Modifier Rescue
     (Identifier)
-    (Boolean))
-->(Modifier Rescue
-    (Identifier)
-    (Identifier)) })
+  { (Boolean)
+  ->(Identifier) }))