Specialize Renderer to Text

src/Diffing.hs

@@ -72,7 +72,7 @@ readAndTranscodeFile path = do
 -- | result.
 -- | Returns the rendered result strictly, so it's always fully evaluated
 -- | with respect to other IO actions.
-diffFiles :: Parser -> Renderer T.Text b -> Both SourceBlob -> IO b
+diffFiles :: Parser -> Renderer T.Text -> Both SourceBlob -> IO T.Text
 diffFiles parser renderer sourceBlobs = do
   let sources = source <$> sourceBlobs
   terms <- sequence $ parser <$> sources

src/Renderer.hs

@@ -4,9 +4,10 @@ import Data.Functor.Both
 import Diff
 import Info
 import Source
+import Data.Text
 
 -- | A function that will render a diff, given the two source files.
-type Renderer a b = Diff a Info -> Both SourceBlob -> b
+type Renderer a = Diff a Info -> Both SourceBlob -> Text
 
 data DiffArguments = DiffArguments { format :: Format, output :: Maybe FilePath, outputPath :: FilePath }
 

src/Renderer/JSON.hs

@@ -28,7 +28,7 @@ import Syntax
 import Term
 
 -- | Render a diff to a string representing its JSON.
-json :: Renderer a Text
+json :: Renderer a
 json diff sources = toStrict . toLazyText . encodeToTextBuilder $ object ["rows" .= annotateRows (splitDiffByLines (source <$> sources) diff), "oids" .= (oid <$> sources), "paths" .= (path <$> sources)]
   where annotateRows = fmap (fmap NumberedLine) . numberedRows
 

src/Renderer/Patch.hs

@@ -28,7 +28,7 @@ truncatePatch :: DiffArguments -> Both SourceBlob -> Text
 truncatePatch arguments blobs = pack $ header blobs ++ "#timed_out\nTruncating diff: timeout reached.\n"
 
 -- | Render a diff in the traditional patch format.
-patch :: Renderer a Text
+patch :: Renderer a
 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
@@ -118,7 +118,7 @@ emptyHunk :: Hunk (SplitDiff a Info)
 emptyHunk = Hunk { offset = mempty, changes = [], trailingContext = [] }
 
 -- | Render a diff as a series of hunks.
-hunks :: Renderer a [Hunk (SplitDiff a Info)]
+hunks :: Diff a Info -> Both SourceBlob -> [Hunk (SplitDiff a Info)]
 hunks _ blobs | sources <- source <$> blobs
               , sourcesEqual <- runBothWith (==) sources
               , sourcesNull <- runBothWith (&&) (null <$> sources)

src/Renderer/Split.hs

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

test/CorpusSpec.hs

@@ -34,23 +34,23 @@ spec = parallel $ do
     examples "test/diffs/" `shouldNotReturn` []
 
   where
-    runTestsIn :: String -> (String -> String -> Expectation) -> SpecWith ()
+    runTestsIn :: String -> (T.Text -> T.Text -> Expectation) -> SpecWith ()
     runTestsIn directory matcher = do
       paths <- runIO $ examples directory
       let tests = correctTests =<< paths
       mapM_ (\ (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 a String, Both FilePath, Maybe FilePath)]
+    correctTests :: (Both FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath) -> [(String, Renderer a, 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 a String, Both FilePath, Maybe FilePath)]
+    testsForPaths :: (Both FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath) -> [(String, Renderer a, Both FilePath, Maybe FilePath)]
     testsForPaths (paths, json, patch, split) = [ ("json", testJSON, paths, json), ("patch", testPatch, paths, patch), ("split", testSplit, paths, split) ]
-    testPatch :: Renderer a String
+    testPatch :: Renderer a
-    testPatch diff sources = T.unpack $ P.patch diff sources
+    testPatch diff sources = P.patch diff sources
-    testSplit :: Renderer a String
+    testSplit :: Renderer a
-    testSplit diff sources = T.unpack $ Split.split diff sources
+    testSplit diff sources = Split.split diff sources
-    testJSON :: Renderer a String
+    testJSON :: Renderer a
-    testJSON diff sources = T.unpack $ J.json diff sources
+    testJSON diff sources = J.json diff sources
 
 
 -- | Return all the examples from the given directory. Examples are expected to
@@ -77,18 +77,14 @@ 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 T.Text String -> Both FilePath -> Maybe FilePath -> (String -> String -> Expectation) -> Expectation
+testDiff :: Renderer T.Text -> Both FilePath -> Maybe FilePath -> (T.Text -> T.Text -> Expectation) -> Expectation
 testDiff renderer paths diff matcher = do
   sources <- sequence $ readAndTranscodeFile <$> paths
-  actual <- diffFiles parser renderer sourceBlobs
+  actual <- diffFiles parser renderer (sourceBlobs sources)
   case diff of
     Nothing -> matcher actual actual
     Just file -> do
-      expected <- readFile file
+      expected <- T.pack <$> readFile file
       matcher actual expected
   where parser = parserForFilepath (fst paths)
-        sourceBlobs = Both (S.SourceBlob, S.SourceBlob) <*>
+        sourceBlobs sources = Both (S.SourceBlob, S.SourceBlob) <*> sources <*> pure mempty <*> paths <*> pure (Just S.defaultPlainBlob)
-          sources <*>
-          pure mempty <*>
-          paths <*>
-          pure (Just S.defaultPlainBlob)