1
1
mirror of https://github.com/github/semantic.git synced 2024-11-24 08:54:07 +03:00

Transition sexpression term rendering

This commit is contained in:
Timothy Clem 2019-01-18 09:29:51 -08:00
parent 45df906304
commit f23110a73a
10 changed files with 51 additions and 31 deletions

View File

@ -190,6 +190,7 @@ library
, Semantic.API.Diff
, Semantic.API.Converters
, Semantic.API.Parse
, Semantic.API.SExpressions
, Semantic.API.Symbols
, Semantic.API.TOCSummaries
, Semantic.API.Types

View File

@ -49,8 +49,6 @@ data TermRenderer output where
JSONTermRenderer :: TermRenderer (JSON "trees" SomeJSON)
-- | Render to JSON as an adjacency list represenation.
JSONGraphTermRenderer :: TermRenderer (JSON "trees" SomeJSON)
-- | Render to a 'ByteString' formatted as nested s-expressions.
SExpressionTermRenderer :: TermRenderer Builder
-- | Render to a 'ByteString' formatted as a DOT description of the term.
DOTTermRenderer :: TermRenderer (Graph TermVertex)
-- | Render to a 'ByteString' formatted using the 'Show' instance.

View File

@ -1,10 +1,12 @@
module Semantic.API
(
module SymbolsAPI
module SExpressionsAPI
, module SymbolsAPI
, module TOCSummariesAPI
, module Types
) where
import Semantic.API.SExpressions as SExpressionsAPI
import Semantic.API.Symbols as SymbolsAPI
import Semantic.API.TOCSummaries as TOCSummariesAPI
import Semantic.API.Types as Types

View File

