github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-28 18:23:44 +03:00
Code Issues Projects Releases Wiki Activity

Add support for JSON and TypeScript responses

Browse Source
This commit is contained in:
joshvera 2018-07-02 18:02:48 -04:00
parent 71f54e4f57
commit 46f6583504
2 changed files with 22 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Parsing/Parser.hs
View File

@ -3,6 +3,8 @@ module Parsing.Parser
( Parser(..)
, SomeTerm(..)
, withSomeTerm
, SomeSyntaxTerm
, withSomeSyntaxTerm
, SomeAnalysisParser(..)
, SomeASTParser(..)
, someParser
@ -179,6 +181,11 @@ data SomeTerm typeclasses ann where
withSomeTerm :: (forall syntax . ApplyAll typeclasses syntax => Term syntax ann -> a) -> SomeTerm typeclasses ann -> a
withSomeTerm with (SomeTerm term) = with term
data SomeSyntaxTerm syntax ann where
SomeSyntaxTerm :: Term syntax ann -> SomeSyntaxTerm syntax ann
withSomeSyntaxTerm :: (forall syntax . Term syntax ann -> a) -> SomeSyntaxTerm syntax ann -> a
withSomeSyntaxTerm with (SomeSyntaxTerm term) = with term
-- | A parser for producing specialized (tree-sitter) ASTs.
data SomeASTParser where

17
src/Semantic/Parse.hs
View File

@ -10,6 +10,7 @@ import Data.JSON.Fields
import Data.Record
import Data.Term
import Parsing.Parser
import Data.Language hiding (JSON)
import Prologue hiding (MonadError(..))
import Rendering.Graph
import Rendering.Renderer
@ -17,6 +18,8 @@ import Semantic.IO (noLanguageForBlob)
import Semantic.Task
import Serializing.Format
import qualified Language.Ruby.Assignment as Ruby
import qualified Language.TypeScript.Assignment as TypeScript
import qualified Language.JSON.Assignment as JSON
runParse :: (Member (Distribute WrappedTask) effs, Member Task effs) => TermRenderer output -> [Blob] -> Eff effs Builder
runParse JSONTermRenderer = withParsedBlobs (render . renderJSONTerm) >=> serialize JSON
@ -25,11 +28,21 @@ runParse ShowTermRenderer = withParsedBlobs (const (serialize Show))
runParse (SymbolsTermRenderer fields) = withParsedBlobs (\ blob -> decorate (declarationAlgebra blob) >=> render (renderSymbolTerms . renderToSymbols fields blob)) >=> serialize JSON
runParse DOTTermRenderer = withParsedBlobs (const (render renderTreeGraph)) >=> serialize (DOT (termStyle "terms"))
runRawParse :: Member (Distribute WrappedTask) effs => [Blob] -> Eff effs [Term (Sum Ruby.Syntax) ()]
runRawParse = flip distributeFor (\ blob -> WrapTask (do
runRubyParse :: Member (Distribute WrappedTask) effs => [Blob] -> Eff effs [Term (Sum Ruby.Syntax) ()]
runRubyParse = flip distributeFor (\ blob -> WrapTask (do
term <- parse rubyParser blob
pure (() <$ term)))
runTypeScriptParse :: Member (Distribute WrappedTask) effs => [Blob] -> Eff effs [Term (Sum TypeScript.Syntax) ()]
runTypeScriptParse = flip distributeFor (\ blob -> WrapTask (do
term <- parse typescriptParser blob
pure (() <$ term)))
runJSONParse :: Member (Distribute WrappedTask) effs => [Blob] -> Eff effs [Term (Sum JSON.Syntax) ()]
runJSONParse = flip distributeFor (\ blob -> WrapTask (do
term <- parse jsonParser blob
pure (() <$ term)))
withParsedBlobs :: (Member (Distribute WrappedTask) effs, Monoid output) => (forall syntax . (ConstructorName syntax, Foldable syntax, Functor syntax, HasDeclaration syntax, HasPackageDef syntax, Show1 syntax, ToJSONFields1 syntax) => Blob -> Term syntax (Record Location) -> TaskEff output) -> [Blob] -> Eff effs output
withParsedBlobs render = distributeFoldMap (\ blob -> WrapTask (parseSomeBlob blob >>= withSomeTerm (render blob)))