mirror of
https://github.com/github/semantic.git
synced 2024-12-20 13:21:59 +03:00
Extract a helper to run some action in a package body context.
This commit is contained in:
parent
510ce5f83d
commit
6d3b7f33a1
@ -207,9 +207,7 @@ evaluatePackageBodyWith :: forall location term value inner inner' outer
|
|||||||
-> PackageBody term
|
-> PackageBody term
|
||||||
-> Evaluator location value outer [value]
|
-> Evaluator location value outer [value]
|
||||||
evaluatePackageBodyWith perModule perTerm body
|
evaluatePackageBodyWith perModule perTerm body
|
||||||
= runReader (packageModules body)
|
= runInPackageBody evalModule body
|
||||||
. runModules evalModule
|
|
||||||
. withPrelude (packagePrelude body)
|
|
||||||
$ traverse (uncurry evaluateEntryPoint) (ModuleTable.toPairs (packageEntryPoints body))
|
$ traverse (uncurry evaluateEntryPoint) (ModuleTable.toPairs (packageEntryPoints body))
|
||||||
where evalModule m
|
where evalModule m
|
||||||
= runInModule (moduleInfo m)
|
= runInModule (moduleInfo m)
|
||||||
@ -222,11 +220,6 @@ evaluatePackageBodyWith perModule perTerm body
|
|||||||
v <- maybe unit (pure . snd) <$> require m
|
v <- maybe unit (pure . snd) <$> require m
|
||||||
maybe v ((`call` []) <=< variable) sym
|
maybe v ((`call` []) <=< variable) sym
|
||||||
|
|
||||||
withPrelude Nothing a = a
|
|
||||||
withPrelude (Just prelude) a = do
|
|
||||||
preludeEnv <- evalModule prelude *> getEnv
|
|
||||||
withDefaultEnvironment preludeEnv a
|
|
||||||
|
|
||||||
runInModule :: ( Member Fail outer
|
runInModule :: ( Member Fail outer
|
||||||
, inner ~ (LoopControl value ': Return value ': Reader ModuleInfo ': outer)
|
, inner ~ (LoopControl value ': Return value ': Reader ModuleInfo ': outer)
|
||||||
)
|
)
|
||||||
@ -240,6 +233,28 @@ runInModule info
|
|||||||
. fmap fst
|
. fmap fst
|
||||||
. runGoto lowerBound
|
. runGoto lowerBound
|
||||||
|
|
||||||
|
runInPackageBody :: Members '[ Fail
|
||||||
|
, Reader (Environment location value)
|
||||||
|
, Resumable (LoadError location value)
|
||||||
|
, State (Environment location value)
|
||||||
|
, State (Exports location value)
|
||||||
|
, State (ModuleTable (Maybe (Environment location value, value)))
|
||||||
|
, Trace
|
||||||
|
] outer
|
||||||
|
=> (Module term -> Evaluator location value (Modules location value ': outer) value)
|
||||||
|
-> PackageBody term
|
||||||
|
-> Evaluator location value (Modules location value ': outer) a
|
||||||
|
-> Evaluator location value outer a
|
||||||
|
runInPackageBody evalModule body
|
||||||
|
= runReader (packageModules body)
|
||||||
|
. runModules evalModule
|
||||||
|
. withPrelude (packagePrelude body)
|
||||||
|
where withPrelude Nothing a = a
|
||||||
|
withPrelude (Just prelude) a = do
|
||||||
|
preludeEnv <- evalModule prelude *> getEnv
|
||||||
|
withDefaultEnvironment preludeEnv a
|
||||||
|
|
||||||
|
|
||||||
-- | Isolate the given action with an empty global environment and exports.
|
-- | Isolate the given action with an empty global environment and exports.
|
||||||
isolate :: Members '[State (Environment location value), State (Exports location value)] effects => Evaluator location value effects a -> Evaluator location value effects a
|
isolate :: Members '[State (Environment location value), State (Exports location value)] effects => Evaluator location value effects a -> Evaluator location value effects a
|
||||||
isolate = withEnv lowerBound . withExports lowerBound
|
isolate = withEnv lowerBound . withExports lowerBound
|
||||||
|
Loading…
Reference in New Issue
Block a user