@ -0,0 +1,18 @@
{-# LANGUAGE GADTs, TypeOperators, DerivingStrategies #-}
module Semantic.API.SExpressions (parseSExpressionBuilder) where
import Control.Effect
import Control.Exception
import Data.Blob
import Data.ByteString.Builder
import Parsing.Parser
import Semantic.API.Parse
import Semantic.Task as Task
import Serializing.Format
parseSExpressionBuilder :: (Traversable t, Member Distribute sig, ParseEffects sig m)
=> t Blob -> m Builder
parseSExpressionBuilder = distributeFoldMap go
where
go :: (Member (Error SomeException) sig, Member Task sig, Carrier sig m, Monad m) => Blob -> m Builder
go blob@Blob{..} = doParse blobLanguage blob (\_ (SomeTerm t) -> runSerialize Plain (SExpression ByConstructorName) t)

View File

@ -1,23 +1,23 @@
{-# LANGUAGE GADTs, TypeOperators, DerivingStrategies #-}
module Semantic.API.Symbols (parseSymbols, parseSymbolsBuilder) where
import Control.Effect
import Control.Effect.Error
import Control.Exception
import Data.Blob
import Data.ByteString.Builder
import Data.Location
import Data.Maybe
import Data.Term
import qualified Data.Text as T
import Parsing.Parser
import Semantic.API.Converters
import Semantic.API.Parse
import Semantic.API.Types
import Semantic.Task as Task
import Serializing.Format
import Tags.Taggable
import Tags.Tagging
import Control.Effect
import Control.Effect.Error
import Control.Exception
import Data.Blob
import Data.ByteString.Builder
import Data.Location
import Data.Maybe
import Data.Term
import Data.Text (pack)
import Parsing.Parser
import Semantic.API.Converters
import Semantic.API.Parse
import Semantic.API.Types
import Semantic.Task as Task
import Serializing.Format
import Tags.Taggable
import Tags.Tagging
parseSymbolsBuilder :: (Member Distribute sig, ParseEffects sig m, Traversable t)
=> Format ParseTreeSymbolResponse -> t Blob -> m Builder
@ -28,7 +28,7 @@ parseSymbols blobs = ParseTreeSymbolResponse <$> distributeFoldMap go blobs
where
go :: (Member (Error SomeException) sig, Member Task sig, Carrier sig m, Monad m) => Blob -> m [File]
go blob@Blob{..} = doParse blobLanguage blob render `catchError` (\(SomeException _) -> pure (pure emptyFile))
where emptyFile = File (T.pack blobPath) (T.pack (show blobLanguage)) []
where emptyFile = File (pack blobPath) (pack (show blobLanguage)) []
render :: Blob -> SomeTerm TermConstraints Location -> [File]
render blob (SomeTerm term) = renderToSymbols blob term
@ -37,7 +37,7 @@ parseSymbols blobs = ParseTreeSymbolResponse <$> distributeFoldMap go blobs
renderToSymbols blob term = either mempty (pure . tagsToFile blob) (runTagging blob term)
tagsToFile :: Blob -> [Tag] -> File
tagsToFile Blob{..} tags = File (T.pack blobPath) (T.pack (show blobLanguage)) (fmap tagToSymbol tags)
tagsToFile Blob{..} tags = File (pack blobPath) (pack (show blobLanguage)) (fmap tagToSymbol tags)
tagToSymbol :: Tag -> Symbol
tagToSymbol Tag{..}

View File

@ -16,7 +16,7 @@ import Data.Project
import Options.Applicative hiding (style)
import Prologue
import Rendering.Renderer
import Semantic.API (parseSymbolsBuilder, diffSummaryBuilder)
import Semantic.API (parseSymbolsBuilder, parseSExpressionBuilder, diffSummaryBuilder)
import qualified Semantic.AST as AST
import Semantic.Config
import qualified Semantic.Diff as Diff
@ -80,10 +80,10 @@ parseCommand :: Mod CommandFields (Task.TaskEff Builder)
parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate parse trees for path(s)"))
where
parseArgumentsParser = do
renderer <- flag (Parse.runParse SExpressionTermRenderer) (Parse.runParse SExpressionTermRenderer) (long "sexpression" <> help "Output s-expression parse trees (default)")
renderer <- flag parseSExpressionBuilder parseSExpressionBuilder (long "sexpression" <> help "Output s-expression parse trees (default)")
<|> flag' (Parse.runParse JSONTermRenderer) (long "json" <> help "Output JSON parse trees")
<|> flag' (Parse.runParse JSONGraphTermRenderer) (long "json-graph" <> help "Output JSON adjacency list")
<|> flag' (parseSymbolsBuilder JSON) (long "symbols" <> help "Output JSON symbol list")
<|> flag' (parseSymbolsBuilder JSON) (long "symbols" <> help "Output JSON symbol list")
<|> flag' (Parse.runParse DOTTermRenderer) (long "dot" <> help "Output DOT graph parse trees")
<|> flag' (Parse.runParse ShowTermRenderer) (long "show" <> help "Output using the Show instance (debug only, format subject to change without notice)")
<|> flag' (Parse.runParse QuietTermRenderer) (long "quiet" <> help "Don't produce output, but show timing stats")

View File

@ -31,7 +31,6 @@ runParse JSONTermRenderer = withParsedBlobs' renderJSONError (render
runParse JSONGraphTermRenderer = withParsedBlobs' renderJSONError (render . renderAdjGraph) >=> serialize JSON
where renderAdjGraph :: (Recursive t, ToTreeGraph TermVertex (Base t)) => Blob -> t -> JSON.JSON "trees" SomeJSON
renderAdjGraph blob term = renderJSONAdjTerm blob (renderTreeGraph term)
runParse SExpressionTermRenderer = withParsedBlobs (const (serialize (SExpression ByConstructorName)))
runParse ShowTermRenderer = withParsedBlobs (const (serialize Show . quieterm))
runParse DOTTermRenderer = withParsedBlobs (const (render renderTreeGraph)) >=> serialize (DOT (termStyle "terms"))
runParse QuietTermRenderer = distributeFoldMap $ \blob ->

View File

@ -4,7 +4,7 @@ import Control.Monad (when)
import qualified Data.ByteString as B
import Data.ByteString.Builder
import Data.Foldable (for_)
import Semantic.API (parseSymbolsBuilder, diffSummaryBuilder)
import Semantic.API (parseSymbolsBuilder, parseSExpressionBuilder, diffSummaryBuilder)
import Semantic.CLI
import Semantic.IO
import Semantic.Task
@ -34,7 +34,7 @@ spec = parallel $ do
parseFixtures :: [(String, [Blob] -> TaskEff Builder, [File], FilePath)]
parseFixtures =
[ (show SExpressionTermRenderer, runParse SExpressionTermRenderer, path, "test/fixtures/ruby/corpus/and-or.parseA.txt")
[ ("s-expression", parseSExpressionBuilder, path, "test/fixtures/ruby/corpus/and-or.parseA.txt")
, (show JSONTermRenderer, runParse JSONTermRenderer, path, prefix </> "parse-tree.json")
, (show JSONTermRenderer, runParse JSONTermRenderer, path', prefix </> "parse-trees.json")
, (show JSONTermRenderer, runParse JSONTermRenderer, [], prefix </> "parse-tree-empty.json")

View File

@ -3,6 +3,7 @@ module Semantic.Spec (spec) where
import Data.Diff
import Data.Patch
import Semantic.Parse
import Semantic.API
import System.Exit
import SpecHelpers
@ -16,10 +17,10 @@ spec = parallel $ do
output `shouldBe` "{\"trees\":[{\"path\":\"methods.rb\",\"error\":\"NoLanguageForBlob \\\"methods.rb\\\"\",\"language\":\"Unknown\"}]}\n"
it "throws if given an unknown language for sexpression output" $ do
runTask (runParse SExpressionTermRenderer [methodsBlob { blobLanguage = Unknown }]) `shouldThrow` (== ExitFailure 1)
runTask (parseSExpressionBuilder [methodsBlob { blobLanguage = Unknown }]) `shouldThrow` (== ExitFailure 1)
it "renders with the specified renderer" $ do
output <- fmap runBuilder . runTask $ runParse SExpressionTermRenderer [methodsBlob]
output <- fmap runBuilder . runTask $ parseSExpressionBuilder [methodsBlob]
output `shouldBe` "(Statements\n (Method\n (Empty)\n (Identifier)\n (Statements)))\n"
where
methodsBlob = Blob "def foo\nend\n" "methods.rb" Ruby

View File

@ -83,6 +83,7 @@ import Data.Set (Set)
import qualified Semantic.IO as IO
import Semantic.Config (Config)
import Semantic.Telemetry (LogQueue, StatQueue)
import Semantic.API (parseSExpressionBuilder)
import System.Exit (die)
import Control.Exception (displayException)
@ -99,7 +100,7 @@ diffFilePaths (TaskConfig config logger statter) paths = readFilePair paths >>=
-- | Returns an s-expression parse tree for the specified FilePath.
parseFilePath :: TaskConfig -> FilePath -> IO ByteString
parseFilePath (TaskConfig config logger statter) path = (fromJust <$> readBlobFromFile (file path)) >>= runTaskWithConfig config logger statter . runParse SExpressionTermRenderer . pure >>= either (die . displayException) (pure . runBuilder)
parseFilePath (TaskConfig config logger statter) path = (fromJust <$> readBlobFromFile (file path)) >>= runTaskWithConfig config logger statter . parseSExpressionBuilder @[] . pure >>= either (die . displayException) (pure . runBuilder)
-- | Read two files to a BlobPair.
readFilePair :: Both FilePath -> IO BlobPair