1
1
mirror of https://github.com/github/semantic.git synced 2024-12-25 16:02:43 +03:00

Specialize Renderer to Text

This commit is contained in:
joshvera 2016-04-04 17:20:26 -04:00
parent 3b752b834c
commit a553709112
6 changed files with 20 additions and 23 deletions

View File

@ -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

View File

@ -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 }

View File

@ -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

View File

@ -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)

View File

@ -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") <>)

View File

@ -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 diff sources = T.unpack $ P.patch diff sources
testSplit :: Renderer a String
testSplit diff sources = T.unpack $ Split.split diff sources
testJSON :: Renderer a String
testJSON diff sources = T.unpack $ J.json diff sources
testPatch :: Renderer a
testPatch diff sources = P.patch diff sources
testSplit :: Renderer a
testSplit diff sources = Split.split diff sources
testJSON :: Renderer a
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) <*>
sources <*>
pure mempty <*>
paths <*>
pure (Just S.defaultPlainBlob)
sourceBlobs sources = Both (S.SourceBlob, S.SourceBlob) <*> sources <*> pure mempty <*> paths <*> pure (Just S.defaultPlainBlob)