1
1
mirror of https://github.com/github/semantic.git synced 2024-12-29 18:06:14 +03:00

Merge branch 'master' into allocator-effect

This commit is contained in:
Rob Rix 2018-05-17 16:47:24 -04:00 committed by GitHub
commit 6f3698122c
26 changed files with 210 additions and 66 deletions

2
preludes/javascript.js Normal file
View 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) }

View File

@ -70,7 +70,6 @@ library
, Data.Blob , Data.Blob
, Data.Diff , Data.Diff
, Data.Error , Data.Error
, Data.File
, Data.Functor.Both , Data.Functor.Both
, Data.Functor.Classes.Generic , Data.Functor.Classes.Generic
, Data.Graph , Data.Graph
@ -79,6 +78,7 @@ library
, Data.Map.Monoidal , Data.Map.Monoidal
, Data.Mergeable , Data.Mergeable
, Data.Patch , Data.Patch
, Data.Project
, Data.Range , Data.Range
, Data.Record , Data.Record
, Data.Semigroup.App , Data.Semigroup.App
@ -147,6 +147,7 @@ library
, Semantic.Log , Semantic.Log
, Semantic.Parse , Semantic.Parse
, Semantic.Queue , Semantic.Queue
, Semantic.Resolution
, Semantic.Stat , Semantic.Stat
, Semantic.Task , Semantic.Task
, Semantic.Telemetry , Semantic.Telemetry
@ -198,6 +199,7 @@ library
, these , these
, time , time
, unix , unix
, unordered-containers
, haskell-tree-sitter , haskell-tree-sitter
, tree-sitter-go , tree-sitter-go
, tree-sitter-json , tree-sitter-json

View File

@ -29,7 +29,7 @@ import Prologue
lookupModule :: Member (Modules location value) effects => ModulePath -> Evaluator location value effects (Maybe (Maybe (Environment location value, value))) lookupModule :: Member (Modules location value) effects => ModulePath -> Evaluator location value effects (Maybe (Maybe (Environment location value, value)))
lookupModule = send . Lookup 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 :: Member (Modules location value) effects => [FilePath] -> Evaluator location value effects (Maybe ModulePath)
resolve = sendModules . Resolve resolve = sendModules . Resolve

View File

@ -10,8 +10,9 @@ type PackageName = Name
-- | Metadata for a package (name and version). -- | Metadata for a package (name and version).
data PackageInfo = PackageInfo data PackageInfo = PackageInfo
{ packageName :: PackageName { packageName :: PackageName
, packageVersion :: Maybe Version , packageVersion :: Maybe Version
, packageResolutions :: Map.Map FilePath FilePath
} }
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
@ -33,8 +34,8 @@ data Package term = Package
} }
deriving (Eq, Functor, Ord, Show) deriving (Eq, Functor, Ord, Show)
fromModules :: PackageName -> Maybe Version -> Maybe (Module term) -> Int -> [Module term] -> Package term fromModules :: PackageName -> Maybe Version -> Maybe (Module term) -> Int -> [Module term] -> Map.Map FilePath FilePath -> Package term
fromModules name version prelude entryPoints modules = fromModules name version prelude entryPoints modules resolutions =
Package (PackageInfo name version) (PackageBody (ModuleTable.fromModules modules) prelude entryPoints') Package (PackageInfo name version resolutions) (PackageBody (ModuleTable.fromModules modules) prelude entryPoints')
where where
entryPoints' = ModuleTable . Map.fromList $ (,Nothing) . modulePath . moduleInfo <$> if entryPoints == 0 then modules else take entryPoints modules entryPoints' = ModuleTable . Map.fromList $ (,Nothing) . modulePath . moduleInfo <$> if entryPoints == 0 then modules else take entryPoints modules

View File

@ -1,30 +1,32 @@
module Data.File where module Data.Project where
import Data.ByteString.Char8 as BC (pack) import Data.ByteString.Char8 as BC (pack)
import Data.Language import Data.Language
import Prologue import Prologue
import System.FilePath.Posix 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 data File = File
{ filePath :: FilePath { filePath :: FilePath
, fileLanguage :: Maybe Language , fileLanguage :: Maybe Language
} }
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
data Project = Project
{ projectRootDir :: FilePath
, projectFiles :: [File]
, projectLanguage :: Language
, projectEntryPoints :: [File]
}
deriving (Eq, Ord, Show)
file :: FilePath -> File file :: FilePath -> File
file path = File path (languageForFilePath path) file path = File path (languageForFilePath path)
where languageForFilePath = languageForType . takeExtension where languageForFilePath = languageForType . takeExtension
projectName :: Project -> ByteString
projectName = BC.pack . dropExtensions . takeFileName . projectRootDir
projectExtensions :: Project -> [String]
projectExtensions = extensionsForLanguage . projectLanguage

