🔥 the summary renderer.

semantic-diff.cabal

@@ -61,7 +61,6 @@ library
                      , Renderer
                      , Renderer.JSON
                      , Renderer.Patch
-                     , Renderer.Summary
                      , Renderer.SExpression
                      , Renderer.TOC
                      , RWS
@@ -157,7 +156,6 @@ test-suite test
                      , DiffSpec
                      , SemanticSpec
                      , SemanticCmdLineSpec
-                     , SummarySpec
                      , GitmonClientSpec
                      , InterpreterSpec
                      , PatchOutputSpec

src/Arguments.hs

@@ -46,9 +46,6 @@ patchDiff = DiffArguments PatchRenderer identityDecorator
 jsonDiff :: DiffArguments'
 jsonDiff = DiffArguments JSONDiffRenderer identityDecorator
 
-summaryDiff :: DiffArguments'
-summaryDiff = DiffArguments SummaryRenderer identityDecorator
-
 sExpressionDiff :: DiffArguments'
 sExpressionDiff = DiffArguments (SExpressionDiffRenderer TreeOnly) identityDecorator
 

src/Renderer.hs

@@ -25,7 +25,6 @@ import Prologue
 import Renderer.JSON as R
 import Renderer.Patch as R
 import Renderer.SExpression as R
-import Renderer.Summary as R
 import Renderer.TOC as R
 import Source (SourceBlob(..), Source)
 import Syntax as S
@@ -35,7 +34,6 @@ import Term
 data DiffRenderer fields output where
   PatchRenderer :: HasField fields Range => DiffRenderer fields File
   JSONDiffRenderer :: (ToJSONFields (Record fields), HasField fields Range) => DiffRenderer fields (Map Text Value)
-  SummaryRenderer :: HasDefaultFields fields => DiffRenderer fields Summaries
   SExpressionDiffRenderer :: (HasField fields Category, HasField fields SourceSpan) => SExpressionFormat -> DiffRenderer fields ByteString
   ToCRenderer :: (HasField fields Category, HasField fields (Maybe Declaration), HasField fields SourceSpan) => DiffRenderer fields Summaries
 
@@ -43,7 +41,6 @@ resolveDiffRenderer :: (Monoid output, StringConv output ByteString) => DiffRend
 resolveDiffRenderer renderer = case renderer of
   PatchRenderer -> (File .) . R.patch
   JSONDiffRenderer -> R.json
-  SummaryRenderer -> R.summary
   SExpressionDiffRenderer format -> R.sExpression format
   ToCRenderer -> R.toc
 
@@ -102,7 +99,6 @@ instance StringConv File ByteString where
 instance Show (DiffRenderer fields output) where
   showsPrec _ PatchRenderer = showString "PatchRenderer"
   showsPrec _ JSONDiffRenderer = showString "JSONDiffRenderer"
-  showsPrec _ SummaryRenderer = showString "SummaryRenderer"
   showsPrec d (SExpressionDiffRenderer format) = showsUnaryWith showsPrec "SExpressionDiffRenderer" d format
   showsPrec _ ToCRenderer = showString "ToCRenderer"
 

src/Renderer/Summary.hs

