github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-24 07:25:44 +03:00
Code Issues Projects Releases Wiki Activity

Define a moduleNotFound helper to throw LoadErrors.

Browse Source
This commit is contained in:
Rob Rix 2018-05-09 12:22:20 -04:00
parent 662e385b97
commit ccd7424af7
1 changed files with 4 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Control/Abstract/Modules.hs
View File

@ -70,10 +70,8 @@ runModules :: Members '[ Resumable (LoadError location value)
-> Evaluator location term value (Modules location value ': effects) a
-> Evaluator location term value (Reader (ModuleTable [Module term]) ': effects) a
runModules evaluateModule = reinterpretEffect (\ m -> case m of
Load name -> askModuleTable >>= maybe notFound (runMerging . foldMap (Merging . evalAndCache)) . ModuleTable.lookup name
Load name -> askModuleTable >>= maybe (moduleNotFound name) (runMerging . foldMap (Merging . evalAndCache)) . ModuleTable.lookup name
where
notFound = throwResumable (LoadError name)
evalAndCache x = do
let mPath = modulePath (moduleInfo x)
loading <- loadingModule mPath
@ -136,6 +134,9 @@ instance Show1 (LoadError location value) where
instance Eq1 (LoadError location value) where
liftEq _ (LoadError a) (LoadError b) = a == b
moduleNotFound :: Member (Resumable (LoadError location value)) effects => ModulePath -> Evaluator location term value effects (Maybe (Environment location value, value))
moduleNotFound = throwResumable . LoadError
runLoadError :: Evaluator location term value (Resumable (LoadError location value) ': effects) a -> Evaluator location term value effects (Either (SomeExc (LoadError location value)) a)
runLoadError = raiseHandler runError