View File

@ -7,6 +7,7 @@ module Language.Preluded
import GHC.TypeLits import GHC.TypeLits
import qualified Language.Python.Assignment as Python import qualified Language.Python.Assignment as Python
import qualified Language.Ruby.Assignment as Ruby import qualified Language.Ruby.Assignment as Ruby
import qualified Language.TypeScript.Assignment as TypeScript
class Preluded syntax where class Preluded syntax where
type PreludePath syntax :: Symbol type PreludePath syntax :: Symbol
@ -16,3 +17,6 @@ instance Preluded Ruby.Term where
instance Preluded Python.Term where instance Preluded Python.Term where
type PreludePath Python.Term = "preludes/python.py" type PreludePath Python.Term = "preludes/python.py"
instance Preluded TypeScript.Term where
type PreludePath TypeScript.Term = "preludes/javascript.js"

View File

@ -11,6 +11,7 @@ import Data.Functor.Classes.Generic
import Data.JSON.Fields import Data.JSON.Fields
import qualified Data.Language as Language import qualified Data.Language as Language
import qualified Data.List.NonEmpty as NonEmpty import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Semigroup.Reducer as Reducer
import Data.Mergeable import Data.Mergeable
import Diffing.Algorithm import Diffing.Algorithm
import GHC.Generics import GHC.Generics
@ -98,9 +99,17 @@ instance Ord1 Import where liftCompare = genericLiftCompare
instance Show1 Import where liftShowsPrec = genericLiftShowsPrec instance Show1 Import where liftShowsPrec = genericLiftShowsPrec
-- from a import b -- from a import b
-- from a import b as c
-- from a import *
instance Evaluatable Import where 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 eval (Import name xs) = do
modulePaths <- resolvePythonModules name modulePaths <- resolvePythonModules name
@ -118,6 +127,24 @@ instance Evaluatable Import where
| otherwise = Env.overwrite xs importedEnv | 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 } newtype QualifiedImport a = QualifiedImport { qualifiedImportFrom :: QualifiedName }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) 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) Rval <$> go (NonEmpty.zip (FV.name . BC.pack <$> qualifiedName) modulePaths)
where where
-- Evaluate and import the last module, updating the environment -- Evaluate and import the last module, updating the environment
go ((name, path) :| []) = letrec' name $ \addr -> do go ((name, path) :| []) = evalQualifiedImport name path
importedEnv <- maybe emptyEnv fst <$> isolate (require path) -- Evaluate each parent module, just creating a namespace
modifyEnv (mergeEnvs importedEnv)
void $ makeNamespace name addr Nothing
unit
-- Evaluate each parent module, creating a just namespace
go ((name, path) :| xs) = letrec' name $ \addr -> do go ((name, path) :| xs) = letrec' name $ \addr -> do
void $ isolate (require path) void $ isolate (require path)
void $ go (NonEmpty.fromList xs) void $ go (NonEmpty.fromList xs)

View File

