Merge pull request #1104 from github/generalize-alignment-over-the-syntax-functor

Generalize alignment over the syntax functor

src/Alignment.hs

@@ -22,7 +22,6 @@ import Patch
 import Range
 import Source hiding (break, drop, take)
 import SplitDiff
-import Syntax
 import Term
 
 -- | Assign line numbers to the lines on each side of a list of rows.
@@ -38,11 +37,11 @@ hasChanges :: (Foldable f, Functor f) => SplitDiff f annotation -> Bool
 hasChanges = or . (True <$)
 
 -- | Align a Diff into a list of Join These SplitDiffs representing the (possibly blank) lines on either side.
-alignDiff :: HasField fields Range => Both Source -> SyntaxDiff leaf fields -> [Join These (SplitSyntaxDiff leaf fields)]
+alignDiff :: Traversable f => HasField fields Range => Both Source -> Diff f (Record fields) -> [Join These (SplitDiff [] (Record fields))]
 alignDiff sources diff = iter (alignSyntax (runBothWith ((Join .) . These)) wrap getRange sources) (alignPatch sources <$> diff)
 
 -- | Align the contents of a patch into a list of lines on the corresponding side(s) of the diff.
-alignPatch :: forall fields leaf. HasField fields Range => Both Source -> Patch (SyntaxTerm leaf fields) -> [Join These (SplitSyntaxDiff leaf fields)]
+alignPatch :: forall fields f. (Traversable f, HasField fields Range) => Both Source -> Patch (Term f (Record fields)) -> [Join These (SplitDiff [] (Record fields))]
 alignPatch sources patch = case patch of
   Delete term -> fmap (pure . SplitDelete) <$> alignSyntax' this (fst sources) term
   Insert term -> fmap (pure . SplitInsert) <$> alignSyntax' that (snd sources) term
