1
1
mirror of https://github.com/github/semantic.git synced 2024-12-23 06:41:45 +03:00

Parameterize the Parser type synonym by functor and annotation.

This commit is contained in:
Rob Rix 2016-07-15 17:43:07 -04:00
parent 96c728a9ca
commit b975559c6d
4 changed files with 11 additions and 9 deletions

View File

@ -15,12 +15,13 @@ import qualified Renderer.Summary as S
import Renderer import Renderer
import Renderer.Split import Renderer.Split
import Source import Source
import Syntax
import System.Directory import System.Directory
import System.FilePath import System.FilePath
import qualified System.IO as IO import qualified System.IO as IO
-- | Returns a rendered diff given a parser, diff arguments and two source blobs. -- | Returns a rendered diff given a parser, diff arguments and two source blobs.
textDiff :: (Eq (Record fields), HasField fields Category, HasField fields Cost, HasField fields Range) => Parser fields -> DiffArguments -> Both SourceBlob -> IO Text textDiff :: (Eq (Record fields), HasField fields Category, HasField fields Cost, HasField fields Range) => Parser (Syntax Text) (Record fields) -> DiffArguments -> Both SourceBlob -> IO Text
textDiff parser arguments sources = case format arguments of textDiff parser arguments sources = case format arguments of
Split -> diffFiles parser split sources Split -> diffFiles parser split sources
Patch -> diffFiles parser P.patch sources Patch -> diffFiles parser P.patch sources
@ -36,7 +37,7 @@ truncatedDiff arguments sources = case format arguments of
Summary -> pure "" Summary -> pure ""
-- | Prints a rendered diff to stdio or a filepath given a parser, diff arguments and two source blobs. -- | Prints a rendered diff to stdio or a filepath given a parser, diff arguments and two source blobs.
printDiff :: (Eq (Record fields), HasField fields Category, HasField fields Cost, HasField fields Range) => Parser fields -> DiffArguments -> Both SourceBlob -> IO () printDiff :: (Eq (Record fields), HasField fields Category, HasField fields Cost, HasField fields Range) => Parser (Syntax Text) (Record fields) -> DiffArguments -> Both SourceBlob -> IO ()
printDiff parser arguments sources = case format arguments of printDiff parser arguments sources = case format arguments of
Split -> put (output arguments) =<< diffFiles parser split sources Split -> put (output arguments) =<< diffFiles parser split sources
where where

View File

