mirror of
https://github.com/github/semantic.git
synced 2024-11-24 17:04:47 +03:00
Merge pull request #532 from zhujinxuan/module-pathtype
Refactor definition of Module to use pathtype
This commit is contained in:
Patrick Thomson
GitHub
commit
46d82018b2
@ -62,10 +62,10 @@ lookupModule :: Has (Modules address value) sig m => ModulePath -> Evaluator ter
|
||||
lookupModule = sendModules . flip Lookup pure
|
||||
|
||||
-- | Resolve a list of module paths to a possible module table entry.
|
||||
resolve :: Has (Modules address value) sig m => [FilePath] -> Evaluator term address value m (Maybe ModulePath)
|
||||
resolve :: Has (Modules address value) sig m => [Path.AbsRelFile] -> Evaluator term address value m (Maybe ModulePath)
|
||||
resolve = sendModules . flip Resolve pure
|
||||
|
||||
listModulesInDir :: Has (Modules address value) sig m => FilePath -> Evaluator term address value m [ModulePath]
|
||||
listModulesInDir :: Has (Modules address value) sig m => Path.AbsRelDir -> Evaluator term address value m [ModulePath]
|
||||
listModulesInDir = sendModules . flip List pure
|
||||
|
||||
|
||||
@ -85,8 +85,8 @@ load path = sendModules (Load path pure)
|
||||
data Modules address value (m :: * -> *) k
|
||||
= Load ModulePath (ModuleResult address value -> m k)
|
||||
| Lookup ModulePath (Maybe (ModuleResult address value) -> m k)
|
||||
| Resolve [FilePath] (Maybe ModulePath -> m k)
|
||||
| List FilePath ([ModulePath] -> m k)
|
||||
| Resolve [Path.AbsRelFile] (Maybe ModulePath -> m k)
|
||||
| List Path.AbsRelDir ([ModulePath] -> m k)
|
||||
deriving (Functor, Generic1)
|
||||
|
||||
instance HFunctor (Modules address value)
|
||||
@ -115,8 +115,8 @@ instance ( Has (Reader (ModuleTable (Module (ModuleResult address value)))) sig
|
||||
case op of
|
||||
Load name k -> askModuleTable >>= maybeM (throwLoadError (ModuleNotFoundError name)) . fmap moduleBody . ModuleTable.lookup name >>= k
|
||||
Lookup path k -> askModuleTable >>= k . fmap moduleBody . ModuleTable.lookup path
|
||||
Resolve names k -> k (find (`Set.member` paths) (map Path.absRel names))
|
||||
List dir k -> k (filter ((dir ==) . Path.toString . Path.takeDirectory) (toList paths))
|
||||
Resolve names k -> k (find (`Set.member` paths) names)
|
||||
List dir k -> k (filter ((dir ==) . Path.takeDirectory) (toList paths))
|
||||
alg (R other) = ModulesC (alg (R (handleCoercible other)))
|
||||
|
||||
askModuleTable :: Has (Reader (ModuleTable (Module (ModuleResult address value)))) sig m => m (ModuleTable (Module (ModuleResult address value)))
|
||||
@ -152,12 +152,14 @@ throwLoadError err@(ModuleNotFoundError name) = throwResumable $ BaseError (Modu
|
||||
|
||||
-- | An error thrown when we can't resolve a module from a qualified name.
|
||||
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.
|
||||
NotFoundError :: Path.AbsRelFileDir -- The path that was not found.
|
||||
-> [Path.AbsRelFile] -- List of paths searched that shows where semantic looked for this module.
|
||||
-> Language -- Language.
|
||||
-> ResolutionError ModulePath
|
||||
|
||||
GoImportError :: FilePath -> ResolutionError [ModulePath]
|
||||
-- Go Lang may have its package import path as an uri like https://github.com/packagename rather than an file path
|
||||
-- TODO: A typed path can be used here to represent the uri
|
||||
GoImportError :: String -> ResolutionError [ModulePath]
|
||||
|
||||
deriving instance Eq (ResolutionError b)
|
||||
deriving instance Show (ResolutionError b)
|
||||
|
||||
@ -2,11 +2,14 @@ module Data.Abstract.Path
|
||||
( dropRelativePrefix
|
||||
, joinPaths
|
||||
, stripQuotes
|
||||
, joinUntypedPaths
|
||||
) where
|
||||
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import System.FilePath.Posix
|
||||
import qualified System.Path as Path
|
||||
import System.Path.PartClass (FileDir)
|
||||
|
||||
-- | Join two paths a and b. Handles walking up relative directories in b. e.g.
|
||||
--
|
||||
@ -14,14 +17,25 @@ import System.FilePath.Posix
|
||||
-- joinPaths "a/b" "./c" == "a/b/c"
|
||||
--
|
||||
-- Walking beyond the beginning of a just stops when you get to the root of a.
|
||||
joinPaths :: FilePath -> FilePath -> FilePath
|
||||
joinPaths a b = let bs = splitPath (normalise b)
|
||||
n = length (filter (== "../") bs)
|
||||
joinUntypedPaths :: FilePath -> FilePath -> FilePath
|
||||
joinUntypedPaths a b = let bs = splitPath (normalise b)
|
||||
n = length (filter (== "../") bs)
|
||||
in normalise $ walkup n a </> joinPath (drop n bs)
|
||||
where
|
||||
walkup 0 str = str
|
||||
walkup n str = walkup (pred n) (takeDirectory str)
|
||||
|
||||
-- | Join two paths a and b. Handles walking up relative directories in b. e.g.
|
||||
--
|
||||
-- joinPaths "a/b" "../c" == "a/c"
|
||||
-- joinPaths "a/b" "./c" == "a/b/c"
|
||||
--
|
||||
-- Walking beyond the beginning of a just stops when you get to the root of a.
|
||||
-- TODO: Rewrite it with pathtype
|
||||
joinPaths :: FileDir fd => Path.AbsRelDir -> Path.Rel fd -> Path.AbsRel fd
|
||||
joinPaths x y= Path.path $ joinUntypedPaths (Path.toString x) (Path.toString y)
|
||||
|
||||
|
||||
stripQuotes :: Text -> Text
|
||||
stripQuotes = T.dropAround (`elem` ("\'\"" :: String))
|
||||
|
||||
|
||||
@ -43,7 +43,7 @@ resolveGoImport :: ( Has (Modules address value) sig m
|
||||
resolveGoImport (ImportPath path Data.ImportPath.Unknown) = throwResolutionError $ GoImportError path
|
||||
resolveGoImport (ImportPath path Relative) = do
|
||||
ModuleInfo{..} <- currentModule
|
||||
paths <- listModulesInDir $ (joinPaths (takeDirectory . Path.toString $ modulePath) path)
|
||||
paths <- listModulesInDir $ (joinPaths (Path.takeDirectory modulePath) (Path.rel path))
|
||||
case paths of
|
||||
[] -> throwResolutionError $ GoImportError path
|
||||
_ -> pure paths
|
||||
@ -54,7 +54,7 @@ resolveGoImport (ImportPath path NonRelative) = do
|
||||
-- Import an absolute path that's defined in this package being analyzed.
|
||||
-- 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)
|
||||
(_ : _ : p : xs) | p == package -> listModulesInDir (Path.toAbsRel $ Path.joinPath xs)
|
||||
_ -> throwResolutionError $ GoImportError path
|
||||
|
||||
-- | Import declarations (symbols are added directly to the calling environment).
|
||||
|
||||
@ -25,6 +25,7 @@ import Data.JSON.Fields
|
||||
import qualified Data.Language as Language
|
||||
import Diffing.Algorithm
|
||||
import Source.Span
|
||||
import qualified System.Path as Path
|
||||
|
||||
newtype Text a = Text { value :: T.Text }
|
||||
deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable)
|
||||
@ -61,9 +62,9 @@ resolvePHPName :: ( Has (Modules address value) sig m
|
||||
-> Evaluator term address value m ModulePath
|
||||
resolvePHPName n = do
|
||||
modulePath <- resolve [name]
|
||||
maybeM (throwResolutionError $ NotFoundError name [name] Language.PHP) modulePath
|
||||
maybeM (throwResolutionError $ NotFoundError (Path.toFileDir name) [name] Language.PHP) modulePath
|
||||
where name = toName n
|
||||
toName = T.unpack . dropRelativePrefix . stripQuotes
|
||||
toName = Path.absRel . T.unpack . dropRelativePrefix . stripQuotes
|
||||
|
||||
include :: ( Has (Modules address value) sig m
|
||||
, Has (Reader (CurrentFrame address)) sig m
|
||||
|
||||
@ -97,11 +97,11 @@ resolvePythonModules q = do
|
||||
search rootDir x = do
|
||||
trace ("searching for " <> show x <> " in " <> show rootDir)
|
||||
let path = normalise (rootDir </> normalise x)
|
||||
let searchPaths = [ path </> "__init__.py"
|
||||
let searchPaths = Path.absRel <$> [ path </> "__init__.py"
|
||||
, path <.> ".py"
|
||||
]
|
||||
modulePath <- resolve searchPaths
|
||||
maybeM (throwResolutionError $ NotFoundError path searchPaths Language.Python) modulePath
|
||||
maybeM (throwResolutionError $ NotFoundError (Path.absRel path) searchPaths Language.Python) modulePath
|
||||
|
||||
data Alias a = Alias { aliasValue :: a, aliasName :: a}
|
||||
deriving (Generic1, Diffable, Foldable, FreeVariables1, Functor, Hashable1, ToJSONFields1, Traversable)
|
||||
|
||||
@ -32,7 +32,7 @@ import qualified Data.Text as T
|
||||
import Data.Traversable (for)
|
||||
import Diffing.Algorithm
|
||||
import GHC.Generics (Generic1)
|
||||
import System.FilePath.Posix
|
||||
import qualified System.Path as Path
|
||||
|
||||
-- TODO: Fully sort out ruby require/load mechanics
|
||||
--
|
||||
@ -46,9 +46,9 @@ resolveRubyName :: ( Has (Modules address value) sig m
|
||||
-> Evaluator term address value m M.ModulePath
|
||||
resolveRubyName name = do
|
||||
let name' = cleanNameOrPath name
|
||||
let paths = [name' <.> "rb"]
|
||||
let paths = [name' Path.<.> "rb"]
|
||||
modulePath <- resolve paths
|
||||
maybeM (throwResolutionError $ NotFoundError name' paths Language.Ruby) modulePath
|
||||
maybeM (throwResolutionError $ NotFoundError (Path.toFileDir name') paths Language.Ruby) modulePath
|
||||
|
||||
-- load "/root/src/file.rb"
|
||||
resolveRubyPath :: ( Has (Modules address value) sig m
|
||||
@ -61,10 +61,10 @@ resolveRubyPath :: ( Has (Modules address value) sig m
|
||||
resolveRubyPath path = do
|
||||
let name' = cleanNameOrPath path
|
||||
modulePath <- resolve [name']
|
||||
maybeM (throwResolutionError $ NotFoundError name' [name'] Language.Ruby) modulePath
|
||||
maybeM (throwResolutionError $ NotFoundError (Path.toFileDir name') [name'] Language.Ruby) modulePath
|
||||
|
||||
cleanNameOrPath :: Text -> String
|
||||
cleanNameOrPath = T.unpack . dropRelativePrefix . stripQuotes
|
||||
cleanNameOrPath :: Text -> Path.AbsRelFile
|
||||
cleanNameOrPath = Path.absRel . T.unpack . dropRelativePrefix . stripQuotes
|
||||
|
||||
data Send a = Send { sendReceiver :: Maybe a, sendSelector :: Maybe a, sendArgs :: [a], sendBlock :: Maybe a }
|
||||
deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable)
|
||||
|
||||
@ -37,8 +37,8 @@ resolveWithNodejsStrategy :: ( Has (Modules address value) sig m
|
||||
=> ImportPath
|
||||
-> [String]
|
||||
-> Evaluator term address value m M.ModulePath
|
||||
resolveWithNodejsStrategy (ImportPath path NonRelative) exts = resolveNonRelativePath path exts
|
||||
resolveWithNodejsStrategy (ImportPath path _) exts = resolveRelativePath path exts
|
||||
resolveWithNodejsStrategy (ImportPath path NonRelative) exts = resolveNonRelativePath (Path.relDir path) exts
|
||||
resolveWithNodejsStrategy (ImportPath path _) exts = resolveRelativePath (Path.rel path) exts
|
||||
|
||||
-- | Resolve a relative TypeScript import to a known 'ModuleName' or fail.
|
||||
--
|
||||
@ -54,17 +54,17 @@ resolveRelativePath :: ( Has (Modules address value) sig m
|
||||
, Has (Resumable (BaseError ResolutionError)) sig m
|
||||
, Has Trace sig m
|
||||
)
|
||||
=> FilePath
|
||||
=> Path.RelFileDir
|
||||
-> [String]
|
||||
-> Evaluator term address value m M.ModulePath
|
||||
resolveRelativePath relImportPath exts = do
|
||||
M.ModuleInfo{..} <- currentModule
|
||||
let relRootDir = takeDirectory (Path.toString modulePath)
|
||||
let path = joinPaths relRootDir relImportPath
|
||||
let relRootDir = Path.takeDirectory modulePath
|
||||
let path = relRootDir `joinPaths` relImportPath
|
||||
trace ("attempting to resolve (relative) require/import " <> show relImportPath)
|
||||
resolveModule path exts >>= either notFound (\x -> x <$ traceResolve relImportPath path)
|
||||
where
|
||||
notFound xs = throwResolutionError $ NotFoundError relImportPath xs Language.TypeScript
|
||||
notFound xs = throwResolutionError $ NotFoundError (Path.toAbsRel relImportPath) xs Language.TypeScript
|
||||
|
||||
-- | Resolve a non-relative TypeScript import to a known 'ModuleName' or fail.
|
||||
--
|
||||
@ -76,6 +76,10 @@ resolveRelativePath relImportPath exts = do
|
||||
--
|
||||
-- /root/node_modules/moduleB.ts, etc
|
||||
-- /node_modules/moduleB.ts, etc
|
||||
-- TODO: The NonRelative package means the packages in node_modules,
|
||||
-- laying relatively in filesystem under the project root. Perhaps we
|
||||
-- can rename the function like resolvePackagePath to resolve the
|
||||
-- confusion between Path.RelDir and NonRelative.
|
||||
resolveNonRelativePath :: ( Has (Modules address value) sig m
|
||||
, Has (Reader M.ModuleInfo) sig m
|
||||
, Has (Reader PackageInfo) sig m
|
||||
@ -83,39 +87,40 @@ resolveNonRelativePath :: ( Has (Modules address value) sig m
|
||||
, Has (Resumable (BaseError ResolutionError)) sig m
|
||||
, Has Trace sig m
|
||||
)
|
||||
=> FilePath
|
||||
=> Path.RelDir
|
||||
-> [String]
|
||||
-> Evaluator term address value m M.ModulePath
|
||||
resolveNonRelativePath name exts = do
|
||||
M.ModuleInfo{..} <- currentModule
|
||||
go (Path.toAbsRel Path.currentDir) (Path.takeDirectory modulePath) mempty
|
||||
where
|
||||
nodeModulesPath dir = dir Path.</> Path.relDir "node_modules" Path.</> Path.relDir name
|
||||
nodeModulesPath dir = dir Path.</> Path.relDir "node_modules" Path.</> name
|
||||
-- Recursively search in a 'node_modules' directory, stepping up a directory each time.
|
||||
go root path searched = do
|
||||
trace ("attempting to resolve (non-relative) require/import " <> show name)
|
||||
res <- resolveModule (Path.toString $ nodeModulesPath path) exts
|
||||
res <- resolveModule (Path.toFileDir $ nodeModulesPath path) exts
|
||||
case res of
|
||||
Left xs | Just parentDir <- Path.takeSuperDirectory path , root /= path -> go root parentDir (searched <> xs)
|
||||
| otherwise -> notFound (searched <> xs)
|
||||
Right m -> m <$ traceResolve name m
|
||||
notFound xs = throwResolutionError $ NotFoundError name xs Language.TypeScript
|
||||
notFound xs = throwResolutionError $ NotFoundError (Path.toAbsRel $ Path.toFileDir name) xs Language.TypeScript
|
||||
|
||||
-- | Resolve a module name to a ModulePath.
|
||||
resolveModule :: ( Has (Modules address value) sig m
|
||||
, Has (Reader PackageInfo) sig m
|
||||
, Has Trace sig m
|
||||
)
|
||||
=> FilePath -- ^ Module path used as directory to search in
|
||||
=> Path.AbsRelFileDir -- ^ Module path used as directory to search in
|
||||
-> [String] -- ^ File extensions to look for
|
||||
-> Evaluator term address value m (Either [FilePath] M.ModulePath)
|
||||
-> Evaluator term address value m (Either [M.ModulePath] M.ModulePath)
|
||||
resolveModule path' exts = do
|
||||
let path = makeRelative "." path'
|
||||
let path = makeRelative "." $ Path.toString path'
|
||||
PackageInfo{..} <- currentPackage
|
||||
let packageDotJSON = Map.lookup (path </> "package.json") packageResolutions
|
||||
let searchPaths = ((path <.>) <$> exts)
|
||||
let searchPaths' = ((path <.>) <$> exts)
|
||||
<> maybe mempty (:[]) packageDotJSON
|
||||
<> (((path </> "index") <.>) <$> exts)
|
||||
let searchPaths = fmap Path.absRel searchPaths'
|
||||
trace ("searching in " <> show searchPaths)
|
||||
maybe (Left searchPaths) Right <$> resolve searchPaths
|
||||
|
||||
|
||||
@ -68,6 +68,7 @@ import Data.Abstract.Value.Concrete as Concrete (Value, ValueError (..
|
||||
import Data.Abstract.Value.Type as Type
|
||||
import Data.Blob
|
||||
import Data.Functor.Foldable
|
||||
import Data.Functor (($>))
|
||||
import Data.Graph.Algebraic
|
||||
import Data.Graph.ControlFlowVertex (VertexDeclaration)
|
||||
import Data.Language as Language
|
||||
@ -383,7 +384,7 @@ resumingResolutionError :: ( Has Trace sig m
|
||||
resumingResolutionError = runResolutionErrorWith $ \ baseError -> do
|
||||
traceError "ResolutionError" baseError
|
||||
case baseErrorException baseError of
|
||||
NotFoundError nameToResolve _ _ -> pure $ Path.absRel nameToResolve
|
||||
NotFoundError nameToResolve _ _ -> maybe (traceError ("NotFileError: resolve path is " ++ show nameToResolve) baseError $> Path.toAbsRel Path.emptyFile) pure $ Path.fileFromFileDir nameToResolve
|
||||
GoImportError pathToResolve -> pure [Path.absRel pathToResolve]
|
||||
|
||||
resumingLoadError :: ( Has Trace sig m
|
||||
|
||||
@ -7,14 +7,14 @@ spec :: Spec
|
||||
spec = parallel $
|
||||
describe "joinPaths" $ do
|
||||
it "joins empty paths" $
|
||||
joinPaths "" "" `shouldBe` "."
|
||||
joinUntypedPaths "" "" `shouldBe` "."
|
||||
it "joins relative paths" $
|
||||
joinPaths "a/b" "./c" `shouldBe` "a/b/c"
|
||||
joinUntypedPaths "a/b" "./c" `shouldBe` "a/b/c"
|
||||
it "joins absolute paths" $
|
||||
joinPaths "/a/b" "c" `shouldBe` "/a/b/c"
|
||||
joinUntypedPaths "/a/b" "c" `shouldBe` "/a/b/c"
|
||||
it "walks up directories for ../" $
|
||||
joinPaths "a/b" "../c" `shouldBe` "a/c"
|
||||
joinUntypedPaths "a/b" "../c" `shouldBe` "a/c"
|
||||
it "walks up directories for multiple ../" $
|
||||
joinPaths "a/b" "../../c" `shouldBe` "c"
|
||||
joinUntypedPaths "a/b" "../../c" `shouldBe` "c"
|
||||
it "stops walking at top directory" $
|
||||
joinPaths "a/b" "../../../c" `shouldBe` "c"
|
||||
joinUntypedPaths "a/b" "../../../c" `shouldBe` "c"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user