diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 6fc58a7a4..7322c4a3b 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -111,7 +111,7 @@ library , Rendering.JSON , Rendering.Renderer , Rendering.SExpression - , Rendering.Tag + , Rendering.Symbol , Rendering.TOC -- High-level flow & operational functionality (logging, stats, etc.) , Semantic diff --git a/src/Rendering/Renderer.hs b/src/Rendering/Renderer.hs index a850f2c2c..d6588ac5a 100644 --- a/src/Rendering/Renderer.hs +++ b/src/Rendering/Renderer.hs @@ -11,12 +11,14 @@ module Rendering.Renderer , renderJSONTerms , renderToCDiff , renderToCTerm +, renderSymbolTerms +, renderToSymbols , renderToTags , renderDOTDiff , renderDOTTerm , Summaries(..) -, TagFields(..) -, defaultTagFields +, SymbolFields(..) +, defaultSymbolFields ) where import Data.Aeson (Value) @@ -25,7 +27,7 @@ import Data.Output import Rendering.DOT as R import Rendering.JSON as R import Rendering.SExpression as R -import Rendering.Tag as R +import Rendering.Symbol as R import Rendering.TOC as R -- | Specification of renderers for diffs, producing output in the parameter type. @@ -44,14 +46,14 @@ deriving instance Show (DiffRenderer output) -- | Specification of renderers for terms, producing output in the parameter type. data TermRenderer output where - -- | Compute a table of contents for the term & encode it as JSON. - ToCTermRenderer :: TermRenderer Summaries -- | Render to JSON with the format documented in docs/json-format.md under “Term.” JSONTermRenderer :: TermRenderer [Value] -- | Render to a 'ByteString' formatted as nested s-expressions. SExpressionTermRenderer :: TermRenderer ByteString - -- | Render to a list of tags. - TagsTermRenderer :: TagFields -> TermRenderer [Value] + -- | Render to a list of tags (deprecated). + TagsTermRenderer :: TermRenderer [Value] + -- | Render to a list of symbols. + SymbolsTermRenderer :: SymbolFields -> TermRenderer [Value] -- | Render to a 'ByteString' formatted as a DOT description of the term. DOTTermRenderer :: TermRenderer ByteString diff --git a/src/Rendering/Symbol.hs b/src/Rendering/Symbol.hs new file mode 100644 index 000000000..39d1a1eae --- /dev/null +++ b/src/Rendering/Symbol.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE DataKinds, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} +module Rendering.Symbol +( renderSymbolTerms +, renderToSymbols +, renderToTags +, SymbolFields(..) +, defaultSymbolFields +) where + +import Analysis.Declaration +import Data.Aeson +import Data.Blob +import Data.Maybe (mapMaybe) +import Data.Record +import Data.Span +import Data.Term +import Control.Monad (join) +import GHC.Generics +import qualified Data.Text as T +import qualified Data.Map as Map +import Rendering.TOC + + +-- | Render a 'Term' to a ctags like output (See 'Tag'). +-- +-- This format is going away. Prefer the new 'renderToSymbols' as it provides a +-- more compact data representation and custom field selection. This exists to +-- back support the staff shipped tag generation in github/github. +renderToTags :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Blob -> Term f (Record fields) -> [Value] +renderToTags Blob{..} = fmap toJSON . termToC blobPath + where + termToC :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => FilePath -> Term f (Record fields) -> [Symbol] + termToC path = mapMaybe (symbolSummary defaultTagSymbolFields path "unchanged") . termTableOfContentsBy declaration + + +-- | Render terms to final JSON structure. +renderSymbolTerms :: [Value] -> Map.Map T.Text Value +renderSymbolTerms = Map.singleton "files" . toJSON + +-- | Render a 'Term' to a list of symbols (See 'Symbol'). +renderToSymbols :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => SymbolFields -> Blob -> Term f (Record fields) -> [Value] +renderToSymbols fields Blob{..} term = [toJSON (termToC fields blobPath term)] + where + termToC :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => SymbolFields -> FilePath -> Term f (Record fields) -> File + termToC fields path = File (T.pack path) (T.pack . show <$> blobLanguage) . mapMaybe (symbolSummary fields path "unchanged") . termTableOfContentsBy declaration + +-- | Construct a 'Symbol' from a node annotation and a change type label. +symbolSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => SymbolFields -> FilePath -> T.Text -> Record fields -> Maybe Symbol +symbolSummary SymbolFields{..} path _ record = case getDeclaration record of + Just ErrorDeclaration{} -> Nothing + Just declaration -> Just Symbol + { symbolName = when symbolFieldsName (declarationIdentifier declaration) + , symbolPath = when symbolFieldsPath (T.pack path) + , symbolLang = join (when symbolFieldsLang (T.pack . show <$> declarationLanguage declaration)) + , symbolKind = when symbolFieldsKind (toCategoryName declaration) + , symbolLine = when symbolFieldsLine (declarationText declaration) + , symbolSpan = when symbolFieldsSpan (getField record) + } + _ -> Nothing + +data File = File + { filePath :: T.Text + , fileLanguage :: Maybe T.Text + , fileSymbols :: [Symbol] + } deriving (Generic, Eq, Show) + +instance ToJSON File where + toJSON File{..} = object [ "path" .= filePath + , "language" .= fileLanguage + , "symbols" .= fileSymbols ] + +data Symbol = Symbol + { symbolName :: Maybe T.Text + , symbolPath :: Maybe T.Text + , symbolLang :: Maybe T.Text + , symbolKind :: Maybe T.Text + , symbolLine :: Maybe T.Text + , symbolSpan :: Maybe Span + } deriving (Generic, Eq, Show) + +instance ToJSON Symbol where + toJSON Symbol{..} = objectWithoutNulls + [ "symbol" .= symbolName + , "path" .= symbolPath + , "language" .= symbolLang + , "kind" .= symbolKind + , "line" .= symbolLine + , "span" .= symbolSpan ] + where objectWithoutNulls = object . filter (\(_, v) -> v /= Null) + +when :: Bool -> a -> Maybe a +when True a = Just a +when False _ = Nothing + +data SymbolFields = SymbolFields + { symbolFieldsName :: Bool + , symbolFieldsPath :: Bool + , symbolFieldsLang :: Bool + , symbolFieldsKind :: Bool + , symbolFieldsLine :: Bool + , symbolFieldsSpan :: Bool + } + deriving (Eq, Show) + +defaultSymbolFields :: SymbolFields +defaultSymbolFields = SymbolFields True False False True False True + +defaultTagSymbolFields :: SymbolFields +defaultTagSymbolFields = SymbolFields True True True True True True diff --git a/src/Rendering/Tag.hs b/src/Rendering/Tag.hs deleted file mode 100644 index d5da0fed5..000000000 --- a/src/Rendering/Tag.hs +++ /dev/null @@ -1,73 +0,0 @@ -{-# LANGUAGE DataKinds, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} -module Rendering.Tag -( renderToTags -, TagFields(..) -, defaultTagFields -) where - -import Analysis.Declaration -import Data.Aeson -import Data.Blob -import Data.Maybe (mapMaybe) -import Data.Record -import Data.Span -import Data.Term -import GHC.Generics -import qualified Data.Text as T -import Rendering.TOC - --- | Render a 'Term' to a ctags like output (See 'Tag'). -renderToTags :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => TagFields -> Blob -> Term f (Record fields) -> [Value] -renderToTags fields Blob{..} = fmap toJSON . termToC fields blobPath - where - termToC :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => TagFields -> FilePath -> Term f (Record fields) -> [Tag] - termToC fields path = mapMaybe (tagSummary fields path "unchanged") . termTableOfContentsBy declaration - --- | Construct a 'Tag' from a node annotation and a change type label. -tagSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => TagFields -> FilePath -> T.Text -> Record fields -> Maybe Tag -tagSummary TagFields{..} path _ record = case getDeclaration record of - Just ErrorDeclaration{} -> Nothing - Just declaration -> Just $ Tag - { tagSymbol = when tagFieldsShowSymbol (declarationIdentifier declaration) - , tagPath = when tagFieldsShowPath (T.pack path) - , tagLanguage = if tagFieldsShowLanguage then (T.pack . show <$> declarationLanguage declaration) else Nothing - , tagKind = when tagFieldsShowKind (toCategoryName declaration) - , tagLine = when tagFieldsShowLine (declarationText declaration) - , tagSpan = when tagFieldsShowSpan (getField record) - } - _ -> Nothing - -data Tag = Tag - { tagSymbol :: Maybe T.Text - , tagPath :: Maybe T.Text - , tagLanguage :: Maybe T.Text - , tagKind :: Maybe T.Text - , tagLine :: Maybe T.Text - , tagSpan :: Maybe Span - } deriving (Generic, Eq, Show) - -instance ToJSON Tag where - toJSON Tag{..} = objectWithoutNulls [ "symbol" .= tagSymbol - , "path" .= tagPath - , "language" .= tagLanguage - , "kind" .= tagKind - , "line" .= tagLine - , "span" .= tagSpan ] - where objectWithoutNulls = object . filter (\(_, v) -> v /= Null) - -when :: Bool -> a -> Maybe a -when True a = Just a -when False _ = Nothing - -data TagFields = TagFields - { tagFieldsShowSymbol :: Bool - , tagFieldsShowPath :: Bool - , tagFieldsShowLanguage :: Bool - , tagFieldsShowKind :: Bool - , tagFieldsShowLine :: Bool - , tagFieldsShowSpan :: Bool - } - deriving (Eq, Show) - -defaultTagFields :: TagFields -defaultTagFields = TagFields True True True True True True diff --git a/src/Semantic.hs b/src/Semantic.hs index 41d6c6b50..c0d753630 100644 --- a/src/Semantic.hs +++ b/src/Semantic.hs @@ -45,6 +45,7 @@ parseBlobs :: Output output => TermRenderer output -> [Blob] -> Task ByteString parseBlobs renderer blobs = toOutput' <$> distributeFoldMap (parseBlob renderer) blobs where toOutput' = case renderer of JSONTermRenderer -> toOutput . renderJSONTerms + SymbolsTermRenderer _ -> toOutput . renderSymbolTerms _ -> toOutput -- | A task to parse a 'Blob' and render the resulting 'Term'. @@ -52,11 +53,11 @@ parseBlob :: TermRenderer output -> Blob -> Task output parseBlob renderer blob@Blob{..} | Just (SomeParser parser) <- someParser (Proxy :: Proxy '[ConstructorName, HasDeclaration, IdentifierName, Foldable, Functor, ToJSONFields1]) <$> blobLanguage = parse parser blob >>= case renderer of - ToCTermRenderer -> decorate (declarationAlgebra blob) >=> render (renderToCTerm blob) - JSONTermRenderer -> decorate constructorLabel >=> decorate identifierLabel >=> render (renderJSONTerm blob) - SExpressionTermRenderer -> decorate constructorLabel . (Nil <$) >=> render renderSExpressionTerm - TagsTermRenderer fields -> decorate (declarationAlgebra blob) >=> render (renderToTags fields blob) - DOTTermRenderer -> render (renderDOTTerm blob) + JSONTermRenderer -> decorate constructorLabel >=> decorate identifierLabel >=> render (renderJSONTerm blob) + SExpressionTermRenderer -> decorate constructorLabel . (Nil <$) >=> render renderSExpressionTerm + TagsTermRenderer -> decorate (declarationAlgebra blob) >=> render (renderToTags blob) + SymbolsTermRenderer fields -> decorate (declarationAlgebra blob) >=> render (renderToSymbols fields blob) + DOTTermRenderer -> render (renderDOTTerm blob) | otherwise = throwError (SomeException (NoLanguageForBlob blobPath)) newtype NoLanguageForBlob = NoLanguageForBlob FilePath diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 442eb254f..5d7a2fb26 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -16,7 +16,7 @@ import Data.List.Split (splitWhen) import Data.Semigroup ((<>)) import Data.Version (showVersion) import Development.GitRev -import Options.Applicative hiding (action) +import Options.Applicative import Rendering.Renderer import qualified Paths_semantic_diff as Library (version) import Semantic.IO (languageForFilePath) @@ -76,13 +76,13 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar parseArgumentsParser = runParse <$> ( flag (SomeRenderer SExpressionTermRenderer) (SomeRenderer SExpressionTermRenderer) (long "sexpression" <> help "Output s-expression parse trees (default)") <|> flag' (SomeRenderer JSONTermRenderer) (long "json" <> help "Output JSON parse trees") - <|> flag' (SomeRenderer ToCTermRenderer) (long "toc" <> help "Output JSON table of contents summary") - <|> flag' (SomeRenderer . TagsTermRenderer) (long "tags" <> help "Output JSON tags/symbols") - <*> ( option tagFieldsReader ( long "fields" - <> help "Comma delimited list of specific fields to return (tags output only)." + <|> flag' (SomeRenderer TagsTermRenderer) (long "tags" <> help "Output JSON tags") + <|> flag' (SomeRenderer . SymbolsTermRenderer) (long "symbols" <> help "Output JSON symbol list") + <*> ( option symbolFieldsReader ( long "fields" + <> help "Comma delimited list of specific fields to return (symbols output only)." <> metavar "FIELDS") - <|> pure defaultTagFields) - <|> flag' (SomeRenderer DOTTermRenderer) (long "dot" <> help "Output the term as a DOT graph")) + <|> pure defaultSymbolFields) + <|> flag' (SomeRenderer DOTTermRenderer) (long "dot" <> help "Output DOT graph parse trees")) <*> ( Right <$> some (argument filePathReader (metavar "FILES...")) <|> pure (Left stdin) ) @@ -97,14 +97,14 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar options options fields = option (optionsReader options) (fields <> showDefaultWith (findOption options) <> metavar (intercalate "|" (fmap fst options))) findOption options value = maybe "" fst (find ((== value) . snd) options) - -- Example: semantic parse --tags --fields=symbol,path,language,kind,line,span - tagFieldsReader = eitherReader parseTagFields - parseTagFields arg = let fields = splitWhen (== ',') arg in - Right $ TagFields - { tagFieldsShowSymbol = (elem "symbol" fields) - , tagFieldsShowPath = (elem "path" fields) - , tagFieldsShowLanguage = (elem "language" fields) - , tagFieldsShowKind = (elem "kind" fields) - , tagFieldsShowLine = (elem "line" fields) - , tagFieldsShowSpan = (elem "span" fields) + -- Example: semantic parse --symbols --fields=symbol,path,language,kind,line,span + symbolFieldsReader = eitherReader parseSymbolFields + parseSymbolFields arg = let fields = splitWhen (== ',') arg in + Right SymbolFields + { symbolFieldsName = "symbol" `elem` fields + , symbolFieldsPath = "path" `elem` fields + , symbolFieldsLang = "language" `elem` fields + , symbolFieldsKind = "kind" `elem` fields + , symbolFieldsLine = "line" `elem` fields + , symbolFieldsSpan = "span" `elem` fields } diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs index fefa5bf7a..188c1e40d 100644 --- a/test/Rendering/TOC/Spec.hs +++ b/test/Rendering/TOC/Spec.hs @@ -37,7 +37,7 @@ import Semantic import Semantic.Task import Semantic.Util import SpecHelpers -import Test.Hspec (Spec, describe, it, parallel) +import Test.Hspec (Spec, describe, it, parallel, pendingWith) import Test.Hspec.Expectations.Pretty import Test.Hspec.LeanCheck import Test.LeanCheck diff --git a/test/Semantic/CLI/Spec.hs b/test/Semantic/CLI/Spec.hs index e21a7057e..209797908 100644 --- a/test/Semantic/CLI/Spec.hs +++ b/test/Semantic/CLI/Spec.hs @@ -38,7 +38,8 @@ parseFixtures = , (SomeRenderer JSONTermRenderer, pathMode, jsonParseTreeOutput) , (SomeRenderer JSONTermRenderer, pathMode', jsonParseTreeOutput') , (SomeRenderer JSONTermRenderer, Right [], emptyJsonParseTreeOutput) - , (SomeRenderer ToCTermRenderer, Right [("test/fixtures/ruby/method-declaration.A.rb", Just Ruby)], tocOutput) + , (SomeRenderer (SymbolsTermRenderer defaultSymbolFields), Right [("test/fixtures/ruby/method-declaration.A.rb", Just Ruby)], symbolsOutput) + , (SomeRenderer TagsTermRenderer, Right [("test/fixtures/ruby/method-declaration.A.rb", Just Ruby)], tagsOutput) ] where pathMode = Right [("test/fixtures/ruby/and-or.A.rb", Just Ruby)] pathMode' = Right [("test/fixtures/ruby/and-or.A.rb", Just Ruby), ("test/fixtures/ruby/and-or.B.rb", Just Ruby)] @@ -47,7 +48,8 @@ parseFixtures = jsonParseTreeOutput = "{\"trees\":[{\"path\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"And\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"name\":\"foo\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"Identifier\",\"children\":[],\"name\":\"bar\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}},\"language\":\"Ruby\"}]}\n" jsonParseTreeOutput' = "{\"trees\":[{\"path\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"And\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"name\":\"foo\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"Identifier\",\"children\":[],\"name\":\"bar\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}},\"language\":\"Ruby\"},{\"path\":\"test/fixtures/ruby/and-or.B.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Or\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"name\":\"foo\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"Identifier\",\"children\":[],\"name\":\"bar\",\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]}}],\"sourceRange\":[0,10],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,11]}},{\"category\":\"And\",\"children\":[{\"category\":\"Or\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"name\":\"a\",\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]}},{\"category\":\"Identifier\",\"children\":[],\"name\":\"b\",\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]}}],\"sourceRange\":[11,17],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,7]}},{\"category\":\"Identifier\",\"children\":[],\"name\":\"c\",\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]}}],\"sourceRange\":[11,23],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,13]}}],\"sourceRange\":[0,24],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"language\":\"Ruby\"}]}\n" emptyJsonParseTreeOutput = "{\"trees\":[]}\n" - tocOutput = "{\"changes\":{\"test/fixtures/ruby/method-declaration.A.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"term\":\"foo\",\"changeType\":\"unchanged\"}]},\"errors\":{}}\n" + symbolsOutput = "{\"files\":[{\"path\":\"test/fixtures/ruby/method-declaration.A.rb\",\"symbols\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"kind\":\"Method\",\"symbol\":\"foo\"}],\"language\":\"Ruby\"}]}\n" + tagsOutput = "[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"path\":\"test/fixtures/ruby/method-declaration.A.rb\",\"kind\":\"Method\",\"symbol\":\"foo\",\"line\":\"def foo\",\"language\":\"Ruby\"}]\n" diffFixtures :: [(SomeRenderer DiffRenderer, Either Handle [Both (FilePath, Maybe Language)], ByteString)] diff --git a/vendor/haskell-tree-sitter b/vendor/haskell-tree-sitter index 5e0ea38a4..79271a537 160000 --- a/vendor/haskell-tree-sitter +++ b/vendor/haskell-tree-sitter @@ -1 +1 @@ -Subproject commit 5e0ea38a438333020740a4b67fd3e6af36aab6dd +Subproject commit 79271a537b78377baa5dcad37effa363b59c77b6