1
1
mirror of https://github.com/github/semantic.git synced 2024-12-24 23:42:31 +03:00

IntegrationSpec no longer uses runCommand

This commit is contained in:
Timothy Clem 2017-04-19 13:25:46 -07:00
parent 18e81adb14
commit c3f4ee6a36
2 changed files with 68 additions and 21 deletions

View File

@ -2,7 +2,6 @@
module IntegrationSpec where
import Command
import Command.Parse
import Data.Functor.Both
import Data.List (union, concat, transpose)
import Data.Record
@ -110,23 +109,14 @@ normalizeName path = dropExtension $ dropExtension path
testParse :: FilePath -> FilePath -> Expectation
testParse path expectedOutput = do
source <- readFileToUnicode path
let blob = sourceBlob source path
term <- parserForFilePath path blob
let actual = (Verbatim . stripWhitespace) $ printTerm term 0 TreeOnly
expected <- (Verbatim . stripWhitespace) <$> B.readFile expectedOutput
actual <- verbatim <$> parseFile path
expected <- verbatim <$> B.readFile expectedOutput
actual `shouldBe` expected
testDiff :: (Both SourceBlob -> Diff (Syntax Text) (Record DefaultFields) -> ByteString) -> Both FilePath -> FilePath -> Expectation
testDiff renderer paths expectedOutput = do
(blobs, diff') <- runCommand $ do
blobs <- traverse readFile paths
terms <- traverse (traverse parseBlob) blobs
Just diff' <- maybeDiff terms
return (fromMaybe . emptySourceBlob <$> paths <*> blobs, diff')
let diffOutput = renderer blobs diff'
let actual = Verbatim (stripWhitespace diffOutput)
expected <- Verbatim . stripWhitespace <$> B.readFile expectedOutput
actual <- verbatim <$> diffPaths paths
expected <- verbatim <$> B.readFile expectedOutput
actual `shouldBe` expected
stripWhitespace :: ByteString -> ByteString
@ -140,3 +130,6 @@ newtype Verbatim = Verbatim ByteString
instance Show Verbatim where
showsPrec _ (Verbatim byteString) = ('\n':) . (T.unpack (decodeUtf8 byteString) ++)
verbatim :: ByteString -> Verbatim
verbatim = Verbatim . stripWhitespace

View File

@ -1,21 +1,75 @@
module SpecHelpers where
{-# LANGUAGE DataKinds, GADTs, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
module SpecHelpers
( diffPaths
, parseFile
, readFileToUnicode
, parserForFilePath
) where
import Data.Functor.Both
import Data.Record
import Info
import Language
import Parser
import Parser.Language hiding (parserForFilePath)
import Prologue
import qualified Data.ByteString as B
import qualified Data.Text.ICU.Convert as Convert
import qualified Data.Text.ICU.Detect as Detect
import Renderer.SExpression
import Source
import Info
import Data.Record
import Syntax
import Language
import Parser
import Parser.Language
import Interpreter
import Data.RandomWalkSimilarity
import Term
import Diff
import System.FilePath
import Patch
-- TODO: Write helper functions for parse file and diff files that don't depend on Command.
-- | Read a file and convert it to Unicode.
-- testDiff :: Both SourceBlob -> IO (Diff (Syntax Text) (Record DefaultFields))
-- | Returns an s-expression formatted diff for the specified FilePath pair.
diffPaths :: Both FilePath -> IO ByteString
diffPaths paths = do
blobs <- traverse readFileToSourceBlob paths
terms' <- traverse (traverse parseBlob) blobs
let diff = runDiff terms'
pure $ renderer (fromMaybe . emptySourceBlob <$> paths <*> blobs) diff
where
renderer = sExpression TreeOnly
runDiff :: HasField fields Category => Both (Maybe (Term (Syntax Text) (Record fields))) -> Diff (Syntax Text) (Record fields)
runDiff terms = case runJoin terms of
(Just left, Nothing) -> pure $ Delete left
(Nothing, Just right) -> pure $ Insert right
(Just left, Just right) -> stripDiff (runBothWith diffTerms (fmap decorate (both left right)))
_ -> error "nothing to diff"
where
decorate = defaultFeatureVectorDecorator getLabel
getLabel :: HasField fields Category => TermF (Syntax Text) (Record fields) a -> (Category, Maybe Text)
getLabel (h :< t) = (Info.category h, case t of
Leaf s -> Just s
_ -> Nothing)
-- | Returns an s-expression parse tree for the specified FilePath.
parseFile :: FilePath -> IO ByteString
parseFile path = do
source <- readFileToUnicode path
term <- parseBlob $ sourceBlob source path
pure $ printTerm term 0 TreeOnly
parseBlob :: SourceBlob -> IO (Term (Syntax Text) (Record DefaultFields))
parseBlob blob@SourceBlob{..} = parserForFilePath path blob
-- | Read a file to a SourceBlob
readFileToSourceBlob :: FilePath -> IO (Maybe SourceBlob)
readFileToSourceBlob path = do
source <- (Just <$> readFileToUnicode path) `catch` (const (pure Nothing) :: IOException -> IO (Maybe Source))
pure $ flip sourceBlob path <$> source
-- | Read a file, convert it's contents unicode and return it wrapped in Source.
readFileToUnicode :: FilePath -> IO Source
readFileToUnicode path = B.readFile path >>= transcode
where