Merge remote-tracking branch 'origin/master' into ruby-assignment

src/Arguments.hs

@@ -18,20 +18,6 @@ data DiffArguments where
 
 deriving instance Show DiffArguments
 
-type DiffArguments' = DiffMode -> DiffArguments
-
-patchDiff :: DiffArguments'
-patchDiff = DiffArguments PatchDiffRenderer
-
-jsonDiff :: DiffArguments'
-jsonDiff = DiffArguments JSONDiffRenderer
-
-sExpressionDiff :: DiffArguments'
-sExpressionDiff = DiffArguments SExpressionDiffRenderer
-
-tocDiff :: DiffArguments'
-tocDiff = DiffArguments ToCDiffRenderer
-
 
 data ParseMode = ParseStdin | ParsePaths [(FilePath, Maybe Language)]
   deriving Show
@@ -44,13 +30,6 @@ data ParseArguments where
 
 deriving instance Show ParseArguments
 
-type ParseArguments' = ParseMode -> ParseArguments
-
-sExpressionParseTree :: ParseArguments'
-sExpressionParseTree = ParseArguments SExpressionTermRenderer
-
-jsonParseTree :: ParseArguments'
-jsonParseTree = ParseArguments JSONTermRenderer
 
 data ProgramMode = Parse ParseArguments | Diff DiffArguments
   deriving Show

src/Data/Align/Generic.hs

@@ -10,38 +10,30 @@ import Prologue
 
 -- | Functors which can be aligned (structure-unioning-ly zipped). The default implementation will operate generically over the constructors in the aligning type.
 class GAlign f where
-  galign :: f a -> f b -> Maybe (f (These a b))
-  galign = galignWith identity
-
   -- | Perform generic alignment of values of some functor, applying the given function to alignments of elements.
   galignWith :: (These a b -> c) -> f a -> f b -> Maybe (f c)
   default galignWith :: (Generic1 f, GAlign (Rep1 f)) => (These a b -> c) -> f a -> f b -> Maybe (f c)
   galignWith f a b = to1 <$> galignWith f (from1 a) (from1 b)
 
+galign :: GAlign f => f a -> f b -> Maybe (f (These a b))
+galign = galignWith identity
 
 -- 'Data.Align.Align' instances
 
 instance GAlign [] where
-  galign = galignAlign
   galignWith = galignWithAlign
 instance GAlign Maybe where