@ -27,7 +27,7 @@ import TreeSitter
import Text.Parser.TreeSitter.Language import Text.Parser.TreeSitter.Language
-- | Return a parser based on the file extension (including the "."). -- | Return a parser based on the file extension (including the ".").
parserForType :: T.Text -> Parser '[Range, Category, Cost] parserForType :: T.Text -> Parser (Syntax Text) (Record '[Range, Category])
parserForType mediaType = case languageForType mediaType of parserForType mediaType = case languageForType mediaType of
Just C -> treeSitterParser C ts_language_c Just C -> treeSitterParser C ts_language_c
Just JavaScript -> treeSitterParser JavaScript ts_language_javascript Just JavaScript -> treeSitterParser JavaScript ts_language_javascript
@ -35,7 +35,7 @@ parserForType mediaType = case languageForType mediaType of
_ -> lineByLineParser _ -> lineByLineParser
-- | A fallback parser that treats a file simply as rows of strings. -- | A fallback parser that treats a file simply as rows of strings.
lineByLineParser :: Parser '[Range, Category, Cost] lineByLineParser :: Parser (Syntax Text) (Record '[Range, Category])
lineByLineParser input = pure . cofree . root $ case foldl' annotateLeaves ([], 0) lines of lineByLineParser input = pure . cofree . root $ case foldl' annotateLeaves ([], 0) lines of
(leaves, _) -> cofree <$> leaves (leaves, _) -> cofree <$> leaves
where where
@ -49,7 +49,7 @@ lineByLineParser input = pure . cofree . root $ case foldl' annotateLeaves ([],
toText = T.pack . Source.toString toText = T.pack . Source.toString
-- | Return the parser that should be used for a given path. -- | Return the parser that should be used for a given path.
parserForFilepath :: FilePath -> Parser '[Range, Category, Cost] parserForFilepath :: FilePath -> Parser (Syntax Text) (Record '[Range, Category])
parserForFilepath = parserForType . T.pack . takeExtension parserForFilepath = parserForType . T.pack . takeExtension
-- | Replace every string leaf with leaves of the words in the string. -- | Replace every string leaf with leaves of the words in the string.
@ -84,7 +84,7 @@ decorateTerm decorator = cata $ \ c -> cofree ((decorator (extract <$> c) .: hea
-- | result. -- | result.
-- | Returns the rendered result strictly, so it's always fully evaluated -- | Returns the rendered result strictly, so it's always fully evaluated
-- | with respect to other IO actions. -- | with respect to other IO actions.
diffFiles :: (HasField fields Category, HasField fields Cost, HasField fields Range, Eq (Record fields)) => Parser fields -> Renderer (Record fields) -> Both SourceBlob -> IO T.Text diffFiles :: (HasField fields Category, HasField fields Cost, HasField fields Range, Eq (Record fields)) => Parser (Syntax Text) (Record fields) -> Renderer (Record fields) -> Both SourceBlob -> IO T.Text
diffFiles parser renderer sourceBlobs = do diffFiles parser renderer sourceBlobs = do
let sources = source <$> sourceBlobs let sources = source <$> sourceBlobs
terms <- sequence $ parser <$> sources terms <- sequence $ parser <$> sources

View File

@ -14,7 +14,7 @@ import Source
-- | A function that takes a source file and returns an annotated AST. -- | A function that takes a source file and returns an annotated AST.
-- | The return is in the IO monad because some of the parsers are written in C -- | The return is in the IO monad because some of the parsers are written in C
-- | and aren't pure. -- | and aren't pure.
type Parser fields = Source Char -> IO (Term Text (Record fields)) type Parser f a = Source Char -> IO (Cofree f a)
-- | Categories that are treated as fixed nodes. -- | Categories that are treated as fixed nodes.
fixedCategories :: Set.Set Category fixedCategories :: Set.Set Category

View File

@ -10,13 +10,14 @@ import Language
import Parser import Parser
import Range import Range
import Source import Source
import Syntax
import Foreign import Foreign
import Foreign.C.String import Foreign.C.String
import Text.Parser.TreeSitter hiding (Language(..)) import Text.Parser.TreeSitter hiding (Language(..))
import qualified Text.Parser.TreeSitter as TS import qualified Text.Parser.TreeSitter as TS
-- | Returns a TreeSitter parser for the given language and TreeSitter grammar. -- | Returns a TreeSitter parser for the given language and TreeSitter grammar.
treeSitterParser :: Language -> Ptr TS.Language -> Parser '[Range, Category, Cost] treeSitterParser :: Language -> Ptr TS.Language -> Parser (Syntax Text) (Record '[Range, Category, Cost])
treeSitterParser language grammar contents = do treeSitterParser language grammar contents = do
document <- ts_document_make document <- ts_document_make
ts_document_set_language document grammar ts_document_set_language document grammar
@ -50,7 +51,7 @@ defaultCategoryForNodeName name = case name of
_ -> Other name _ -> Other name
-- | Return a parser for a tree sitter language & document. -- | Return a parser for a tree sitter language & document.
documentToTerm :: Language -> Ptr Document -> Parser '[Range, Category, Cost] documentToTerm :: Language -> Ptr Document -> Parser (Syntax Text) (Record '[Range, Category, Cost])
documentToTerm language document contents = alloca $ \ root -> do documentToTerm language document contents = alloca $ \ root -> do
ts_document_root_node_p document root ts_document_root_node_p document root
toTerm root toTerm root