@@ -50,21 +49,19 @@ alignPatch sources patch = case patch of
     (alignSyntax' this (fst sources) term1)
     (alignSyntax' that (snd sources) term2)
   where getRange = byteRange . extract
-        alignSyntax' :: (forall a. Identity a -> Join These a) -> Source -> SyntaxTerm leaf fields -> [Join These (SyntaxTerm leaf fields)]
+        alignSyntax' :: (forall a. Identity a -> Join These a) -> Source -> Term f (Record fields) -> [Join These (Term [] (Record fields))]
         alignSyntax' side source term = hylo (alignSyntax side cofree getRange (Identity source)) runCofree (Identity <$> term)
         this = Join . This . runIdentity
         that = Join . That . runIdentity
 
 -- | The Applicative instance f is either Identity or Both. Identity is for Terms in Patches, Both is for Diffs in unchanged portions of the diff.
-alignSyntax :: (Applicative f, HasField fields Range) => (forall a. f a -> Join These a) -> (SyntaxTermF leaf fields term -> term) -> (term -> Range) -> f Source -> TermF (Syntax leaf) (f (Record fields)) [Join These term] -> [Join These term]
-alignSyntax toJoinThese toNode getRange sources (infos :< syntax) = catMaybes $ case syntax of
-  Leaf s -> wrapInBranch (const (Leaf s)) <$> alignBranch getRange [] bothRanges
-  Syntax.Comment a -> wrapInBranch (const (Syntax.Comment a)) <$> alignBranch getRange [] bothRanges
-  Fixed children -> wrapInBranch Fixed <$> alignBranch getRange (join children) bothRanges
-  _ -> wrapInBranch Indexed <$> alignBranch getRange (join (toList syntax)) bothRanges
+alignSyntax :: (Applicative f, HasField fields Range, Foldable g) => (forall a. f a -> Join These a) -> (TermF [] (Record fields) term -> term) -> (term -> Range) -> f Source -> TermF g (f (Record fields)) [Join These term] -> [Join These term]
+alignSyntax toJoinThese toNode getRange sources (infos :< syntax) =
+  catMaybes $ wrapInBranch <$> alignBranch getRange (join (toList syntax)) bothRanges
   where bothRanges = modifyJoin (fromThese [] []) lineRanges
-        lineRanges = toJoinThese $ actualLineRanges <$> (byteRange <$> infos) <*> sources
-        wrapInBranch constructor = applyThese $ toJoinThese ((\ info (range, children) -> toNode (setCharacterRange info range :< constructor children)) <$> infos)
+        lineRanges = toJoinThese $ actualLineRanges . byteRange <$> infos <*> sources
+        wrapInBranch = applyThese $ toJoinThese (makeNode <$> infos)
+        makeNode info (range, children) = toNode (setByteRange info range :< children)
 
 -- | Given a function to get the range, a list of already-aligned children, and the lists of ranges spanned by a branch, return the aligned lines.
 alignBranch :: (term -> Range) -> [Join These term] -> Both [Range] -> [Join These (Range, [term])]

src/Info.hs

@@ -4,7 +4,7 @@ module Info
 , HasDefaultFields
 , Range(..)
 , byteRange
-, setCharacterRange
+, setByteRange
 , Category(..)
 , category
 , setCategory
@@ -36,8 +36,8 @@ newtype SourceText = SourceText { unText :: Text }
 byteRange :: HasField fields Range => Record fields -> Range
 byteRange = getField
 
-setCharacterRange :: HasField fields Range => Record fields -> Range -> Record fields
-setCharacterRange = setField
+setByteRange :: HasField fields Range => Record fields -> Range -> Record fields
+setByteRange = setField
 
 category :: HasField fields Category => Record fields -> Category
 category = getField

src/Renderer/JSON.hs

@@ -106,6 +106,9 @@ instance ToJSON a => ToJSONFields (SplitPatch a) where
   toJSONFields (SplitDelete a) = [ "delete" .= a ]
   toJSONFields (SplitReplace a) = [ "replace" .= a ]
 
+instance ToJSON a => ToJSONFields [a] where
+  toJSONFields list = [ "children" .= list ]
+
 instance ToJSON recur => ToJSONFields (Syntax leaf recur) where
   toJSONFields syntax = [ "children" .= toList syntax ]
 

src/Renderer/Patch.hs

@@ -116,7 +116,7 @@ emptyHunk :: Hunk (SplitDiff a annotation)
 emptyHunk = Hunk { offset = mempty, changes = [], trailingContext = [] }
 
 -- | Render a diff as a series of hunks.
-hunks :: HasField fields Range => SyntaxDiff leaf fields -> Both SourceBlob -> [Hunk (SplitSyntaxDiff leaf fields)]
+hunks :: (Traversable f, HasField fields Range) => Diff f (Record fields) -> Both SourceBlob -> [Hunk (SplitDiff [] (Record fields))]
 hunks _ blobs | sources <- source <$> blobs
               , sourcesEqual <- runBothWith (==) sources
               , sourcesNull <- runBothWith (&&) (Source.null <$> sources)

test/AlignmentSpec.hs

@@ -256,13 +256,13 @@ instance Listable BranchElement where
 counts :: [Join These (Int, a)] -> Both Int
 counts numbered = fromMaybe 0 . getLast . mconcat . fmap Last <$> Join (unalign (runJoin . fmap Prologue.fst <$> numbered))
 
-align :: Both Source.Source -> ConstructibleFree (Patch (Term (Syntax Text) (Record '[Range]))) (Both (Record '[Range])) -> PrettyDiff (SplitDiff (Syntax Text) (Record '[Range]))
+align :: Both Source.Source -> ConstructibleFree (Syntax Text) (Patch (Term (Syntax Text) (Record '[Range]))) (Both (Record '[Range])) -> PrettyDiff (SplitDiff [] (Record '[Range]))
 align sources = PrettyDiff sources . fmap (fmap (getRange &&& identity)) . alignDiff sources . deconstruct
 
 info :: Int -> Int -> Record '[Range]
 info start end = Range start end :. Nil
 
-prettyDiff :: Both Source.Source -> [Join These (ConstructibleFree (SplitPatch (Term (Syntax Text) (Record '[Range]))) (Record '[Range]))] -> PrettyDiff (SplitDiff (Syntax Text) (Record '[Range]))
+prettyDiff :: Both Source.Source -> [Join These (ConstructibleFree [] (SplitPatch (Term [] (Record '[Range]))) (Record '[Range]))] -> PrettyDiff (SplitDiff [] (Record '[Range]))
 prettyDiff sources = PrettyDiff sources . fmap (fmap ((getRange &&& identity) . deconstruct))
 
 data PrettyDiff a = PrettyDiff { unPrettySources :: Both Source.Source, unPrettyLines :: [Join These (Range, a)] }
@@ -277,7 +277,7 @@ instance Show (PrettyDiff a) where
           pad n string = (<>) (take n string) (replicate (max 0 (n - length string)) ' ')
           toBoth them = showDiff <$> them `applyThese` modifyJoin (uncurry These) sources
 
-newtype ConstructibleFree patch annotation = ConstructibleFree { deconstruct :: Free (CofreeF (Syntax Text) annotation) patch }
+newtype ConstructibleFree f patch annotation = ConstructibleFree { deconstruct :: Free (CofreeF f annotation) patch }
 
 
 class PatchConstructible p where
@@ -292,7 +292,11 @@ instance PatchConstructible (SplitPatch (Term (Syntax Text) (Record '[Range])))
   insert = SplitInsert
   delete = SplitDelete
 
-instance PatchConstructible patch => PatchConstructible (ConstructibleFree patch annotation) where
+instance PatchConstructible (SplitPatch (Term [] (Record '[Range]))) where
+  insert = SplitInsert . hoistCofree toList
+  delete = SplitDelete . hoistCofree toList
+
+instance (Functor f, PatchConstructible patch) => PatchConstructible (ConstructibleFree f patch annotation) where
   insert = ConstructibleFree . pure . insert
   delete = ConstructibleFree . pure . delete
 
@@ -300,10 +304,18 @@ class SyntaxConstructible s where
   leaf :: annotation -> Text -> s annotation
   branch :: annotation -> [s annotation] -> s annotation
 
-instance SyntaxConstructible (ConstructibleFree patch) where
+instance SyntaxConstructible (ConstructibleFree (Syntax Text) patch) where
   leaf info = ConstructibleFree . free . Free . (info :<) . Leaf
   branch info = ConstructibleFree . free . Free . (info :<) . Indexed . fmap deconstruct
 
+instance SyntaxConstructible (ConstructibleFree [] patch) where
+  leaf info = ConstructibleFree . free . Free . (info :<) . const []
+  branch info = ConstructibleFree . free . Free . (info :<) . fmap deconstruct
+
 instance SyntaxConstructible (Cofree (Syntax Text)) where
   info `leaf` value = cofree $ info :< Leaf value
   info `branch` children = cofree $ info :< Indexed children
+
+instance SyntaxConstructible (Cofree []) where
+  info `leaf` _ = cofree $ info :< []
+  info `branch` children = cofree $ info :< children

test/SemanticCmdLineSpec.hs

@@ -78,6 +78,7 @@ 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\",\"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"