@ -2,14 +2,16 @@
module Language.TypeScript.Syntax where module Language.TypeScript.Syntax where
import qualified Data.Abstract.Environment as Env import qualified Data.Abstract.Environment as Env
import qualified Data.Abstract.FreeVariables as FV
import Data.Abstract.Evaluatable import Data.Abstract.Evaluatable
import qualified Data.Abstract.FreeVariables as FV
import qualified Data.Abstract.Module as M import qualified Data.Abstract.Module as M
import Data.Abstract.Package
import Data.Abstract.Path import Data.Abstract.Path
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import Data.JSON.Fields import Data.JSON.Fields
import qualified Data.Language as Language import qualified Data.Language as Language
import qualified Data.Map as Map
import Data.Semigroup.Reducer (Reducer) import Data.Semigroup.Reducer (Reducer)
import Diffing.Algorithm import Diffing.Algorithm
import Prelude import Prelude
@ -33,9 +35,12 @@ toName :: ImportPath -> Name
toName = FV.name . BC.pack . unPath toName = FV.name . BC.pack . unPath
-- Node.js resolution algorithm: https://nodejs.org/api/modules.html#modules_all_together -- 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 resolveWithNodejsStrategy :: Members '[ Modules location value
, Reader M.ModuleInfo , Reader M.ModuleInfo
, Reader PackageInfo
, Resumable ResolutionError , Resumable ResolutionError
, Trace , Trace
] effects ] effects
@ -54,6 +59,7 @@ resolveWithNodejsStrategy (ImportPath path NonRelative) exts = resolveNonRelativ
-- /root/src/moduleB/index.ts -- /root/src/moduleB/index.ts
resolveRelativePath :: Members '[ Modules location value resolveRelativePath :: Members '[ Modules location value
, Reader M.ModuleInfo , Reader M.ModuleInfo
, Reader PackageInfo
, Resumable ResolutionError , Resumable ResolutionError
, Trace , Trace
] effects ] effects
@ -64,7 +70,8 @@ resolveRelativePath relImportPath exts = do
M.ModuleInfo{..} <- currentModule M.ModuleInfo{..} <- currentModule
let relRootDir = takeDirectory modulePath let relRootDir = takeDirectory modulePath
let path = joinPaths relRootDir relImportPath 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 where
notFound xs = throwResumable $ NotFoundError relImportPath xs Language.TypeScript notFound xs = throwResumable $ NotFoundError relImportPath xs Language.TypeScript
@ -80,6 +87,7 @@ resolveRelativePath relImportPath exts = do
-- /node_modules/moduleB.ts, etc -- /node_modules/moduleB.ts, etc
resolveNonRelativePath :: Members '[ Modules location value resolveNonRelativePath :: Members '[ Modules location value
, Reader M.ModuleInfo , Reader M.ModuleInfo
, Reader PackageInfo
, Resumable ResolutionError , Resumable ResolutionError
, Trace , Trace
] effects ] effects
@ -93,24 +101,31 @@ resolveNonRelativePath name exts = do
nodeModulesPath dir = takeDirectory dir </> "node_modules" </> name nodeModulesPath dir = takeDirectory dir </> "node_modules" </> name
-- Recursively search in a 'node_modules' directory, stepping up a directory each time. -- Recursively search in a 'node_modules' directory, stepping up a directory each time.
go root path searched = do 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 case res of
Left xs | parentDir <- takeDirectory path , root /= parentDir -> go root parentDir (searched <> xs) Left xs | parentDir <- takeDirectory path , root /= parentDir -> go root parentDir (searched <> xs)
| otherwise -> notFound (searched <> xs) | otherwise -> notFound (searched <> xs)
Right m -> m <$ traceResolve name m Right m -> m <$ traceResolve name m
notFound xs = throwResumable $ NotFoundError name xs Language.TypeScript notFound xs = throwResumable $ NotFoundError name xs Language.TypeScript
resolveTSModule :: Member (Modules location value) effects -- | Resolve a module name to a ModulePath.
=> FilePath resolveModule :: Members '[ Modules location value
-> [String] , 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) -> Evaluator location value effects (Either [FilePath] M.ModulePath)
resolveTSModule path exts = maybe (Left searchPaths) Right <$> resolve searchPaths resolveModule path' exts = do
where searchPaths = let path = makeRelative "." path'
((path <.>) <$> exts) PackageInfo{..} <- currentPackage
-- TODO: Requires parsing package.json, getting the path of the let packageDotJSON = Map.lookup (path </> "package.json") packageResolutions
-- "types" property and adding that value to the search Paths. let searchPaths = ((path <.>) <$> exts)
-- <> [searchDir </> "package.json"] <> maybe mempty (:[]) packageDotJSON
<> (((path </> "index") <.>) <$> exts) <> (((path </> "index") <.>) <$> exts)
trace ("searching in " <> show searchPaths)
maybe (Left searchPaths) Right <$> resolve searchPaths
typescriptExtensions :: [String] typescriptExtensions :: [String]
typescriptExtensions = ["ts", "tsx", "d.ts"] typescriptExtensions = ["ts", "tsx", "d.ts"]

View File

