1
1
mirror of https://github.com/github/semantic.git synced 2024-12-19 21:01:35 +03:00

Parser takes a list of field types.

This commit is contained in:
Rob Rix 2016-07-14 16:35:20 -04:00
parent c59bb6ebfe
commit d1ed015446
4 changed files with 15 additions and 9 deletions

View File

@ -1,10 +1,14 @@
module DiffOutput where
import Category
import Prologue
import qualified Data.Text.IO as TextIO
import Data.Functor.Both
import Data.Record
import Diffing
import Info
import Parser
import Range
import qualified Renderer.JSON as J
import qualified Renderer.Patch as P
import qualified Renderer.Summary as S
@ -16,7 +20,7 @@ import System.FilePath
import qualified System.IO as IO
-- | Returns a rendered diff given a parser, diff arguments and two source blobs.
textDiff :: Parser -> DiffArguments -> Both SourceBlob -> IO Text
textDiff :: (Eq (Record fields), HasField fields Category, HasField fields Cost, HasField fields Range, HasField fields Size) => Parser fields -> DiffArguments -> Both SourceBlob -> IO Text
textDiff parser arguments sources = case format arguments of
Split -> diffFiles parser split sources
Patch -> diffFiles parser P.patch sources
@ -32,7 +36,7 @@ truncatedDiff arguments sources = case format arguments of
Summary -> pure ""
-- | Prints a rendered diff to stdio or a filepath given a parser, diff arguments and two source blobs.
printDiff :: Parser -> DiffArguments -> Both SourceBlob -> IO ()
printDiff :: (Eq (Record fields), HasField fields Category, HasField fields Cost, HasField fields Range, HasField fields Size) => Parser fields -> DiffArguments -> Both SourceBlob -> IO ()
printDiff parser arguments sources = case format arguments of
Split -> put (output arguments) =<< diffFiles parser split sources
where

View File

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

View File

@ -14,7 +14,7 @@ import Source
-- | 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
-- | and aren't pure.
type Parser = Source Char -> IO (Term Text Info)
type Parser fields = Source Char -> IO (Term Text (Record fields))
-- | Categories that are treated as fixed nodes.
fixedCategories :: Set.Set Category

View File

@ -1,3 +1,4 @@
{-# LANGUAGE DataKinds #-}
module TreeSitter where
import Prologue hiding (Constructor)
@ -15,7 +16,7 @@ import Text.Parser.TreeSitter hiding (Language(..))
import qualified Text.Parser.TreeSitter as TS
-- | Returns a TreeSitter parser for the given language and TreeSitter grammar.
treeSitterParser :: Language -> Ptr TS.Language -> Parser
treeSitterParser :: Language -> Ptr TS.Language -> Parser '[Range, Category, Size, Cost]
treeSitterParser language grammar contents = do
document <- ts_document_make
ts_document_set_language document grammar
@ -49,7 +50,7 @@ defaultCategoryForNodeName name = case name of
_ -> Other name
-- | Return a parser for a tree sitter language & document.
documentToTerm :: Language -> Ptr Document -> Parser
documentToTerm :: Language -> Ptr Document -> Parser '[Range, Category, Size, Cost]
documentToTerm language document contents = alloca $ \ root -> do
ts_document_root_node_p document root
toTerm root