Renderer takes an annotation type parameter.

src/Diffing.hs

@@ -81,7 +81,7 @@ readAndTranscodeFile path = do
 -- | result.
 -- | Returns the rendered result strictly, so it's always fully evaluated
 -- | with respect to other IO actions.
-diffFiles :: (HasField fields Category, HasField fields Cost, HasField fields Range, HasField fields Size, Eq (Record fields)) => Parser fields -> Renderer -> Both SourceBlob -> IO T.Text
+diffFiles :: (HasField fields Category, HasField fields Cost, HasField fields Range, HasField fields Size, Eq (Record fields)) => Parser fields -> Renderer (Record fields) -> Both SourceBlob -> IO T.Text
 diffFiles parser renderer sourceBlobs = do
   let sources = source <$> sourceBlobs
   terms <- sequence $ parser <$> sources
@@ -94,8 +94,7 @@ diffFiles parser renderer sourceBlobs = do
         (_, _) -> runBothWith (diffTerms construct shouldCompareTerms diffCostWithCachedTermCosts) $ replaceLeaves <*> terms
 
   pure $! renderer textDiff sourceBlobs
-  where construct :: CofreeF (Syntax Text) (Both Info) (Diff Text Info) -> Diff Text Info
-        construct (info :< syntax) = free (Free ((setCost <$> info <*> sumCost syntax) :< syntax))
+  where construct (info :< syntax) = free (Free ((setCost <$> info <*> sumCost syntax) :< syntax))
         sumCost = fmap getSum . foldMap (fmap Sum . getCost)
         getCost diff = case runFree diff of
           Free (info :< _) -> cost <$> info

src/Renderer.hs

@@ -7,7 +7,7 @@ import Info
 import Source
 
 -- | A function that will render a diff, given the two source files.
-type Renderer = Diff Text Info -> Both SourceBlob -> Text
+type Renderer annotation = Diff Text annotation -> Both SourceBlob -> Text
 
 data DiffArguments = DiffArguments { format :: Format, output :: Maybe FilePath, outputPath :: FilePath }
  deriving (Show)

src/Renderer/JSON.hs

@@ -23,7 +23,7 @@ import Syntax
 import Term
 
 -- | Render a diff to a string representing its JSON.
-json :: Renderer
+json :: (HasField fields Category, HasField fields Range) => Renderer (Record fields)
 json diff sources = toS . toLazyByteString . fromEncoding . pairs $ "rows" .= annotateRows (alignDiff (source <$> sources) diff) <> "oids" .= (oid <$> sources) <> "paths" .= (path <$> sources)
   where annotateRows = fmap (fmap NumberedLine) . numberedRows
 

src/Renderer/Patch.hs

@@ -27,7 +27,7 @@ truncatePatch :: DiffArguments -> Both SourceBlob -> Text
 truncatePatch _ blobs = pack $ header blobs <> "#timed_out\nTruncating diff: timeout reached.\n"
 
 -- | Render a diff in the traditional patch format.
-patch :: Renderer
+patch :: HasField fields Range => Renderer (Record fields)
 patch diff blobs = pack $ case getLast (foldMap (Last . Just) string) of
   Just c | c /= '\n' -> string <> "\n\\ No newline at end of file\n"
   _ -> string

src/Renderer/Split.hs

@@ -57,7 +57,7 @@ splitPatchToClassName patch = stringValue $ "patch " ++ case patch of
   SplitReplace _ -> "replace"
 
 -- | Render a diff as an HTML split diff.
-split :: Renderer
+split :: (HasField fields Category, HasField fields Range, HasField fields Size) => Renderer (Record fields)
 split diff blobs = TL.toStrict . renderHtml
   . docTypeHtml
     . ((head $ link ! A.rel "stylesheet" ! A.href "style.css") <>)

src/Renderer/Summary.hs

@@ -1,11 +1,14 @@
 module Renderer.Summary where
 
+import Category
 import Prologue
 import Renderer
-import DiffSummary
 import Data.Aeson
 import Data.ByteString.Builder
+import Data.Record
 import Data.Text (pack)
+import DiffSummary
+import Range
 
-summary :: Renderer
+summary :: (HasField fields Category, HasField fields Range) => Renderer (Record fields)
 summary diff _ = toS . toLazyByteString . fromEncoding . foldable $ pack . show <$> diffSummary diff

test/CorpusSpec.hs

@@ -1,21 +1,24 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DataKinds, FlexibleContexts, GeneralizedNewtypeDeriving #-}
 module CorpusSpec where
 
 import System.IO
-import Data.String
 import Diffing
 import Renderer
 import qualified Renderer.JSON as J
 import qualified Renderer.Patch as P
 import qualified Renderer.Split as Split
 
+import Category
 import Control.DeepSeq
 import Data.Functor.Both
 import Data.List as List
 import Data.Map as Map
+import Data.Record
 import Data.Set as Set
 import qualified Data.Text as T
+import Info
 import Prologue hiding (fst, snd)
+import Range
 import qualified Source as S
 import System.FilePath
 import System.FilePath.Glob
@@ -39,10 +42,8 @@ spec = parallel $ do
       let tests = correctTests =<< paths
       traverse_ (\ (formatName, renderer, paths, output) -> it (normalizeName (fst paths) ++ " (" ++ formatName ++ ")") $ testDiff renderer paths output matcher) tests
 
-    correctTests :: (Both FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath) -> [(String, Renderer, Both FilePath, Maybe FilePath)]
     correctTests paths@(_, Nothing, Nothing, Nothing) = testsForPaths paths
     correctTests paths = List.filter (\(_, _, _, output) -> isJust output) $ testsForPaths paths
-    testsForPaths :: (Both FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath) -> [(String, Renderer, Both FilePath, Maybe FilePath)]
     testsForPaths (paths, json, patch, split) = [ ("json", J.json, paths, json), ("patch", P.patch, paths, patch), ("split", Split.split, paths, split) ]
 
 -- | Return all the examples from the given directory. Examples are expected to
@@ -69,7 +70,7 @@ normalizeName path = addExtension (dropExtension $ dropExtension path) (takeExte
 -- | Given file paths for A, B, and, optionally, a diff, return whether diffing
 -- | the files will produce the diff. If no diff is provided, then the result
 -- | is true, but the diff will still be calculated.
-testDiff :: Renderer -> Both FilePath -> Maybe FilePath -> (Verbatim -> Verbatim -> Expectation) -> Expectation
+testDiff :: Renderer (Record '[Range, Category, Size, Cost]) -> Both FilePath -> Maybe FilePath -> (Verbatim -> Verbatim -> Expectation) -> Expectation
 testDiff renderer paths diff matcher = do
   sources <- sequence $ readAndTranscodeFile <$> paths
   actual <- Verbatim <$> diffFiles parser renderer (sourceBlobs sources)