@ -29,7 +29,7 @@ import Data.Record
import Data.Sum import Data.Sum
import qualified Data.Syntax as Syntax import qualified Data.Syntax as Syntax
import Data.Term import Data.Term
import Data.File import Data.Project
import Foreign.Ptr import Foreign.Ptr
import qualified GHC.TypeLits as TypeLevel import qualified GHC.TypeLits as TypeLevel
import qualified Language.Go.Assignment as Go import qualified Language.Go.Assignment as Go
@ -73,7 +73,7 @@ someAnalysisParser :: ( ApplyAll' typeclasses Go.Syntax
-> Language -- ^ The 'Language' to select. -> Language -- ^ The 'Language' to select.
-> SomeAnalysisParser typeclasses (Record Location) -- ^ A 'SomeAnalysisParser abstracting the syntax type to be produced. -> SomeAnalysisParser typeclasses (Record Location) -- ^ A 'SomeAnalysisParser abstracting the syntax type to be produced.
someAnalysisParser _ Go = SomeAnalysisParser goParser Nothing 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 _ PHP = SomeAnalysisParser phpParser Nothing
someAnalysisParser _ Python = SomeAnalysisParser pythonParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) (Just Python)) 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)) someAnalysisParser _ Ruby = SomeAnalysisParser rubyParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) (Just Ruby))

View File

@ -6,7 +6,7 @@ module Semantic.CLI
, Parse.runParse , Parse.runParse
) where ) where
import Data.File import Data.Project
import Data.Language (Language) import Data.Language (Language)
import Data.List (intercalate) import Data.List (intercalate)
import Data.List.Split (splitWhen) import Data.List.Split (splitWhen)

View File

@ -28,7 +28,7 @@ import Data.Abstract.Module
import Data.Abstract.Package as Package import Data.Abstract.Package as Package
import Data.Abstract.Value (Value, ValueError(..), runValueErrorWith) import Data.Abstract.Value (Value, ValueError(..), runValueErrorWith)
import Data.ByteString.Char8 (pack) import Data.ByteString.Char8 (pack)
import Data.File import Data.Project
import Data.Record import Data.Record
import Data.Semilattice.Lower import Data.Semilattice.Lower
import Data.Term import Data.Term
@ -39,7 +39,7 @@ import Semantic.Task as Task
data GraphType = ImportGraph | CallGraph 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 => GraphType
-> Project -> Project
-> Eff effs (Graph Vertex) -> Eff effs (Graph Vertex)
@ -69,7 +69,7 @@ graph graphType project
. runTermEvaluator @_ @_ @(Value (Located Precise)) . runTermEvaluator @_ @_ @(Value (Located Precise))
-- | Parse a list of files into a 'Package'. -- | 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. => Parser term -- ^ A parser.
-> Maybe File -- ^ Prelude (optional). -> Maybe File -- ^ Prelude (optional).
-> Project -- ^ Project to parse into a package. -> 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 parsePackage parser preludeFile project@Project{..} = do
prelude <- traverse (parseModule parser Nothing) preludeFile prelude <- traverse (parseModule parser Nothing) preludeFile
p <- parseModules parser project 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) pkg <$ trace ("project: " <> show pkg)
where where

View File

