diff --git a/src/Analysis/Abstract/BadModuleResolutions.hs b/src/Analysis/Abstract/BadModuleResolutions.hs index 84a77feb7..b094641c8 100644 --- a/src/Analysis/Abstract/BadModuleResolutions.hs +++ b/src/Analysis/Abstract/BadModuleResolutions.hs @@ -7,7 +7,7 @@ import Control.Abstract.Evaluator import Data.Abstract.Evaluatable import Prologue -resumingBadModuleResolutions :: Evaluator location term value (Resumable (ResolutionError value) ': effects) a -> Evaluator location term value effects a +resumingBadModuleResolutions :: Evaluator location term value (Resumable ResolutionError ': effects) a -> Evaluator location term value effects a resumingBadModuleResolutions = raiseHandler (relay pure (\ (Resumable err) yield -> traceM ("ResolutionError:" <> show err) *> case err of NotFoundError nameToResolve _ _ -> yield nameToResolve GoImportError pathToResolve -> yield [pathToResolve])) diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 3caac83c1..75898bee5 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -66,7 +66,7 @@ type MonadEvaluatable location term value effects = , Resumable (AddressError location value) , Resumable (EvalError value) , Resumable (LoadError term) - , Resumable (ResolutionError value) + , Resumable ResolutionError , Resumable (Unspecialized value) , Return value , State (Environment location value) @@ -78,18 +78,18 @@ type MonadEvaluatable location term value effects = ) -- | An error thrown when we can't resolve a module from a qualified name. -data ResolutionError value resume where +data ResolutionError resume where NotFoundError :: String -- ^ The path that was not found. -> [String] -- ^ List of paths searched that shows where semantic looked for this module. -> Language -- ^ Language. - -> ResolutionError value ModulePath + -> ResolutionError ModulePath - GoImportError :: FilePath -> ResolutionError value [ModulePath] + GoImportError :: FilePath -> ResolutionError [ModulePath] -deriving instance Eq (ResolutionError a b) -deriving instance Show (ResolutionError a b) -instance Show1 (ResolutionError value) where liftShowsPrec _ _ = showsPrec -instance Eq1 (ResolutionError value) where +deriving instance Eq (ResolutionError b) +deriving instance Show (ResolutionError b) +instance Show1 ResolutionError where liftShowsPrec _ _ = showsPrec +instance Eq1 ResolutionError where liftEq _ (NotFoundError a _ l1) (NotFoundError b _ l2) = a == b && l1 == l2 liftEq _ (GoImportError a) (GoImportError b) = a == b liftEq _ _ _ = False diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index 38d6b0323..7a011b38e 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -33,7 +33,7 @@ resolveGoImport (ImportPath path Relative) = do ModuleInfo{..} <- currentModule paths <- listModulesInDir (joinPaths (takeDirectory modulePath) path) case paths of - [] -> throwResumable @(ResolutionError value) $ GoImportError path + [] -> throwResumable $ GoImportError path _ -> pure paths resolveGoImport (ImportPath path NonRelative) = do package <- BC.unpack . unName . Package.packageName <$> currentPackage @@ -43,7 +43,7 @@ resolveGoImport (ImportPath path NonRelative) = do -- First two are source, next is package name, remaining are path to package -- (e.g. github.com/golang//path...). (_ : _ : p : xs) | p == package -> listModulesInDir (joinPath xs) - _ -> throwResumable @(ResolutionError value) $ GoImportError path + _ -> throwResumable $ GoImportError path -- | Import declarations (symbols are added directly to the calling environment). -- diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index e4b1faf4f..f56afdfe7 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -38,7 +38,7 @@ instance Evaluatable VariableName resolvePHPName :: forall value location term effects. MonadEvaluatable location term value effects => ByteString -> Evaluator location term value effects ModulePath resolvePHPName n = do modulePath <- resolve [name] - maybe (throwResumable @(ResolutionError value) $ NotFoundError name [name] Language.PHP) pure modulePath + maybe (throwResumable $ NotFoundError name [name] Language.PHP) pure modulePath where name = toName n toName = BC.unpack . dropRelativePrefix . stripQuotes diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index 629371db8..4c02b5999 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -54,7 +54,7 @@ relativeQualifiedName prefix paths = RelativeQualifiedName (BC.unpack prefix) (J resolvePythonModules :: forall value term location effects . Members '[ Reader ModuleInfo , Reader (ModuleTable [Module term]) - , Resumable (ResolutionError value) + , Resumable ResolutionError ] effects => QualifiedName -> Evaluator location term value effects (NonEmpty ModulePath) @@ -81,7 +81,7 @@ resolvePythonModules q = do , path <.> ".py" ] modulePath <- resolve searchPaths - maybe (throwResumable @(ResolutionError value) $ NotFoundError path searchPaths Language.Python) pure modulePath + maybe (throwResumable $ NotFoundError path searchPaths Language.Python) pure modulePath -- | Import declarations (symbols are added directly to the calling environment). diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index c01911afc..affde069e 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -22,14 +22,14 @@ resolveRubyName name = do let name' = cleanNameOrPath name let paths = [name' <.> "rb"] modulePath <- resolve paths - maybe (throwResumable @(ResolutionError value) $ NotFoundError name' paths Language.Ruby) pure modulePath + maybe (throwResumable $ NotFoundError name' paths Language.Ruby) pure modulePath -- load "/root/src/file.rb" resolveRubyPath :: forall value term location effects. MonadEvaluatable location term value effects => ByteString -> Evaluator location term value effects ModulePath resolveRubyPath path = do let name' = cleanNameOrPath path modulePath <- resolve [name'] - maybe (throwResumable @(ResolutionError value) $ NotFoundError name' [name'] Language.Ruby) pure modulePath + maybe (throwResumable $ NotFoundError name' [name'] Language.Ruby) pure modulePath cleanNameOrPath :: ByteString -> String cleanNameOrPath = BC.unpack . dropRelativePrefix . stripQuotes diff --git a/src/Language/TypeScript/Syntax.hs b/src/Language/TypeScript/Syntax.hs index 7a47f51c0..b307395dd 100644 --- a/src/Language/TypeScript/Syntax.hs +++ b/src/Language/TypeScript/Syntax.hs @@ -43,14 +43,14 @@ 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 :: forall value term location effects. MonadEvaluatable location term value effects => FilePath -> [String] -> Evaluator location term value effects ModulePath +resolveRelativePath :: MonadEvaluatable location term value effects => FilePath -> [String] -> Evaluator location term value effects ModulePath resolveRelativePath relImportPath exts = do ModuleInfo{..} <- currentModule let relRootDir = takeDirectory modulePath let path = joinPaths relRootDir relImportPath resolveTSModule path exts >>= either notFound (\x -> traceResolve relImportPath x (pure x)) where - notFound xs = throwResumable @(ResolutionError value) $ NotFoundError relImportPath xs Language.TypeScript + notFound xs = throwResumable $ NotFoundError relImportPath xs Language.TypeScript -- | Resolve a non-relative TypeScript import to a known 'ModuleName' or fail. -- @@ -62,7 +62,7 @@ resolveRelativePath relImportPath exts = do -- -- /root/node_modules/moduleB.ts, etc -- /node_modules/moduleB.ts, etc -resolveNonRelativePath :: forall value term location effects. MonadEvaluatable location term value effects => FilePath -> [String] -> Evaluator location term value effects ModulePath +resolveNonRelativePath :: MonadEvaluatable location term value effects => FilePath -> [String] -> Evaluator location term value effects ModulePath resolveNonRelativePath name exts = do ModuleInfo{..} <- currentModule go "." modulePath mempty @@ -75,7 +75,7 @@ resolveNonRelativePath name exts = do Left xs | parentDir <- takeDirectory path , root /= parentDir -> go root parentDir (searched <> xs) | otherwise -> notFound (searched <> xs) Right m -> traceResolve name m $ pure m - notFound xs = throwResumable @(ResolutionError value) $ NotFoundError name xs Language.TypeScript + notFound xs = throwResumable $ NotFoundError name xs Language.TypeScript resolveTSModule :: MonadEvaluatable location term value effects => FilePath -> [String] -> Evaluator location term value effects (Either [FilePath] ModulePath) resolveTSModule path exts = maybe (Left searchPaths) Right <$> resolve searchPaths diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index dbbd71675..7ca86f888 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -70,7 +70,7 @@ importGraphAnalysis :: forall term syntax ann a => Evaluator (Located Precise term) term (Value (Located Precise term)) ( State (ImportGraph (Term (Sum syntax) ann)) ': Resumable (AddressError (Located Precise term) (Value (Located Precise term))) - ': Resumable (ResolutionError (Value (Located Precise term))) + ': Resumable ResolutionError ': Resumable (EvalError (Value (Located Precise term))) ': State [Name] ': Resumable (ValueError (Located Precise term) (Value (Located Precise term)))