diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 3d3eeb73e..d64da9dfb 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -16,6 +16,9 @@ import Rendering.Renderer import Semantic.IO (Files, NoLanguageForBlob (..)) import Semantic.Task import System.FilePath.Posix +import qualified Data.ByteString.Char8 as B +import Path +import Data.Record graph :: (Members '[Distribute WrappedTask, Files, Task, Exc SomeException, Telemetry] effs) => Maybe FilePath @@ -41,3 +44,23 @@ graph maybeRootDir renderer Blob{..} | otherwise = throwError (SomeException (NoLanguageForBlob blobPath)) where packageName = name . BC.pack . dropExtensions . takeFileName + +graphPackage :: (Show (Record location), Ord (Record location), Members '[Distribute WrappedTask, Files, Task, Exc SomeException, Telemetry] effs) + => GraphRenderer output + -> Path Abs Dir + -> SomeAnalysisParser '[ Analysis.Evaluatable, Analysis.Declarations1, FreeVariables1, Functor, Eq1, Ord1, Show1 ] (Record location) + -> Eff effs ByteString +graphPackage renderer rootDir (SomeAnalysisParser parser exts preludePath) = do + paths <- listFiles (toFilePath rootDir) exts + prelude <- traverse (parseModule parser Nothing) preludePath + let packageName = name . B.pack . toFilePath $ dirname rootDir + package <- parsePackage packageName parser (toFilePath rootDir) paths + + let modulePaths = intercalate "," $ ModuleTable.keys (packageModules (packageBody package)) + writeLog Info ("Package " <> show packageName <> " loaded") [("paths", modulePaths)] + + graphImports prelude package >>= case renderer of + JSONGraphRenderer -> pure . toOutput + DOTGraphRenderer -> pure . Abstract.renderImportGraph + + where packageName = name . BC.pack . dropExtensions . takeFileName