mirror of
https://github.com/github/semantic.git
synced 2024-11-24 00:42:33 +03:00
Merge branch 'master' into stack-ghc-package-paths
This commit is contained in:
Jon Ruskin
GitHub
commit
5bc8abf457
@ -7,6 +7,7 @@ module Data.Syntax.Algebra
|
||||
, identifierAlgebra
|
||||
, syntaxIdentifierAlgebra
|
||||
, cyclomaticComplexityAlgebra
|
||||
, ConstructorName(..)
|
||||
, ConstructorLabel(..)
|
||||
, constructorNameAndConstantFields
|
||||
, constructorLabel
|
||||
|
||||
@ -1,8 +1,10 @@
|
||||
{-# LANGUAGE DataKinds, GADTs, RankNTypes, ScopedTypeVariables, TypeOperators #-}
|
||||
{-# LANGUAGE ConstraintKinds, DataKinds, GADTs, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
|
||||
module Parser
|
||||
( Parser(..)
|
||||
, SomeParser(..)
|
||||
, someParser
|
||||
-- Syntax parsers
|
||||
, parserForLanguage
|
||||
, syntaxParserForLanguage
|
||||
-- À la carte parsers
|
||||
, jsonParser
|
||||
, markdownParser
|
||||
@ -13,6 +15,7 @@ module Parser
|
||||
|
||||
import qualified CMarkGFM
|
||||
import Data.Functor.Classes (Eq1)
|
||||
import Data.Kind
|
||||
import Data.Ix
|
||||
import Data.Record
|
||||
import qualified Data.Syntax as Syntax
|
||||
@ -49,9 +52,43 @@ data Parser term where
|
||||
-- | A parser for 'Markdown' using cmark.
|
||||
MarkdownParser :: Parser (Term (TermF [] CMarkGFM.NodeType) (Node Markdown.Grammar))
|
||||
|
||||
-- | Apply all of a list of typeclasses to all of a list of functors using 'Apply'. Used by 'someParser' to constrain all of the language-specific syntax types to the typeclasses in question.
|
||||
type family ApplyAll (typeclasses :: [(* -> *) -> Constraint]) (functors :: [* -> *]) :: Constraint where
|
||||
ApplyAll (typeclass ': typeclasses) functors = (Apply typeclass functors, ApplyAll typeclasses functors)
|
||||
ApplyAll '[] functors = ()
|
||||
|
||||
-- | A parser for some specific language, producing 'Term's whose syntax satisfies a list of typeclass constraints.
|
||||
--
|
||||
-- This enables us to abstract over the details of the specific syntax types in cases where we can describe all the requirements on the syntax with a list of typeclasses.
|
||||
data SomeParser typeclasses where
|
||||
SomeParser :: ApplyAll typeclasses fs => { unSomeParser :: Parser (Term (Union fs) (Record Location)) } -> SomeParser typeclasses
|
||||
|
||||
-- | Construct a 'SomeParser' given a proxy for a list of typeclasses and the 'Language' to be parsed, all of which must be satisfied by all of the types in the syntaxes of our supported languages.
|
||||
--
|
||||
-- This can be used to perform operations uniformly over terms produced by blobs with different 'Language's, and which therefore have different types in general. For example, given some 'Blob', we can parse and 'show' the parsed & assigned 'Term' like so:
|
||||
--
|
||||
-- > case someParser (Proxy :: Proxy '[Show1]) (blobLanguage language) of { Just parser -> runTask (parse parser blob) >>= putStrLn . show ; _ -> return () }
|
||||
someParser :: ( ApplyAll typeclasses JSON.Syntax
|
||||
, ApplyAll typeclasses Markdown.Syntax
|
||||
, ApplyAll typeclasses Python.Syntax
|
||||
, ApplyAll typeclasses Ruby.Syntax
|
||||
, ApplyAll typeclasses TypeScript.Syntax
|
||||
)
|
||||
=> proxy typeclasses -- ^ A proxy for the list of typeclasses required, e.g. @(Proxy :: Proxy '[Show1])@.
|
||||
-> Language -- ^ The 'Language' to select.
|
||||
-> Maybe (SomeParser typeclasses) -- ^ 'Maybe' a 'SomeParser' abstracting the syntax type to be produced.
|
||||
someParser _ Go = Nothing
|
||||
someParser _ JavaScript = Just (SomeParser typescriptParser)
|
||||
someParser _ JSON = Just (SomeParser jsonParser)
|
||||
someParser _ JSX = Just (SomeParser typescriptParser)
|
||||
someParser _ Markdown = Just (SomeParser markdownParser)
|
||||
someParser _ Python = Just (SomeParser pythonParser)
|
||||
someParser _ Ruby = Just (SomeParser rubyParser)
|
||||
someParser _ TypeScript = Just (SomeParser typescriptParser)
|
||||
|
||||
-- | Return a 'Language'-specific 'Parser', if one exists, falling back to the 'LineByLineParser'.
|
||||
parserForLanguage :: Language -> Maybe (Parser (Term Syntax (Record DefaultFields)))
|
||||
parserForLanguage language = case language of
|
||||
syntaxParserForLanguage :: Language -> Maybe (Parser (Term Syntax (Record DefaultFields)))
|
||||
syntaxParserForLanguage language = case language of
|
||||
Go -> Just (TreeSitterParser tree_sitter_go)
|
||||
JavaScript -> Just (TreeSitterParser tree_sitter_typescript)
|
||||
JSON -> Just (TreeSitterParser tree_sitter_json)
|
||||
|
||||
@ -7,14 +7,16 @@ module Semantic
|
||||
, diffTermPair
|
||||
) where
|
||||
|
||||
import Algorithm (Diffable)
|
||||
import Control.Exception
|
||||
import Control.Monad ((<=<))
|
||||
import Control.Monad.Error.Class
|
||||
import Data.Bifunctor
|
||||
import Data.Align.Generic
|
||||
import Data.Blob
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Diff
|
||||
import Data.Functor.Both as Both
|
||||
import Data.Functor.Classes
|
||||
import Data.Output
|
||||
import Data.Record
|
||||
import Data.Syntax.Algebra
|
||||
@ -46,21 +48,22 @@ parseBlob renderer blob@Blob{..} = case (renderer, blobLanguage) of
|
||||
(ToCTermRenderer, Just Language.Python) -> parse pythonParser blob >>= decorate (declarationAlgebra blob) >>= render (renderToCTerm blob)
|
||||
(ToCTermRenderer, Just Language.TypeScript) -> parse typescriptParser blob >>= decorate (declarationAlgebra blob) >>= render (renderToCTerm blob)
|
||||
(ToCTermRenderer, Just Language.Ruby) -> parse rubyParser blob >>= decorate (declarationAlgebra blob) >>= render (renderToCTerm blob)
|
||||
(ToCTermRenderer, _) | Just syntaxParser <- syntaxParser -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob) >>= render (renderToCTerm blob)
|
||||
(JSONTermRenderer, Just Language.JSON) -> parse jsonParser blob >>= decorate constructorLabel >>= render (renderJSONTerm blob)
|
||||
(JSONTermRenderer, Just Language.Markdown) -> parse markdownParser blob >>= decorate constructorLabel >>= render (renderJSONTerm blob)
|
||||
(JSONTermRenderer, Just Language.Python) -> parse pythonParser blob >>= decorate constructorLabel >>= render (renderJSONTerm blob)
|
||||
(JSONTermRenderer, Just Language.TypeScript) -> parse typescriptParser blob >>= decorate constructorLabel >>= render (renderJSONTerm blob)
|
||||
(JSONTermRenderer, Just Language.Ruby) -> parse rubyParser blob >>= decorate constructorLabel >>= render (renderJSONTerm blob)
|
||||
(JSONTermRenderer, _) | Just syntaxParser <- syntaxParser -> parse syntaxParser blob >>= decorate syntaxIdentifierAlgebra >>= render (renderJSONTerm blob)
|
||||
(SExpressionTermRenderer, Just Language.JSON) -> parse jsonParser blob >>= decorate constructorLabel >>= render renderSExpressionTerm . fmap keepConstructorLabel
|
||||
(SExpressionTermRenderer, Just Language.Markdown) -> parse markdownParser blob >>= decorate constructorLabel >>= render renderSExpressionTerm . fmap keepConstructorLabel
|
||||
(SExpressionTermRenderer, Just Language.Python) -> parse pythonParser blob >>= decorate constructorLabel >>= render renderSExpressionTerm . fmap keepConstructorLabel
|
||||
(SExpressionTermRenderer, Just Language.TypeScript) -> parse typescriptParser blob >>= decorate constructorLabel >>= render renderSExpressionTerm . fmap keepConstructorLabel
|
||||
(SExpressionTermRenderer, Just Language.Ruby) -> parse rubyParser blob >>= decorate constructorLabel >>= render renderSExpressionTerm . fmap keepConstructorLabel
|
||||
(SExpressionTermRenderer, _) | Just syntaxParser <- syntaxParser -> parse syntaxParser blob >>= render renderSExpressionTerm . fmap keepCategory
|
||||
(ToCTermRenderer, lang)
|
||||
| Just syntaxParser <- lang >>= syntaxParserForLanguage ->
|
||||
parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob) >>= render (renderToCTerm blob)
|
||||
|
||||
(JSONTermRenderer, lang)
|
||||
| Just (SomeParser parser) <- lang >>= someParser (Proxy :: Proxy '[ConstructorName, Foldable, Functor]) ->
|
||||
parse parser blob >>= decorate constructorLabel >>= render (renderJSONTerm blob)
|
||||
| Just syntaxParser <- lang >>= syntaxParserForLanguage ->
|
||||
parse syntaxParser blob >>= decorate syntaxIdentifierAlgebra >>= render (renderJSONTerm blob)
|
||||
|
||||
(SExpressionTermRenderer, lang)
|
||||
| Just (SomeParser parser) <- lang >>= someParser (Proxy :: Proxy '[ConstructorName, Foldable, Functor]) ->
|
||||
parse parser blob >>= decorate constructorLabel . (Nil <$) >>= render renderSExpressionTerm
|
||||
| Just syntaxParser <- lang >>= syntaxParserForLanguage ->
|
||||
parse syntaxParser blob >>= render renderSExpressionTerm . fmap keepCategory
|
||||
_ -> throwError (SomeException (NoParserForLanguage blobPath blobLanguage))
|
||||
where syntaxParser = blobLanguage >>= parserForLanguage
|
||||
|
||||
data NoParserForLanguage = NoParserForLanguage FilePath (Maybe Language.Language)
|
||||
deriving (Eq, Exception, Ord, Show, Typeable)
|
||||
@ -75,38 +78,41 @@ diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of
|
||||
(OldToCDiffRenderer, Just Language.Markdown) -> run (\ blob -> parse markdownParser blob >>= decorate (markupSectionAlgebra blob)) diffTerms (renderToCDiff blobs)
|
||||
(OldToCDiffRenderer, Just Language.Python) -> run (\ blob -> parse pythonParser blob >>= decorate (declarationAlgebra blob)) diffTerms (renderToCDiff blobs)
|
||||
(OldToCDiffRenderer, Just Language.Ruby) -> run (\ blob -> parse rubyParser blob >>= decorate (declarationAlgebra blob)) diffTerms (renderToCDiff blobs)
|
||||
(OldToCDiffRenderer, _) | Just syntaxParser <- syntaxParser -> run (\ blob -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob)) diffSyntaxTerms (renderToCDiff blobs)
|
||||
(OldToCDiffRenderer, lang)
|
||||
| Just syntaxParser <- lang >>= syntaxParserForLanguage ->
|
||||
run (\ blob -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob)) diffSyntaxTerms (renderToCDiff blobs)
|
||||
|
||||
(ToCDiffRenderer, Just Language.Markdown) -> run (\ blob -> parse markdownParser blob >>= decorate (markupSectionAlgebra blob)) diffTerms (renderToCDiff blobs)
|
||||
(ToCDiffRenderer, Just Language.Python) -> run (\ blob -> parse pythonParser blob >>= decorate (declarationAlgebra blob)) diffTerms (renderToCDiff blobs)
|
||||
(ToCDiffRenderer, Just Language.Ruby) -> run (\ blob -> parse rubyParser blob >>= decorate (declarationAlgebra blob)) diffTerms (renderToCDiff blobs)
|
||||
(ToCDiffRenderer, Just Language.TypeScript) -> run (\ blob -> parse typescriptParser blob >>= decorate (declarationAlgebra blob)) diffTerms (renderToCDiff blobs)
|
||||
(ToCDiffRenderer, _) | Just syntaxParser <- syntaxParser -> run (\ blob -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob)) diffSyntaxTerms (renderToCDiff blobs)
|
||||
(ToCDiffRenderer, lang)
|
||||
| Just syntaxParser <- lang >>= syntaxParserForLanguage ->
|
||||
run (\ blob -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob)) diffSyntaxTerms (renderToCDiff blobs)
|
||||
|
||||
(JSONDiffRenderer, lang)
|
||||
| Just (SomeParser parser) <- lang >>= someParser (Proxy :: Proxy '[Diffable, Eq1, Foldable, Functor, GAlign, Show1, Traversable]) ->
|
||||
run (parse parser) diffTerms (renderJSONDiff blobs)
|
||||
| Just syntaxParser <- lang >>= syntaxParserForLanguage ->
|
||||
run (decorate syntaxIdentifierAlgebra <=< parse syntaxParser) diffSyntaxTerms (renderJSONDiff blobs)
|
||||
|
||||
(PatchDiffRenderer, lang)
|
||||
| Just (SomeParser parser) <- lang >>= someParser (Proxy :: Proxy '[Diffable, Eq1, Foldable, Functor, GAlign, Show1, Traversable]) ->
|
||||
run (parse parser) diffTerms (renderPatch blobs)
|
||||
| Just syntaxParser <- lang >>= syntaxParserForLanguage ->
|
||||
run (parse syntaxParser) diffSyntaxTerms (renderPatch blobs)
|
||||
|
||||
(SExpressionDiffRenderer, lang)
|
||||
| Just (SomeParser parser) <- lang >>= someParser (Proxy :: Proxy '[ConstructorName, Diffable, Eq1, Foldable, Functor, GAlign, Show1, Traversable]) ->
|
||||
run (decorate constructorLabel . (Nil <$) <=< parse parser) diffTerms renderSExpressionDiff
|
||||
| Just syntaxParser <- lang >>= syntaxParserForLanguage ->
|
||||
run (fmap (fmap keepCategory) . parse syntaxParser) diffSyntaxTerms renderSExpressionDiff
|
||||
|
||||
(JSONDiffRenderer, Just Language.JSON) -> run (parse jsonParser) diffTerms (renderJSONDiff blobs)
|
||||
(JSONDiffRenderer, Just Language.Markdown) -> run (parse markdownParser) diffTerms (renderJSONDiff blobs)
|
||||
(JSONDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffTerms (renderJSONDiff blobs)
|
||||
(JSONDiffRenderer, Just Language.Ruby) -> run (parse rubyParser) diffTerms (renderJSONDiff blobs)
|
||||
(JSONDiffRenderer, Just Language.TypeScript) -> run (parse typescriptParser) diffTerms (renderJSONDiff blobs)
|
||||
(JSONDiffRenderer, _) | Just syntaxParser <- syntaxParser -> run (decorate syntaxIdentifierAlgebra <=< parse syntaxParser) diffSyntaxTerms (renderJSONDiff blobs)
|
||||
(PatchDiffRenderer, Just Language.JSON) -> run (parse jsonParser) diffTerms (renderPatch blobs)
|
||||
(PatchDiffRenderer, Just Language.Markdown) -> run (parse markdownParser) diffTerms (renderPatch blobs)
|
||||
(PatchDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffTerms (renderPatch blobs)
|
||||
(PatchDiffRenderer, Just Language.Ruby) -> run (parse rubyParser) diffTerms (renderPatch blobs)
|
||||
(PatchDiffRenderer, Just Language.TypeScript) -> run (parse typescriptParser) diffTerms (renderPatch blobs)
|
||||
(PatchDiffRenderer, _) | Just syntaxParser <- syntaxParser -> run (parse syntaxParser) diffSyntaxTerms (renderPatch blobs)
|
||||
(SExpressionDiffRenderer, Just Language.JSON) -> run (decorate constructorLabel <=< parse jsonParser) diffTerms (renderSExpressionDiff . bimap keepConstructorLabel keepConstructorLabel)
|
||||
(SExpressionDiffRenderer, Just Language.Markdown) -> run (decorate constructorLabel <=< parse markdownParser) diffTerms (renderSExpressionDiff . bimap keepConstructorLabel keepConstructorLabel)
|
||||
(SExpressionDiffRenderer, Just Language.Python) -> run (decorate constructorLabel <=< parse pythonParser) diffTerms (renderSExpressionDiff . bimap keepConstructorLabel keepConstructorLabel)
|
||||
(SExpressionDiffRenderer, Just Language.Ruby) -> run (decorate constructorLabel <=< parse rubyParser) diffTerms (renderSExpressionDiff . bimap keepConstructorLabel keepConstructorLabel)
|
||||
(SExpressionDiffRenderer, Just Language.TypeScript) -> run (decorate constructorLabel <=< parse typescriptParser) diffTerms (renderSExpressionDiff . bimap keepConstructorLabel keepConstructorLabel)
|
||||
(SExpressionDiffRenderer, _) | Just syntaxParser <- syntaxParser -> run (parse syntaxParser) diffSyntaxTerms (renderSExpressionDiff . bimap keepCategory keepCategory)
|
||||
_ -> throwError (SomeException (NoParserForLanguage effectivePath effectiveLanguage))
|
||||
where (effectivePath, effectiveLanguage) = case runJoin blobs of
|
||||
(Blob { blobLanguage = Just lang, blobPath = path }, _) -> (path, Just lang)
|
||||
(_, Blob { blobLanguage = Just lang, blobPath = path }) -> (path, Just lang)
|
||||
(Blob { blobPath = path }, _) -> (path, Nothing)
|
||||
syntaxParser = effectiveLanguage >>= parserForLanguage
|
||||
|
||||
run :: Functor syntax => (Blob -> Task (Term syntax ann)) -> (Term syntax ann -> Term syntax ann -> Diff syntax ann ann) -> (Diff syntax ann ann -> output) -> Task output
|
||||
run parse diff renderer = distributeFor blobs parse >>= runBothWith (diffTermPair blobs diff) >>= render renderer
|
||||
@ -127,6 +133,3 @@ diffTermPair blobs differ t1 t2 = case runJoin (blobExists <$> blobs) of
|
||||
|
||||
keepCategory :: HasField fields Category => Record fields -> Record '[Category]
|
||||
keepCategory = (:. Nil) . category
|
||||
|
||||
keepConstructorLabel :: Record (ConstructorLabel ': fields) -> Record '[ConstructorLabel]
|
||||
keepConstructorLabel = (:. Nil) . rhead
|
||||
|
||||
@ -88,7 +88,7 @@ spec = parallel $ do
|
||||
|
||||
it "summarizes Go methods with receivers with special formatting" $ do
|
||||
sourceBlobs <- blobsForPaths (both "go/method-with-receiver.A.go" "go/method-with-receiver.B.go")
|
||||
let Just goParser = parserForLanguage Go
|
||||
let Just goParser = syntaxParserForLanguage Go
|
||||
diff <- runTask $ distributeFor sourceBlobs (\ blob -> parse goParser blob >>= decorate (syntaxDeclarationAlgebra blob)) >>= runBothWith (diffTermPair sourceBlobs diffSyntaxTerms)
|
||||
diffTOC diff `shouldBe`
|
||||
[ JSONSummary "Method" "(*apiClient) CheckAuth" (sourceSpanBetween (3,1) (3,101)) "added" ]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user