1
1
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:
Rob Rix 2018-05-09 13:07:51 -04:00
parent 510ce5f83d
commit 6d3b7f33a1

View File

@ -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