diff --git a/test/CorpusSpec.hs b/test/CorpusSpec.hs index 67aaabd7e..92de8005d 100644 --- a/test/CorpusSpec.hs +++ b/test/CorpusSpec.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DataKinds, FlexibleContexts, GeneralizedNewtypeDeriving #-} module CorpusSpec where -import Data.String +import Unsafe (unsafeFromJust) import Diffing import Renderer import qualified Renderer.JSON as J @@ -11,14 +11,11 @@ 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 Data.List (union) import qualified Data.Text as T import Info -import Prologue hiding (fst, snd) -import Range +import Prologue hiding (fst, snd, lookup) import qualified Source as S import System.FilePath import System.FilePath.Glob @@ -37,32 +34,36 @@ spec = parallel $ do examples "test/diffs/" `shouldNotReturn` [] where - runTestsIn :: FilePath -> (Verbatim -> Verbatim -> Expectation) -> SpecWith () + 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 (normalizeName (fst paths) ++ " (" ++ formatName ++ ")") $ testDiff renderer paths output matcher) tests - - correctTests paths@(_, Nothing, Nothing, Nothing) = testsForPaths paths - correctTests paths = List.filter (\(_, _, _, output) -> isJust output) $ testsForPaths paths - testsForPaths (paths, json, patch, split) = [ ("json", J.json, paths, json), ("patch", P.patch, paths, patch), ("split", Split.split, paths, split) ] + traverse_ (\ (formatName, renderer, paths, output) -> + it (maybe "/dev/null" normalizeName (fst paths) ++ " (" ++ formatName ++ ")") $ testDiff renderer paths output matcher) tests + correctTests paths@(_, _, Nothing, Nothing, Nothing) = testsForPaths paths + correctTests paths = filter (\(_, _, _, output) -> isJust output) $ testsForPaths paths + testsForPaths (aPath, bPath, json, patch, split) = [ ("json", J.json, paths, json), ("patch", P.patch, paths, patch), ("split", Split.split, paths, split) ] + where paths = both aPath bPath -- | Return all the examples from the given directory. Examples are expected to -- | have the form "foo.A.js", "foo.B.js", "foo.patch.js". Diffs are not -- | required as the test may be verifying that the inputs don't crash. -examples :: FilePath -> IO [(Both FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath)] +examples :: FilePath -> IO [(Maybe FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath, Maybe FilePath)] examples directory = do - as <- toDict <$> globFor "*.A.*" - bs <- toDict <$> globFor "*.B.*" - jsons <- toDict <$> globFor "*.json.*" - patches <- toDict <$> globFor "*.patch.*" - splits <- toDict <$> globFor "*.split.*" - let keys = Set.unions $ keysSet <$> [as, bs] - pure $ (\name -> (both (as ! name) (bs ! name), Map.lookup name jsons, Map.lookup name patches, Map.lookup name splits)) <$> sort (Set.toList keys) + as <- globFor "*.A.*" + bs <- globFor "*.B.*" + jsons <- globFor "*.json.*" + patches <- globFor "*.patch.*" + splits <- globFor "*.split.*" + + let lookupName name = (lookupNormalized name as, lookupNormalized name bs, lookupNormalized name jsons, lookupNormalized name patches, lookupNormalized name splits) + + let keys = normalizeName <$> union as bs + pure $ lookupName <$> keys where + lookupNormalized name = find $ (== name) . normalizeName globFor :: FilePath -> IO [FilePath] globFor p = globDir1 (compile p) directory - toDict list = Map.fromList ((normalizeName <$> list) `zip` list) -- | Given a test name like "foo.A.js", return "foo.js". normalizeName :: FilePath -> FilePath @@ -71,17 +72,23 @@ 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 (Record '[Range, Category, Cost]) -> Both FilePath -> Maybe FilePath -> (Verbatim -> Verbatim -> Expectation) -> Expectation +testDiff :: Renderer (Record '[Range, Category, Cost]) -> Both (Maybe FilePath) -> Maybe FilePath -> (Maybe Verbatim -> Maybe Verbatim -> Expectation) -> Expectation testDiff renderer paths diff matcher = do - sources <- sequence $ readAndTranscodeFile <$> paths - actual <- Verbatim <$> diffFiles parser renderer (sourceBlobs sources) + sources <- traverse (traverse readAndTranscodeFile) paths + actual <- fmap Verbatim <$> traverse (diffFiles' sources) parser case diff of Nothing -> matcher actual actual Just file -> do expected <- Verbatim <$> readFile file - matcher actual expected - where parser = parserForFilepath (fst paths) - sourceBlobs sources = pure S.SourceBlob <*> sources <*> pure mempty <*> paths <*> pure (Just S.defaultPlainBlob) + matcher actual (Just expected) + where diffFiles' sources parser = diffFiles parser renderer (sourceBlobs sources paths) + parser = parserForFilepath <$> runBothWith (<|>) paths + sourceBlobs :: Both (Maybe (S.Source Char)) -> Both (Maybe FilePath) -> Both S.SourceBlob + sourceBlobs sources paths = case runJoin paths of + (Nothing, Nothing) -> Join (S.emptySourceBlob "", S.emptySourceBlob "") + (Nothing, Just filepath) -> Join (S.emptySourceBlob "", S.sourceBlob (unsafeFromJust $ snd sources) filepath) + (Just filepath, Nothing) -> Join (S.sourceBlob (unsafeFromJust $ fst sources) filepath, S.emptySourceBlob "") + (Just path1, Just path2) -> Join (S.sourceBlob (unsafeFromJust $ fst sources) path1, S.sourceBlob (unsafeFromJust $ snd sources) path2) -- | A wrapper around `Text` with a more readable `Show` instance. newtype Verbatim = Verbatim Text