github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-02 20:41:38 +03:00
Code Issues Projects Releases Wiki Activity

Better way to pass around tag fields to the one renderer

Browse Source
This commit is contained in:
Timothy Clem 2018-01-16 11:39:04 -08:00
parent 173b9acd38
commit 706ed5cc0c
3 changed files with 12 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Rendering/Renderer.hs
View File

@ -51,7 +51,7 @@ data TermRenderer output where
-- | Render to a 'ByteString' formatted as nested s-expressions.
SExpressionTermRenderer :: TermRenderer ByteString
-- | Render to a list of tags.
TagsTermRenderer :: TermRenderer [Value]
TagsTermRenderer :: TagFields -> TermRenderer [Value]
-- | Render to a 'ByteString' formatted as a DOT description of the term.
DOTTermRenderer :: TermRenderer ByteString

10
src/Semantic.hs
View File

@ -41,21 +41,21 @@ import Semantic.Task as Task
-- - Built in concurrency where appropriate.
-- - Easy to consume this interface from other application (e.g a cmdline or web server app).
parseBlobs :: Output output => TagFields -> TermRenderer output -> [Blob] -> Task ByteString
parseBlobs fields renderer blobs = toOutput' <$> distributeFoldMap (parseBlob fields renderer) blobs
parseBlobs :: Output output => TermRenderer output -> [Blob] -> Task ByteString
parseBlobs renderer blobs = toOutput' <$> distributeFoldMap (parseBlob renderer) blobs
where toOutput' = case renderer of
JSONTermRenderer -> toOutput . renderJSONTerms
_ -> toOutput
-- | A task to parse a 'Blob' and render the resulting 'Term'.
parseBlob :: TagFields -> TermRenderer output -> Blob -> Task output
parseBlob fields renderer blob@Blob{..}
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 -> decorate (declarationAlgebra blob) >=> render (renderToTags fields blob)
TagsTermRenderer fields -> decorate (declarationAlgebra blob) >=> render (renderToTags fields blob)
DOTTermRenderer -> render (renderDOTTerm blob)
| otherwise = throwError (SomeException (NoLanguageForBlob blobPath))

13
src/Semantic/CLI.hs
View File

@ -33,8 +33,8 @@ main = customExecParser (prefs showHelpOnEmpty) arguments >>= uncurry Task.runTa
runDiff :: SomeRenderer DiffRenderer -> Either Handle [Both (FilePath, Maybe Language)] -> Task.Task ByteString
runDiff (SomeRenderer diffRenderer) = Semantic.diffBlobPairs diffRenderer <=< Task.readBlobPairs
runParse :: SomeRenderer TermRenderer -> TagFields -> Either Handle [(FilePath, Maybe Language)] -> Task.Task ByteString
runParse (SomeRenderer parseTreeRenderer) fields = Semantic.parseBlobs fields parseTreeRenderer <=< Task.readBlobs
runParse :: SomeRenderer TermRenderer -> Either Handle [(FilePath, Maybe Language)] -> Task.Task ByteString
runParse (SomeRenderer parseTreeRenderer) = Semantic.parseBlobs parseTreeRenderer <=< Task.readBlobs
-- | A parser for the application's command-line arguments.
--
@ -77,9 +77,8 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar
<$> ( 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")
<|> 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)." <> metavar "FIELDS") <|> pure defaultTagFields)
<|> flag' (SomeRenderer DOTTermRenderer) (long "dot" <> help "Output the term as a DOT graph"))
<*> (option fieldsReader (long "fields" <> help "Comma delimited list of specific fields to return (tags output only)." <> metavar "FIELDS") <|> pure defaultTagFields)
<*> ( Right <$> some (argument filePathReader (metavar "FILES..."))
<|> pure (Left stdin) )
@ -94,9 +93,9 @@ 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: --fields=symbol,path,language,kind,line,span
fieldsReader = eitherReader parseFields
parseFields arg = let fields = splitWhen (== ',') arg in
-- 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)