sbt strategy

spectrometer.cabal

@@ -183,6 +183,7 @@ library
     Strategy.RPM
     Strategy.Ruby.BundleShow
     Strategy.Ruby.GemfileLock
+    Strategy.Scala
     Types
     VCS.Git
 

src/App/Fossa/Analyze.hs

@@ -57,6 +57,7 @@ import qualified Strategy.Python.SetupPy as SetupPy
 import qualified Strategy.RPM as RPM
 import qualified Strategy.Ruby.BundleShow as BundleShow
 import qualified Strategy.Ruby.GemfileLock as GemfileLock
+import qualified Strategy.Scala as Scala
 import Text.URI (URI)
 import qualified Text.URI as URI
 import Types
@@ -222,6 +223,8 @@ discoverFuncs =
   , Cargo.discover
 
   , RPM.discover
+
+  , Scala.discover
   ]
 
 updateProgress :: Has Logger sig m => Progress -> m ()

src/Srclib/Converter.hs

@@ -13,13 +13,14 @@ import qualified Data.Set as Set
 import DepTypes
 import Graphing (Graphing)
 import qualified Graphing
+import Path (toFilePath)
 import Srclib.Types
 
 toSourceUnit :: Project -> Maybe SourceUnit
 toSourceUnit Project{..} = do
   bestStrategy <- safeHead projectStrategies
 
-  let renderedPath = Text.pack (show projectPath) <> "/" <> projStrategyName bestStrategy
+  let renderedPath = Text.pack (toFilePath projectPath) <> "/" <> projStrategyName bestStrategy
 
       graph :: Graphing Dependency
       graph = projStrategyGraph bestStrategy

src/Strategy/Maven/Pom.hs

@@ -1,5 +1,6 @@
 module Strategy.Maven.Pom
   ( discover
+  , mkProjectClosure
   ) where
 
 import Prologue

src/Strategy/Maven/Pom/Closure.hs

@@ -1,6 +1,7 @@
 module Strategy.Maven.Pom.Closure
   ( findProjects
   , MavenProjectClosure(..)
+  , buildProjectClosures
   ) where
 
 import Prologue

src/Strategy/Maven/Pom/Resolver.hs

@@ -40,8 +40,8 @@ buildGlobalClosure files = do
   -- Because the group/artifact/version are required to match, we can just build edges between _coordinates_, rather than between _pom files_
   buildClosure :: Map (Path Abs File) Pom -> GlobalClosure
   buildClosure cache = GlobalClosure
-    { globalGraph = AM.vertices (map pomCoord (M.elems cache)) `AM.overlay` AM.overlays
-        [AM.edge parentCoord (pomCoord pom)
+    { globalGraph = AM.vertices (map pomCoord (M.elems cache)) `AM.overlay` AM.edges
+        [(parentCoord,pomCoord pom)
           | pom <- M.elems cache
           , Just parentCoord <- [pomParentCoord pom]]
     , globalPoms = indexBy (pomCoord . snd) (M.toList cache)

src/Strategy/Scala.hs

@@ -0,0 +1,111 @@
+-- | The scala strategy leverages the machinery from maven-pom.
+--
+-- Sbt has a command to export pom files, with one caveat -- in multi-project
+-- setups, parent/child relationships are not present in the generated poms.
+--
+-- The only non-trivial logic that exists in this strategy is adding edges
+-- between poms in the maven "global closure", before building the individual
+-- multi-project closures.
+module Strategy.Scala
+  ( discover,
+  )
+where
+
+import qualified Algebra.Graph.AdjacencyMap as AM
+import Control.Effect.Output
+import qualified Data.Map.Strict as M
+import Data.Maybe (catMaybes)
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import Data.Text.Lazy.Encoding (decodeUtf8)
+import Discovery.Walk
+import Control.Effect.Diagnostics
+import Effect.Exec
+import Effect.ReadFS
+import Prologue
+import Strategy.Maven.Pom (mkProjectClosure)
+import Strategy.Maven.Pom.Closure (buildProjectClosures)
+import Strategy.Maven.Pom.PomFile (MavenCoordinate (..), Pom (..))
+import Strategy.Maven.Pom.Resolver (GlobalClosure (..), buildGlobalClosure)
+import Types
+
+discover :: HasDiscover sig m => Path Abs Dir -> m ()
+discover basedir =
+  walk
+    ( \_ _ files ->
+        case find (\f -> fileName f == "build.sbt") files of
+          Nothing -> pure WalkContinue
+          Just file -> do
+            runStrategy "scala-sbt" ScalaGroup (analyze basedir file)
+            pure WalkSkipAll
+    )
+    basedir
+
+makePomCmd :: Command
+makePomCmd =
+  Command
+    { cmdName = "sbt",
+      cmdArgs = ["makePom", "-no-colors"],
+      cmdAllowErr = Never
+    }
+
+analyze ::
+  ( Has Exec sig m,
+    Has Diagnostics sig m,
+    Has ReadFS sig m,
+    Has (Output ProjectClosure) sig m
+  ) =>
+  Path Abs Dir ->
+  Path Abs File ->
+  m ()
+analyze basedir file = do
+  stdoutBL <- execThrow (parent file) makePomCmd
+
+  -- stdout for "sbt makePom" looks something like:
+  --
+  -- > ...
+  -- > [info] Wrote /absolute/path/to/pom.xml
+  -- > [info] Wrote /absolute/path/to/other/pom.xml
+  -- > ...
+  let stdoutLText = decodeUtf8 stdoutBL
+      stdout = TL.toStrict stdoutLText
+      --
+      stdoutLines :: [Text]
+      stdoutLines = T.lines stdout
+      --
+      pomLines :: [Text]
+      pomLines = catMaybes $ map (T.stripPrefix "[info] Wrote ") stdoutLines
+      --
+      pomLocations :: Maybe [Path Abs File]
+      pomLocations = traverse (parseAbsFile . T.unpack) pomLines
+
+  case pomLocations of
+    Nothing -> fatalText ("Could not parse pom paths from:\n" <> T.unlines pomLines)
+    Just [] -> fatalText ("No sbt projects found")
+    Just paths -> do
+      globalClosure <- buildGlobalClosure paths
+
+      -- The pom files generated by sbt do not include the proper <parent> references.
+      -- We need to introduce these edges ourselves.
+      let pomEdges :: AM.AdjacencyMap MavenCoordinate
+          pomEdges =
+            AM.edges
+              [ (parentPom, childPom)
+                | -- build references to any pom
+                  parentPom <- AM.vertexList (globalGraph globalClosure),
+                  -- from any other pom
+                  childPom <- AM.vertexList (globalGraph globalClosure),
+                  parentPom /= childPom,
+                  -- when the other pom has it as a dependency
+                  Just (_, pom) <- [M.lookup childPom (globalPoms globalClosure)],
+                  let deps = M.keys (pomDependencies pom),
+                  any
+                    ( \(group, artifact) ->
+                        coordGroup parentPom == group && coordArtifact parentPom == artifact
+                    )
+                    deps
+              ]
+          globalClosure' = globalClosure {globalGraph = AM.overlay pomEdges (globalGraph globalClosure)}
+          projects = buildProjectClosures basedir globalClosure'
+
+      traverse_ (output . mkProjectClosure basedir) projects

src/Types.hs

@@ -149,6 +149,7 @@ data StrategyGroup =
   | RustGroup
   | RPMGroup
   | ArchiveGroup
+  | ScalaGroup
   deriving (Eq, Ord, Show, Generic)
 
 -- FIXME: we also need to annotate dep graphs with Path Rel File -- merge these somehow?