mirror of
https://github.com/github/semantic.git
synced 2024-12-29 01:42:43 +03:00
Merge branch 'master' into allocator-effect
This commit is contained in:
commit
6f3698122c
2
preludes/javascript.js
Normal file
2
preludes/javascript.js
Normal file
@ -0,0 +1,2 @@
|
||||
// can't quite define console.log in a way we can evaluate yet, but...
|
||||
// function log(x) { return __semantic_print(x) }
|
@ -70,7 +70,6 @@ library
|
||||
, Data.Blob
|
||||
, Data.Diff
|
||||
, Data.Error
|
||||
, Data.File
|
||||
, Data.Functor.Both
|
||||
, Data.Functor.Classes.Generic
|
||||
, Data.Graph
|
||||
@ -79,6 +78,7 @@ library
|
||||
, Data.Map.Monoidal
|
||||
, Data.Mergeable
|
||||
, Data.Patch
|
||||
, Data.Project
|
||||
, Data.Range
|
||||
, Data.Record
|
||||
, Data.Semigroup.App
|
||||
@ -147,6 +147,7 @@ library
|
||||
, Semantic.Log
|
||||
, Semantic.Parse
|
||||
, Semantic.Queue
|
||||
, Semantic.Resolution
|
||||
, Semantic.Stat
|
||||
, Semantic.Task
|
||||
, Semantic.Telemetry
|
||||
@ -198,6 +199,7 @@ library
|
||||
, these
|
||||
, time
|
||||
, unix
|
||||
, unordered-containers
|
||||
, haskell-tree-sitter
|
||||
, tree-sitter-go
|
||||
, tree-sitter-json
|
||||
|
@ -29,7 +29,7 @@ import Prologue
|
||||
lookupModule :: Member (Modules location value) effects => ModulePath -> Evaluator location value effects (Maybe (Maybe (Environment location value, value)))
|
||||
lookupModule = send . Lookup
|
||||
|
||||
-- Resolve a list of module paths to a possible module table entry.
|
||||
-- | Resolve a list of module paths to a possible module table entry.
|
||||
resolve :: Member (Modules location value) effects => [FilePath] -> Evaluator location value effects (Maybe ModulePath)
|
||||
resolve = sendModules . Resolve
|
||||
|
||||
|
@ -10,8 +10,9 @@ type PackageName = Name
|
||||
|
||||
-- | Metadata for a package (name and version).
|
||||
data PackageInfo = PackageInfo
|
||||
{ packageName :: PackageName
|
||||
, packageVersion :: Maybe Version
|
||||
{ packageName :: PackageName
|
||||
, packageVersion :: Maybe Version
|
||||
, packageResolutions :: Map.Map FilePath FilePath
|
||||
}
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
@ -33,8 +34,8 @@ data Package term = Package
|
||||
}
|
||||
deriving (Eq, Functor, Ord, Show)
|
||||
|
||||
fromModules :: PackageName -> Maybe Version -> Maybe (Module term) -> Int -> [Module term] -> Package term
|
||||
fromModules name version prelude entryPoints modules =
|
||||
Package (PackageInfo name version) (PackageBody (ModuleTable.fromModules modules) prelude entryPoints')
|
||||
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')
|
||||
where
|
||||
entryPoints' = ModuleTable . Map.fromList $ (,Nothing) . modulePath . moduleInfo <$> if entryPoints == 0 then modules else take entryPoints modules
|
||||
|
@ -1,30 +1,32 @@
|
||||
module Data.File where
|
||||
module Data.Project where
|
||||
|
||||
import Data.ByteString.Char8 as BC (pack)
|
||||
import Data.Language
|
||||
import Prologue
|
||||
import System.FilePath.Posix
|
||||
|
||||
data Project = Project
|
||||
{ projectRootDir :: FilePath
|
||||
, projectFiles :: [File]
|
||||
, projectLanguage :: Language
|
||||
, projectEntryPoints :: [File]
|
||||
, projectExcludeDirs :: [FilePath]
|
||||
}
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
projectName :: Project -> ByteString
|
||||
projectName = BC.pack . dropExtensions . takeFileName . projectRootDir
|
||||
|
||||
projectExtensions :: Project -> [String]
|
||||
projectExtensions = extensionsForLanguage . projectLanguage
|
||||
|
||||
|
||||
data File = File
|
||||
{ filePath :: FilePath
|
||||
, fileLanguage :: Maybe Language
|
||||
}
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
data Project = Project
|
||||
{ projectRootDir :: FilePath
|
||||
, projectFiles :: [File]
|
||||
, projectLanguage :: Language
|
||||
, projectEntryPoints :: [File]
|
||||
}
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
file :: FilePath -> File
|
||||
file path = File path (languageForFilePath path)
|
||||
where languageForFilePath = languageForType . takeExtension
|
||||
|
||||
projectName :: Project -> ByteString
|
||||
projectName = BC.pack . dropExtensions . takeFileName . projectRootDir
|
||||
|
||||
projectExtensions :: Project -> [String]
|
||||
projectExtensions = extensionsForLanguage . projectLanguage
|
@ -7,6 +7,7 @@ module Language.Preluded
|
||||
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
|
||||
@ -16,3 +17,6 @@ instance Preluded Ruby.Term where
|
||||
|
||||
instance Preluded Python.Term where
|
||||
type PreludePath Python.Term = "preludes/python.py"
|
||||
|
||||
instance Preluded TypeScript.Term where
|
||||
type PreludePath TypeScript.Term = "preludes/javascript.js"
|
||||
|
@ -11,6 +11,7 @@ import Data.Functor.Classes.Generic
|
||||
import Data.JSON.Fields
|
||||
import qualified Data.Language as Language
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
import qualified Data.Semigroup.Reducer as Reducer
|
||||
import Data.Mergeable
|
||||
import Diffing.Algorithm
|
||||
import GHC.Generics
|
||||
@ -98,9 +99,17 @@ instance Ord1 Import where liftCompare = genericLiftCompare
|
||||
instance Show1 Import where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
-- from a import b
|
||||
-- from a import b as c
|
||||
-- from a import *
|
||||
instance Evaluatable Import where
|
||||
-- from . import moduleY
|
||||
-- This is a bit of a special case in the syntax as this actually behaves like a qualified relative import.
|
||||
eval (Import (RelativeQualifiedName n Nothing) [(name, _)]) = do
|
||||
path <- NonEmpty.last <$> resolvePythonModules (RelativeQualifiedName n (Just (qualifiedName (unName name :| []))))
|
||||
Rval <$> evalQualifiedImport name path
|
||||
|
||||
-- from a import b
|
||||
-- from a import b as c
|
||||
-- from a import *
|
||||
-- from .moduleY import b
|
||||
eval (Import name xs) = do
|
||||
modulePaths <- resolvePythonModules name
|
||||
|
||||
@ -118,6 +127,24 @@ instance Evaluatable Import where
|
||||
| otherwise = Env.overwrite xs importedEnv
|
||||
|
||||
|
||||
-- Evaluate a qualified import
|
||||
evalQualifiedImport :: ( AbstractValue location a effects
|
||||
, Addressable location effects
|
||||
, Reducer.Reducer a (Cell location a)
|
||||
, Members '[ (State (Exports location a))
|
||||
, (State (Environment location a))
|
||||
, (State (Heap location (Cell location) a))
|
||||
, (Reader (Environment location a))
|
||||
, (Modules location a)
|
||||
] effects
|
||||
)
|
||||
=> Name -> ModulePath -> Evaluator location a effects a
|
||||
evalQualifiedImport name path = letrec' name $ \addr -> do
|
||||
importedEnv <- maybe emptyEnv fst <$> isolate (require path)
|
||||
modifyEnv (mergeEnvs importedEnv)
|
||||
void $ makeNamespace name addr Nothing
|
||||
unit
|
||||
|
||||
newtype QualifiedImport a = QualifiedImport { qualifiedImportFrom :: QualifiedName }
|
||||
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
|
||||
|
||||
@ -135,12 +162,8 @@ instance Evaluatable QualifiedImport where
|
||||
Rval <$> go (NonEmpty.zip (FV.name . BC.pack <$> qualifiedName) modulePaths)
|
||||
where
|
||||
-- Evaluate and import the last module, updating the environment
|
||||
go ((name, path) :| []) = letrec' name $ \addr -> do
|
||||
importedEnv <- maybe emptyEnv fst <$> isolate (require path)
|
||||
modifyEnv (mergeEnvs importedEnv)
|
||||
void $ makeNamespace name addr Nothing
|
||||
unit
|
||||
-- Evaluate each parent module, creating a just namespace
|
||||
go ((name, path) :| []) = evalQualifiedImport name path
|
||||
-- Evaluate each parent module, just creating a namespace
|
||||
go ((name, path) :| xs) = letrec' name $ \addr -> do
|
||||
void $ isolate (require path)
|
||||
void $ go (NonEmpty.fromList xs)
|
||||
|
@ -2,14 +2,16 @@
|
||||
module Language.TypeScript.Syntax where
|
||||
|
||||
import qualified Data.Abstract.Environment as Env
|
||||
import qualified Data.Abstract.FreeVariables as FV
|
||||
import Data.Abstract.Evaluatable
|
||||
import qualified Data.Abstract.FreeVariables as FV
|
||||
import qualified Data.Abstract.Module as M
|
||||
import Data.Abstract.Package
|
||||
import Data.Abstract.Path
|
||||
import qualified Data.ByteString.Char8 as BC
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Char8 as BC
|
||||
import Data.JSON.Fields
|
||||
import qualified Data.Language as Language
|
||||
import qualified Data.Map as Map
|
||||
import Data.Semigroup.Reducer (Reducer)
|
||||
import Diffing.Algorithm
|
||||
import Prelude
|
||||
@ -33,9 +35,12 @@ toName :: ImportPath -> Name
|
||||
toName = FV.name . BC.pack . unPath
|
||||
|
||||
-- Node.js resolution algorithm: https://nodejs.org/api/modules.html#modules_all_together
|
||||
-- TypeScript has a couple of different strategies, but the main one mimics Node.js.
|
||||
--
|
||||
-- NB: TypeScript has a couple of different strategies, but the main one (and the
|
||||
-- only one we support) mimics Node.js.
|
||||
resolveWithNodejsStrategy :: Members '[ Modules location value
|
||||
, Reader M.ModuleInfo
|
||||
, Reader PackageInfo
|
||||
, Resumable ResolutionError
|
||||
, Trace
|
||||
] effects
|
||||
@ -54,6 +59,7 @@ resolveWithNodejsStrategy (ImportPath path NonRelative) exts = resolveNonRelativ
|
||||
-- /root/src/moduleB/index.ts
|
||||
resolveRelativePath :: Members '[ Modules location value
|
||||
, Reader M.ModuleInfo
|
||||
, Reader PackageInfo
|
||||
, Resumable ResolutionError
|
||||
, Trace
|
||||
] effects
|
||||
@ -64,7 +70,8 @@ resolveRelativePath relImportPath exts = do
|
||||
M.ModuleInfo{..} <- currentModule
|
||||
let relRootDir = takeDirectory modulePath
|
||||
let path = joinPaths relRootDir relImportPath
|
||||
resolveTSModule path exts >>= either notFound (\x -> x <$ traceResolve relImportPath path)
|
||||
trace ("attempting to resolve (relative) require/import " <> show relImportPath)
|
||||
resolveModule path exts >>= either notFound (\x -> x <$ traceResolve relImportPath path)
|
||||
where
|
||||
notFound xs = throwResumable $ NotFoundError relImportPath xs Language.TypeScript
|
||||
|
||||
@ -80,6 +87,7 @@ resolveRelativePath relImportPath exts = do
|
||||
-- /node_modules/moduleB.ts, etc
|
||||
resolveNonRelativePath :: Members '[ Modules location value
|
||||
, Reader M.ModuleInfo
|
||||
, Reader PackageInfo
|
||||
, Resumable ResolutionError
|
||||
, Trace
|
||||
] effects
|
||||
@ -93,24 +101,31 @@ resolveNonRelativePath name exts = do
|
||||
nodeModulesPath dir = takeDirectory dir </> "node_modules" </> name
|
||||
-- Recursively search in a 'node_modules' directory, stepping up a directory each time.
|
||||
go root path searched = do
|
||||
res <- resolveTSModule (nodeModulesPath path) exts
|
||||
trace ("attempting to resolve (non-relative) require/import " <> show name)
|
||||
res <- resolveModule (nodeModulesPath path) exts
|
||||
case res of
|
||||
Left xs | parentDir <- takeDirectory path , root /= parentDir -> go root parentDir (searched <> xs)
|
||||
| otherwise -> notFound (searched <> xs)
|
||||
Right m -> m <$ traceResolve name m
|
||||
notFound xs = throwResumable $ NotFoundError name xs Language.TypeScript
|
||||
|
||||
resolveTSModule :: Member (Modules location value) effects
|
||||
=> FilePath
|
||||
-> [String]
|
||||
-- | Resolve a module name to a ModulePath.
|
||||
resolveModule :: Members '[ Modules location value
|
||||
, Reader PackageInfo
|
||||
, Trace
|
||||
] effects
|
||||
=> FilePath -- ^ Module path used as directory to search in
|
||||
-> [String] -- ^ File extensions to look for
|
||||
-> Evaluator location value effects (Either [FilePath] M.ModulePath)
|
||||
resolveTSModule path exts = maybe (Left searchPaths) Right <$> resolve searchPaths
|
||||
where searchPaths =
|
||||
((path <.>) <$> exts)
|
||||
-- TODO: Requires parsing package.json, getting the path of the
|
||||
-- "types" property and adding that value to the search Paths.
|
||||
-- <> [searchDir </> "package.json"]
|
||||
<> (((path </> "index") <.>) <$> exts)
|
||||
resolveModule path' exts = do
|
||||
let path = makeRelative "." path'
|
||||
PackageInfo{..} <- currentPackage
|
||||
let packageDotJSON = Map.lookup (path </> "package.json") packageResolutions
|
||||
let searchPaths = ((path <.>) <$> exts)
|
||||
<> maybe mempty (:[]) packageDotJSON
|
||||
<> (((path </> "index") <.>) <$> exts)
|
||||
trace ("searching in " <> show searchPaths)
|
||||
maybe (Left searchPaths) Right <$> resolve searchPaths
|
||||
|
||||
typescriptExtensions :: [String]
|
||||
typescriptExtensions = ["ts", "tsx", "d.ts"]
|
||||
|
@ -29,7 +29,7 @@ import Data.Record
|
||||
import Data.Sum
|
||||
import qualified Data.Syntax as Syntax
|
||||
import Data.Term
|
||||
import Data.File
|
||||
import Data.Project
|
||||
import Foreign.Ptr
|
||||
import qualified GHC.TypeLits as TypeLevel
|
||||
import qualified Language.Go.Assignment as Go
|
||||
@ -73,7 +73,7 @@ someAnalysisParser :: ( ApplyAll' typeclasses Go.Syntax
|
||||
-> Language -- ^ The 'Language' to select.
|
||||
-> SomeAnalysisParser typeclasses (Record Location) -- ^ A 'SomeAnalysisParser abstracting the syntax type to be produced.
|
||||
someAnalysisParser _ Go = SomeAnalysisParser goParser Nothing
|
||||
someAnalysisParser _ JavaScript = SomeAnalysisParser typescriptParser Nothing
|
||||
someAnalysisParser _ JavaScript = SomeAnalysisParser typescriptParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) (Just JavaScript))
|
||||
someAnalysisParser _ PHP = SomeAnalysisParser phpParser Nothing
|
||||
someAnalysisParser _ Python = SomeAnalysisParser pythonParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) (Just Python))
|
||||
someAnalysisParser _ Ruby = SomeAnalysisParser rubyParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) (Just Ruby))
|
||||
|
@ -6,7 +6,7 @@ module Semantic.CLI
|
||||
, Parse.runParse
|
||||
) where
|
||||
|
||||
import Data.File
|
||||
import Data.Project
|
||||
import Data.Language (Language)
|
||||
import Data.List (intercalate)
|
||||
import Data.List.Split (splitWhen)
|
||||
|
@ -28,7 +28,7 @@ import Data.Abstract.Module
|
||||
import Data.Abstract.Package as Package
|
||||
import Data.Abstract.Value (Value, ValueError(..), runValueErrorWith)
|
||||
import Data.ByteString.Char8 (pack)
|
||||
import Data.File
|
||||
import Data.Project
|
||||
import Data.Record
|
||||
import Data.Semilattice.Lower
|
||||
import Data.Term
|
||||
@ -39,7 +39,7 @@ import Semantic.Task as Task
|
||||
|
||||
data GraphType = ImportGraph | CallGraph
|
||||
|
||||
graph :: Members '[Distribute WrappedTask, Files, Task, Exc SomeException, Telemetry, Trace] effs
|
||||
graph :: Members '[Distribute WrappedTask, Files, Resolution, Task, Exc SomeException, Telemetry, Trace] effs
|
||||
=> GraphType
|
||||
-> Project
|
||||
-> Eff effs (Graph Vertex)
|
||||
@ -69,7 +69,7 @@ graph graphType project
|
||||
. runTermEvaluator @_ @_ @(Value (Located Precise))
|
||||
|
||||
-- | Parse a list of files into a 'Package'.
|
||||
parsePackage :: Members '[Distribute WrappedTask, Files, Task, Trace] effs
|
||||
parsePackage :: Members '[Distribute WrappedTask, Files, Resolution, Task, Trace] effs
|
||||
=> Parser term -- ^ A parser.
|
||||
-> Maybe File -- ^ Prelude (optional).
|
||||
-> Project -- ^ Project to parse into a package.
|
||||
@ -77,7 +77,8 @@ parsePackage :: Members '[Distribute WrappedTask, Files, Task, Trace] effs
|
||||
parsePackage parser preludeFile project@Project{..} = do
|
||||
prelude <- traverse (parseModule parser Nothing) preludeFile
|
||||
p <- parseModules parser project
|
||||
let pkg = Package.fromModules n Nothing prelude (length projectEntryPoints) p
|
||||
resMap <- Task.resolutionMap project
|
||||
let pkg = Package.fromModules n Nothing prelude (length projectEntryPoints) p resMap
|
||||
pkg <$ trace ("project: " <> show pkg)
|
||||
|
||||
where
|
||||
|
@ -5,7 +5,6 @@ module Semantic.IO
|
||||
, isDirectory
|
||||
, readBlobPairsFromHandle
|
||||
, readBlobsFromHandle
|
||||
, readBlobsFromPaths
|
||||
, readProjectFromPaths
|
||||
, readBlobsFromDir
|
||||
, findFiles
|
||||
@ -13,9 +12,10 @@ module Semantic.IO
|
||||
, NoLanguageForBlob(..)
|
||||
, noLanguageForBlob
|
||||
, readBlob
|
||||
, readProject
|
||||
, readBlobs
|
||||
, readBlobPairs
|
||||
, readProject
|
||||
, findFilesInDir
|
||||
, write
|
||||
, Handle(..)
|
||||
, getHandle
|
||||
@ -38,7 +38,7 @@ import Control.Monad.IO.Class
|
||||
import Data.Aeson
|
||||
import qualified Data.Blob as Blob
|
||||
import Data.Bool
|
||||
import Data.File
|
||||
import Data.Project
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Builder as B
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
@ -97,9 +97,6 @@ readBlobFromPath file = do
|
||||
maybeFile <- readFile file
|
||||
maybe (fail ("cannot read '" <> show file <> "', file not found or language not supported.")) pure maybeFile
|
||||
|
||||
readBlobsFromPaths :: MonadIO m => [File] -> m [Blob.Blob]
|
||||
readBlobsFromPaths files = catMaybes <$> traverse readFile files
|
||||
|
||||
readProjectFromPaths :: MonadIO m => Maybe FilePath -> FilePath -> Language -> [FilePath] -> m Project
|
||||
readProjectFromPaths maybeRoot path lang excludeDirs = do
|
||||
isDir <- isDirectory path
|
||||
@ -107,15 +104,15 @@ readProjectFromPaths maybeRoot path lang excludeDirs = do
|
||||
then (id, [], fromMaybe path maybeRoot)
|
||||
else (filter (/= path), [toFile path], fromMaybe (takeDirectory path) maybeRoot)
|
||||
|
||||
paths <- liftIO $ filterFun <$> findFiles rootDir exts excludeDirs
|
||||
pure $ Project rootDir (toFile <$> paths) lang entryPoints
|
||||
paths <- liftIO $ filterFun <$> findFilesInDir rootDir exts excludeDirs
|
||||
pure $ Project rootDir (toFile <$> paths) lang entryPoints excludeDirs
|
||||
where
|
||||
toFile path = File path (Just lang)
|
||||
exts = extensionsForLanguage lang
|
||||
|
||||
-- Recursively find files in a directory.
|
||||
findFiles :: forall m. MonadIO m => FilePath -> [String] -> [FilePath] -> m [FilePath]
|
||||
findFiles path exts excludeDirs = do
|
||||
findFilesInDir :: forall m. MonadIO m => FilePath -> [String] -> [FilePath] -> m [FilePath]
|
||||
findFilesInDir path exts excludeDirs = do
|
||||
_:/dir <- liftIO $ Tree.build path
|
||||
pure $ (onlyFiles . Tree.filterDir (withExtensions exts) . Tree.filterDir (notIn excludeDirs)) dir
|
||||
where
|
||||
@ -208,6 +205,9 @@ readBlobPairs (Right paths) = traverse (send . Read . FromPathPair) paths
|
||||
readProject :: Member Files effs => Maybe FilePath -> FilePath -> Language -> [FilePath] -> Eff effs Project
|
||||
readProject rootDir dir excludeDirs = send . ReadProject rootDir dir excludeDirs
|
||||
|
||||
findFiles :: Member Files effs => FilePath -> [String] -> [FilePath] -> Eff effs [FilePath]
|
||||
findFiles dir exts = send . FindFiles dir exts
|
||||
|
||||
-- | A task which writes a 'B.Builder' to a 'Handle' or a 'FilePath'.
|
||||
write :: Member Files effs => Destination -> B.Builder -> Eff effs ()
|
||||
write dest = send . Write dest
|
||||
@ -247,6 +247,7 @@ data Destination = ToPath FilePath | ToHandle (Handle 'IO.WriteMode)
|
||||
data Files out where
|
||||
Read :: Source out -> Files out
|
||||
ReadProject :: Maybe FilePath -> FilePath -> Language -> [FilePath] -> Files Project
|
||||
FindFiles :: FilePath -> [String] -> [FilePath] -> Files [FilePath]
|
||||
Write :: Destination -> B.Builder -> Files ()
|
||||
|
||||
-- | Run a 'Files' effect in 'IO'.
|
||||
@ -257,6 +258,7 @@ runFiles = interpret $ \ files -> case files of
|
||||
Read (FromPathPair paths) -> rethrowing (runBothWith readFilePair paths)
|
||||
Read (FromPairHandle handle) -> rethrowing (readBlobPairsFromHandle handle)
|
||||
ReadProject rootDir dir language excludeDirs -> rethrowing (readProjectFromPaths rootDir dir language excludeDirs)
|
||||
FindFiles dir exts excludeDirs -> rethrowing (findFilesInDir dir exts excludeDirs)
|
||||
Write (ToPath path) builder -> liftIO (IO.withBinaryFile path IO.WriteMode (`B.hPutBuilder` builder))
|
||||
Write (ToHandle (WriteHandle handle)) builder -> liftIO (B.hPutBuilder handle builder)
|
||||
|
||||
|
45
src/Semantic/Resolution.hs
Normal file
45
src/Semantic/Resolution.hs
Normal file
@ -0,0 +1,45 @@
|
||||
{-# LANGUAGE ConstraintKinds, GADTs, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
|
||||
module Semantic.Resolution where
|
||||
|
||||
import Control.Monad.Effect
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types (parseMaybe)
|
||||
import Data.Blob
|
||||
import Data.Project
|
||||
import qualified Data.Map as Map
|
||||
import Data.Source
|
||||
import Data.Language
|
||||
import Prologue
|
||||
import Semantic.IO
|
||||
import System.FilePath.Posix
|
||||
|
||||
|
||||
nodeJSResolutionMap :: Member Files effs => FilePath -> Text -> [FilePath] -> Eff effs (Map FilePath FilePath)
|
||||
nodeJSResolutionMap rootDir prop excludeDirs = do
|
||||
files <- findFiles rootDir [".json"] excludeDirs
|
||||
let packageFiles = file <$> filter ((==) "package.json" . takeFileName) files
|
||||
blobs <- readBlobs (Right packageFiles)
|
||||
pure $ fold (mapMaybe (lookup prop) blobs)
|
||||
where
|
||||
lookup :: Text -> Blob -> Maybe (Map FilePath FilePath)
|
||||
lookup k Blob{..} = decodeStrict (sourceBytes blobSource) >>= lookupProp blobPath k
|
||||
|
||||
lookupProp :: FilePath -> Text -> Object -> Maybe (Map FilePath FilePath)
|
||||
lookupProp path k res = flip parseMaybe res $ \obj -> Map.singleton relPkgDotJSONPath . relEntryPath <$> obj .: k
|
||||
where relPkgDotJSONPath = makeRelative rootDir path
|
||||
relEntryPath x = takeDirectory relPkgDotJSONPath </> x
|
||||
|
||||
resolutionMap :: Member Resolution effs => Project -> Eff effs (Map FilePath FilePath)
|
||||
resolutionMap Project{..} = case projectLanguage of
|
||||
TypeScript -> send (NodeJSResolution projectRootDir "types" projectExcludeDirs)
|
||||
JavaScript -> send (NodeJSResolution projectRootDir "main" projectExcludeDirs)
|
||||
_ -> send NoResolution
|
||||
|
||||
data Resolution output where
|
||||
NodeJSResolution :: FilePath -> Text -> [FilePath] -> Resolution (Map FilePath FilePath)
|
||||
NoResolution :: Resolution (Map FilePath FilePath)
|
||||
|
||||
runResolution :: Members '[Files] effs => Eff (Resolution ': effs) a -> Eff effs a
|
||||
runResolution = interpret $ \ res -> case res of
|
||||
NodeJSResolution dir prop excludeDirs -> nodeJSResolutionMap dir prop excludeDirs
|
||||
NoResolution -> pure Map.empty
|
@ -10,7 +10,11 @@ module Semantic.Task
|
||||
, IO.readBlobs
|
||||
, IO.readBlobPairs
|
||||
, IO.readProject
|
||||
, IO.findFiles
|
||||
, IO.write
|
||||
-- * Module Resolution
|
||||
, resolutionMap
|
||||
, Resolution
|
||||
-- * Telemetry
|
||||
, writeLog
|
||||
, writeStat
|
||||
@ -66,6 +70,7 @@ import Parsing.TreeSitter
|
||||
import Prologue hiding (MonadError (..))
|
||||
import Semantic.Distribute
|
||||
import qualified Semantic.IO as IO
|
||||
import Semantic.Resolution
|
||||
import Semantic.Log
|
||||
import Semantic.Queue
|
||||
import Semantic.Stat as Stat
|
||||
@ -77,6 +82,7 @@ import System.IO (stderr)
|
||||
-- | A high-level task producing some result, e.g. parsing, diffing, rendering. 'Task's can also specify explicit concurrency via 'distribute', 'distributeFor', and 'distributeFoldMap'
|
||||
type TaskEff = Eff '[Distribute WrappedTask
|
||||
, Task
|
||||
, Resolution
|
||||
, IO.Files
|
||||
, Reader Options
|
||||
, Trace
|
||||
@ -129,7 +135,14 @@ runTaskWithOptions options task = do
|
||||
|
||||
(result, stat) <- withTiming "run" [] $ do
|
||||
let run :: TaskEff a -> IO (Either SomeException a)
|
||||
run = runM . runError . runTelemetry logger statter . runTraceInTelemetry . runReader options . IO.runFiles . runTaskF . runDistribute (run . unwrapTask)
|
||||
run = runM . runError
|
||||
. runTelemetry logger statter
|
||||
. runTraceInTelemetry
|
||||
. runReader options
|
||||
. IO.runFiles
|
||||
. runResolution
|
||||
. runTaskF
|
||||
. runDistribute (run . unwrapTask)
|
||||
run task
|
||||
queue statter stat
|
||||
|
||||
|
@ -13,7 +13,7 @@ import Data.Abstract.Evaluatable
|
||||
import Data.Abstract.Value
|
||||
import Data.Abstract.Type
|
||||
import Data.Blob
|
||||
import Data.File
|
||||
import Data.Project
|
||||
import Data.Functor.Foldable
|
||||
import qualified Data.Language as Language
|
||||
import Data.Term
|
||||
@ -28,6 +28,7 @@ import Text.Show (showListWith)
|
||||
|
||||
import qualified Language.Python.Assignment as Python
|
||||
import qualified Language.Ruby.Assignment as Ruby
|
||||
import qualified Language.TypeScript.Assignment as TypeScript
|
||||
|
||||
justEvaluating
|
||||
= runM
|
||||
@ -75,6 +76,7 @@ evalGoProject path = justEvaluating =<< evaluateProject goParser Language.Go Not
|
||||
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
|
||||
evalTypeScriptProjectQuietly path = evaluatingWithHoles =<< evaluateProject typescriptParser Language.TypeScript Nothing path
|
||||
evalTypeScriptProject path = justEvaluating =<< evaluateProject typescriptParser Language.TypeScript Nothing path
|
||||
|
||||
@ -82,6 +84,7 @@ typecheckGoFile path = checking =<< evaluateProjectWithCaching goParser Language
|
||||
|
||||
rubyPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) (Just Language.Ruby)
|
||||
pythonPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) (Just Language.Python)
|
||||
javaScriptPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) (Just Language.JavaScript)
|
||||
|
||||
-- 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)
|
||||
|
@ -30,6 +30,11 @@ spec = parallel $ do
|
||||
env <- environment . snd . fst <$> evaluate "main2.py"
|
||||
Env.names env `shouldContain` [ "bar", "foo" ]
|
||||
|
||||
it "imports with relative syntax" $ do
|
||||
((_, state), _) <- evaluate "main3.py"
|
||||
Env.names (environment state) `shouldContain` [ "utils" ]
|
||||
(derefQName (heap state) ("utils" :| []) (environment state) >>= deNamespace) `shouldBe` Just ("utils", ["to_s"])
|
||||
|
||||
it "subclasses" $ do
|
||||
((res, _), _) <- evaluate "subclass.py"
|
||||
res `shouldBe` Right [injValue (String "\"bar\"")]
|
||||
|
@ -32,7 +32,7 @@ evaluate
|
||||
= runM
|
||||
. fmap (first reassociate)
|
||||
. evaluating @Precise @(Value Precise)
|
||||
. runReader (PackageInfo (name "test") Nothing)
|
||||
. runReader (PackageInfo (name "test") Nothing mempty)
|
||||
. runReader (ModuleInfo "test/Control/Abstract/Evaluator/Spec.hs")
|
||||
. Value.runValueError
|
||||
. runEnvironmentError
|
||||
|
@ -28,7 +28,7 @@ import Data.Bifunctor (first)
|
||||
import Data.Blob as X
|
||||
import Data.ByteString.Builder (toLazyByteString)
|
||||
import Data.ByteString.Lazy (toStrict)
|
||||
import Data.File as X
|
||||
import Data.Project as X
|
||||
import Data.Functor.Listable as X
|
||||
import Data.Language as X
|
||||
import Data.List.NonEmpty as X (NonEmpty(..))
|
||||
|
7
test/fixtures/javascript/analysis/main2.js
vendored
Normal file
7
test/fixtures/javascript/analysis/main2.js
vendored
Normal file
@ -0,0 +1,7 @@
|
||||
const bar = require('bar')
|
||||
const tos = require('tos')
|
||||
const wap = require('wap')
|
||||
|
||||
console.log(bar())
|
||||
console.log(tos())
|
||||
console.log(wap())
|
3
test/fixtures/javascript/analysis/node_modules/bar.js
generated
vendored
Normal file
3
test/fixtures/javascript/analysis/node_modules/bar.js
generated
vendored
Normal file
@ -0,0 +1,3 @@
|
||||
module.exports = function qux() {
|
||||
return "this is the qux function in bar.js";
|
||||
}
|
3
test/fixtures/javascript/analysis/node_modules/tos/index.js
generated
vendored
Normal file
3
test/fixtures/javascript/analysis/node_modules/tos/index.js
generated
vendored
Normal file
@ -0,0 +1,3 @@
|
||||
module.exports = function tos() {
|
||||
return "this is the tos function in tos/index.js";
|
||||
}
|
4
test/fixtures/javascript/analysis/node_modules/wap/package.json
generated
vendored
Normal file
4
test/fixtures/javascript/analysis/node_modules/wap/package.json
generated
vendored
Normal file
@ -0,0 +1,4 @@
|
||||
{
|
||||
"name": "wap",
|
||||
"main": "start.js"
|
||||
}
|
3
test/fixtures/javascript/analysis/node_modules/wap/start.js
generated
vendored
Normal file
3
test/fixtures/javascript/analysis/node_modules/wap/start.js
generated
vendored
Normal file
@ -0,0 +1,3 @@
|
||||
module.exports = function wap() {
|
||||
return "this is the wap function in wap/start.js (resolved through package.json)";
|
||||
}
|
3
test/fixtures/python/analysis/c/__init__.py
vendored
Normal file
3
test/fixtures/python/analysis/c/__init__.py
vendored
Normal file
@ -0,0 +1,3 @@
|
||||
from . import utils
|
||||
|
||||
print(utils.to_s())
|
2
test/fixtures/python/analysis/c/utils.py
vendored
Normal file
2
test/fixtures/python/analysis/c/utils.py
vendored
Normal file
@ -0,0 +1,2 @@
|
||||
def to_s():
|
||||
return "hi";
|
1
test/fixtures/python/analysis/main3.py
vendored
Normal file
1
test/fixtures/python/analysis/main3.py
vendored
Normal file
@ -0,0 +1 @@
|
||||
from c import *
|
Loading…
Reference in New Issue
Block a user