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:
parent
9bf816db3b
commit
1b245278a1
@ -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)
|
||||
|
@ -28,37 +28,37 @@ import Data.Semigroup.Foldable (foldMap1)
|
||||
import Prologue
|
||||
|
||||
-- | Retrieve an evaluated module, if any. The outer 'Maybe' indicates whether we’ve begun loading the module or not, while the inner 'Maybe' indicates whether we’ve completed loading it or not. Thus, @Nothing@ means we’ve never tried to load it, @Just Nothing@ means we’ve started but haven’t 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'
|
||||
|
@ -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))
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
)
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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))
|
||||
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user