@@ -1,548 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, ScopedTypeVariables  #-}
-{-# OPTIONS_GHC -Wno-deprecations #-}
--- Disabling deprecation warnings due to pattern match against RescueModifier.
-module Renderer.Summary (Summaries(..), summary, diffSummaries, DiffSummary(..), DiffInfo(..), diffToDiffSummaries, isBranchInfo, isErrorSummary, JSONSummary(..)) where
-
-import Prologue
-import Diff
-import Patch
-import Term
-import Info (HasDefaultFields, category, byteRange)
-import Range
-import Syntax as S
-import Category as C
-import Data.Functor.Both hiding (fst, snd)
-import qualified Data.Functor.Both as Both
-import Data.Functor.Listable
-import Data.List.NonEmpty (nonEmpty)
-import qualified Data.Text as Text
-import Data.Text.Listable
-import Data.Record
-import Data.These
-import Text.PrettyPrint.Leijen.Text ((<+>), squotes, space, string, Doc, punctuate, pretty, hsep)
-import qualified Text.PrettyPrint.Leijen.Text as P
-import Data.Aeson
-import SourceSpan
-import Source hiding (null)
-import qualified Data.Map as Map
-import qualified Data.List as List
-
-data Summaries = Summaries { changes, errors :: !(Map Text [Value]) }
-  deriving Show
-
-instance Monoid Summaries where
-  mempty = Summaries mempty mempty
-  mappend (Summaries c1 e1) (Summaries c2 e2) = Summaries (Map.unionWith (<>) c1 c2) (Map.unionWith (<>) e1 e2)
-
-instance StringConv Summaries ByteString where
-  strConv _ = toS . (<> "\n") . encode
-
-instance ToJSON Summaries where
-  toJSON Summaries{..} = object [ "changes" .= changes, "errors" .= errors ]
-
-data Annotatable a = Annotatable a | Unannotatable a
-
-annotatable :: SyntaxTerm leaf fields -> Annotatable (SyntaxTerm leaf fields)
-annotatable term = isAnnotatable (unwrap term) term
-  where isAnnotatable syntax = case syntax of
-          S.Class{} -> Annotatable
-          S.Method{} -> Annotatable
-          S.Function{} -> Annotatable
-          S.Module{} -> Annotatable
-          S.Namespace{} -> Annotatable
-          S.Interface{} -> Annotatable
-          _ -> Unannotatable
-
-data Identifiable a = Identifiable a | Unidentifiable a
-
-identifiable :: SyntaxTerm leaf fields -> Identifiable (SyntaxTerm leaf fields)
-identifiable term = isIdentifiable (unwrap term) term
-  where isIdentifiable syntax = case syntax of
-          S.FunctionCall{} -> Identifiable
-          S.MethodCall{} -> Identifiable
-          S.Function{} -> Identifiable
-          S.Assignment{} -> Identifiable
-          S.OperatorAssignment{} -> Identifiable
-          S.VarAssignment{} -> Identifiable
-          S.SubscriptAccess{} -> Identifiable
-          S.Module{} -> Identifiable
-          S.Namespace{} -> Identifiable
-          S.Interface{} -> Identifiable
-          S.Class{} -> Identifiable
-          S.Method{} -> Identifiable
-          S.Leaf{} -> Identifiable
-          S.DoWhile{} -> Identifiable
-          S.Import{} -> Identifiable
-          S.Export{} -> Identifiable
-          S.Ternary{} -> Identifiable
-          S.If{} -> Identifiable
-          S.Try{} -> Identifiable
-          S.Switch{} -> Identifiable
-          S.Rescue{} -> Identifiable
-          S.Pair{} -> Identifiable
-          S.Array ty _ -> maybe Unidentifiable (const Identifiable) ty
-          S.Object ty _ -> maybe Unidentifiable (const Identifiable) ty
-          S.BlockStatement{} -> Identifiable
-          S.TypeDecl{} -> Identifiable
-          S.Ty{} -> Identifiable
-          _ -> Unidentifiable
-
-data JSONSummary info span = JSONSummary { info :: info, span :: span }
-                 | ErrorSummary { info :: info, span :: span }
-                 deriving (Generic, Eq, Show)
-
-instance (ToJSON info, ToJSON span) => ToJSON (JSONSummary info span) where
-  toJSON JSONSummary{..} = object [ "summary" .= info, "span" .= span ]
-  toJSON ErrorSummary{..} = object [ "summary" .= info, "span" .= span ]
-
-isErrorSummary :: JSONSummary info span -> Bool
-isErrorSummary ErrorSummary{} = True
-isErrorSummary _ = False
-
-data DiffInfo = LeafInfo { leafCategory :: Category, termName :: Text, sourceSpan :: SourceSpan }
- | BranchInfo { branches :: [ DiffInfo ], branchCategory :: Category, branchType :: Branch }
- | ErrorInfo { errorSpan :: SourceSpan, termName :: Text }
- | HideInfo -- Hide/Strip from summary output entirely.
- deriving (Eq, Show)
-
-data Branch = BIndexed | BFixed | BCommented | BIf deriving (Show, Eq, Generic)
-
-data DiffSummary a = DiffSummary {
-  diffSummaryPatch :: Patch a,
-  parentAnnotation :: [Either (Category, Text) (Category, Text)]
-} deriving (Eq, Functor, Show, Generic)
-
-summary :: HasDefaultFields fields => Both SourceBlob -> Diff (Syntax Text) (Record fields) -> Summaries
-summary blobs diff = Summaries changes errors
-  where
-    changes = if null changes' then mempty else Map.singleton summaryKey (toJSON <$> changes')
-    errors = if null errors' then mempty else Map.singleton summaryKey (toJSON <$> errors')
-    (errors', changes') = List.partition isErrorSummary summaries
-    summaryKey = toSummaryKey (path <$> blobs)
-    summaries = diffSummaries blobs diff
-
-    -- Returns a key representing the filename. If the filenames are different,
-    -- return 'before -> after'.
-    toSummaryKey :: Both FilePath -> Text
-    toSummaryKey = runBothWith $ \before after ->
-      toS $ case (before, after) of
-        ("", after) -> after
-        (before, "") -> before
-        (before, after) | before == after -> after
-        (before, after) | not (null before) && not (null after) -> before <> " -> " <> after
-        (_, _) -> mempty
-
--- Returns a list of diff summary texts given two source blobs and a diff.
-diffSummaries :: (StringConv leaf Text, HasDefaultFields fields) => Both SourceBlob -> SyntaxDiff leaf fields -> [JSONSummary Text SourceSpans]
-diffSummaries blobs diff = summaryToTexts =<< diffToDiffSummaries (source <$> blobs) diff
-
--- Takes a 'DiffSummary DiffInfo' and returns a list of JSON Summaries whose text summaries represent the LeafInfo summaries of the 'DiffSummary'.
-summaryToTexts :: DiffSummary DiffInfo -> [JSONSummary Text SourceSpans]
-summaryToTexts DiffSummary{..} = appendParentContexts <$> jsonDocSummaries diffSummaryPatch
-  where appendParentContexts jsonSummary =
-          jsonSummary { info = show $ info jsonSummary <+> parentContexts parentAnnotation }
-
--- Returns a list of 'DiffSummary' given two source blobs and a diff.
-diffToDiffSummaries :: (StringConv leaf Text, HasDefaultFields fields) => Both Source -> SyntaxDiff leaf fields -> [DiffSummary DiffInfo]
-diffToDiffSummaries sources = para $ \diff ->
-  let
-    diff' = free (Prologue.fst <$> diff)
-    annotateWithCategory :: [DiffSummary DiffInfo] -> [DiffSummary DiffInfo]
-    annotateWithCategory children = case (beforeTerm diff', afterTerm diff') of
-      (_, Just diff'') -> appendSummary (Both.snd sources) diff'' <$> children
-      (Just diff'', _) -> appendSummary (Both.fst sources) diff'' <$> children
-      (Nothing, Nothing) -> []
-  in case diff of
-    -- Skip comments and leaves since they don't have any changes
-    (Free (_ :< syntax)) -> annotateWithCategory (toList syntax >>= snd)
-    (Pure patch) -> [ DiffSummary (mapPatch (termToDiffInfo beforeSource) (termToDiffInfo afterSource) patch) [] ]
-  where
-    (beforeSource, afterSource) = runJoin sources
-
--- Flattens a patch of diff infos into a list of docs, one for every 'LeafInfo' or `ErrorInfo` it contains.
-jsonDocSummaries :: Patch DiffInfo -> [JSONSummary Doc SourceSpans]
-jsonDocSummaries patch = case patch of
-  Replace i1 i2 -> zipWith (\a b ->
-    JSONSummary
-     {
-      info = info (prefixWithPatch patch This a) <+> "with" <+> info b
-    , span = SourceSpans $ These (span a) (span b)
-    }) (toLeafInfos i1) (toLeafInfos i2)
-  Insert info -> prefixWithPatch patch That <$> toLeafInfos info
-  Delete info -> prefixWithPatch patch This <$> toLeafInfos info
-
--- Prefixes a given doc with the type of patch it represents.
-prefixWithPatch :: Patch DiffInfo -> (SourceSpan -> These SourceSpan SourceSpan) -> JSONSummary Doc SourceSpan -> JSONSummary Doc SourceSpans
-prefixWithPatch patch constructor = prefixWithThe (patchToPrefix patch)
-  where
-    prefixWithThe prefix jsonSummary = jsonSummary
-      {
-        info = prefix <+> info jsonSummary
-      , span = SourceSpans $ constructor (span jsonSummary)
-      }
-    patchToPrefix patch = case patch of
-      (Replace _ _) -> "Replaced"
-      (Insert _) -> "Added"
-      (Delete _) -> "Deleted"
-
-toLeafInfos :: DiffInfo -> [JSONSummary Doc SourceSpan]
-toLeafInfos err@ErrorInfo{..} = pure $ ErrorSummary (pretty err) errorSpan
-toLeafInfos BranchInfo{..} = branches >>= toLeafInfos
-toLeafInfos HideInfo = []
-toLeafInfos LeafInfo{..} = pure $ JSONSummary (summary leafCategory termName) sourceSpan
-  where
-    summary :: Category -> Text -> Doc
-    summary category termName = case category of
-      C.NumberLiteral -> squotes $ toDoc termName
-      C.IntegerLiteral -> squotes $ toDoc termName
-      C.Boolean -> squotes $ toDoc termName
-      C.StringLiteral -> termAndCategoryName
-      C.Export -> termAndCategoryName
-      C.Import -> termAndCategoryName
-      C.Subshell -> termAndCategoryName
-      C.AnonymousFunction -> "an" <+> toDoc termName <+> "function"
-      C.Begin -> categoryName'
-      C.Select -> categoryName'
-      C.Else -> categoryName'
-      C.Ensure -> categoryName'
-      C.Break -> categoryName'
-      C.Continue -> categoryName'
-      C.BeginBlock -> categoryName'
-      C.EndBlock -> categoryName'
-      C.Yield | Text.null termName -> categoryName'
-      C.Return | Text.null termName -> categoryName'
-      C.Switch | Text.null termName -> categoryName'
-      _ -> "the" <+> squotes (toDoc termName) <+> toDoc categoryName
-      where
-        termAndCategoryName = "the" <+> toDoc termName <+> toDoc categoryName
-        categoryName = toCategoryName category
-        categoryName' = case categoryName of
-          name | startsWithVowel name -> "an" <+> toDoc name
-               | otherwise -> "a" <+> toDoc name
-        startsWithVowel text = getAny $ foldMap (Any . flip Text.isPrefixOf text) vowels
-        vowels = Text.singleton <$> ("aeiouAEIOU" :: [Char])
-
--- Returns a text representing a specific term given a source and a term.
-toTermName :: forall leaf fields. (StringConv leaf Text, HasDefaultFields fields) => Source -> SyntaxTerm leaf fields -> Text
-toTermName source term = case unwrap term of
-  S.Send _ _ -> termNameFromSource term
-  S.Ty _ -> termNameFromSource term
-  S.TypeDecl id _ -> toTermName' id
-  S.TypeAssertion _ _ -> termNameFromSource term
-  S.TypeConversion _ _ -> termNameFromSource term
-  S.Go expr -> toTermName' expr
-  S.Defer expr -> toTermName' expr
-  S.AnonymousFunction params _ -> "anonymous" <> paramsToArgNames params
-  S.Fixed children -> termNameFromChildren term children
-  S.Indexed children -> maybe "branch" sconcat (nonEmpty (intersperse ", " (toTermName' <$> children)))
-  Leaf leaf -> toS leaf
-  S.Assignment identifier _ -> toTermName' identifier
-  S.Function identifier _ _ -> toTermName' identifier
-  S.ParameterDecl _ _ -> termNameFromSource term
-  S.FunctionCall i _ args -> case unwrap i of
-    S.AnonymousFunction params _ ->
-      -- Omit a function call's arguments if it's arguments match the underlying
-      -- anonymous function's arguments.
-      if (category . extract <$> args) == (category . extract <$> params)
-      then toTermName' i
-      else "(" <> toTermName' i <> ")" <> paramsToArgNames args
-    _ -> toTermName' i <> paramsToArgNames args
-  S.MemberAccess base property -> case (unwrap base, unwrap property) of
-    (S.FunctionCall{}, S.FunctionCall{}) -> toTermName' base <> "()." <> toTermName' property <> "()"
-    (S.FunctionCall{}, _) -> toTermName' base <> "()." <> toTermName' property
-    (_, S.FunctionCall{}) -> toTermName' base <> "." <> toTermName' property <> "()"
-    (_, _) -> toTermName' base <> "." <> toTermName' property
-  S.MethodCall targetId methodId _ methodParams -> toTermName' targetId <> sep <> toTermName' methodId <> paramsToArgNames methodParams
-    where sep = case unwrap targetId of
-            S.FunctionCall{} -> "()."
-            _ -> "."
-  S.SubscriptAccess base element -> case (unwrap base, unwrap element) of
-    (S.FunctionCall{}, S.FunctionCall{}) -> toTermName' base <> "()." <> toTermName' element <> "()"
-    (S.FunctionCall{}, _) -> toTermName' base <> "()." <> toTermName' element
-    (_, S.FunctionCall{}) -> toTermName' base <> "[" <> toTermName' element <> "()" <> "]"
-    (S.Indexed _, _) -> case category . extract $ base of
-      SliceTy -> termNameFromSource base <> toTermName' element
-      _ -> toTermName' base <> "[" <> toTermName' element <> "]"
-    (_, _) -> toTermName' base <> "[" <> toTermName' element <> "]"
-  S.VarAssignment varId _ -> termNameFromChildren term varId
-  S.VarDecl _ -> termNameFromSource term
-  -- TODO: We should remove Case from Syntax since I don't think we should ever
-  -- evaluate Case as a single toTermName Text - joshvera
-  S.Case expr _ -> termNameFromSource expr
-  S.Switch exprs _ -> maybe "" toTermName' (fmap snd (unsnoc exprs))
-  S.Ternary expr _ -> toTermName' expr
-  S.OperatorAssignment id _ -> toTermName' id
-  S.Operator _ -> termNameFromSource term
-  S.Object ty kvs -> maybe ("{ " <> Text.intercalate ", " (toTermName' <$> kvs) <> " }") termNameFromSource ty
-  S.Pair k v -> toKeyName k <> toArgName v
-  S.Return children -> Text.intercalate ", " (termNameFromSource <$> children)
-  S.Yield children -> Text.intercalate ", " (termNameFromSource <$> children)
-  S.ParseError _ -> termNameFromSource term
-  S.If expr _ -> termNameFromSource expr
-  S.For clauses _ -> termNameFromChildren term clauses
-  S.While expr _ -> toTermName' expr
-  S.DoWhile _ expr -> toTermName' expr
-  S.Throw expr -> termNameFromSource expr
-  S.Constructor expr -> toTermName' expr
-  S.Try clauses _ _ _ -> termNameFromChildren term clauses
-  S.Select clauses -> termNameFromChildren term clauses
-  S.Array ty _ -> maybe (termNameFromSource term) termNameFromSource ty
-  S.Class identifier _ _ -> toTermName' identifier
-  S.Method _ identifier (Just receiver) args _ -> termNameFromSource receiver <> "." <> toTermName' identifier <> paramsToArgNames args
-  S.Method _ identifier Nothing args _ -> toTermName' identifier <> paramsToArgNames args
-  S.Comment a -> toS a
-  S.Commented _ _ -> termNameFromChildren term (toList $ unwrap term)
-  S.Module identifier _ -> toTermName' identifier
-  S.Namespace identifier _ -> toTermName' identifier
-  S.Interface identifier _ _ -> toTermName' identifier
-  S.Import identifier [] -> termNameFromSource identifier
-  S.Import identifier exprs -> termNameFromChildren term exprs <> " from " <> toTermName' identifier
-  S.Export Nothing expr -> "{ " <> Text.intercalate ", " (termNameFromSource <$> expr) <> " }"
-  S.Export (Just identifier) [] -> "{ " <> toTermName' identifier <> " }"
-  S.Export (Just identifier) expr -> "{ " <> Text.intercalate ", " (termNameFromSource <$> expr) <> " }" <> " from " <> toTermName' identifier
-  S.Negate expr -> toTermName' expr
-  S.Struct ty _ -> maybe (termNameFromSource term) termNameFromSource ty
-  S.Rescue args _ -> Text.intercalate ", " $ toTermName' <$> args
-  S.Break expr -> maybe "" toTermName' expr
-  S.Continue expr -> maybe "" toTermName' expr
-  S.BlockStatement children -> termNameFromChildren term children
-  S.DefaultCase children -> termNameFromChildren term children
-  S.FieldDecl children -> termNameFromChildren term children
-  where toTermName' = toTermName source
-        termNameFromChildren term children = termNameFromRange (unionRangesFrom (range term) (range <$> children))
-        termNameFromSource term = termNameFromRange (range term)
-        termNameFromRange range = toText $ Source.slice range source
-        range = byteRange . extract
-        paramsToArgNames params = "(" <> Text.intercalate ", " (toArgName <$> params) <> ")"
-        toArgName :: SyntaxTerm leaf fields -> Text
-        toArgName arg = case identifiable arg of
-                          Identifiable arg -> toTermName' arg
-                          Unidentifiable _ -> "…"
-        toKeyName key = case toTermName' key of
-          n | Text.head n == ':' -> n <> " => "
-          n -> n <> ": "
-
-parentContexts :: [Either (Category, Text) (Category, Text)] -> Doc
-parentContexts contexts = hsep $ either identifiableDoc annotatableDoc <$> contexts
-  where
-    identifiableDoc (c, t) = case c of
-      C.Assignment -> "in an" <+> catName c <+> "to" <+> termName t
-      C.Select -> "in a" <+> catName c
-      C.Begin -> "in a" <+> catName c
-      C.Else -> "in an" <+> catName c
-      C.Elsif -> "in the" <+> squotes (termName t) <+> catName c
-      C.Method -> "in the" <+> squotes (termName t) <+> catName c
-      C.SingletonMethod -> "in the" <+> squotes (termName t) <+> catName c
-      C.Ternary -> "in the" <+> squotes (termName t) <+> catName c
-      C.Ensure -> "in an" <+> catName c
-      C.Rescue -> case t of
-        "" -> "in a" <+> catName c
-        _ -> "in the" <+> squotes (termName t) <+> catName c
-      C.Modifier C.Rescue -> "in the" <+> squotes ("rescue" <+> termName t) <+> "modifier"
-      C.If -> "in the" <+> squotes (termName t) <+> catName c
-      C.Case -> "in the" <+> squotes (termName t) <+> catName c
-      C.Break -> case t of
-        "" -> "in a" <+> catName c
-        _ -> "in the" <+> squotes (termName t) <+> catName c
-      C.Continue -> case t of
-        "" -> "in a" <+> catName c
-        _ -> "in the" <+> squotes (termName t) <+> catName c
-      C.Switch -> case t of
-        "" -> "in a" <+> catName c
-        _ -> "in the" <+> squotes (termName t) <+> catName c
-      C.When -> "in a" <+> catName c
-      C.BeginBlock -> "in a" <+> catName c
-      C.EndBlock -> "in an" <+> catName c
-      C.DefaultCase -> "in a" <+> catName c
-      C.TypeDecl -> "in the" <+> squotes (termName t) <+> catName c
-      _ -> "in the" <+> termName t <+> catName c
-    annotatableDoc (c, t) = "of the" <+> squotes (termName t) <+> catName c
-    catName = toDoc . toCategoryName
-    termName = toDoc
-
-toDoc :: Text -> Doc
-toDoc = string . toS
-
-termToDiffInfo :: (StringConv leaf Text, HasDefaultFields fields) => Source -> SyntaxTerm leaf fields -> DiffInfo
-termToDiffInfo blob term = case unwrap term of
-  S.Indexed children -> BranchInfo (termToDiffInfo' <$> children) (category $ extract term) BIndexed
-  S.Fixed children -> BranchInfo (termToDiffInfo' <$> children) (category $ extract term) BFixed
-  S.AnonymousFunction _ _ -> LeafInfo C.AnonymousFunction (toTermName' term) (getField $ extract term)
-  S.Comment _ -> HideInfo
-  S.Commented cs leaf -> BranchInfo (termToDiffInfo' <$> cs <> maybeToList leaf) (category $ extract term) BCommented
-  S.ParseError _ -> ErrorInfo (getField $ extract term) (toTermName' term)
-  _ -> toLeafInfo term
-  where toTermName' = toTermName blob
-        termToDiffInfo' = termToDiffInfo blob
-        toLeafInfo term = LeafInfo (category $ extract term) (toTermName' term) (getField $ extract term)
-
--- | Append a parentAnnotation to the current DiffSummary instance.
--- | For a DiffSummary without a parentAnnotation, we append a parentAnnotation with the first identifiable term.
--- | For a DiffSummary with a parentAnnotation, we append the next annotatable term to the extant parentAnnotation.
--- | If a DiffSummary already has a parentAnnotation, and a (grand) parentAnnotation, then we return the summary without modification.
-appendSummary :: (StringConv leaf Text, HasDefaultFields fields) => Source -> SyntaxTerm leaf fields -> DiffSummary DiffInfo -> DiffSummary DiffInfo
-appendSummary source term summary =
-  case (parentAnnotation summary, identifiable term, annotatable term) of
-    ([], Identifiable _, _) -> appendParentAnnotation Left
-    ([_], _, Annotatable _) -> appendParentAnnotation Right
-    (_, _, _) -> summary
-  where
-    appendParentAnnotation constructor = summary
-      { parentAnnotation = parentAnnotation summary <> [ constructor (category (extract term), toTermName source term) ] }
-
-isBranchInfo :: DiffInfo -> Bool
-isBranchInfo info = case info of
-  BranchInfo{} -> True
-  _ -> False
-
--- The user-facing category name of 'a'.
-class HasCategory a where
-  toCategoryName :: a -> Text
-
--- Instances
-
-instance HasCategory Text where
-  toCategoryName = identity
-
-instance HasCategory Category where
-  toCategoryName category = case category of
-    C.Ty -> "type"
-    ArrayLiteral -> "array"
-    BooleanOperator -> "boolean operator"
-    MathOperator -> "math operator"
-    BitwiseOperator -> "bitwise operator"
-    RelationalOperator -> "relational operator"
-    Boolean -> "boolean"
-    DictionaryLiteral -> "dictionary"
-    C.Comment -> "comment"
-    C.ParseError -> "error"
-    ExpressionStatements -> "expression statements"
-    C.Assignment -> "assignment"
-    C.Function -> "function"
-    C.FunctionCall -> "function call"
-    C.MemberAccess -> "member access"
-    C.MethodCall -> "method call"
-    C.Args -> "arguments"
-    C.VarAssignment -> "var assignment"
-    C.VarDecl -> "variable"
-    C.Switch -> "switch statement"
-    C.Case -> "case statement"
-    C.SubscriptAccess -> "subscript access"
-    C.MathAssignment -> "math assignment"
-    C.Ternary -> "ternary expression"
-    C.Operator -> "operator"
-    Identifier -> "identifier"
-    IntegerLiteral -> "integer"
-    NumberLiteral -> "number"
-    FloatLiteral -> "float"
-    Other s -> s
-    C.Pair -> "pair"
-    C.Params -> "params"
-    Program -> "top level"
-    Regex -> "regex"
-    StringLiteral -> "string"
-    SymbolLiteral -> "symbol"
-    TemplateString -> "template string"
-    C.For -> "for statement"
-    C.While -> "while statement"
-    C.DoWhile -> "do/while statement"
-    C.Object -> "object"
-    C.Return -> "return statement"
-    C.Throw -> "throw statement"
-    C.Constructor -> "constructor"
-    C.Catch -> "catch statement"
-    C.Try -> "try statement"
-    C.Finally -> "finally statement"
-    C.Class -> "class"
-    C.Method -> "method"
-    C.If -> "if statement"
-    C.CommaOperator -> "comma operator"
-    C.Empty -> "empty statement"
-    C.Module -> "module"
-    C.Namespace -> "namespace"
-    C.Interface -> "interface"
-    C.Import -> "import statement"
-    C.Export -> "export statement"
-    C.AnonymousFunction -> "anonymous function"
-    C.Interpolation -> "interpolation"
-    C.Subshell -> "subshell command"
-    C.OperatorAssignment -> "operator assignment"
-    C.Yield -> "yield statement"
-    C.Until -> "until statement"
-    C.Unless -> "unless statement"
-    C.Begin -> "begin statement"
-    C.Else -> "else block"
-    C.Elsif -> "elsif block"
-    C.Ensure -> "ensure block"
-    C.Rescue -> "rescue block"
-    C.RescueModifier -> "rescue modifier"
-    C.When -> "when comparison"
-    C.RescuedException -> "last exception"
-    C.RescueArgs -> "arguments"
-    C.Negate -> "negate"
-    C.Select -> "select statement"
-    C.Go -> "go statement"
-    C.Slice -> "slice literal"
-    C.Defer -> "defer statement"
-    C.TypeAssertion -> "type assertion statement"
-    C.TypeConversion -> "type conversion expression"
-    C.ArgumentPair -> "argument"
-    C.KeywordParameter -> "parameter"
-    C.OptionalParameter -> "parameter"
-    C.SplatParameter -> "parameter"
-    C.HashSplatParameter -> "parameter"
-    C.BlockParameter -> "parameter"
-    C.ArrayTy -> "array type"
-    C.DictionaryTy -> "dictionary type"
-    C.StructTy -> "struct type"
-    C.Struct -> "struct"
-    C.Break -> "break statement"
-    C.Continue -> "continue statement"
-    C.Binary -> "binary statement"
-    C.Unary -> "unary statement"
-    C.Constant -> "constant"
-    C.Superclass -> "superclass"
-    C.SingletonClass -> "singleton class"
-    C.SingletonMethod -> "method"
-    C.RangeExpression -> "range"
-    C.ScopeOperator -> "scope operator"
-    C.BeginBlock -> "BEGIN block"
-    C.EndBlock -> "END block"
-    C.ParameterDecl -> "parameter declaration"
-    C.DefaultCase -> "default statement"
-    C.TypeDecl -> "type declaration"
-    C.PointerTy -> "pointer type"
-    C.FieldDecl -> "field declaration"
-    C.SliceTy -> "slice type"
-    C.Element -> "element"
-    C.Literal -> "literal"
-    C.ChannelTy -> "channel type"
-    C.Send -> "send statement"
-    C.IndexExpression -> "index expression"
-    C.FunctionTy -> "function type"
-    C.IncrementStatement -> "increment statement"
-    C.DecrementStatement -> "decrement statement"
-    C.QualifiedIdentifier -> "qualified identifier"
-    C.FieldDeclarations -> "field declarations"
-    C.RuneLiteral -> "rune literal"
-    C.Modifier C.Rescue -> "rescue modifier"
-    C.Modifier c -> toCategoryName c
-
-instance HasField fields Category => HasCategory (SyntaxTerm leaf fields) where
-  toCategoryName = toCategoryName . category . extract
-
-instance Listable Branch where
-  tiers = cons0 BIndexed \/ cons0 BFixed \/ cons0 BCommented \/ cons0 BIf
-
-instance Listable1 DiffSummary where
-  liftTiers termTiers = liftCons2 (liftTiers termTiers) (liftTiers (eitherTiers (liftTiers (mapT unListableText tiers)))) DiffSummary
-    where eitherTiers tiers = liftTiers2 tiers tiers
-
-instance Listable a => Listable (DiffSummary a) where
-  tiers = tiers1
-
-instance P.Pretty DiffInfo where
-  pretty LeafInfo{..} = squotes (string $ toSL termName) <+> string (toSL (toCategoryName leafCategory))
-  pretty BranchInfo{..} = mconcat $ punctuate (string "," P.<> space) (pretty <$> branches)
-  pretty ErrorInfo{..} = squotes (string $ toSL termName) <+> "at" <+> (string . toSL $ displayStartEndPos errorSpan)
-  pretty HideInfo = ""

src/Renderer/TOC.hs

@@ -1,7 +1,8 @@
-{-# LANGUAGE DeriveAnyClass, RankNTypes #-}
+{-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, RankNTypes #-}
 module Renderer.TOC
 ( toc
 , diffTOC
+, Summaries(..)
 , JSONSummary(..)
 , Summarizable(..)
 , isValidSummary
@@ -28,13 +29,25 @@ import Diff
 import Info
 import Patch
 import Prologue
-import Renderer.Summary (Summaries(..))
 import qualified Data.List as List
 import qualified Data.Map as Map hiding (null)
 import Source hiding (null)
 import Syntax as S
 import Term
 
+data Summaries = Summaries { changes, errors :: !(Map Text [Value]) }
+  deriving Show
+
+instance Monoid Summaries where
+  mempty = Summaries mempty mempty
+  mappend (Summaries c1 e1) (Summaries c2 e2) = Summaries (Map.unionWith (<>) c1 c2) (Map.unionWith (<>) e1 e2)
+
+instance StringConv Summaries ByteString where
+  strConv _ = toS . (<> "\n") . encode
+
+instance ToJSON Summaries where
+  toJSON Summaries{..} = object [ "changes" .= changes, "errors" .= errors ]
+
 data JSONSummary = JSONSummary { info :: Summarizable }
                  | ErrorSummary { error :: Text, errorSpan :: SourceSpan }
                  deriving (Generic, Eq, Show)

src/SemanticCmdLine.hs

@@ -76,7 +76,6 @@ arguments gitDir alternates = info (version <*> helper <*> argumentsParser) desc
     diffArgumentsParser = Diff
       <$> ( (  flag patchDiff patchDiff (long "patch" <> help "Output a patch(1)-compatible diff (default)")
            <|> flag' jsonDiff (long "json" <> help "Output a json diff")
-           <|> flag' summaryDiff (long "summary" <> help "Output a diff summary")
            <|> flag' sExpressionDiff (long "sexpression" <> help "Output an s-expression diff tree")
            <|> flag' tocDiff (long "toc" <> help "Output a table of contents diff summary") )
          <*> (  DiffPaths

test/CommandSpec.hs

@@ -55,11 +55,6 @@ spec = parallel $ do
       blobs `shouldBe` [both b b]
 
   describe "fetchDiffs" $ do
-    it "generates diff summaries for two shas" $ do
-      (errors, summaries) <- fetchDiffsOutput summaryText "test/fixtures/git/examples/all-languages.git" "dfac8fd681b0749af137aebf3203e77a06fbafc2" "2e4144eb8c44f007463ec34cb66353f0041161fe" [("methods.rb", Just Ruby)] (const identity) Renderer.SummaryRenderer
-      errors `shouldBe` Just (fromList [])
-      summaries `shouldBe` Just (fromList [("methods.rb", ["Added the 'foo()' method"])])
-
     it "generates toc summaries for two shas" $ do
       (errors, summaries) <- fetchDiffsOutput termText "test/fixtures/git/examples/all-languages.git" "dfac8fd681b0749af137aebf3203e77a06fbafc2" "2e4144eb8c44f007463ec34cb66353f0041161fe" [("methods.rb", Just Ruby)] declarationDecorator Renderer.ToCRenderer
       errors `shouldBe` Just (fromList [])
@@ -71,11 +66,11 @@ spec = parallel $ do
       summaries `shouldBe` Just (fromList [("methods.rb", ["foo"])])
 
     it "errors with bad shas" $
-      fetchDiffsOutput summaryText "test/fixtures/git/examples/all-languages.git" "dead" "beef" [("methods.rb", Just Ruby)] (const identity) Renderer.SummaryRenderer
+      fetchDiffsOutput summaryText "test/fixtures/git/examples/all-languages.git" "dead" "beef" [("methods.rb", Just Ruby)] declarationDecorator Renderer.ToCRenderer
         `shouldThrow` (== Git.BackendError "Could not lookup dead: Object not found - no match for prefix (dead000000000000000000000000000000000000)")
 
     it "errors with bad repo path" $
-      fetchDiffsOutput summaryText "test/fixtures/git/examples/not-a-repo.git" "dfac8fd681b0749af137aebf3203e77a06fbafc2" "2e4144eb8c44f007463ec34cb66353f0041161fe" [("methods.rb", Just Ruby)] (const identity) Renderer.SummaryRenderer
+      fetchDiffsOutput summaryText "test/fixtures/git/examples/not-a-repo.git" "dfac8fd681b0749af137aebf3203e77a06fbafc2" "2e4144eb8c44f007463ec34cb66353f0041161fe" [("methods.rb", Just Ruby)] declarationDecorator Renderer.ToCRenderer
         `shouldThrow` errorCall "Could not open repository \"test/fixtures/git/examples/not-a-repo.git\""
 
   where repoPath = "test/fixtures/git/examples/all-languages.git"

test/SemanticCmdLineSpec.hs

@@ -62,12 +62,10 @@ data DiffFixture = DiffFixture
 instance Listable DiffFixture where
   tiers = cons0 (DiffFixture (patchDiff pathMode "" []) patchOutput)
        \/ cons0 (DiffFixture (jsonDiff pathMode "" []) jsonOutput)
-       \/ cons0 (DiffFixture (summaryDiff pathMode "" []) summaryOutput)
        \/ cons0 (DiffFixture (sExpressionDiff pathMode "" []) sExpressionOutput)
        \/ cons0 (DiffFixture (tocDiff pathMode "" []) tocOutput)
        \/ cons0 (DiffFixture (patchDiff commitMode repo []) patchOutput')
        \/ cons0 (DiffFixture (jsonDiff commitMode repo []) jsonOutput')
-       \/ cons0 (DiffFixture (summaryDiff commitMode repo []) summaryOutput')
        \/ cons0 (DiffFixture (sExpressionDiff commitMode repo []) sExpressionOutput')
        \/ cons0 (DiffFixture (tocDiff commitMode repo []) tocOutput')
 
@@ -77,8 +75,6 @@ instance Listable DiffFixture where
 
       patchOutput = "diff --git a/test/fixtures/ruby/method-declaration.A.rb b/test/fixtures/ruby/method-declaration.B.rb\nindex 0000000000000000000000000000000000000000..0000000000000000000000000000000000000000 100644\n--- a/test/fixtures/ruby/method-declaration.A.rb\n+++ b/test/fixtures/ruby/method-declaration.B.rb\n@@ -1,3 +1,4 @@\n-def foo\n+def bar(a)\n+  baz\n end\n\n"
       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"

test/Spec.hs

@@ -7,7 +7,6 @@ import qualified Data.Mergeable.Spec
 import qualified Data.RandomWalkSimilarity.Spec
 import qualified Data.Syntax.Assignment.Spec
 import qualified DiffSpec
-import qualified SummarySpec
 import qualified GitmonClientSpec
 import qualified InterpreterSpec
 import qualified PatchOutputSpec
@@ -30,7 +29,6 @@ main = hspec $ do
     describe "Data.RandomWalkSimilarity" Data.RandomWalkSimilarity.Spec.spec
     describe "Data.Syntax.Assignment" Data.Syntax.Assignment.Spec.spec
     describe "Diff" DiffSpec.spec
-    describe "Summary" SummarySpec.spec
     describe "Interpreter" InterpreterSpec.spec
     describe "PatchOutput" PatchOutputSpec.spec
     describe "Range" RangeSpec.spec

test/SummarySpec.hs

@@ -1,102 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-module SummarySpec where
-
-import Category
-import Data.Functor.Both
-import Data.Functor.Listable
-import Data.List (partition)
-import RWS
-import Data.Record
-import Data.String
-import Diff
-import Language
-import Renderer.Summary
-import Info
-import Interpreter
-import Patch
-import Prologue
-import Source
-import SpecHelpers
-import Syntax
-import Term
-import Test.Hspec (Spec, describe, it, parallel)
-import Test.Hspec.Expectations.Pretty
-import Test.Hspec.LeanCheck
-import Data.These
-
-sourceSpanBetween :: (Int, Int) -> (Int, Int) -> SourceSpan
-sourceSpanBetween (s1, e1) (s2, e2) = SourceSpan (SourcePos s1 e1) (SourcePos s2 e2)
-
-arrayInfo :: Record '[Category, Range, SourceSpan]
-arrayInfo = ArrayLiteral :. Range 0 3 :. sourceSpanBetween (1, 1) (1, 5) :. Nil
-
-literalInfo :: Record '[Category, Range, SourceSpan]
-literalInfo = StringLiteral :. Range 1 2 :. sourceSpanBetween (1, 2) (1, 4) :. Nil
-
-testDiff :: Diff (Syntax Text) (Record '[Category, Range, SourceSpan])
-testDiff = free $ Free (pure arrayInfo :< Indexed [ free $ Pure (Insert (cofree $ literalInfo :< Leaf "\"a\"")) ])
-
-testSummary :: DiffSummary DiffInfo
-testSummary = DiffSummary { diffSummaryPatch = Insert (LeafInfo StringLiteral "a" $ sourceSpanBetween (1,1) (1, 2)), parentAnnotation = [] }
-
-replacementSummary :: DiffSummary DiffInfo
-replacementSummary = DiffSummary { diffSummaryPatch = Replace (LeafInfo StringLiteral "a" $ sourceSpanBetween (1, 2) (1, 4)) (LeafInfo SymbolLiteral "b" $ sourceSpanBetween (1,1) (1, 2)), parentAnnotation = [Left (Info.FunctionCall, "foo")] }
-
-blobs :: Both SourceBlob
-blobs = both (SourceBlob (fromText "[]") nullOid "a.js" (Just defaultPlainBlob) (Just JavaScript)) (SourceBlob (fromText "[a]") nullOid "b.js" (Just defaultPlainBlob) (Just JavaScript))
-
-spec :: Spec
-spec = parallel $ do
-  describe "diffSummaries" $ do
-    it "outputs a diff summary" $
-      diffSummaries blobs testDiff `shouldBe` [ JSONSummary "Added the \"a\" string" (SourceSpans . That $ sourceSpanBetween (1, 2) (1, 4)) ]
-
-    prop "equal terms produce identity diffs" $
-      \ a -> let term = defaultFeatureVectorDecorator (category . headF) (unListableF a :: SyntaxTerm String '[Category, Range, SourceSpan]) in
-        diffSummaries blobs (diffTerms term term) `shouldBe` []
-
-  describe "DiffInfo" $ do
-    prop "patches in summaries match the patches in diffs" $
-      \a -> let
-        diff = unListableDiff a :: SyntaxDiff String '[Category, Range, SourceSpan]
-        summaries = diffToDiffSummaries (source <$> blobs) diff
-        patches = toList diff
-        in
-          case (partition isBranchNode (diffSummaryPatch <$> summaries), partition isIndexedOrFixed patches) of
-            ((branchPatches, otherPatches), (branchDiffPatches, otherDiffPatches)) ->
-              (() <$ branchPatches, () <$ otherPatches) `shouldBe` (() <$ branchDiffPatches, () <$ otherDiffPatches)
-    prop "generates one LeafInfo for each child in an arbitrary branch patch" $
-      \a -> let
-        diff = unListableDiff a :: SyntaxDiff String '[Category, Range, SourceSpan]
-        diffInfoPatches = diffSummaryPatch <$> diffToDiffSummaries (source <$> blobs) diff
-        syntaxPatches = toList diff
-        extractLeaves :: DiffInfo -> [DiffInfo]
-        extractLeaves (BranchInfo children _ _) = join $ extractLeaves <$> children
-        extractLeaves leaf = [ leaf ]
-
-        extractDiffLeaves :: SyntaxTerm String '[Category, Range, SourceSpan] -> [ SyntaxTerm String '[Category, Range, SourceSpan] ]
-        extractDiffLeaves term = case unwrap term of
-          (Indexed children) -> join $ extractDiffLeaves <$> children
-          (Fixed children) -> join $ extractDiffLeaves <$> children
-          Commented children leaf -> children <> maybeToList leaf >>= extractDiffLeaves
-          _ -> [ term ]
-        in
-          case (partition isBranchNode diffInfoPatches, partition isIndexedOrFixed syntaxPatches) of
-            ((branchPatches, _), (diffPatches, _)) ->
-              let listOfLeaves = foldMap extractLeaves (join $ toList <$> branchPatches)
-                  listOfDiffLeaves = foldMap extractDiffLeaves (diffPatches >>= toList)
-               in
-                Prologue.length listOfLeaves `shouldBe` Prologue.length listOfDiffLeaves
-
-isIndexedOrFixed :: Patch (Term (Syntax a) annotation) -> Bool
-isIndexedOrFixed = any (isIndexedOrFixed' . unwrap)
-
-isIndexedOrFixed' :: Syntax a f -> Bool
-isIndexedOrFixed' syntax = case syntax of
-  (Indexed _) -> True
-  (Fixed _) -> True
-  (Commented _ _) -> True
-  _ -> False
-
-isBranchNode :: Patch DiffInfo -> Bool
-isBranchNode = any isBranchInfo