@ -5,7 +5,6 @@ module Semantic.IO
, isDirectory , isDirectory
, readBlobPairsFromHandle , readBlobPairsFromHandle
, readBlobsFromHandle , readBlobsFromHandle
, readBlobsFromPaths
, readProjectFromPaths , readProjectFromPaths
, readBlobsFromDir , readBlobsFromDir
, findFiles , findFiles
@ -13,9 +12,10 @@ module Semantic.IO
, NoLanguageForBlob(..) , NoLanguageForBlob(..)
, noLanguageForBlob , noLanguageForBlob
, readBlob , readBlob
, readProject
, readBlobs , readBlobs
, readBlobPairs , readBlobPairs
, readProject
, findFilesInDir
, write , write
, Handle(..) , Handle(..)
, getHandle , getHandle
@ -38,7 +38,7 @@ import Control.Monad.IO.Class
import Data.Aeson import Data.Aeson
import qualified Data.Blob as Blob import qualified Data.Blob as Blob
import Data.Bool import Data.Bool
import Data.File import Data.Project
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
@ -97,9 +97,6 @@ readBlobFromPath file = do
maybeFile <- readFile file maybeFile <- readFile file
maybe (fail ("cannot read '" <> show file <> "', file not found or language not supported.")) pure maybeFile 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 :: MonadIO m => Maybe FilePath -> FilePath -> Language -> [FilePath] -> m Project
readProjectFromPaths maybeRoot path lang excludeDirs = do readProjectFromPaths maybeRoot path lang excludeDirs = do
isDir <- isDirectory path isDir <- isDirectory path
@ -107,15 +104,15 @@ readProjectFromPaths maybeRoot path lang excludeDirs = do
then (id, [], fromMaybe path maybeRoot) then (id, [], fromMaybe path maybeRoot)
else (filter (/= path), [toFile path], fromMaybe (takeDirectory path) maybeRoot) else (filter (/= path), [toFile path], fromMaybe (takeDirectory path) maybeRoot)
paths <- liftIO $ filterFun <$> findFiles rootDir exts excludeDirs paths <- liftIO $ filterFun <$> findFilesInDir rootDir exts excludeDirs
pure $ Project rootDir (toFile <$> paths) lang entryPoints pure $ Project rootDir (toFile <$> paths) lang entryPoints excludeDirs
where where
toFile path = File path (Just lang) toFile path = File path (Just lang)
exts = extensionsForLanguage lang exts = extensionsForLanguage lang
-- Recursively find files in a directory. -- Recursively find files in a directory.
findFiles :: forall m. MonadIO m => FilePath -> [String] -> [FilePath] -> m [FilePath] findFilesInDir :: forall m. MonadIO m => FilePath -> [String] -> [FilePath] -> m [FilePath]
findFiles path exts excludeDirs = do findFilesInDir path exts excludeDirs = do
_:/dir <- liftIO $ Tree.build path _:/dir <- liftIO $ Tree.build path
pure $ (onlyFiles . Tree.filterDir (withExtensions exts) . Tree.filterDir (notIn excludeDirs)) dir pure $ (onlyFiles . Tree.filterDir (withExtensions exts) . Tree.filterDir (notIn excludeDirs)) dir
where 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 :: Member Files effs => Maybe FilePath -> FilePath -> Language -> [FilePath] -> Eff effs Project
readProject rootDir dir excludeDirs = send . ReadProject rootDir dir excludeDirs 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'. -- | A task which writes a 'B.Builder' to a 'Handle' or a 'FilePath'.
write :: Member Files effs => Destination -> B.Builder -> Eff effs () write :: Member Files effs => Destination -> B.Builder -> Eff effs ()
write dest = send . Write dest write dest = send . Write dest
@ -247,6 +247,7 @@ data Destination = ToPath FilePath | ToHandle (Handle 'IO.WriteMode)
data Files out where data Files out where
Read :: Source out -> Files out Read :: Source out -> Files out
ReadProject :: Maybe FilePath -> FilePath -> Language -> [FilePath] -> Files Project ReadProject :: Maybe FilePath -> FilePath -> Language -> [FilePath] -> Files Project
FindFiles :: FilePath -> [String] -> [FilePath] -> Files [FilePath]
Write :: Destination -> B.Builder -> Files () Write :: Destination -> B.Builder -> Files ()
-- | Run a 'Files' effect in 'IO'. -- | Run a 'Files' effect in 'IO'.
@ -257,6 +258,7 @@ runFiles = interpret $ \ files -> case files of
Read (FromPathPair paths) -> rethrowing (runBothWith readFilePair paths) Read (FromPathPair paths) -> rethrowing (runBothWith readFilePair paths)
Read (FromPairHandle handle) -> rethrowing (readBlobPairsFromHandle handle) Read (FromPairHandle handle) -> rethrowing (readBlobPairsFromHandle handle)
ReadProject rootDir dir language excludeDirs -> rethrowing (readProjectFromPaths rootDir dir language excludeDirs) 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 (ToPath path) builder -> liftIO (IO.withBinaryFile path IO.WriteMode (`B.hPutBuilder` builder))
Write (ToHandle (WriteHandle handle)) builder -> liftIO (B.hPutBuilder handle builder) Write (ToHandle (WriteHandle handle)) builder -> liftIO (B.hPutBuilder handle builder)

View 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

View File

@ -10,7 +10,11 @@ module Semantic.Task
, IO.readBlobs , IO.readBlobs
, IO.readBlobPairs , IO.readBlobPairs
, IO.readProject , IO.readProject
, IO.findFiles
, IO.write , IO.write
-- * Module Resolution
, resolutionMap
, Resolution
-- * Telemetry -- * Telemetry
, writeLog , writeLog
, writeStat , writeStat
@ -66,6 +70,7 @@ import Parsing.TreeSitter
import Prologue hiding (MonadError (..)) import Prologue hiding (MonadError (..))
import Semantic.Distribute import Semantic.Distribute
import qualified Semantic.IO as IO import qualified Semantic.IO as IO
import Semantic.Resolution
import Semantic.Log import Semantic.Log
import Semantic.Queue import Semantic.Queue
import Semantic.Stat as Stat 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' -- | 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 type TaskEff = Eff '[Distribute WrappedTask
, Task , Task
, Resolution
, IO.Files , IO.Files
, Reader Options , Reader Options
, Trace , Trace
@ -129,7 +135,14 @@ runTaskWithOptions options task = do
(result, stat) <- withTiming "run" [] $ do (result, stat) <- withTiming "run" [] $ do
let run :: TaskEff a -> IO (Either SomeException a) 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 run task
queue statter stat queue statter stat

View File

@ -13,7 +13,7 @@ import Data.Abstract.Evaluatable
import Data.Abstract.Value import Data.Abstract.Value
import Data.Abstract.Type import Data.Abstract.Type
import Data.Blob import Data.Blob
import Data.File import Data.Project
import Data.Functor.Foldable import Data.Functor.Foldable
import qualified Data.Language as Language import qualified Data.Language as Language
import Data.Term import Data.Term
@ -28,6 +28,7 @@ import Text.Show (showListWith)
import qualified Language.Python.Assignment as Python import qualified Language.Python.Assignment as Python
import qualified Language.Ruby.Assignment as Ruby import qualified Language.Ruby.Assignment as Ruby
import qualified Language.TypeScript.Assignment as TypeScript
justEvaluating justEvaluating
= runM = runM
@ -75,6 +76,7 @@ evalGoProject path = justEvaluating =<< evaluateProject goParser Language.Go Not
evalRubyProject path = justEvaluating =<< evaluateProject rubyParser Language.Ruby rubyPrelude path evalRubyProject path = justEvaluating =<< evaluateProject rubyParser Language.Ruby rubyPrelude path
evalPHPProject path = justEvaluating =<< evaluateProject phpParser Language.PHP Nothing path evalPHPProject path = justEvaluating =<< evaluateProject phpParser Language.PHP Nothing path
evalPythonProject path = justEvaluating =<< evaluateProject pythonParser Language.Python pythonPrelude 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 evalTypeScriptProjectQuietly path = evaluatingWithHoles =<< evaluateProject typescriptParser Language.TypeScript Nothing path
evalTypeScriptProject path = justEvaluating =<< 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) 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) 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. -- 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) evaluateProject parser lang prelude path = evaluatePackageWith id withTermSpans . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= parsePackage parser prelude)

