Erlang support with rebar3 (#70)

* initial parser and tests

* graph creation and testing

* support git locators

* srclib converter

spectrometer.cabal

@@ -131,6 +131,7 @@ library
     Strategy.Clojure
     Strategy.Cocoapods.Podfile
     Strategy.Cocoapods.PodfileLock
+    Strategy.Erlang.Rebar3Tree
     Strategy.Go.GlideLock
     Strategy.Go.GoList
     Strategy.Go.Gomod
@@ -203,6 +204,7 @@ test-suite unit-tests
     Clojure.ClojureSpec
     Cocoapods.PodfileLockSpec
     Cocoapods.PodfileSpec
+    Erlang.Rebar3TreeSpec
     Go.GlideLockSpec
     Go.GoListSpec
     Go.GomodSpec

src/App/Fossa/Analyze.hs

@@ -28,6 +28,7 @@ import qualified Strategy.Carthage as Carthage
 import qualified Strategy.Clojure as Clojure
 import qualified Strategy.Cocoapods.Podfile as Podfile
 import qualified Strategy.Cocoapods.PodfileLock as PodfileLock
+import qualified Strategy.Erlang.Rebar3Tree as Rebar3Tree
 import qualified Strategy.Go.GoList as GoList
 import qualified Strategy.Go.Gomod as Gomod
 import qualified Strategy.Go.GopkgLock as GopkgLock
@@ -166,7 +167,9 @@ renderCause e = fromMaybe renderSomeException $
 
 discoverFuncs :: HasDiscover sig m => [Path Abs Dir -> m ()]
 discoverFuncs =
-  [ GoList.discover
+  [ Rebar3Tree.discover
+
+  , GoList.discover
   , Gomod.discover
   , GopkgToml.discover
   , GopkgLock.discover

src/DepTypes.hs

@@ -42,8 +42,10 @@ data DepEnvironment =
 -- | A Dependency type. This corresponds to a "fetcher" on the backend
 data DepType =
     SubprojectType -- ^ A first-party subproject
+  | GitType -- ^ Repository in Github
   | GemType    -- ^ Gem registry
   | GooglesourceType  -- ^ android.googlesource.com
+  | HexType    -- ^ Hex registry
   | MavenType -- ^ Maven registry
   | NodeJSType -- ^ NPM registry (or similar)
   | NuGetType -- ^ Nuget registry

src/Srclib/Converter.hs

@@ -93,7 +93,9 @@ depTypeToFetcher :: DepType -> Text
 depTypeToFetcher = \case
   SubprojectType -> "mvn" -- FIXME. I knew SubprojectType would come back to bite us.
   GooglesourceType -> "git" -- FIXME. Yet another thing that's coming back to bite us
+  GitType -> "git"
   GemType -> "gem"
+  HexType -> "hex"
   MavenType -> "mvn"
   NodeJSType -> "npm"
   NuGetType -> "nuget"

src/Strategy/Carthage.hs

@@ -96,15 +96,15 @@ analyze topPath = evalGrapher $ do
 entryToCheckoutName :: ResolvedEntry -> Text
 entryToCheckoutName entry =
   case resolvedType entry of
-    GitType -> resolvedName entry
+    GitEntry -> resolvedName entry
     -- this is safe because T.splitOn always returns a non-empty list
     GithubType -> Unsafe.last . T.splitOn "/" $ resolvedName entry
     BinaryType -> resolvedName entry
 
 entryToDepName :: ResolvedEntry -> Text
 entryToDepName entry =
   case resolvedType entry of
-    GitType -> resolvedName entry
+    GitEntry -> resolvedName entry
     GithubType -> "https://github.com/" <> resolvedName entry
     BinaryType -> resolvedName entry
 
@@ -130,7 +130,7 @@ parseSingleEntry :: Parser ResolvedEntry
 parseSingleEntry = L.nonIndented scn $ do
   entryType <- lexeme $ choice
     [ GithubType <$ chunk "github"
-    , GitType    <$ chunk "git"
+    , GitEntry    <$ chunk "git"
     , BinaryType <$ chunk "binary"
     ]
 
@@ -163,5 +163,5 @@ data ResolvedEntry = ResolvedEntry
   , resolvedVersion :: Text
   } deriving (Eq, Ord, Show, Generic)
 
-data EntryType = GithubType | GitType | BinaryType
+data EntryType = GithubType | GitEntry | BinaryType
   deriving (Eq, Ord, Show, Generic)

src/Strategy/Erlang/Rebar3Tree.hs

@@ -0,0 +1,125 @@
+module Strategy.Erlang.Rebar3Tree
+  ( discover
+  , analyze
+
+  , buildGraph
+  , rebar3TreeParser
+  , Rebar3Dep(..)
+  )
+  where
+
+import Prologue
+
+import Control.Carrier.Error.Either
+import qualified Data.Map.Strict as M
+import qualified Data.Text as T
+import Text.Megaparsec
+import Text.Megaparsec.Char
+
+import DepTypes
+import Discovery.Walk
+import Effect.Exec
+import Graphing (Graphing, unfold)
+import Types
+
+discover :: HasDiscover sig m => Path Abs Dir -> m ()
+discover = walk $ \dir _ files -> do
+  case find (\f -> (fileName f) == "rebar.config") files of
+    Nothing -> pure ()
+    Just _  -> runSimpleStrategy "erlang-rebar3tree" ErlangGroup $ analyze dir
+
+  pure WalkContinue
+
+rebar3TreeCmd :: Command
+rebar3TreeCmd = Command
+  { cmdNames = ["rebar3"]
+  , cmdBaseArgs = ["tree", "-v"]
+  , cmdAllowErr = Never
+  }
+
+analyze :: (Has Exec sig m, Has (Error ExecErr) sig m) => Path Rel Dir -> m ProjectClosureBody
+analyze dir = mkProjectClosure dir <$> execParser rebar3TreeParser dir rebar3TreeCmd []
+
+mkProjectClosure :: Path Rel Dir -> [Rebar3Dep] -> ProjectClosureBody
+mkProjectClosure dir deps = ProjectClosureBody
+  { bodyModuleDir    = dir
+  , bodyDependencies = dependencies
+  , bodyLicenses     = []
+  }
+  where
+  dependencies = ProjectDependencies
+    { dependenciesGraph    = buildGraph deps
+    , dependenciesOptimal  = NotOptimal
+    , dependenciesComplete = NotComplete
+    }
+
+buildGraph :: [Rebar3Dep] -> Graphing Dependency
+buildGraph deps = unfold deps subDeps toDependency
+  where
+  toDependency Rebar3Dep{..} = 
+    Dependency { dependencyType = if T.isInfixOf "github.com" depLocation then GitType else HexType
+                 , dependencyName = if T.isInfixOf "github.com" depLocation then depLocation else depName
+                 , dependencyVersion = Just (CEq depVersion)
+                 , dependencyLocations = []
+                 , dependencyEnvironments = []
+                 , dependencyTags = M.empty
+                 }
+
+data Rebar3Dep = Rebar3Dep
+  { depName     :: Text
+  , depVersion  :: Text
+  , depLocation :: Text
+  , subDeps     :: [Rebar3Dep]
+  } deriving (Eq, Ord, Show, Generic)
+
+type Parser = Parsec Void Text
+
+rebar3TreeParser :: Parser [Rebar3Dep]
+rebar3TreeParser = concat <$> ((try (rebarDep 0) <|> ignoredLine) `sepBy` eol) <* eof
+  where
+  isEndLine :: Char -> Bool
+  isEndLine '\n' = True
+  isEndLine '\r' = True
+  isEndLine _    = False
+
+  -- ignore content until the end of the line
+  ignored :: Parser ()
+  ignored = () <$ takeWhileP (Just "ignored") (not . isEndLine)
+
+  ignoredLine :: Parser [Rebar3Dep]
+  ignoredLine = do
+    ignored
+    pure []
+
+  findName :: Parser Text
+  findName = takeWhileP (Just "dep") (/= '─')
+
+  findVersion :: Parser Text
+  findVersion = takeWhileP (Just "version") (/= ' ')
+
+  findLocation :: Parser Text
+  findLocation = takeWhileP (Just "location") (/= ')')
+
+  rebarDep :: Int -> Parser [Rebar3Dep]
+  rebarDep depth = do
+    _ <- chunk " "
+    slashCount <- many "  │"
+    _ <- satisfy (\_ -> length slashCount == depth)
+
+    _ <- chunk "  & " <|> chunk "  ├─ " <|> chunk " ├─ " <|> chunk " └─ " 
+    dep <- findName
+    _ <- chunk "─"
+    version <- findVersion
+    _ <- chunk " ("
+    location <- findLocation
+    _ <- chunk ")"
+
+    deps <- many $ try $ rebarRecurse $ depth + 1
+
+    pure [Rebar3Dep dep version location (concat deps)]
+
+  rebarRecurse :: Int -> Parser [Rebar3Dep]
+  rebarRecurse depth = do
+    _ <- chunk "\n"
+    deps <- rebarDep depth
+    pure deps

src/Types.hs

@@ -137,6 +137,7 @@ data ProjectDependencies = ProjectDependencies
 data StrategyGroup =
     CarthageGroup
   | DotnetGroup
+  | ErlangGroup
   | GolangGroup
   | GooglesourceGroup
   | GradleGroup

test/Erlang/Rebar3TreeSpec.hs

@@ -0,0 +1,117 @@
+module Erlang.Rebar3TreeSpec
+  ( spec
+  ) where
+
+import Prologue
+
+import qualified Data.Map.Strict as M
+import qualified Data.Text.IO as TIO
+import Text.Megaparsec
+
+import DepTypes
+import Graphing()
+import Strategy.Erlang.Rebar3Tree
+import GraphUtil
+
+import Test.Hspec
+
+dependencyOne :: Dependency
+dependencyOne = Dependency { dependencyType = GitType
+                      , dependencyName = "https://github.com/dep/one"
+                      , dependencyVersion = Just (CEq "1.0.0")
+                      , dependencyLocations = []
+                      , dependencyEnvironments = []
+                      , dependencyTags = M.empty
+                      }
+
+dependencyTwo :: Dependency
+dependencyTwo = Dependency { dependencyType = HexType
+                      , dependencyName = "two"
+                      , dependencyVersion = Just (CEq "2.0.0")
+                      , dependencyLocations = []
+                      , dependencyEnvironments = []
+                      , dependencyTags = M.empty
+                      }
+dependencyThree :: Dependency
+dependencyThree = Dependency { dependencyType = HexType
+                      , dependencyName = "three"
+                      , dependencyVersion = Just (CEq "3.0.0")
+                      , dependencyLocations = []
+                      , dependencyEnvironments = []
+                      , dependencyTags = M.empty
+                      }
+
+dependencyFour :: Dependency
+dependencyFour = Dependency { dependencyType = GitType
+                      , dependencyName = "https://github.com/dep/four"
+                      , dependencyVersion = Just (CEq "4.0.0")
+                      , dependencyLocations = []
+                      , dependencyEnvironments = []
+                      , dependencyTags = M.empty
+                      }
+
+dependencyFive :: Dependency
+dependencyFive = Dependency { dependencyType = HexType
+                      , dependencyName = "five"
+                      , dependencyVersion = Just (CEq "5.0.0")
+                      , dependencyLocations = []
+                      , dependencyEnvironments = []
+                      , dependencyTags = M.empty
+                      }
+
+depOne :: Rebar3Dep
+depOne = Rebar3Dep 
+          { depName = "one"
+          , depVersion = "1.0.0"
+          , depLocation = "https://github.com/dep/one"
+          , subDeps = [depTwo, depFour]
+          }
+
+depTwo :: Rebar3Dep
+depTwo = Rebar3Dep 
+          { depName = "two"
+          , depVersion = "2.0.0"
+          , depLocation = "hex package"
+          , subDeps = [depThree]
+          }         
+
+depThree :: Rebar3Dep
+depThree = Rebar3Dep 
+          { depName = "three"
+          , depVersion = "3.0.0"
+          , depLocation = "hex package"
+          , subDeps = []
+          }         
+
+depFour :: Rebar3Dep
+depFour = Rebar3Dep 
+          { depName = "four"
+          , depVersion = "4.0.0"
+          , depLocation = "https://github.com/dep/four"
+          , subDeps = []
+          }         
+
+depFive :: Rebar3Dep
+depFive = Rebar3Dep 
+          { depName = "five"
+          , depVersion = "5.0.0"
+          , depLocation = "hex package"
+          , subDeps = []
+          }         
+
+spec :: Spec
+spec = do
+  contents <- runIO (TIO.readFile "test/Erlang/testdata/rebar3tree")
+
+  describe "rebar3 tree analyzer" $
+    it "produces the expected output" $ do
+      let res = buildGraph [depOne, depFive]
+      expectDeps [dependencyOne, dependencyTwo, dependencyThree, dependencyFour, dependencyFive] res
+      expectDirect [dependencyOne, dependencyFive] res
+      expectEdges [(dependencyOne, dependencyTwo), (dependencyOne, dependencyFour), (dependencyTwo, dependencyThree)] res
+
+  describe "rebar3 tree parser" $ do
+    it "parses ideal rebar3 tree output" $ do
+      case runParser rebar3TreeParser "" contents of
+        Left failCode -> traceM $ show failCode
+        Right result -> result `shouldMatchList` [depOne, depFive]

test/Erlang/testdata/rebar3tree

@@ -0,0 +1,5 @@
+   ├─ one─1.0.0 (https://github.com/dep/one)
+   │  ├─ two─2.0.0 (hex package)
+   │  │  └─ three─3.0.0 (hex package)
+   │  └─ four─4.0.0 (https://github.com/dep/four)
+   └─ five─5.0.0 (hex package)