diff --git a/src/Control/Abstract/Modules.hs b/src/Control/Abstract/Modules.hs index c82c8c38b..92b89c72e 100644 --- a/src/Control/Abstract/Modules.hs +++ b/src/Control/Abstract/Modules.hs @@ -2,7 +2,7 @@ module Control.Abstract.Modules ( ModuleResult , lookupModule -, resolvePaths +, resolve , listModulesInDir , require , load @@ -41,8 +41,8 @@ lookupModule :: (Member (Modules address value) sig, Carrier sig m) => ModulePat lookupModule = sendModules . flip Lookup ret -- | Resolve a list of module paths to a possible module table entry. -resolvePaths :: (Member (Modules address value) sig, Carrier sig m) => [FilePath] -> Evaluator term address value m (Maybe ModulePath) -resolvePaths = sendModules . flip ResolvePaths ret +resolve :: (Member (Modules address value) sig, Carrier sig m) => [FilePath] -> Evaluator term address value m (Maybe ModulePath) +resolve = sendModules . flip Resolve ret listModulesInDir :: (Member (Modules address value) sig, Carrier sig m) => FilePath -> Evaluator term address value m [ModulePath] listModulesInDir = sendModules . flip List ret @@ -62,10 +62,10 @@ load path = sendModules (Load path ret) data Modules address value (m :: * -> *) k - = Load ModulePath (ModuleResult address value -> k) - | Lookup ModulePath (Maybe (ModuleResult address value) -> k) - | ResolvePaths [FilePath] (Maybe ModulePath -> k) - | List FilePath ([ModulePath] -> k) + = Load ModulePath (ModuleResult address value -> k) + | Lookup ModulePath (Maybe (ModuleResult address value) -> k) + | Resolve [FilePath] (Maybe ModulePath -> k) + | List FilePath ([ModulePath] -> k) deriving (Functor) instance HFunctor (Modules address value) where @@ -100,10 +100,10 @@ instance ( Member (Reader (ModuleTable (NonEmpty (Module (ModuleResult address v => Carrier (Modules address value :+: sig) (ModulesC address value m) where ret = ModulesC . const . ret eff op = ModulesC (\ paths -> handleSum (eff . handleReader paths runModulesC) (\case - Load name k -> askModuleTable >>= maybeM (throwLoadError (ModuleNotFoundError name)) . fmap (runMerging . foldMap1 (Merging . moduleBody)) . ModuleTable.lookup name >>= flip runModulesC paths . k - Lookup path k -> askModuleTable >>= flip runModulesC paths . k . fmap (runMerging . foldMap1 (Merging . moduleBody)) . ModuleTable.lookup path - ResolvePaths names k -> runModulesC (k (find (`Set.member` paths) names)) paths - List dir k -> runModulesC (k (filter ((dir ==) . takeDirectory) (toList paths))) paths) op) + Load name k -> askModuleTable >>= maybeM (throwLoadError (ModuleNotFoundError name)) . fmap (runMerging . foldMap1 (Merging . moduleBody)) . ModuleTable.lookup name >>= flip runModulesC paths . k + Lookup path k -> askModuleTable >>= flip runModulesC paths . k . fmap (runMerging . foldMap1 (Merging . moduleBody)) . ModuleTable.lookup path + Resolve names k -> runModulesC (k (find (`Set.member` paths) names)) paths + List dir k -> runModulesC (k (filter ((dir ==) . takeDirectory) (toList paths))) paths) op) askModuleTable :: (Member (Reader (ModuleTable (NonEmpty (Module (ModuleResult address value))))) sig, Carrier sig m) => m (ModuleTable (NonEmpty (Module (ModuleResult address value)))) askModuleTable = ask diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 259853e3f..a3ec0d12a 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -19,7 +19,7 @@ module Data.Abstract.Evaluatable import Control.Abstract hiding (Load) import Control.Abstract.Context as X import Control.Abstract.Evaluator as X hiding (LoopControl(..), Return(..), catchLoopControl, runLoopControl, catchReturn, runReturn) -import Control.Abstract.Modules as X (Modules, ModuleResult, ResolutionError(..), load, lookupModule, listModulesInDir, require, resolvePaths, throwResolutionError) +import Control.Abstract.Modules as X (Modules, ModuleResult, ResolutionError(..), load, lookupModule, listModulesInDir, require, resolve, throwResolutionError) import Control.Abstract.Value as X hiding (Boolean(..), Function(..), While(..)) import Data.Abstract.BaseError as X import Data.Abstract.Declarations as X diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index 85d1352c7..bff5590a6 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -50,7 +50,7 @@ resolvePHPName :: ( Member (Modules address value) sig => T.Text -> Evaluator term address value m ModulePath resolvePHPName n = do - modulePath <- resolvePaths [name] + modulePath <- resolve [name] maybeM (throwResolutionError $ NotFoundError name [name] Language.PHP) modulePath where name = toName n toName = T.unpack . dropRelativePrefix . stripQuotes diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index 4e81429d2..0c00bca2c 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -100,7 +100,7 @@ resolvePythonModules q = do let searchPaths = [ path "__init__.py" , path <.> ".py" ] - modulePath <- resolvePaths searchPaths + modulePath <- resolve searchPaths maybeM (throwResolutionError $ NotFoundError path searchPaths Language.Python) modulePath diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index a595a69ac..057fc1f3a 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -42,7 +42,7 @@ resolveRubyName :: ( Member (Modules address value) sig resolveRubyName name = do let name' = cleanNameOrPath name let paths = [name' <.> "rb"] - modulePath <- resolvePaths paths + modulePath <- resolve paths maybeM (throwResolutionError $ NotFoundError name' paths Language.Ruby) modulePath -- load "/root/src/file.rb" @@ -56,7 +56,7 @@ resolveRubyPath :: ( Member (Modules address value) sig -> Evaluator term address value m M.ModulePath resolveRubyPath path = do let name' = cleanNameOrPath path - modulePath <- resolvePaths [name'] + modulePath <- resolve [name'] maybeM (throwResolutionError $ NotFoundError name' [name'] Language.Ruby) modulePath cleanNameOrPath :: Text -> String diff --git a/src/Language/TypeScript/Resolution.hs b/src/Language/TypeScript/Resolution.hs index 3d37e05b3..e9565ed7a 100644 --- a/src/Language/TypeScript/Resolution.hs +++ b/src/Language/TypeScript/Resolution.hs @@ -120,7 +120,7 @@ resolveModule path' exts = do <> maybe mempty (:[]) packageDotJSON <> (((path "index") <.>) <$> exts) trace ("searching in " <> show searchPaths) - maybe (Left searchPaths) Right <$> resolvePaths searchPaths + maybe (Left searchPaths) Right <$> resolve searchPaths typescriptExtensions :: [String] typescriptExtensions = ["ts", "tsx", "d.ts"]