mirror of
https://github.com/github/semantic.git
synced 2024-12-24 23:42:31 +03:00
Refactor to always expect filepaths
This commit is contained in:
parent
52e4dd435a
commit
80ee905afc
@ -9,6 +9,7 @@ import GHC.Show (Show(..))
|
||||
import Data.List (union)
|
||||
import Diffing
|
||||
import Info
|
||||
import qualified Data.Functor.Both as Both
|
||||
import Parse
|
||||
import Prologue hiding (fst, snd)
|
||||
import Renderer
|
||||
@ -25,71 +26,65 @@ spec = parallel $ do
|
||||
it "lists example fixtures" $ do
|
||||
examples "test/corpus/sexpression/ruby/" `shouldNotReturn` []
|
||||
|
||||
describe "should produce the correct diff" $ runTestsIn "test/corpus/sexpression/ruby/" shouldBe
|
||||
describe "should produce the correct ruby diffs" $ runTestsIn "test/corpus/sexpression/ruby/"
|
||||
|
||||
where
|
||||
runTestsIn :: FilePath -> (Maybe Verbatim -> Maybe Verbatim -> Expectation) -> SpecWith ()
|
||||
runTestsIn directory matcher = do
|
||||
paths <- runIO $ examples directory
|
||||
let tests = correctTests =<< paths
|
||||
traverse_ (\ (formatName, renderer, paths, output) ->
|
||||
it (maybe "/dev/null" normalizeName (uncurry (<|>) (runJoin paths)) ++ " (" ++ formatName ++ ")") $ testDiff renderer paths output matcher) tests
|
||||
runTestsIn :: FilePath -> SpecWith ()
|
||||
runTestsIn directory = do
|
||||
examples <- runIO $ examples directory
|
||||
let tests = testsForPaths =<< examples
|
||||
traverse_ (\ (formatName, renderer, files, output) ->
|
||||
it (normalizeName (Both.fst files) ++ " (" ++ formatName ++ ")") $ testDiff renderer files output) tests
|
||||
|
||||
correctTests paths@(_, _, Nothing) = testsForPaths paths
|
||||
correctTests paths = filter (\(_, _, _, output) -> isJust output) $ testsForPaths paths
|
||||
testsForPaths (aPath, bPath, sexpression) = [ ("sexpression", Renderer.sExpression TreeOnly, paths, sexpression) ]
|
||||
where paths = both aPath bPath
|
||||
where paths = both aPath bPath
|
||||
|
||||
data Example = DiffExample { fileA :: FilePath, fileB :: FilePath, diffOutput :: FilePath }
|
||||
| ParseExample { file :: FilePath, parseOutput :: FilePath }
|
||||
|
||||
-- | Return all the examples from the given directory. Examples are expected to
|
||||
-- | have the form "foo.A.js", "foo.B.js", "foo.sexpression.js". Diffs are not
|
||||
-- | required as the test may be verifying that the inputs don't crash.
|
||||
-- | have the form "foo.A.js", "foo.B.js", "foo.sexpression.js".
|
||||
-- |
|
||||
-- | file.A.rb
|
||||
-- | file.B.rb
|
||||
-- | file.A.sexpression.rb
|
||||
-- | file.B.sexpression.rb
|
||||
-- | file.sexpression.rb
|
||||
examples :: FilePath -> IO [(Maybe FilePath, Maybe FilePath, Maybe FilePath)]
|
||||
-- |
|
||||
-- | file.sexpression.txt
|
||||
-- |
|
||||
-- | file.sexpressionA.txt
|
||||
-- | file.sexpressionB.txt
|
||||
|
||||
examples :: FilePath -> IO [(FilePath, FilePath, FilePath)]
|
||||
examples directory = do
|
||||
as <- globFor "*.A.*"
|
||||
bs <- globFor "*.B.*"
|
||||
sexpressions <- globFor "*.sexpression.*"
|
||||
sexpressions <- globFor "*[^AB].sexpression.*"
|
||||
|
||||
let lookupName name = (lookupNormalized name as, lookupNormalized name bs, lookupNormalized name sexpressions)
|
||||
|
||||
let keys = (normalizeName <$> as) `union` (normalizeName <$> bs)
|
||||
pure $ lookupName <$> keys
|
||||
where
|
||||
lookupNormalized name = find $ (== name) . normalizeName
|
||||
lookupNormalized :: FilePath -> [FilePath] -> FilePath
|
||||
lookupNormalized name xs = fromMaybe
|
||||
(panic ("cannot find " <> T.pack name <> " make sure .A, .B and .sexpression.txt exist." :: Text))
|
||||
(find ((== name) . normalizeName) xs)
|
||||
globFor :: FilePath -> IO [FilePath]
|
||||
globFor p = globDir1 (compile p) directory
|
||||
|
||||
-- | Given a test name like "foo.A.js", return "foo.js".
|
||||
-- | Given a test name like "foo.A.js", return "foo".
|
||||
normalizeName :: FilePath -> FilePath
|
||||
normalizeName path = dropExtension $ dropExtension path
|
||||
|
||||
-- | 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 (Record '[Cost, Range, Category, SourceSpan]) -> Both (Maybe FilePath) -> Maybe FilePath -> (Maybe Verbatim -> Maybe Verbatim -> Expectation) -> Expectation
|
||||
testDiff renderer paths diff matcher = do
|
||||
sources <- traverse (traverse readAndTranscodeFile) paths
|
||||
actual <- fmap (Verbatim . stripWhitespace) <$> traverse ((pure . concatOutputs . pure) <=< diffFiles' sources) parser
|
||||
case diff of
|
||||
Nothing -> matcher actual actual
|
||||
Just file -> do
|
||||
expected <- (Verbatim . stripWhitespace) <$> readFile file
|
||||
matcher actual (Just expected)
|
||||
testDiff :: Renderer (Record '[Cost, Range, Category, SourceSpan]) -> Both FilePath -> FilePath -> Expectation
|
||||
testDiff renderer paths diff = do
|
||||
sources <- sequence $ readAndTranscodeFile <$> paths
|
||||
diff' <- diffFiles parser renderer (sourceBlobs sources)
|
||||
let actual = (Verbatim . stripWhitespace. concatOutputs . pure) diff'
|
||||
expected <- (Verbatim . stripWhitespace) <$> readFile diff
|
||||
actual `shouldBe` expected
|
||||
where
|
||||
diffFiles' sources parser = diffFiles parser renderer (sourceBlobs sources paths)
|
||||
parser = parserWithCost <$> runBothWith (<|>) paths
|
||||
|
||||
sourceBlobs :: Both (Maybe Source) -> Both (Maybe FilePath) -> Both SourceBlob
|
||||
sourceBlobs sources paths = case runJoin paths of
|
||||
(Nothing, Nothing) -> Join (emptySourceBlob "", emptySourceBlob "")
|
||||
(Nothing, Just filepath) -> Join (emptySourceBlob "", sourceBlob (unsafeFromJust $ snd sources) filepath)
|
||||
(Just filepath, Nothing) -> Join (sourceBlob (unsafeFromJust $ fst sources) filepath, emptySourceBlob "")
|
||||
(Just path1, Just path2) -> Join (sourceBlob (unsafeFromJust $ fst sources) path1, sourceBlob (unsafeFromJust $ snd sources) path2)
|
||||
parser = parserWithCost (fst paths)
|
||||
sourceBlobs sources = Source.SourceBlob <$> sources <*> pure mempty <*> paths <*> pure (Just Source.defaultPlainBlob)
|
||||
|
||||
stripWhitespace :: Text -> Text
|
||||
stripWhitespace = T.foldl' go T.empty
|
||||
|
Loading…
Reference in New Issue
Block a user