From 7cd1d0ea99d9dd3058e2f977251141a2eb4804b7 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 15 May 2018 15:50:09 -0700 Subject: [PATCH] Build a resolution map along with creating a Package --- src/Data/Abstract/Package.hs | 7 ++++--- src/Data/File.hs | 1 + src/Semantic/Graph.hs | 7 ++++--- src/Semantic/IO.hs | 2 +- src/Semantic/Resolution.hs | 23 ++++++++++++----------- src/Semantic/Task.hs | 3 ++- 6 files changed, 24 insertions(+), 19 deletions(-) diff --git a/src/Data/Abstract/Package.hs b/src/Data/Abstract/Package.hs index b88e70043..800222fd3 100644 --- a/src/Data/Abstract/Package.hs +++ b/src/Data/Abstract/Package.hs @@ -22,6 +22,7 @@ data PackageBody term = PackageBody { packageModules :: ModuleTable [Module term] , packagePrelude :: Maybe (Module term) , packageEntryPoints :: ModuleTable (Maybe Name) + , packageResolutions :: Map.Map FilePath FilePath } deriving (Eq, Functor, Ord, Show) @@ -33,8 +34,8 @@ data Package term = Package } deriving (Eq, Functor, Ord, Show) -fromModules :: PackageName -> Maybe Version -> Maybe (Module term) -> Int -> [Module term] -> Package term -fromModules name version prelude entryPoints modules = - Package (PackageInfo name version) (PackageBody (ModuleTable.fromModules modules) prelude entryPoints') +fromModules :: PackageName -> Maybe Version -> Maybe (Module term) -> Int -> [Module term] -> Map.Map FilePath FilePath -> Package term +fromModules name version prelude entryPoints modules resolutions = + Package (PackageInfo name version) (PackageBody (ModuleTable.fromModules modules) prelude entryPoints' resolutions) where entryPoints' = ModuleTable . Map.fromList $ (,Nothing) . modulePath . moduleInfo <$> if entryPoints == 0 then modules else take entryPoints modules diff --git a/src/Data/File.hs b/src/Data/File.hs index 91498f753..706b08951 100644 --- a/src/Data/File.hs +++ b/src/Data/File.hs @@ -16,6 +16,7 @@ data Project = Project , projectFiles :: [File] , projectLanguage :: Language , projectEntryPoints :: [File] + , projectExcludeDirs :: [FilePath] } deriving (Eq, Ord, Show) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index c80f6ec9b..f13e7499b 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -25,7 +25,7 @@ import Semantic.Task as Task data GraphType = ImportGraph | CallGraph -graph :: Members '[Distribute WrappedTask, Files, Task, Exc SomeException, Telemetry, Trace] effs +graph :: Members '[Distribute WrappedTask, Files, Resolution, Task, Exc SomeException, Telemetry, Trace] effs => GraphType -> GraphRenderer output -> Project @@ -61,7 +61,7 @@ graph graphType renderer project constrainingTypes = id -- | Parse a list of files into a 'Package'. -parsePackage :: Members '[Distribute WrappedTask, Files, Task, Trace] effs +parsePackage :: Members '[Distribute WrappedTask, Files, Resolution, Task, Trace] effs => Parser term -- ^ A parser. -> Maybe File -- ^ Prelude (optional). -> Project -- ^ Project to parse into a package. @@ -69,7 +69,8 @@ parsePackage :: Members '[Distribute WrappedTask, Files, Task, Trace] effs parsePackage parser preludeFile project@Project{..} = do prelude <- traverse (parseModule parser Nothing) preludeFile p <- parseModules parser project - let pkg = Package.fromModules n Nothing prelude (length projectEntryPoints) p + resMap <- Task.resolutionMap project + let pkg = Package.fromModules n Nothing prelude (length projectEntryPoints) p resMap pkg <$ trace ("project: " <> show pkg) where diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs index b842c02b9..ef9f0950a 100644 --- a/src/Semantic/IO.hs +++ b/src/Semantic/IO.hs @@ -99,7 +99,7 @@ readProjectFromPaths maybeRoot path lang excludeDirs = do else (filter (/= path), [toFile path], fromMaybe (takeDirectory path) maybeRoot) paths <- liftIO $ filterFun <$> findFilesInDir rootDir exts excludeDirs - pure $ Project rootDir (toFile <$> paths) lang entryPoints + pure $ Project rootDir (toFile <$> paths) lang entryPoints excludeDirs where toFile path = File path (Just lang) exts = extensionsForLanguage lang diff --git a/src/Semantic/Resolution.hs b/src/Semantic/Resolution.hs index ca0a5863d..826992310 100644 --- a/src/Semantic/Resolution.hs +++ b/src/Semantic/Resolution.hs @@ -14,29 +14,30 @@ import Semantic.IO import System.FilePath.Posix -nodeJSResolutionMap :: Member Files effs => FilePath -> Language -> [FilePath] -> Eff effs (Map FilePath FilePath) -nodeJSResolutionMap dir lang excludeDirs = do - files <- findFiles dir [".json"] excludeDirs -- ["node_modules"] +nodeJSResolutionMap :: Member Files effs => FilePath -> Text -> [FilePath] -> Eff effs (Map FilePath FilePath) +nodeJSResolutionMap dir prop excludeDirs = do + files <- findFiles dir [".json"] excludeDirs let packageFiles = file <$> filter ((==) "package.json" . takeFileName) files blobs <- readBlobs (Right packageFiles) - pure $ fold (mapMaybe (lookup (propertyNameForLanguage lang)) blobs) + pure $ fold (mapMaybe (lookup prop) blobs) where - -- Entrypoint property name is different for JavaScript vs. TypeScript module resolution. - propertyNameForLanguage TypeScript = "types" - propertyNameForLanguage _ = "main" - lookup :: Text -> Blob -> Maybe (Map FilePath FilePath) lookup k Blob{..} = decodeStrict (sourceBytes blobSource) >>= lookupProp blobPath k lookupProp :: FilePath -> Text -> Object -> Maybe (Map FilePath FilePath) lookupProp path k res = flip parseMaybe res $ \obj -> Map.singleton path <$> obj .: k -nodeResolution :: Member Resolution effs => FilePath -> Language -> [FilePath] -> Eff effs (Map FilePath FilePath) -nodeResolution dir prop = send . NodeJSResolution dir prop +resolutionMap :: Member Resolution effs => Project -> Eff effs (Map FilePath FilePath) +resolutionMap Project{..} = case projectLanguage of + TypeScript -> send (NodeJSResolution projectRootDir "types" projectExcludeDirs) + JavaScript -> send (NodeJSResolution projectRootDir "main" projectExcludeDirs) + _ -> send NoResolution data Resolution output where - NodeJSResolution :: FilePath -> Language -> [FilePath] -> Resolution (Map FilePath FilePath) + NodeJSResolution :: FilePath -> Text -> [FilePath] -> Resolution (Map FilePath FilePath) + NoResolution :: Resolution (Map FilePath FilePath) runResolution :: Members '[Files] effs => Eff (Resolution ': effs) a -> Eff effs a runResolution = interpret $ \ res -> case res of NodeJSResolution dir prop excludeDirs -> nodeJSResolutionMap dir prop excludeDirs + NoResolution -> pure Map.empty diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs index 112f75d34..d490d51cb 100644 --- a/src/Semantic/Task.hs +++ b/src/Semantic/Task.hs @@ -14,7 +14,8 @@ module Semantic.Task , IO.findFiles , IO.writeToOutput -- * Module Resolution -, nodeResolution +, resolutionMap +, Resolution -- * Telemetry , writeLog , writeStat