-  galign = galignAlign
   galignWith = galignWithAlign
 instance GAlign Identity where
   galignWith f (Identity a) (Identity b) = Just (Identity (f (These a b)))
 
 instance (GAlign f, GAlign (Union fs)) => GAlign (Union (f ': fs)) where
-  galign u1 u2 = case (decompose u1, decompose u2) of
-    (Left u1', Left u2') -> weaken <$> galign u1' u2'
-    (Right r1, Right r2) -> inj <$> galign r1 r2
-    _ -> Nothing
   galignWith f u1 u2 = case (decompose u1, decompose u2) of
     (Left u1', Left u2') -> weaken <$> galignWith f u1' u2'
     (Right r1, Right r2) -> inj <$> galignWith f r1 r2
     _ -> Nothing
 
 instance GAlign (Union '[]) where
-  galign _ _ = Nothing
   galignWith _ _ _ = Nothing
 
 -- | Implements a function suitable for use as the definition of 'galign' for 'Align'able functors.

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

@@ -17,9 +17,9 @@ class GShow1 f where
   -- | showsPrec function for an application of the type constructor based on showsPrec and showList functions for the argument type.
   gliftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
 
-  -- | showList function for an application of the type constructor based on showsPrec and showList functions for the argument type. The default implementation using standard list syntax is correct for most types.
+-- | showList function for an application of the type constructor based on showsPrec and showList functions for the argument type. The default implementation using standard list syntax is correct for most types.
-  gliftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
+gliftShowList :: GShow1 f => (Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
-  gliftShowList sp sl = showListWith (gliftShowsPrec sp sl 0)
+gliftShowList sp sl = showListWith (gliftShowsPrec sp sl 0)
 
 -- | A suitable implementation of Show1’s liftShowsPrec for Generic1 types.
 genericLiftShowsPrec :: (Generic1 f, GShow1 (Rep1 f)) => (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS

src/Data/Syntax/Assignment.hs

@@ -75,8 +75,8 @@ module Data.Syntax.Assignment
 , Result(..)
 , Error(..)
 , ErrorCause(..)
-, showError
+, printError
-, showExpectation
+, withSGRCode
 -- Running
 , assign
 , assignBy
@@ -94,7 +94,6 @@ import qualified Data.IntMap.Lazy as IntMap
 import Data.Ix (inRange)
 import Data.List.NonEmpty (nonEmpty)
 import Data.Record
-import Data.String
 import GHC.Stack
 import qualified Info
 import Prologue hiding (Alt, get, Location, state)
@@ -103,6 +102,7 @@ import qualified Source (Source(..), drop, slice, sourceText, actualLines)
 import System.Console.ANSI
 import Text.Parser.TreeSitter.Language
 import Text.Show hiding (show)
+import System.IO (hIsTerminalDevice, hPutStr)
 
 -- | Assignment from an AST with some set of 'symbol's onto some other value.
 --
@@ -181,18 +181,28 @@ data ErrorCause grammar
   deriving (Eq, Show)
 
 -- | Pretty-print an Error with reference to the source where it occurred.
-showError :: Show grammar => Source.Source -> Error grammar -> String
+printError :: Show grammar => Source.Source -> Error grammar -> IO ()
-showError source error@Error{..}
+printError source error@Error{..}
-  = withSGRCode [SetConsoleIntensity BoldIntensity] (showSourcePos Nothing errorPos) . showString ": " . withSGRCode [SetColor Foreground Vivid Red] (showString "error") . showString ": " . showExpectation error . showChar '\n'
+  =  do
-  . showString (toS context) . (if isSuffixOf "\n" context then identity else showChar '\n')
+    withSGRCode [SetConsoleIntensity BoldIntensity] . putStrErr . (showSourcePos Nothing errorPos) . showString ": " $ ""
-  . showString (replicate (succ (Info.column errorPos + lineNumberDigits)) ' ') . withSGRCode [SetColor Foreground Vivid Green] (showChar '^') . showChar '\n'
+    withSGRCode [SetColor Foreground Vivid Red] . putStrErr . (showString "error") . showString ": " . showExpectation error . showChar '\n' . showString (toS context) . (if isSuffixOf "\n" context then identity else showChar '\n') . showString (replicate (succ (Info.column errorPos + lineNumberDigits)) ' ') $ ""
-  . showString (prettyCallStack callStack)
+    withSGRCode [SetColor Foreground Vivid Green] . putStrErr . (showChar '^') . showChar '\n' . showString (prettyCallStack callStack) $ ""
-  $ ""
+
   where context = maybe "\n" (Source.sourceText . sconcat) (nonEmpty [ Source.Source (toS (showLineNumber i)) <> Source.Source ": " <> l | (i, l) <- zip [1..] (Source.actualLines source), inRange (Info.line errorPos - 2, Info.line errorPos) i ])
         showLineNumber n = let s = show n in replicate (lineNumberDigits - length s) ' ' <> s
         lineNumberDigits = succ (floor (logBase 10 (fromIntegral (Info.line errorPos) :: Double)))
-        showSGRCode = showString . setSGRCode
+        putStrErr = hPutStr stderr
-        withSGRCode code s = showSGRCode code . s . showSGRCode []
+
+withSGRCode :: [SGR] -> IO a -> IO ()
+withSGRCode code action = do
+  isTerm <- hIsTerminalDevice stderr
+  if isTerm then do
+    _ <- hSetSGR stderr code
+    _ <- action
+    hSetSGR stderr []
+  else do
+    _ <- action
+    pure ()
 
 showExpectation :: Show grammar => Error grammar -> ShowS
 showExpectation Error{..} = case errorCause of

src/Parser.hs

@@ -26,6 +26,7 @@ import qualified Language.Ruby.Syntax as Ruby
 import Prologue hiding (Location)
 import Source
 import Syntax hiding (Go)
+import System.IO (hPutStrLn)
 import System.Console.ANSI
 import Term
 import qualified Text.Parser.TreeSitter as TS
@@ -81,20 +82,18 @@ runParser parser = case parser of
   AssignmentParser parser by assignment -> \ source -> do
     ast <- runParser parser source
     let Result err term = assignBy by assignment source ast
-    traverse_ (putStrLn . showError source) (toList err)
+    traverse_ (printError source) (toList err)
     case term of
       Just term -> do
         let errors = termErrors term `asTypeOf` toList err
-        traverse_ (putStrLn . showError source) errors
+        traverse_ (printError source) errors
-        unless (Prologue.null errors) $
+        unless (Prologue.null errors) $ do
-          putStrLn (withSGRCode [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Red] (shows (Prologue.length errors) . showChar ' ' . showString (if Prologue.length errors == 1 then "error" else "errors")) $ "")
+          withSGRCode [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Red] . hPutStrLn stderr . (shows (Prologue.length errors) . showChar ' ' . showString (if Prologue.length errors == 1 then "error" else "errors")) $ ""
         pure term
       Nothing -> pure (errorTerm source err)
   TreeSitterParser language tslanguage -> treeSitterParser language tslanguage
   MarkdownParser -> pure . cmarkParser
   LineByLineParser -> lineByLineParser
-  where showSGRCode = showString . setSGRCode
-        withSGRCode code s = showSGRCode code . s . showSGRCode []
 
 errorTerm :: Syntax.Error (Error grammar) :< fs => Source -> Maybe (Error grammar) -> Term (Union fs) (Record Location)
 errorTerm source err = cofree ((totalRange source :. totalSpan source :. Nil) :< inj (Syntax.Error (fromMaybe (Error (SourcePos 0 0) (UnexpectedEndOfInput [])) err)))

src/Renderer.hs

@@ -7,7 +7,8 @@ module Renderer
 , renderSExpressionTerm
 , renderJSONDiff
 , renderJSONTerm
-, renderToC
+, renderToCDiff
+, renderToCTerm
 , declarationAlgebra
 , markupSectionAlgebra
 , syntaxDeclarationAlgebra
@@ -47,6 +48,8 @@ deriving instance Show (DiffRenderer output)
 
 -- | Specification of renderers for terms, producing output in the parameter type.
 data TermRenderer output where
+  -- | Compute a table of contents for the term & encode it as JSON.
+  ToCTermRenderer :: TermRenderer Summaries
   -- | Render to JSON with the format documented in docs/json-format.md under “Term.”
   JSONTermRenderer :: TermRenderer [Value]
   -- | Render to a 'ByteString' formatted as nested s-expressions.

src/Renderer/TOC.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, RankNTypes, TypeOperators #-}
 module Renderer.TOC
-( renderToC
+( renderToCDiff
+, renderToCTerm
 , diffTOC
 , Summaries(..)
 , JSONSummary(..)
@@ -21,6 +22,7 @@ import Data.Align (crosswalk)
 import Data.Functor.Both hiding (fst, snd)
 import qualified Data.Functor.Both as Both
 import Data.Functor.Listable
+import Data.List.NonEmpty (nonEmpty)
 import Data.Proxy
 import Data.Record
 import Data.Text (toLower)
@@ -114,12 +116,12 @@ declarationAlgebra proxy source r
   where getSource = toText . flip Source.slice source . byteRange . extract
 
 -- | Compute 'Declaration's with the headings of 'Markup.Section's.
-markupSectionAlgebra :: (Markup.Section :< fs, Syntax.Error error :< fs, HasField fields Range, Show error, Functor (Union fs))
+markupSectionAlgebra :: (Markup.Section :< fs, Syntax.Error error :< fs, HasField fields Range, Show error, Functor (Union fs), Foldable (Union fs))
                      => Proxy error
                      -> Source
                      -> RAlgebra (TermF (Union fs) (Record fields)) (Term (Union fs) (Record fields)) (Maybe Declaration)
 markupSectionAlgebra proxy source r
-  | Just (Markup.Section (heading, _) _) <- prj (tailF r) = Just $ SectionDeclaration (getSource heading)
+  | Just (Markup.Section (heading, _) _) <- prj (tailF r) = Just $ SectionDeclaration (maybe (getSource heading) (toText . flip Source.slice source . sconcat) (nonEmpty (byteRange . extract <$> toList (unwrap heading))))
   | Just (Syntax.Error err) <- prj (tailF r) = Just $ ErrorDeclaration (show (err `asProxyTypeOf` proxy))
   | otherwise = Nothing
   where getSource = toText . flip Source.slice source . byteRange . extract
@@ -140,15 +142,21 @@ tableOfContentsBy :: Traversable f
                   => (forall b. TermF f annotation b -> Maybe a) -- ^ A function mapping relevant nodes onto values in Maybe.
                   -> Diff f annotation                           -- ^ The diff to compute the table of contents for.
                   -> [Entry a]                                   -- ^ A list of entries for relevant changed and unchanged nodes in the diff.
-tableOfContentsBy selector = fromMaybe [] . iter diffAlgebra . fmap (Just . fmap patchEntry . crosswalk (cata termAlgebra))
+tableOfContentsBy selector = fromMaybe [] . iter diffAlgebra . fmap (Just . fmap patchEntry . crosswalk (termTableOfContentsBy selector))
   where diffAlgebra r = case (selector (first Both.snd r), fold r) of
           (Just a, Nothing) -> Just [Unchanged a]
           (Just a, Just []) -> Just [Changed a]
           (_     , entries) -> entries
-        termAlgebra r | Just a <- selector r = [a]
-                      | otherwise = fold r
         patchEntry = these Deleted Inserted (const Replaced) . unPatch
 
+termTableOfContentsBy :: Traversable f
+                      => (forall b. TermF f annotation b -> Maybe a)
+                      -> Term f annotation
+                      -> [a]
+termTableOfContentsBy selector = cata termAlgebra
+  where termAlgebra r | Just a <- selector r = [a]
+                      | otherwise = fold r
+
 dedupe :: HasField fields (Maybe Declaration) => [Entry (Record fields)] -> [Entry (Record fields)]
 dedupe = foldl' go []
   where go xs x | (_, _:_) <- find (exactMatch `on` entryPayload) x xs = xs
@@ -170,13 +178,16 @@ entrySummary entry = case entry of
   Deleted a   -> recordSummary a "removed"
   Inserted a  -> recordSummary a "added"
   Replaced a  -> recordSummary a "modified"
-  where recordSummary record = case getDeclaration record of
-          Just (ErrorDeclaration text) -> Just . const (ErrorSummary text (sourceSpan record))
-          Just declaration -> Just . JSONSummary (toCategoryName declaration) (declarationIdentifier declaration) (sourceSpan record)
-          Nothing -> const Nothing
 
-renderToC :: (HasField fields (Maybe Declaration), HasField fields SourceSpan, Traversable f) => Both SourceBlob -> Diff f (Record fields) -> Summaries
+-- | Construct a 'JSONSummary' from a node annotation and a change type label.
-renderToC blobs = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . diffTOC
+recordSummary :: (HasField fields (Maybe Declaration), HasField fields SourceSpan) => Record fields -> Text -> Maybe JSONSummary
+recordSummary record = case getDeclaration record of
+  Just (ErrorDeclaration text) -> Just . const (ErrorSummary text (sourceSpan record))
+  Just declaration -> Just . JSONSummary (toCategoryName declaration) (declarationIdentifier declaration) (sourceSpan record)
+  Nothing -> const Nothing
+
+renderToCDiff :: (HasField fields (Maybe Declaration), HasField fields SourceSpan, Traversable f) => Both SourceBlob -> Diff f (Record fields) -> Summaries
+renderToCDiff blobs = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . diffTOC
   where toMap [] = mempty
         toMap as = Map.singleton summaryKey (toJSON <$> as)
         summaryKey = toS $ case runJoin (path <$> blobs) of
@@ -185,9 +196,17 @@ renderToC blobs = uncurry Summaries . bimap toMap toMap . List.partition isValid
                           | before == after -> after
                           | otherwise -> before <> " -> " <> after
 
+renderToCTerm :: (HasField fields (Maybe Declaration), HasField fields SourceSpan, Traversable f) => SourceBlob -> Term f (Record fields) -> Summaries
+renderToCTerm blob = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . termToC
+  where toMap [] = mempty
+        toMap as = Map.singleton (toS (path blob)) (toJSON <$> as)
+
 diffTOC :: (HasField fields (Maybe Declaration), HasField fields SourceSpan, Traversable f) => Diff f (Record fields) -> [JSONSummary]
 diffTOC = mapMaybe entrySummary . dedupe . tableOfContentsBy declaration
 
+termToC :: (HasField fields (Maybe Declaration), HasField fields SourceSpan, Traversable f) => Term f (Record fields) -> [JSONSummary]
+termToC = mapMaybe (flip recordSummary "unchanged") . termTableOfContentsBy declaration
+
 -- The user-facing category name
 toCategoryName :: Declaration -> Text
 toCategoryName declaration = case declaration of

src/Semantic.hs

@@ -45,6 +45,9 @@ parseBlobs renderer = fmap toS . distributeFoldMap (parseBlob renderer) . filter
 -- | A task to parse a 'SourceBlob' and render the resulting 'Term'.
 parseBlob :: TermRenderer output -> SourceBlob -> Task output
 parseBlob renderer blob@SourceBlob{..} = case (renderer, blobLanguage) of
+  (ToCTermRenderer, Just Language.Markdown) -> parse markdownParser source >>= decorate (markupSectionAlgebra (Proxy :: Proxy Markdown.Error) source) >>= render (renderToCTerm blob)
+  (ToCTermRenderer, Just Language.Python) -> parse pythonParser source >>= decorate (declarationAlgebra (Proxy :: Proxy Python.Error) source) . hoistCofree (weaken :: Union fs a -> Union (Declaration.Method ': fs) a) >>= render (renderToCTerm blob)
+  (ToCTermRenderer, _) -> parse syntaxParser source >>= decorate (syntaxDeclarationAlgebra source) >>= render (renderToCTerm blob)
   (JSONTermRenderer, Just Language.Markdown) -> parse markdownParser source >>= render (renderJSONTerm blob)
   (JSONTermRenderer, Just Language.Python) -> parse pythonParser source >>= render (renderJSONTerm blob)
   (JSONTermRenderer, _) -> parse syntaxParser source >>= decorate identifierAlgebra >>= render (renderJSONTerm blob)
@@ -64,9 +67,9 @@ diffBlobPairs renderer = fmap toS . distributeFoldMap (diffBlobPair renderer) .
 -- | A task to parse a pair of 'SourceBlob's, diff them, and render the 'Diff'.
 diffBlobPair :: DiffRenderer output -> Both SourceBlob -> Task output
 diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of
-  (ToCDiffRenderer, Just Language.Markdown) -> run (\ source -> parse markdownParser source >>= decorate (markupSectionAlgebra (Proxy :: Proxy Markdown.Error) source)) diffLinearly (renderToC blobs)
+  (ToCDiffRenderer, Just Language.Markdown) -> run (\ source -> parse markdownParser source >>= decorate (markupSectionAlgebra (Proxy :: Proxy Markdown.Error) source)) diffLinearly (renderToCDiff blobs)
-  (ToCDiffRenderer, Just Language.Python) -> run (\ source -> parse pythonParser source >>= decorate (declarationAlgebra (Proxy :: Proxy Python.Error) source) . hoistCofree (weaken :: Union fs a -> Union (Declaration.Method ': fs) a)) diffLinearly (renderToC blobs)
+  (ToCDiffRenderer, Just Language.Python) -> run (\ source -> parse pythonParser source >>= decorate (declarationAlgebra (Proxy :: Proxy Python.Error) source) . hoistCofree (weaken :: Union fs a -> Union (Declaration.Method ': fs) a)) diffLinearly (renderToCDiff blobs)
-  (ToCDiffRenderer, _) -> run (\ source -> parse syntaxParser source >>= decorate (syntaxDeclarationAlgebra source)) diffTerms (renderToC blobs)
+  (ToCDiffRenderer, _) -> run (\ source -> parse syntaxParser source >>= decorate (syntaxDeclarationAlgebra source)) diffTerms (renderToCDiff blobs)
   (JSONDiffRenderer, Just Language.Markdown) -> run (parse markdownParser) diffLinearly (renderJSONDiff blobs)
   (JSONDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffLinearly (renderJSONDiff blobs)
   (JSONDiffRenderer, _) -> run (decorate identifierAlgebra <=< parse syntaxParser) diffTerms (renderJSONDiff blobs)

src/SemanticCmdLine.hs

@@ -10,6 +10,7 @@ import Data.Version (showVersion)
 import Development.GitRev
 import Options.Applicative hiding (action)
 import Prologue hiding (concurrently, fst, snd, readFile)
+import Renderer
 import qualified Data.ByteString as B
 import qualified Paths_semantic_diff as Library (version)
 import qualified Semantic.Task as Task
@@ -61,10 +62,10 @@ arguments = info (version <*> helper <*> argumentsParser) description
 
     diffCommand = command "diff" (info diffArgumentsParser (progDesc "Show changes between commits or paths"))
     diffArgumentsParser = Diff
-      <$> ( (  flag patchDiff patchDiff (long "patch" <> help "Output a patch(1)-compatible diff (default)")
+      <$> ( (  flag (DiffArguments PatchDiffRenderer) (DiffArguments PatchDiffRenderer) (long "patch" <> help "Output a patch(1)-compatible diff (default)")
-           <|> flag' jsonDiff (long "json" <> help "Output a json diff")
+           <|> flag' (DiffArguments JSONDiffRenderer) (long "json" <> help "Output a json diff")
-           <|> flag' sExpressionDiff (long "sexpression" <> help "Output an s-expression diff tree")
+           <|> flag' (DiffArguments SExpressionDiffRenderer) (long "sexpression" <> help "Output an s-expression diff tree")
-           <|> flag' tocDiff (long "toc" <> help "Output a table of contents for a diff") )
+           <|> flag' (DiffArguments ToCDiffRenderer) (long "toc" <> help "Output a table of contents for a diff") )
          <*> (  DiffPaths
                <$> argument filePathReader (metavar "FILE_A")
                <*> argument filePathReader (metavar "FILE_B")
@@ -72,8 +73,9 @@ arguments = info (version <*> helper <*> argumentsParser) description
 
     parseCommand = command "parse" (info parseArgumentsParser (progDesc "Print parse trees for path(s)"))
     parseArgumentsParser = Parse
-      <$> ( (  flag sExpressionParseTree sExpressionParseTree (long "sexpression" <> help "Output s-expression parse trees (default)")
+      <$> ( (  flag (ParseArguments SExpressionTermRenderer) (ParseArguments SExpressionTermRenderer) (long "sexpression" <> help "Output s-expression parse trees (default)")
-           <|> flag' jsonParseTree (long "json" <> help "Output JSON parse trees") )
+           <|> flag' (ParseArguments JSONTermRenderer) (long "json" <> help "Output JSON parse trees")
+           <|> flag' (ParseArguments ToCTermRenderer) (long "toc" <> help "Output a table of contents for a file"))
          <*> (  ParsePaths
                <$> some (argument filePathReader (metavar "FILES..."))
             <|> pure ParseStdin ))

test/SemanticCmdLineSpec.hs

@@ -4,20 +4,22 @@ module SemanticCmdLineSpec where
 import Prologue
 import Arguments
 import Language
+import Renderer
 import SemanticCmdLine
-import Data.Functor.Listable
 import Test.Hspec hiding (shouldBe, shouldNotBe, shouldThrow, errorCall)
 import Test.Hspec.Expectations.Pretty
-import Test.Hspec.LeanCheck
 
 spec :: Spec
 spec = parallel $ do
-  prop "runDiff for all modes and formats" $
+  describe "runDiff" $
-    \ DiffFixture{..} -> do
+    for_ diffFixtures $ \ (arguments@DiffArguments{..}, expected) ->
+      it ("renders to " <> show diffRenderer <> " in mode " <> show diffMode) $ do
         output <- runDiff arguments
         output `shouldBe'` expected
-  prop "runParse for all modes and formats" $
+
-    \ ParseFixture{..} -> do
+  describe "runParse" $
+    for_ parseFixtures $ \ (arguments@ParseArguments{..}, expected) ->
+      it ("renders to " <> show parseTreeRenderer <> " in mode " <> show parseMode) $ do
         output <- runParse arguments
         output `shouldBe'` expected
   where
@@ -25,27 +27,23 @@ spec = parallel $ do
       when (actual /= expected) $ print actual
       actual `shouldBe` expected
 
+parseFixtures :: [(ParseArguments, ByteString)]
+parseFixtures =
+  [ (ParseArguments SExpressionTermRenderer pathMode, sExpressionParseTreeOutput)
+  , (ParseArguments JSONTermRenderer pathMode, jsonParseTreeOutput)
+  , (ParseArguments JSONTermRenderer pathMode', jsonParseTreeOutput')
+  , (ParseArguments JSONTermRenderer (ParsePaths []), emptyJsonParseTreeOutput)
+  , (ParseArguments JSONTermRenderer (ParsePaths [("not-a-file.rb", Just Ruby)]), emptyJsonParseTreeOutput)
+  , (ParseArguments ToCTermRenderer (ParsePaths [("test/fixtures/ruby/method-declaration.A.rb", Just Ruby)]), tocOutput)
+  ]
+  where pathMode = ParsePaths [("test/fixtures/ruby/and-or.A.rb", Just Ruby)]
+        pathMode' = ParsePaths [("test/fixtures/ruby/and-or.A.rb", Just Ruby), ("test/fixtures/ruby/and-or.B.rb", Just Ruby)]
 
-data ParseFixture = ParseFixture
+        sExpressionParseTreeOutput = "(Program\n  (Binary\n    (Identifier)\n    (Other \"and\")\n    (Identifier)))\n"
-  { arguments :: ParseArguments
+        jsonParseTreeOutput = "[{\"filePath\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"and\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}},\"language\":\"Ruby\"}]\n"
-  , expected :: ByteString
+        jsonParseTreeOutput' = "[{\"filePath\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"and\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}},\"language\":\"Ruby\"},{\"filePath\":\"test/fixtures/ruby/and-or.B.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"or\",\"children\":[],\"sourceRange\":[4,6],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,7]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]}}],\"sourceRange\":[0,10],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,11]}},{\"category\":\"Binary\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]}},{\"category\":\"or\",\"children\":[],\"sourceRange\":[13,15],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,5]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]}}],\"sourceRange\":[11,17],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,7]}},{\"category\":\"and\",\"children\":[],\"sourceRange\":[18,21],\"sourceSpan\":{\"start\":[2,8],\"end\":[2,11]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]}}],\"sourceRange\":[11,23],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,13]}}],\"sourceRange\":[0,24],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"language\":\"Ruby\"}]\n"
-  } deriving (Show)
+        emptyJsonParseTreeOutput = "[]\n"
-
+        tocOutput = "{\"changes\":{\"test/fixtures/ruby/method-declaration.A.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"term\":\"foo\",\"changeType\":\"unchanged\"}]},\"errors\":{}}\n"
-instance Listable ParseFixture where
-  tiers = cons0 (ParseFixture (sExpressionParseTree pathMode) sExpressionParseTreeOutput)
-       \/ cons0 (ParseFixture (jsonParseTree pathMode) jsonParseTreeOutput)
-       \/ cons0 (ParseFixture (jsonParseTree pathMode') jsonParseTreeOutput')
-       \/ cons0 (ParseFixture (jsonParseTree (ParsePaths [])) emptyJsonParseTreeOutput)
-       \/ cons0 (ParseFixture (jsonParseTree (ParsePaths [("not-a-file.rb", Just Ruby)])) emptyJsonParseTreeOutput)
-
-    where
-      pathMode = ParsePaths [("test/fixtures/ruby/and-or.A.rb", Just Ruby)]
-      pathMode' = ParsePaths [("test/fixtures/ruby/and-or.A.rb", Just Ruby), ("test/fixtures/ruby/and-or.B.rb", Just Ruby)]
-
-      sExpressionParseTreeOutput = "(Program\n  (Binary\n    (Identifier)\n    (Other \"and\")\n    (Identifier)))\n"
-      jsonParseTreeOutput = "[{\"filePath\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"and\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}},\"language\":\"Ruby\"}]\n"
-      jsonParseTreeOutput' = "[{\"filePath\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"and\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}},\"language\":\"Ruby\"},{\"filePath\":\"test/fixtures/ruby/and-or.B.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"or\",\"children\":[],\"sourceRange\":[4,6],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,7]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]}}],\"sourceRange\":[0,10],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,11]}},{\"category\":\"Binary\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]}},{\"category\":\"or\",\"children\":[],\"sourceRange\":[13,15],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,5]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]}}],\"sourceRange\":[11,17],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,7]}},{\"category\":\"and\",\"children\":[],\"sourceRange\":[18,21],\"sourceSpan\":{\"start\":[2,8],\"end\":[2,11]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]}}],\"sourceRange\":[11,23],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,13]}}],\"sourceRange\":[0,24],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"language\":\"Ruby\"}]\n"
-      emptyJsonParseTreeOutput = "[]\n"
 
 
 data DiffFixture = DiffFixture
@@ -53,20 +51,20 @@ data DiffFixture = DiffFixture
   , expected :: ByteString
   } deriving (Show)
 
-instance Listable DiffFixture where
+diffFixtures :: [(DiffArguments, ByteString)]
-  tiers = cons0 (DiffFixture (patchDiff pathMode) patchOutput)
+diffFixtures =
-       \/ cons0 (DiffFixture (jsonDiff pathMode) jsonOutput)
+  [ (DiffArguments PatchDiffRenderer pathMode, patchOutput)
-       \/ cons0 (DiffFixture (sExpressionDiff pathMode) sExpressionOutput)
+  , (DiffArguments JSONDiffRenderer pathMode, jsonOutput)
-       \/ cons0 (DiffFixture (tocDiff pathMode) tocOutput)
+  , (DiffArguments SExpressionDiffRenderer pathMode, sExpressionOutput)
+  , (DiffArguments ToCDiffRenderer pathMode, tocOutput)
+  ]
+  where pathMode = DiffPaths ("test/fixtures/ruby/method-declaration.A.rb", Just Ruby) ("test/fixtures/ruby/method-declaration.B.rb", Just Ruby)
 
-    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"
-      pathMode = DiffPaths ("test/fixtures/ruby/method-declaration.A.rb", Just Ruby) ("test/fixtures/ruby/method-declaration.B.rb", Just Ruby)
 
-      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"
+        jsonOutput = "{\"diff\":{\"after\":{\"category\":\"Program\",\"sourceRange\":[0,21],\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}},\"children\":[{\"after\":{\"category\":\"Method\",\"identifier\":\"bar\",\"sourceRange\":[0,20],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}},\"children\":[{\"replace\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"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,13],\"sourceSpan\":{\"start\":[1,8],\"end\":[2,3]}}},{\"insert\":{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}],\"before\":{\"category\":\"Method\",\"identifier\":\"foo\",\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}}],\"before\":{\"category\":\"Program\",\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}}},\"oids\":[\"0000000000000000000000000000000000000000\",\"0000000000000000000000000000000000000000\"],\"paths\":[\"test/fixtures/ruby/method-declaration.A.rb\",\"test/fixtures/ruby/method-declaration.B.rb\"]}\n"
-
+        sExpressionOutput = "(Program\n  (Method\n  { (Identifier)\n  ->(Identifier) }\n  {+(Params\n      (Identifier))+}\n  {+(Identifier)+}))\n"
-      jsonOutput = "{\"diff\":{\"after\":{\"category\":\"Program\",\"sourceRange\":[0,21],\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}},\"children\":[{\"after\":{\"category\":\"Method\",\"identifier\":\"bar\",\"sourceRange\":[0,20],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}},\"children\":[{\"replace\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"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,13],\"sourceSpan\":{\"start\":[1,8],\"end\":[2,3]}}},{\"insert\":{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}],\"before\":{\"category\":\"Method\",\"identifier\":\"foo\",\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}}],\"before\":{\"category\":\"Program\",\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}}},\"oids\":[\"0000000000000000000000000000000000000000\",\"0000000000000000000000000000000000000000\"],\"paths\":[\"test/fixtures/ruby/method-declaration.A.rb\",\"test/fixtures/ruby/method-declaration.B.rb\"]}\n"
+        tocOutput = "{\"changes\":{\"test/fixtures/ruby/method-declaration.A.rb -> test/fixtures/ruby/method-declaration.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[3,4]},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"modified\"}]},\"errors\":{}}\n"
-      sExpressionOutput = "(Program\n  (Method\n  { (Identifier)\n  ->(Identifier) }\n  {+(Params\n      (Identifier))+}\n  {+(Identifier)+}))\n"
-      tocOutput = "{\"changes\":{\"test/fixtures/ruby/method-declaration.A.rb -> test/fixtures/ruby/method-declaration.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[3,4]},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"modified\"}]},\"errors\":{}}\n"
 
 repo :: FilePath
 repo = "test/fixtures/git/examples/all-languages.git"