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:
parent
3b752b834c
commit
a553709112
@ -72,7 +72,7 @@ readAndTranscodeFile path = do
|
|||||||
-- | result.
|
-- | result.
|
||||||
-- | Returns the rendered result strictly, so it's always fully evaluated
|
-- | Returns the rendered result strictly, so it's always fully evaluated
|
||||||
-- | with respect to other IO actions.
|
-- | 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
|
diffFiles parser renderer sourceBlobs = do
|
||||||
let sources = source <$> sourceBlobs
|
let sources = source <$> sourceBlobs
|
||||||
terms <- sequence $ parser <$> sources
|
terms <- sequence $ parser <$> sources
|
||||||
|
@ -4,9 +4,10 @@ import Data.Functor.Both
|
|||||||
import Diff
|
import Diff
|
||||||
import Info
|
import Info
|
||||||
import Source
|
import Source
|
||||||
|
import Data.Text
|
||||||
|
|
||||||
-- | A function that will render a diff, given the two source files.
|
-- | 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 }
|
data DiffArguments = DiffArguments { format :: Format, output :: Maybe FilePath, outputPath :: FilePath }
|
||||||
|
|
||||||
|
@ -28,7 +28,7 @@ import Syntax
|
|||||||
import Term
|
import Term
|
||||||
|
|
||||||
-- | Render a diff to a string representing its JSON.
|
-- | 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)]
|
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
|
where annotateRows = fmap (fmap NumberedLine) . numberedRows
|
||||||
|
|
||||||
|
@ -28,7 +28,7 @@ truncatePatch :: DiffArguments -> Both SourceBlob -> Text
|
|||||||
truncatePatch arguments blobs = pack $ header blobs ++ "#timed_out\nTruncating diff: timeout reached.\n"
|
truncatePatch arguments blobs = pack $ header blobs ++ "#timed_out\nTruncating diff: timeout reached.\n"
|
||||||
|
|
||||||
-- | Render a diff in the traditional patch format.
|
-- | 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
|
patch diff blobs = pack $ case getLast (foldMap (Last . Just) string) of
|
||||||
Just c | c /= '\n' -> string ++ "\n\\ No newline at end of file\n"
|
Just c | c /= '\n' -> string ++ "\n\\ No newline at end of file\n"
|
||||||
_ -> string
|
_ -> string
|
||||||
@ -118,7 +118,7 @@ emptyHunk :: Hunk (SplitDiff a Info)
|
|||||||
emptyHunk = Hunk { offset = mempty, changes = [], trailingContext = [] }
|
emptyHunk = Hunk { offset = mempty, changes = [], trailingContext = [] }
|
||||||
|
|
||||||
-- | Render a diff as a series of hunks.
|
-- | 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
|
hunks _ blobs | sources <- source <$> blobs
|
||||||
, sourcesEqual <- runBothWith (==) sources
|
, sourcesEqual <- runBothWith (==) sources
|
||||||
, sourcesNull <- runBothWith (&&) (null <$> sources)
|
, sourcesNull <- runBothWith (&&) (null <$> sources)
|
||||||
|
@ -53,7 +53,7 @@ splitPatchToClassName patch = stringValue $ "patch " ++ case patch of
|
|||||||
SplitReplace _ -> "replace"
|
SplitReplace _ -> "replace"
|
||||||
|
|
||||||
-- | Render a diff as an HTML split diff.
|
-- | Render a diff as an HTML split diff.
|
||||||
split :: Renderer leaf T.Text
|
split :: Renderer leaf
|
||||||
split diff blobs = TL.toStrict . renderHtml
|
split diff blobs = TL.toStrict . renderHtml
|
||||||
. docTypeHtml
|
. docTypeHtml
|
||||||
. ((head $ link ! A.rel "stylesheet" ! A.href "style.css") <>)
|
. ((head $ link ! A.rel "stylesheet" ! A.href "style.css") <>)
|
||||||
|
@ -34,23 +34,23 @@ spec = parallel $ do
|
|||||||
examples "test/diffs/" `shouldNotReturn` []
|
examples "test/diffs/" `shouldNotReturn` []
|
||||||
|
|
||||||
where
|
where
|
||||||
runTestsIn :: String -> (String -> String -> Expectation) -> SpecWith ()
|
runTestsIn :: String -> (T.Text -> T.Text -> Expectation) -> SpecWith ()
|
||||||
runTestsIn directory matcher = do
|
runTestsIn directory matcher = do
|
||||||
paths <- runIO $ examples directory
|
paths <- runIO $ examples directory
|
||||||
let tests = correctTests =<< paths
|
let tests = correctTests =<< paths
|
||||||
mapM_ (\ (formatName, renderer, paths, output) -> it (normalizeName (fst paths) ++ " (" ++ formatName ++ ")") $ testDiff renderer paths output matcher) tests
|
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@(_, Nothing, Nothing, Nothing) = testsForPaths paths
|
||||||
correctTests paths = List.filter (\(_, _, _, output) -> isJust output) $ 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) ]
|
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
|
-- | 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
|
-- | 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
|
-- | the files will produce the diff. If no diff is provided, then the result
|
||||||
-- | is true, but the diff will still be calculated.
|
-- | 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
|
testDiff renderer paths diff matcher = do
|
||||||
sources <- sequence $ readAndTranscodeFile <$> paths
|
sources <- sequence $ readAndTranscodeFile <$> paths
|
||||||
actual <- diffFiles parser renderer sourceBlobs
|
actual <- diffFiles parser renderer (sourceBlobs sources)
|
||||||
case diff of
|
case diff of
|
||||||
Nothing -> matcher actual actual
|
Nothing -> matcher actual actual
|
||||||
Just file -> do
|
Just file -> do
|
||||||
expected <- readFile file
|
expected <- T.pack <$> readFile file
|
||||||
matcher actual expected
|
matcher actual expected
|
||||||
where parser = parserForFilepath (fst paths)
|
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)
|
|
||||||
|
Loading…
Reference in New Issue
Block a user