mirror of
https://github.com/github/semantic.git
synced 2025-01-01 11:46:14 +03:00
ResolutionError doesn’t need its value parameter.
This commit is contained in:
parent
0c30d16898
commit
b4185865c2
src
Analysis/Abstract
Data/Abstract
Language
Semantic
@ -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]))
|
||||
|
@ -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
|
||||
|
@ -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/<package>/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).
|
||||
--
|
||||
|
@ -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
|
||||
|
||||
|
@ -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).
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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)))
|
||||
|
Loading…
Reference in New Issue
Block a user