View File

@ -30,6 +30,11 @@ spec = parallel $ do
env <- environment . snd . fst <$> evaluate "main2.py" env <- environment . snd . fst <$> evaluate "main2.py"
Env.names env `shouldContain` [ "bar", "foo" ] 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 it "subclasses" $ do
((res, _), _) <- evaluate "subclass.py" ((res, _), _) <- evaluate "subclass.py"
res `shouldBe` Right [injValue (String "\"bar\"")] res `shouldBe` Right [injValue (String "\"bar\"")]

View File

@ -32,7 +32,7 @@ evaluate
= runM = runM
. fmap (first reassociate) . fmap (first reassociate)
. evaluating @Precise @(Value Precise) . evaluating @Precise @(Value Precise)
. runReader (PackageInfo (name "test") Nothing) . runReader (PackageInfo (name "test") Nothing mempty)
. runReader (ModuleInfo "test/Control/Abstract/Evaluator/Spec.hs") . runReader (ModuleInfo "test/Control/Abstract/Evaluator/Spec.hs")
. Value.runValueError . Value.runValueError
. runEnvironmentError . runEnvironmentError

View File

@ -28,7 +28,7 @@ import Data.Bifunctor (first)
import Data.Blob as X import Data.Blob as X
import Data.ByteString.Builder (toLazyByteString) import Data.ByteString.Builder (toLazyByteString)
import Data.ByteString.Lazy (toStrict) import Data.ByteString.Lazy (toStrict)
import Data.File as X import Data.Project as X
import Data.Functor.Listable as X import Data.Functor.Listable as X
import Data.Language as X import Data.Language as X
import Data.List.NonEmpty as X (NonEmpty(..)) import Data.List.NonEmpty as X (NonEmpty(..))

View 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())

View File

@ -0,0 +1,3 @@
module.exports = function qux() {
return "this is the qux function in bar.js";
}

View File

@ -0,0 +1,3 @@
module.exports = function tos() {
return "this is the tos function in tos/index.js";
}

View File

@ -0,0 +1,4 @@
{
"name": "wap",
"main": "start.js"
}

View File

@ -0,0 +1,3 @@
module.exports = function wap() {
return "this is the wap function in wap/start.js (resolved through package.json)";
}

View File

@ -0,0 +1,3 @@
from . import utils
print(utils.to_s())

View File

@ -0,0 +1,2 @@
def to_s():
return "hi";

View File

@ -0,0 +1 @@
from c import *