github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-01 00:33:59 +03:00
Code Issues Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/master' into grpc-trees

Browse Source
This commit is contained in:
joshvera 2018-06-18 18:10:46 -04:00
commit 4b8c4ba137
23 changed files with 139 additions and 156 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
preludes/javascript.js
View File

@ -1,2 +0,0 @@
// can't quite define console.log in a way we can evaluate yet, but...
// function log(x) { return __semantic_print(x) }

3
preludes/python.py
View File

@ -1,3 +0,0 @@
def print(x):
__semantic_print(x)
return x

13
preludes/ruby.rb
View File

@ -1,13 +0,0 @@
class Object
def new
self
end
def inspect
return "<object>"
end
end
def puts(obj)
__semantic_print(obj)
end

1
semantic.cabal
View File

@ -127,7 +127,6 @@ library
, Language.PHP.Assignment
, Language.PHP.Grammar
, Language.PHP.Syntax
, Language.Preluded
, Language.Python.Assignment
, Language.Python.Grammar
, Language.Python.Syntax

47
src/Control/Abstract/Primitive.hs
View File

@ -5,25 +5,42 @@ import Control.Abstract.Environment
import Control.Abstract.Evaluator
import Control.Abstract.Heap
import Control.Abstract.Value
import qualified Data.Abstract.Environment as Env
import Data.Abstract.Name
import Data.Text (pack, unpack)
import Data.Text (unpack)
import Prologue
builtin :: ( HasCallStack
, Member (Allocator address value) effects
, Member (Env address) effects
, Member (Reader ModuleInfo) effects
, Member (Reader Span) effects
)
=> String
-> Evaluator address value effects value
-> Evaluator address value effects ()
builtin s def = withCurrentCallStack callStack $ do
let name' = name ("__semantic_" <> pack s)
addr <- alloc name'
bind name' addr
define :: ( HasCallStack
, Member (Allocator address value) effects
, Member (Env address) effects
, Member (Reader ModuleInfo) effects
, Member (Reader Span) effects
)
=> Name
-> Evaluator address value effects value
-> Evaluator address value effects ()
define name def = withCurrentCallStack callStack $ do
addr <- alloc name
bind name addr
def >>= assign addr
defineClass :: ( AbstractValue address value effects
, HasCallStack
, Member (Allocator address value) effects
, Member (Env address) effects
, Member (Reader ModuleInfo) effects
, Member (Reader Span) effects
)
=> Name
-> [Name]
-> Evaluator address value effects a
-> Evaluator address value effects ()
defineClass name superclasses scope = define name $ do
env <- locally $ do
void scope
Env.head <$> getEnv
klass name (map (string . formatName) superclasses) env
lambda :: (AbstractFunction address value effects, Member Fresh effects)
=> (Name -> Evaluator address value effects address)
-> Evaluator address value effects value
@ -43,4 +60,4 @@ defineBuiltins :: ( AbstractValue address value effects
)
=> Evaluator address value effects ()
defineBuiltins =
builtin "print" (lambda (\ v -> variable v >>= deref >>= asString >>= trace . unpack >> box unit))
define "__semantic_print" (lambda (\ v -> variable v >>= deref >>= asString >>= trace . unpack >> box unit))

81
src/Data/Abstract/Evaluatable.hs
View File

