mirror of
https://github.com/github/semantic.git
synced 2024-11-28 18:23:44 +03:00
81 lines
2.8 KiB
Haskell
81 lines
2.8 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
module TreeSitter.Test.Helpers
|
|
( CorpusExample(..)
|
|
, readCorpusFiles
|
|
, parseCorpusFile
|
|
, testCorpus
|
|
) where
|
|
|
|
import Control.Applicative
|
|
import Control.Monad
|
|
import Data.Attoparsec.ByteString.Char8
|
|
import Data.ByteString (ByteString, readFile)
|
|
import Data.ByteString.Char8 (pack, unpack)
|
|
import Data.Either
|
|
import Data.Functor
|
|
import Prelude hiding (takeWhile)
|
|
import System.Exit (exitFailure)
|
|
import System.Path ((</>))
|
|
import qualified System.Path as Path
|
|
import qualified System.Path.Directory as Path
|
|
import System.FilePath.Glob
|
|
import Test.Tasty
|
|
import Test.Tasty.HUnit
|
|
|
|
testCorpus :: (ByteString -> IO (Either String (t a))) -> Path.RelFile -> IO TestTree
|
|
testCorpus parse path = do
|
|
xs <- parseCorpusFile path
|
|
case xs of
|
|
Left e -> print ("Failed to parse corpus: " <> show (Path.toString path) <> " " <> "Error: " <> show e) *> exitFailure
|
|
Right xs -> testGroup (Path.toString path) <$> traverse corpusTestCase xs
|
|
where
|
|
corpusTestCase (CorpusExample name code) = testCase name . either (errMsg code) pass <$> parse code
|
|
pass = const (pure ())
|
|
errMsg code e = assertFailure (e <> "\n``` \n" <> unpack code <> "```")
|
|
|
|
-- Depending on whether these tests are invoked via cabal run or cabal test,
|
|
-- we might be in a project subdirectory or not, so let's make sure we're
|
|
-- in project subdirectories as needed.
|
|
findCorpus :: Path.RelDir -> IO Path.RelDir
|
|
findCorpus p = do
|
|
cwd <- Path.getCurrentDirectory
|
|
if Path.takeDirName cwd == Just (Path.relDir "haskell-tree-sitter")
|
|
then pure p
|
|
else pure (Path.relDir ".." </> p)
|
|
|
|
-- The path is expected to be relative to the language project.
|
|
readCorpusFiles :: Path.RelDir -> IO [Path.RelFile]
|
|
readCorpusFiles parent = do
|
|
dir <- findCorpus parent
|
|
files <- globDir1 (compile "**/*.txt") (Path.toString dir)
|
|
pure (Path.relPath <$> files)
|
|
|
|
data CorpusExample = CorpusExample { name :: String, code :: ByteString }
|
|
deriving (Eq, Show)
|
|
|
|
parseCorpusFile :: Path.RelFile -> IO (Either String [CorpusExample])
|
|
parseCorpusFile path = do
|
|
c <- Data.ByteString.readFile (Path.toString path)
|
|
pure $ parseOnly corpusParser c
|
|
|
|
corpusParser :: Parser [CorpusExample]
|
|
corpusParser = do
|
|
xs <- many' exampleParser
|
|
void endOfInput
|
|
pure xs
|
|
|
|
exampleParser :: Parser CorpusExample
|
|
exampleParser = do
|
|
name <- exampleNameParser
|
|
code <- manyTill anyChar outputSepParser
|
|
_out <- manyTill anyChar (choice [endOfInput, char '=' $> ()])
|
|
pure (CorpusExample name (pack code))
|
|
where outputSepParser = choice [string "\n---\n", string "\r\n---\r\n"]
|
|
|
|
exampleNameParser :: Parser String
|
|
exampleNameParser = do
|
|
_ <- skipWhile (== '=') *> skipSpace
|
|
name <- takeWhile (/= '\n')
|
|
_ <- skipSpace *> skipWhile (== '=') *> skipSpace
|
|
pure (unpack name)
|