1
1
mirror of https://github.com/github/semantic.git synced 2024-12-21 13:51:44 +03:00

Parameterize parseToAST with the tree-sitter language.

This commit is contained in:
Rob Rix 2017-05-19 13:06:00 -04:00
parent 9e5282e73d
commit 2224df586d
2 changed files with 8 additions and 7 deletions

View File

@ -14,6 +14,7 @@ import Prologue hiding (Location)
import Source import Source
import Syntax hiding (Go) import Syntax hiding (Go)
import Term import Term
import qualified Text.Parser.TreeSitter as TS
import Text.Parser.TreeSitter.Language (Symbol) import Text.Parser.TreeSitter.Language (Symbol)
import Text.Parser.TreeSitter.C import Text.Parser.TreeSitter.C
import Text.Parser.TreeSitter.Go import Text.Parser.TreeSitter.Go
@ -22,7 +23,7 @@ import Text.Parser.TreeSitter.TypeScript
import TreeSitter import TreeSitter
data Parser term where data Parser term where
ALaCarteParser :: (InUnion fs (Syntax.Error [Error grammar]), Bounded grammar, Enum grammar, Eq grammar, Symbol grammar) => Assignment (Node grammar) (Term (Union fs) Location) -> Parser (Term (Union fs) Location) ALaCarteParser :: (InUnion fs (Syntax.Error [Error grammar]), Bounded grammar, Enum grammar, Eq grammar, Symbol grammar) => Ptr TS.Language -> Assignment (Node grammar) (Term (Union fs) Location) -> Parser (Term (Union fs) Location)
CParser :: Parser (SyntaxTerm Text DefaultFields) CParser :: Parser (SyntaxTerm Text DefaultFields)
GoParser :: Parser (SyntaxTerm Text DefaultFields) GoParser :: Parser (SyntaxTerm Text DefaultFields)
MarkdownParser :: Parser (SyntaxTerm Text DefaultFields) MarkdownParser :: Parser (SyntaxTerm Text DefaultFields)
@ -42,8 +43,8 @@ parserForLanguage (Just language) = case language of
runParser :: Parser term -> Source -> IO term runParser :: Parser term -> Source -> IO term
runParser parser = case parser of runParser parser = case parser of
ALaCarteParser assignment -> \ source -> do ALaCarteParser language assignment -> \ source -> do
ast <- parseToAST source ast <- parseToAST language source
let Result errors term = assign assignment source ast let Result errors term = assign assignment source ast
pure (fromMaybe (cofree ((totalRange source :. totalSpan source :. Nil) :< inj (Syntax.Error errors))) term) pure (fromMaybe (cofree ((totalRange source :. totalSpan source :. Nil) :< inj (Syntax.Error errors))) term)
CParser -> treeSitterParser C tree_sitter_c CParser -> treeSitterParser C tree_sitter_c

View File

@ -44,10 +44,10 @@ treeSitterParser language grammar source = do
pure term pure term
-- | Parse 'Source' and assign , printing any assignment errors to stdout. -- | Parse 'Source' with the given 'TS.Language' and return its AST.
parseToAST :: (Bounded grammar, Enum grammar) => Source -> IO (A.Rose (A.Node grammar)) parseToAST :: (Bounded grammar, Enum grammar) => Ptr TS.Language -> Source -> IO (A.AST grammar)
parseToAST source = bracket ts_document_new ts_document_free $ \ document -> do parseToAST language source = bracket ts_document_new ts_document_free $ \ document -> do
ts_document_set_language document Ruby.tree_sitter_ruby ts_document_set_language document language
root <- withCStringLen (toText source) $ \ (source, len) -> do root <- withCStringLen (toText source) $ \ (source, len) -> do
ts_document_set_input_string_with_length document source len ts_document_set_input_string_with_length document source len
ts_document_parse_halt_on_error document ts_document_parse_halt_on_error document