@ -1,10 +1,12 @@
{-# LANGUAGE GADTs, RankNTypes, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
{-# LANGUAGE GADTs, KindSignatures, RankNTypes, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
module Data.Abstract.Evaluatable
( module X
, Evaluatable(..)
, evaluatePackageWith
, traceResolve
-- | Effects
-- * Preludes
, HasPrelude(..)
-- * Effects
, EvalError(..)
, throwEvalError
, runEvalError
@ -30,6 +32,7 @@ import Data.Abstract.ModuleTable as ModuleTable
import Data.Abstract.Name as X
import Data.Abstract.Package as Package
import Data.Abstract.Ref as X
import Data.Language
import Data.Scientific (Scientific)
import Data.Semigroup.App
import Data.Semigroup.Foldable
@ -62,7 +65,7 @@ class Show1 constr => Evaluatable constr where
-- | Evaluate a given package.
evaluatePackageWith :: forall address term value inner inner' inner'' outer
evaluatePackageWith :: forall proxy lang address term value inner inner' inner'' outer
. ( AbstractValue address value inner
-- FIXME: It’d be nice if we didn’t have to mention 'Addressable' here at all, but 'Located' locations require knowledge of 'currentModule' to run. Can we fix that?
, Addressable address inner'
@ -70,6 +73,7 @@ evaluatePackageWith :: forall address term value inner inner' inner'' outer
, Evaluatable (Base term)
, Foldable (Cell address)
, FreeVariables term
, HasPrelude lang
, Member Fresh outer
, Member (Resumable (AddressError address value)) outer
, Member (Resumable (EnvironmentError address)) outer
@ -87,15 +91,16 @@ evaluatePackageWith :: forall address term value inner inner' inner'' outer
, inner' ~ (Reader ModuleInfo ': inner'')
, inner'' ~ (Modules address value ': Reader Span ': Reader PackageInfo ': outer)
)
=> (SubtermAlgebra Module term (TermEvaluator term address value inner address) -> SubtermAlgebra Module term (TermEvaluator term address value inner address))
=> proxy lang
-> (SubtermAlgebra Module term (TermEvaluator term address value inner address) -> SubtermAlgebra Module term (TermEvaluator term address value inner address))
-> (SubtermAlgebra (Base term) term (TermEvaluator term address value inner (ValueRef address)) -> SubtermAlgebra (Base term) term (TermEvaluator term address value inner (ValueRef address)))
-> Package term
-> TermEvaluator term address value outer [(address, Environment address)]
evaluatePackageWith analyzeModule analyzeTerm package
evaluatePackageWith lang analyzeModule analyzeTerm package
= runReader (packageInfo package)
. runReader lowerBound
. runReader (packageModules (packageBody package))
. withPrelude (packagePrelude (packageBody package))
. withPrelude package
$ \ preludeEnv
-> raiseHandler (runModules (runTermEvaluator . evalModule preludeEnv))
. traverse (uncurry (evaluateEntryPoint preludeEnv))
@ -121,13 +126,14 @@ evaluatePackageWith analyzeModule analyzeTerm package
bindAll env
maybe (pure ptr) ((`call` []) <=< deref <=< variable) sym
evalPrelude prelude = raiseHandler (runModules (runTermEvaluator . evalModule lowerBound)) $ do
(_, builtinsEnv) <- runInModule lowerBound moduleInfoFromCallStack (TermEvaluator (defineBuiltins *> box unit))
second (mergeEnvs builtinsEnv) <$> evalModule builtinsEnv prelude
withPrelude Nothing f = f lowerBound
withPrelude (Just prelude) f = do
(_, preludeEnv) <- evalPrelude prelude
withPrelude :: Package term
-> (Environment address -> TermEvaluator term address value (Reader (ModuleTable (NonEmpty (Module term))) ': Reader Span ': Reader PackageInfo ': outer) a)
-> TermEvaluator term address value (Reader (ModuleTable (NonEmpty (Module term))) ': Reader Span ': Reader PackageInfo ': outer) a
withPrelude _ f = do
(_, preludeEnv) <- raiseHandler (runModules (runTermEvaluator . evalModule lowerBound)) . runInModule lowerBound moduleInfoFromCallStack . TermEvaluator $ do
defineBuiltins
definePrelude lang
box unit
f preludeEnv
@ -135,6 +141,55 @@ traceResolve :: (Show a, Show b, Member Trace effects) => a -> b -> Evaluator ad
traceResolve name path = trace ("resolved " <> show name <> " -> " <> show path)
-- Preludes
class HasPrelude (language :: Language) where
definePrelude :: ( AbstractValue address value effects
, HasCallStack
, Member (Allocator address value) effects
, Member (Env address) effects
, Member Fresh effects
, Member (Reader ModuleInfo) effects
, Member (Reader Span) effects
, Member (Resumable (EnvironmentError address)) effects
, Member Trace effects
)
=> proxy language
-> Evaluator address value effects ()
definePrelude _ = pure ()
instance HasPrelude 'Go
instance HasPrelude 'Haskell
instance HasPrelude 'Java
instance HasPrelude 'JavaScript
instance HasPrelude 'PHP
builtInPrint :: ( AbstractIntro value
, AbstractFunction address value effects
, Member (Resumable (EnvironmentError address)) effects
, Member (Env address) effects, Member (Allocator address value) effects)
=> Name
-> Evaluator address value effects address
builtInPrint v = do
print <- variable "__semantic_print" >>= deref
void $ call print [variable v]
box unit
instance HasPrelude 'Python where
definePrelude _ =
define "print" (lambda builtInPrint)
instance HasPrelude 'Ruby where
definePrelude _ = do
define "puts" (lambda builtInPrint)
defineClass "Object" [] $ do
define "inspect" (lambda (const (box (string "<object>"))))
instance HasPrelude 'TypeScript
-- FIXME: define console.log using __semantic_print
-- Effects
-- | The type of error thrown when failing to evaluate a term.

7
src/Data/Abstract/Package.hs
View File

@ -22,7 +22,6 @@ newtype Version = Version { versionString :: String }
data PackageBody term = PackageBody
{ packageModules :: ModuleTable (NonEmpty (Module term))
, packagePrelude :: Maybe (Module term)
, packageEntryPoints :: ModuleTable (Maybe Name)
}
deriving (Eq, Functor, Ord, Show)
@ -35,8 +34,8 @@ data Package term = Package
}
deriving (Eq, Functor, Ord, Show)
fromModules :: PackageName -> Maybe Version -> Maybe (Module term) -> Int -> [Module term] -> Map.Map FilePath FilePath -> Package term
fromModules name version prelude entryPoints modules resolutions =
Package (PackageInfo name version resolutions) (PackageBody (ModuleTable.fromModules modules) prelude entryPoints')
fromModules :: PackageName -> Maybe Version -> Int -> [Module term] -> Map.Map FilePath FilePath -> Package term
fromModules name version entryPoints modules resolutions =
Package (PackageInfo name version resolutions) (PackageBody (ModuleTable.fromModules modules) entryPoints')
where
entryPoints' = ModuleTable . Map.fromList $ (,Nothing) . modulePath . moduleInfo <$> if entryPoints == 0 then modules else take entryPoints modules

22
src/Language/Preluded.hs
View File

@ -1,22 +0,0 @@
{-# LANGUAGE DataKinds, TypeFamilies #-}
module Language.Preluded
( Preluded (..)
) where
import GHC.TypeLits
import qualified Language.Python.Assignment as Python
import qualified Language.Ruby.Assignment as Ruby
import qualified Language.TypeScript.Assignment as TypeScript
class Preluded syntax where
type PreludePath syntax :: Symbol
instance Preluded Ruby.Term where
type PreludePath Ruby.Term = "preludes/ruby.rb"
instance Preluded Python.Term where
type PreludePath Python.Term = "preludes/python.py"
instance Preluded TypeScript.Term where
type PreludePath TypeScript.Term = "preludes/javascript.js"

28
src/Parsing/Parser.hs
View File

@ -25,6 +25,7 @@ module Parsing.Parser
import Assigning.Assignment
import qualified CMarkGFM
import Data.Abstract.Evaluatable (HasPrelude)
import Data.AST
import Data.Kind
import Data.Language
@ -32,16 +33,13 @@ import Data.Record
import Data.Sum
import qualified Data.Syntax as Syntax
import Data.Term
import Data.Project
import Foreign.Ptr
import qualified GHC.TypeLits as TypeLevel
import qualified Language.Go.Assignment as Go
import qualified Language.Haskell.Assignment as Haskell
import qualified Language.Java.Assignment as Java
import qualified Language.JSON.Assignment as JSON
import qualified Language.Markdown.Assignment as Markdown
import qualified Language.PHP.Assignment as PHP
import Language.Preluded
import qualified Language.Python.Assignment as Python
import qualified Language.Ruby.Assignment as Ruby
import qualified Language.TypeScript.Assignment as TypeScript
@ -63,10 +61,12 @@ type family ApplyAll' (typeclasses :: [(* -> *) -> Constraint]) (fs :: [* -> *])
-- | A parser, suitable for program analysis, for some specific language, producing 'Term's whose syntax satisfies a list of typeclass constraints.
data SomeAnalysisParser typeclasses ann where
SomeAnalysisParser :: ( Element Syntax.Identifier fs
, ApplyAll' typeclasses fs)
SomeAnalysisParser :: ( ApplyAll' typeclasses fs
, Element Syntax.Identifier fs
, HasPrelude lang
)
=> Parser (Term (Sum fs) ann) -- ^ A parser.
-> Maybe File -- ^ Maybe path to prelude.
-> Proxy lang
-> SomeAnalysisParser typeclasses ann
-- | A parser for some specific language, producing 'Term's whose syntax satisfies a list of typeclass constraints.
@ -81,14 +81,14 @@ someAnalysisParser :: ( ApplyAll' typeclasses Go.Syntax
=> proxy typeclasses -- ^ A proxy for the list of typeclasses required, e.g. @(Proxy :: Proxy '[Show1])@.
-> Language -- ^ The 'Language' to select.
-> SomeAnalysisParser typeclasses (Record Location) -- ^ A 'SomeAnalysisParser abstracting the syntax type to be produced.
someAnalysisParser _ Go = SomeAnalysisParser goParser Nothing
someAnalysisParser _ Java = SomeAnalysisParser javaParser Nothing
someAnalysisParser _ JavaScript = SomeAnalysisParser typescriptParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) JavaScript)
someAnalysisParser _ Haskell = SomeAnalysisParser haskellParser Nothing
someAnalysisParser _ PHP = SomeAnalysisParser phpParser Nothing
someAnalysisParser _ Python = SomeAnalysisParser pythonParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) Python)
someAnalysisParser _ Ruby = SomeAnalysisParser rubyParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) Ruby)
someAnalysisParser _ TypeScript = SomeAnalysisParser typescriptParser Nothing
someAnalysisParser _ Go = SomeAnalysisParser goParser (Proxy :: Proxy 'Go)
someAnalysisParser _ Haskell = SomeAnalysisParser haskellParser (Proxy :: Proxy 'Haskell)
someAnalysisParser _ Java = SomeAnalysisParser javaParser (Proxy :: Proxy 'Java)
someAnalysisParser _ JavaScript = SomeAnalysisParser typescriptParser (Proxy :: Proxy 'JavaScript)
someAnalysisParser _ PHP = SomeAnalysisParser phpParser (Proxy :: Proxy 'PHP)
someAnalysisParser _ Python = SomeAnalysisParser pythonParser (Proxy :: Proxy 'Python)
someAnalysisParser _ Ruby = SomeAnalysisParser rubyParser (Proxy :: Proxy 'Ruby)
someAnalysisParser _ TypeScript = SomeAnalysisParser typescriptParser (Proxy :: Proxy 'TypeScript)
someAnalysisParser _ l = error $ "Analysis not supported for: " <> show l

4
src/Rendering/Renderer.hs
View File

@ -12,7 +12,6 @@ module Rendering.Renderer
, renderToSymbols
, ImportSummary(..)
, renderToImports
, renderToTags
, renderTreeGraph
, Summaries(..)
, TOCSummary(..)
@ -21,7 +20,6 @@ module Rendering.Renderer
, parseSymbolFields
) where
import Data.Aeson (Value)
import Data.ByteString.Builder
import Data.Graph
import Rendering.Graph as R
@ -52,8 +50,6 @@ data TermRenderer output where
JSONTermRenderer :: TermRenderer (JSON "trees" SomeJSON)
-- | Render to a 'ByteString' formatted as nested s-expressions.
SExpressionTermRenderer :: TermRenderer Builder
-- | Render to a list of tags (deprecated).
TagsTermRenderer :: TermRenderer [Value]
-- | Render to a list of symbols.
SymbolsTermRenderer :: SymbolFields -> TermRenderer (JSON "files" SomeJSON)
-- | Render to a list of modules that represent the import graph.

16
src/Rendering/Symbol.hs
View File

@ -1,7 +1,6 @@
{-# LANGUAGE RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
module Rendering.Symbol
( renderToSymbols
, renderToTags
, SymbolFields(..)
, defaultSymbolFields
, parseSymbolFields
@ -20,18 +19,6 @@ import qualified Data.Text as T
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 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)]
@ -100,9 +87,6 @@ data SymbolFields = SymbolFields
defaultSymbolFields :: SymbolFields
defaultSymbolFields = SymbolFields True False False True False True
defaultTagSymbolFields :: SymbolFields
defaultTagSymbolFields = SymbolFields True True True True True True
parseSymbolFields :: String -> SymbolFields
parseSymbolFields arg =
let fields = splitWhen (== ',') arg in

1
src/Semantic/CLI.hs
View File

@ -64,7 +64,6 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar
parseArgumentsParser = do
renderer <- flag (Parse.runParse SExpressionTermRenderer) (Parse.runParse SExpressionTermRenderer) (long "sexpression" <> help "Output s-expression parse trees (default)")
<|> flag' (Parse.runParse JSONTermRenderer) (long "json" <> help "Output JSON parse trees")
<|> flag' (Parse.runParse TagsTermRenderer) (long "tags" <> help "Output JSON tags")
<|> flag' (Parse.runParse . SymbolsTermRenderer) (long "symbols" <> help "Output JSON symbol list")
<*> (option symbolFieldsReader ( long "fields"
<> help "Comma delimited list of specific fields to return (symbols output only)."

16
src/Semantic/Graph.hs
View File

@ -38,20 +38,20 @@ import Semantic.Task as Task
data GraphType = ImportGraph | CallGraph
runGraph :: ( Member (Distribute WrappedTask) effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs)
runGraph :: ( Member (Distribute WrappedTask) effs, Member Resolution effs, Member Task effs, Member Trace effs)
=> GraphType
-> Bool
-> Project
-> Eff effs (Graph Vertex)
runGraph graphType includePackages project
| SomeAnalysisParser parser prelude <- someAnalysisParser
| SomeAnalysisParser parser lang <- someAnalysisParser
(Proxy :: Proxy '[ Evaluatable, Declarations1, FreeVariables1, Functor, Eq1, Ord1, Show1 ]) (projectLanguage project) = do
package <- parsePackage parser prelude project
package <- parsePackage parser project
let analyzeTerm = withTermSpans . case graphType of
ImportGraph -> id
CallGraph -> graphingTerms
analyzeModule = (if includePackages then graphingPackages else id) . graphingModules
analyze runGraphAnalysis (evaluatePackageWith analyzeModule analyzeTerm package) >>= extractGraph
analyze runGraphAnalysis (evaluatePackageWith lang analyzeModule analyzeTerm package) >>= extractGraph
where extractGraph result = case result of
(((_, graph), _), _) -> pure (simplify graph)
runGraphAnalysis
@ -94,16 +94,14 @@ newtype GraphEff address a = GraphEff
}
-- | Parse a list of files into a 'Package'.
parsePackage :: (Member (Distribute WrappedTask) effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs)
parsePackage :: (Member (Distribute WrappedTask) effs, Member Resolution effs, Member Trace effs)
=> Parser term -- ^ A parser.
-> Maybe File -- ^ Prelude (optional).
-> Project -- ^ Project to parse into a package.
-> Eff effs (Package term)
parsePackage parser preludeFile project@Project{..} = do
prelude <- traverse (parseModule parser Nothing) preludeFile
parsePackage parser project@Project{..} = do
p <- parseModules parser project
resMap <- Task.resolutionMap project
let pkg = Package.fromModules n Nothing prelude (length projectEntryPoints) p resMap
let pkg = Package.fromModules n Nothing (length projectEntryPoints) p resMap
pkg <$ trace ("project: " <> show pkg)
where

1
src/Semantic/Parse.hs
View File

@ -22,7 +22,6 @@ runParse :: (Member (Distribute WrappedTask) effs, Member Task effs) => TermRend
runParse JSONTermRenderer = withParsedBlobs (render . renderJSONTerm) >=> serialize JSON
runParse SExpressionTermRenderer = withParsedBlobs (const (serialize (SExpression ByConstructorName)))
runParse ShowTermRenderer = withParsedBlobs (const (serialize Show))
runParse TagsTermRenderer = withParsedBlobs (\ blob -> decorate (declarationAlgebra blob) >=> render (renderToTags blob)) >=> serialize JSON
runParse ImportsTermRenderer = withParsedBlobs (\ blob -> decorate (declarationAlgebra blob) >=> decorate (packageDefAlgebra blob) >=> render (renderToImports blob)) >=> serialize JSON
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"))

28
src/Semantic/Util.hs
View File

@ -17,10 +17,8 @@ import Data.Functor.Foldable
import qualified Data.Language as Language
import Data.Sum (weaken)
import Data.Term
import qualified GHC.TypeLits as TypeLevel
import Language.Haskell.HsColour
import Language.Haskell.HsColour.Colourise
import Language.Preluded
import Parsing.Parser
import Prologue hiding (weaken)
import Semantic.Graph
@ -29,10 +27,6 @@ import Semantic.Task
import Text.Show (showListWith)
import Text.Show.Pretty (ppShow)
import qualified Language.Python.Assignment as Python
import qualified Language.Ruby.Assignment as Ruby
import qualified Language.TypeScript.Assignment as TypeScript
justEvaluating
= runM
. evaluating
@ -87,22 +81,18 @@ checking
. runAddressError
. runTypeError
evalGoProject path = justEvaluating =<< evaluateProject goParser Language.Go Nothing path
evalRubyProject path = justEvaluating =<< evaluateProject rubyParser Language.Ruby rubyPrelude path
evalPHPProject path = justEvaluating =<< evaluateProject phpParser Language.PHP Nothing path
evalPythonProject path = justEvaluating =<< evaluateProject pythonParser Language.Python pythonPrelude path
evalJavaScriptProject path = justEvaluating =<< evaluateProject typescriptParser Language.JavaScript javaScriptPrelude path
evalTypeScriptProject path = justEvaluating =<< evaluateProject typescriptParser Language.TypeScript Nothing path
evalGoProject path = justEvaluating =<< evaluateProject (Proxy :: Proxy 'Language.Go) goParser Language.Go path
evalRubyProject path = justEvaluating =<< evaluateProject (Proxy :: Proxy 'Language.Ruby) rubyParser Language.Ruby path
evalPHPProject path = justEvaluating =<< evaluateProject (Proxy :: Proxy 'Language.PHP) phpParser Language.PHP path
evalPythonProject path = justEvaluating =<< evaluateProject (Proxy :: Proxy 'Language.Python) pythonParser Language.Python path
evalJavaScriptProject path = justEvaluating =<< evaluateProject (Proxy :: Proxy 'Language.JavaScript) typescriptParser Language.JavaScript path
evalTypeScriptProject path = justEvaluating =<< evaluateProject (Proxy :: Proxy 'Language.TypeScript) typescriptParser Language.TypeScript path
typecheckGoFile path = checking =<< evaluateProjectWithCaching goParser Language.Go Nothing path
rubyPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) Language.Ruby
pythonPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) Language.Python
javaScriptPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) Language.JavaScript
typecheckGoFile path = checking =<< evaluateProjectWithCaching (Proxy :: Proxy 'Language.Go) goParser Language.Go path
-- Evaluate a project, starting at a single entrypoint.
evaluateProject parser lang prelude path = evaluatePackageWith id withTermSpans . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= parsePackage parser prelude)
evaluateProjectWithCaching parser lang prelude path = evaluatePackageWith convergingModules (withTermSpans . cachingTerms) . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= parsePackage parser prelude)
evaluateProject proxy parser lang path = evaluatePackageWith proxy id withTermSpans . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= parsePackage parser)
evaluateProjectWithCaching proxy parser lang path = evaluatePackageWith proxy convergingModules (withTermSpans . cachingTerms) . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= parsePackage parser)
parseFile :: Parser term -> FilePath -> IO term

2
test/Analysis/Go/Spec.hs
View File

@ -25,4 +25,4 @@ spec = parallel $ do
where
fixtures = "test/fixtures/go/analysis/"
evaluate entry = evalGoProject (fixtures <> entry)
evalGoProject path = testEvaluating <$> evaluateProject goParser Language.Go Nothing path
evalGoProject path = testEvaluating <$> evaluateProject (Proxy :: Proxy 'Language.Go) goParser Language.Go path

2
test/Analysis/PHP/Spec.hs
View File

@ -32,4 +32,4 @@ spec = parallel $ do
where
fixtures = "test/fixtures/php/analysis/"
evaluate entry = evalPHPProject (fixtures <> entry)
evalPHPProject path = testEvaluating <$> evaluateProject phpParser Language.PHP Nothing path
evalPHPProject path = testEvaluating <$> evaluateProject (Proxy :: Proxy 'Language.PHP) phpParser Language.PHP path

2
test/Analysis/Python/Spec.hs
View File

@ -46,4 +46,4 @@ spec = parallel $ do
ns n = Just . Latest . Last . Just . Namespace n
fixtures = "test/fixtures/python/analysis/"
evaluate entry = evalPythonProject (fixtures <> entry)
evalPythonProject path = testEvaluating <$> evaluateProject pythonParser Language.Python pythonPrelude path
evalPythonProject path = testEvaluating <$> evaluateProject (Proxy :: Proxy 'Language.Python) pythonParser Language.Python path

2
test/Analysis/Ruby/Spec.hs
View File

@ -77,4 +77,4 @@ spec = parallel $ do
ns n = Just . Latest . Last . Just . Namespace n
fixtures = "test/fixtures/ruby/analysis/"
evaluate entry = evalRubyProject (fixtures <> entry)
evalRubyProject path = testEvaluating <$> evaluateProject rubyParser Language.Ruby rubyPrelude path
evalRubyProject path = testEvaluating <$> evaluateProject (Proxy :: Proxy 'Language.Ruby) rubyParser Language.Ruby path

2
test/Analysis/TypeScript/Spec.hs
View File

@ -40,4 +40,4 @@ spec = parallel $ do
where
fixtures = "test/fixtures/typescript/analysis/"
evaluate entry = evalTypeScriptProject (fixtures <> entry)
evalTypeScriptProject path = testEvaluating <$> evaluateProject typescriptParser Language.TypeScript Nothing path
evalTypeScriptProject path = testEvaluating <$> evaluateProject (Proxy :: Proxy 'Language.TypeScript) typescriptParser Language.TypeScript path

1
test/Semantic/CLI/Spec.hs
View File

@ -37,7 +37,6 @@ parseFixtures =
, (show JSONTermRenderer, runParse JSONTermRenderer, path', prefix </> "parse-trees.json")
, (show JSONTermRenderer, runParse JSONTermRenderer, [], prefix </> "parse-tree-empty.json")
, (show (SymbolsTermRenderer defaultSymbolFields), runParse (SymbolsTermRenderer defaultSymbolFields), path'', prefix </> "parse-tree.symbols.json")
, (show TagsTermRenderer, runParse TagsTermRenderer, path'', prefix </> "parse-tree.tags.json")
]
where path = [File "test/fixtures/ruby/corpus/and-or.A.rb" Ruby]
path' = [File "test/fixtures/ruby/corpus/and-or.A.rb" Ruby, File "test/fixtures/ruby/corpus/and-or.B.rb" Ruby]

1
test/SpecHelpers.hs
View File

@ -32,6 +32,7 @@ import Data.Blob as X
import Data.ByteString.Builder (toLazyByteString)
import Data.ByteString.Lazy (toStrict)
import Data.Project as X
import Data.Proxy as X
import Data.Functor.Listable as X
import Data.Language as X
import Data.List.NonEmpty as X (NonEmpty(..))

13
test/fixtures/cli/parse-tree.tags.json vendored
View File

@ -1,13 +0,0 @@
[
{
"span":
{
"start": [1, 1],
"end": [2, 4]
},
"path": "test/fixtures/ruby/corpus/method-declaration.A.rb",
"kind": "Method",
"symbol": "foo",
"line": "def foo",
"language": "Ruby"
}]