1
1
mirror of https://github.com/github/semantic.git synced 2024-12-24 23:42:31 +03:00

🔥 the value parameter from Modules.

This commit is contained in:
Rob Rix 2018-06-18 13:18:20 -04:00
parent 9bf816db3b
commit 1b245278a1
11 changed files with 40 additions and 40 deletions

View File

@ -76,13 +76,13 @@ graphingPackages recur m = packageInclusion (moduleVertex (moduleInfo m)) *> rec
-- | Add vertices to the graph for evaluated modules and the packages containing them.
graphingModules :: forall term address value effects a
. ( Member (Modules address value) effects
. ( Member (Modules address) effects
, Member (Reader ModuleInfo) effects
, Member (State (Graph Vertex)) effects
)
=> SubtermAlgebra Module term (TermEvaluator term address value effects a)
-> SubtermAlgebra Module term (TermEvaluator term address value effects a)
graphingModules recur m = interpose @(Modules address value) pure (\ m yield -> case m of
graphingModules recur m = interpose @(Modules address) pure (\ m yield -> case m of
Load path -> moduleInclusion (moduleVertex (ModuleInfo path)) >> send m >>= yield
Lookup path -> moduleInclusion (moduleVertex (ModuleInfo path)) >> send m >>= yield
_ -> send m >>= yield)

View File

@ -28,37 +28,37 @@ import Data.Semigroup.Foldable (foldMap1)
import Prologue
-- | Retrieve an evaluated module, if any. The outer 'Maybe' indicates whether weve begun loading the module or not, while the inner 'Maybe' indicates whether weve completed loading it or not. Thus, @Nothing@ means weve never tried to load it, @Just Nothing@ means weve started but havent yet finished loading it, and @Just (Just (env, value))@ indicates the result of a completed load.
lookupModule :: Member (Modules address value) effects => ModulePath -> Evaluator address value effects (Maybe (Maybe (address, Environment address)))
lookupModule :: Member (Modules address) effects => ModulePath -> Evaluator address value effects (Maybe (Maybe (address, Environment address)))
lookupModule = sendModules . Lookup
-- | Resolve a list of module paths to a possible module table entry.
resolve :: forall address value effects . Member (Modules address value) effects => [FilePath] -> Evaluator address value effects (Maybe ModulePath)
resolve = sendModules . Resolve @address @value
resolve :: Member (Modules address) effects => [FilePath] -> Evaluator address value effects (Maybe ModulePath)
resolve = sendModules . Resolve
listModulesInDir :: forall address value effects . Member (Modules address value) effects => FilePath -> Evaluator address value effects [ModulePath]
listModulesInDir = sendModules . List @address @value
listModulesInDir :: Member (Modules address) effects => FilePath -> Evaluator address value effects [ModulePath]
listModulesInDir = sendModules . List
-- | Require/import another module by name and return its environment and value.
--
-- Looks up the module's name in the cache of evaluated modules first, returns if found, otherwise loads/evaluates the module.
require :: Member (Modules address value) effects => ModulePath -> Evaluator address value effects (Maybe (address, Environment address))
require :: Member (Modules address) effects => ModulePath -> Evaluator address value effects (Maybe (address, Environment address))
require path = lookupModule path >>= maybeM (load path)
-- | Load another module by name and return its environment and value.
--
-- Always loads/evaluates.
load :: Member (Modules address value) effects => ModulePath -> Evaluator address value effects (Maybe (address, Environment address))
load :: Member (Modules address) effects => ModulePath -> Evaluator address value effects (Maybe (address, Environment address))
load path = sendModules (Load path)
data Modules address value return where
Load :: ModulePath -> Modules address value (Maybe (address, Environment address))
Lookup :: ModulePath -> Modules address value (Maybe (Maybe (address, Environment address)))
Resolve :: [FilePath] -> Modules address value (Maybe ModulePath)
List :: FilePath -> Modules address value [ModulePath]
data Modules address return where
Load :: ModulePath -> Modules address (Maybe (address, Environment address))
Lookup :: ModulePath -> Modules address (Maybe (Maybe (address, Environment address)))
Resolve :: [FilePath] -> Modules address (Maybe ModulePath)
List :: FilePath -> Modules address [ModulePath]
sendModules :: Member (Modules address value) effects => Modules address value return -> Evaluator address value effects return
sendModules :: Member (Modules address) effects => Modules address return -> Evaluator address value effects return
sendModules = send
runModules :: forall term address value effects a
@ -66,11 +66,11 @@ runModules :: forall term address value effects a
, Member (State (ModuleTable (Maybe (address, Environment address)))) effects
, Member Trace effects
)
=> (Module term -> Evaluator address value (Modules address value ': effects) (Module (address, Environment address)))
-> Evaluator address value (Modules address value ': effects) a
=> (Module term -> Evaluator address value (Modules address ': effects) (Module (address, Environment address)))
-> Evaluator address value (Modules address ': effects) a
-> Evaluator address value (Reader (ModuleTable (NonEmpty (Module term))) ': effects) a
runModules evaluateModule = go
where go :: forall a . Evaluator address value (Modules address value ': effects) a -> Evaluator address value (Reader (ModuleTable (NonEmpty (Module term))) ': effects) a
where go :: forall a . Evaluator address value (Modules address ': effects) a -> Evaluator address value (Reader (ModuleTable (NonEmpty (Module term))) ': effects) a
go = reinterpret (\ m -> case m of
Load name -> askModuleTable @term >>= maybe (moduleNotFound name) (runMerging . foldMap (Merging . evalAndCache)) . ModuleTable.lookup name
where
@ -92,7 +92,7 @@ runModules evaluateModule = go
List dir -> modulePathsInDir dir <$> askModuleTable @term)
runModules' :: Member (Reader (ModuleTable (NonEmpty (Module (address, Environment address))))) effects
=> Evaluator address value (Modules address value ': effects) a
=> Evaluator address value (Modules address ': effects) a
-> Evaluator address value effects a
runModules' = interpret $ \case
Load name -> fmap (runMerging' . foldMap1 (Merging' . moduleBody)) . ModuleTable.lookup name <$> askModuleTable'

View File

@ -49,7 +49,7 @@ class Show1 constr => Evaluatable constr where
, Member (Allocator address value) effects
, Member (Env address) effects
, Member (LoopControl address) effects
, Member (Modules address value) effects
, Member (Modules address) effects
, Member (Reader ModuleInfo) effects
, Member (Reader PackageInfo) effects
, Member (Reader Span) effects
@ -65,8 +65,8 @@ class Show1 constr => Evaluatable constr where
evaluate :: forall address term value effects
. ( AbstractValue address value (LoopControl address ': Return address ': Env address ': Allocator address value ': Reader ModuleInfo ': Modules address value ': effects)
, Addressable address (Reader ModuleInfo ': Modules address value ': effects)
. ( AbstractValue address value (LoopControl address ': Return address ': Env address ': Allocator address value ': Reader ModuleInfo ': Modules address ': effects)
, Addressable address (Reader ModuleInfo ': Modules address ': effects)
, Declarations term
, Evaluatable (Base term)
, Foldable (Cell address)
@ -131,7 +131,7 @@ evaluatePackageWith :: forall proxy lang address term value inner inner' inner''
, ValueRoots address value
, inner ~ (LoopControl address ': Return address ': Env address ': Allocator address value ': inner')
, inner' ~ (Reader ModuleInfo ': inner'')
, inner'' ~ (Modules address value ': Reader Span ': Reader PackageInfo ': outer)
, inner'' ~ (Modules address ': Reader Span ': Reader PackageInfo ': outer)
)
=> proxy lang
-> (SubtermAlgebra Module term (TermEvaluator term address value inner address) -> SubtermAlgebra Module term (TermEvaluator term address value inner address))

View File

@ -27,7 +27,7 @@ importPath str = let path = stripQuotes str in ImportPath (T.unpack path) (pathT
defaultAlias :: ImportPath -> Name
defaultAlias = name . T.pack . takeFileName . unPath
resolveGoImport :: ( Member (Modules address value) effects
resolveGoImport :: ( Member (Modules address) effects
, Member (Reader ModuleInfo) effects
, Member (Reader Package.PackageInfo) effects
, Member (Resumable ResolutionError) effects

View File

@ -35,7 +35,7 @@ instance Evaluatable VariableName
-- file, the complete contents of the included file are treated as though it
-- were defined inside that function.
resolvePHPName :: ( Member (Modules address value) effects
resolvePHPName :: ( Member (Modules address) effects
, Member (Resumable ResolutionError) effects
)
=> T.Text
@ -49,7 +49,7 @@ resolvePHPName n = do
include :: ( AbstractValue address value effects
, Member (Allocator address value) effects
, Member (Env address) effects
, Member (Modules address value) effects
, Member (Modules address) effects
, Member (Resumable ResolutionError) effects
, Member (Resumable (EnvironmentError address)) effects
, Member Trace effects

View File

@ -50,7 +50,7 @@ relativeQualifiedName prefix paths = RelativeQualifiedName (T.unpack prefix) (Ju
-- Subsequent imports of `parent.two` or `parent.three` will execute
-- `parent/two/__init__.py` and
-- `parent/three/__init__.py` respectively.
resolvePythonModules :: ( Member (Modules address value) effects
resolvePythonModules :: ( Member (Modules address) effects
, Member (Reader ModuleInfo) effects
, Member (Resumable ResolutionError) effects
, Member Trace effects
@ -126,7 +126,7 @@ instance Evaluatable Import where
evalQualifiedImport :: ( AbstractValue address value effects
, Member (Allocator address value) effects
, Member (Env address) effects
, Member (Modules address value) effects
, Member (Modules address) effects
)
=> Name -> ModulePath -> Evaluator address value effects value
evalQualifiedImport name path = letrec' name $ \addr -> do

View File

@ -16,7 +16,7 @@ import System.FilePath.Posix
-- TODO: Fully sort out ruby require/load mechanics
--
-- require "json"
resolveRubyName :: ( Member (Modules address value) effects
resolveRubyName :: ( Member (Modules address) effects
, Member (Resumable ResolutionError) effects
)
=> Text
@ -28,7 +28,7 @@ resolveRubyName name = do
maybeM (throwResumable $ NotFoundError name' paths Language.Ruby) modulePath
-- load "/root/src/file.rb"
resolveRubyPath :: ( Member (Modules address value) effects
resolveRubyPath :: ( Member (Modules address) effects
, Member (Resumable ResolutionError) effects
)
=> Text
@ -73,7 +73,7 @@ instance Evaluatable Require where
rvalBox v -- Returns True if the file was loaded, False if it was already loaded. http://ruby-doc.org/core-2.5.0/Kernel.html#method-i-require
doRequire :: ( AbstractValue address value effects
, Member (Modules address value) effects
, Member (Modules address) effects
)
=> M.ModulePath
-> Evaluator address value effects (value, Environment address)
@ -102,7 +102,7 @@ instance Evaluatable Load where
doLoad :: ( AbstractValue address value effects
, Member (Env address) effects
, Member (Modules address value) effects
, Member (Modules address) effects
, Member (Resumable ResolutionError) effects
, Member Trace effects
)

View File

@ -35,7 +35,7 @@ toName = name . T.pack . unPath
--
-- NB: TypeScript has a couple of different strategies, but the main one (and the
-- only one we support) mimics Node.js.
resolveWithNodejsStrategy :: ( Member (Modules address value) effects
resolveWithNodejsStrategy :: ( Member (Modules address) effects
, Member (Reader M.ModuleInfo) effects
, Member (Reader PackageInfo) effects
, Member (Resumable ResolutionError) effects
@ -54,7 +54,7 @@ resolveWithNodejsStrategy (ImportPath path NonRelative) exts = resolveNonRelativ
-- /root/src/moduleB.ts
-- /root/src/moduleB/package.json (if it specifies a "types" property)
-- /root/src/moduleB/index.ts
resolveRelativePath :: ( Member (Modules address value) effects
resolveRelativePath :: ( Member (Modules address) effects
, Member (Reader M.ModuleInfo) effects
, Member (Reader PackageInfo) effects
, Member (Resumable ResolutionError) effects
@ -82,7 +82,7 @@ resolveRelativePath relImportPath exts = do
--
-- /root/node_modules/moduleB.ts, etc
-- /node_modules/moduleB.ts, etc
resolveNonRelativePath :: ( Member (Modules address value) effects
resolveNonRelativePath :: ( Member (Modules address) effects
, Member (Reader M.ModuleInfo) effects
, Member (Reader PackageInfo) effects
, Member (Resumable ResolutionError) effects
@ -107,7 +107,7 @@ resolveNonRelativePath name exts = do
notFound xs = throwResumable $ NotFoundError name xs Language.TypeScript
-- | Resolve a module name to a ModulePath.
resolveModule :: ( Member (Modules address value) effects
resolveModule :: ( Member (Modules address) effects
, Member (Reader PackageInfo) effects
, Member Trace effects
)
@ -133,7 +133,7 @@ javascriptExtensions = ["js"]
evalRequire :: ( AbstractValue address value effects
, Member (Allocator address value) effects
, Member (Env address) effects
, Member (Modules address value) effects
, Member (Modules address) effects
)
=> M.ModulePath
-> Name

View File

@ -75,7 +75,7 @@ newtype GraphEff address a = GraphEff
, Env address
, Allocator address (Value address (GraphEff address))
, Reader ModuleInfo
, Modules address (Value address (GraphEff address))
, Modules address
, Reader Span
, Reader PackageInfo
, State (Graph Vertex)

View File

@ -47,7 +47,7 @@ newtype UtilEff address a = UtilEff
, Env address
, Allocator address (Value address (UtilEff address))
, Reader ModuleInfo
, Modules address (Value address (UtilEff address))
, Modules address
, Reader Span
, Reader PackageInfo
, Resumable (ValueError address (UtilEff address))

View File

@ -131,7 +131,7 @@ newtype TestEff a = TestEff
, Env Precise
, Allocator Precise Val
, Reader ModuleInfo
, Modules Precise Val
, Modules Precise
, Reader Span
, Reader PackageInfo
, Resumable (ValueError Precise TestEff)