Support multiple --input directories

diff --git a/app/Main.hs b/app/Main.hs
index e31b0d8a74d73fcf14f0745018a44f7740c2987b..897ee7679db8a18afb1ac39004d55c5966007253 100644 (file)
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -5,23 +5,24 @@ module Main (main) where
 import qualified Data.ByteString.Lazy as BL
 import Options.Applicative
 
-import Classgraph.Merge (mergeDir)
+import Classgraph.Merge (mergeDirs)
 import Classgraph.Render (renderProgram)
 
 data Opts = Opts
-  { optInput  :: FilePath
-  , optOutput :: FilePath
+  { optInputs :: ![FilePath]
+  , optOutput :: !FilePath
   }
 
 opts :: Parser Opts
 opts = Opts
-  <$> strOption
-        (  long "input"
-        <> short 'i'
-        <> metavar "DIR"
-        <> value ".classgraph"
-        <> showDefault
-        <> help "Directory of per-module *.json dumps written by the plugin." )
+  <$> many
+        (strOption
+          (  long "input"
+          <> short 'i'
+          <> metavar "DIR"
+          <> help "Directory of per-module *.json dumps written by the plugin. \
+                  \May be repeated to merge dumps from multiple packages \
+                  \(default: ./.classgraph)." ))
   <*> strOption
         (  long "output"
         <> short 'o'
@@ -36,6 +37,11 @@ main = do
          (fullDesc
           <> progDesc "Merge classgraph plugin output and render an interactive HTML viewer."
           <> header "classgraph-view — interactive typeclass hierarchy"))
-  pd <- mergeDir (optInput o)
+  let inputs = case optInputs o of
+        [] -> [".classgraph"]
+        xs -> xs
+  pd <- mergeDirs inputs
   BL.writeFile (optOutput o) (renderProgram pd)
-  putStrLn ("Wrote " <> optOutput o)
+  putStrLn $ "Wrote " <> optOutput o <>
+             "  (merged " <> show (length inputs) <> " input dir" <>
+             (if length inputs == 1 then ")" else "s)")

diff --git a/src/Classgraph/Merge.hs b/src/Classgraph/Merge.hs
index 06e9ab3c98ce9bce2e05448c5dca7411917d1f4e..2fac1ad985e056902c395b1d18c7b1ea9979db92 100644 (file)
--- a/src/Classgraph/Merge.hs
+++ b/src/Classgraph/Merge.hs
@@ -4,6 +4,7 @@
 -- 'ProgramData' value. Deduplicates on 'QualName'.
 module Classgraph.Merge
   ( mergeDir
+  , mergeDirs
   , mergeDumps
   ) where
 
@@ -19,19 +20,29 @@ import Classgraph.Schema
 -- | Read every @*.json@ file in the given directory, decode as
 -- 'ModuleDump', and merge.
 mergeDir :: FilePath -> IO ProgramData
-mergeDir dir = do
+mergeDir dir = mergeDirs [dir]
+
+-- | Like 'mergeDir' but reads from multiple directories. Useful for
+-- projects that compile several packages in different locations on the
+-- repo, each with its own @.classgraph@ output.
+mergeDirs :: [FilePath] -> IO ProgramData
+mergeDirs dirs = do
+  dumps <- concat <$> mapM readDumpsInDir dirs
+  pure (mergeDumps dumps)
+
+readDumpsInDir :: FilePath -> IO [ModuleDump]
+readDumpsInDir dir = do
   entries <- listDirectory dir
   let candidates = [ dir </> e | e <- entries, takeExtension e == ".json" ]
   jsonFiles <- filterM doesFileExist candidates
-  dumps <- mapM readDump jsonFiles
-  pure (mergeDumps dumps)
-  where
-    readDump :: FilePath -> IO ModuleDump
-    readDump fp = do
-      bs <- BL.readFile fp
-      case Aeson.eitherDecode bs of
-        Right d -> pure d
-        Left e  -> error ("classgraph: cannot decode " <> fp <> ": " <> e)
+  mapM readDump jsonFiles
+
+readDump :: FilePath -> IO ModuleDump
+readDump fp = do
+  bs <- BL.readFile fp
+  case Aeson.eitherDecode bs of
+    Right d -> pure d
+    Left e  -> error ("classgraph: cannot decode " <> fp <> ": " <> e)
 
 -- | Combine many 'ModuleDump's, deduplicating classes / families /
 -- instances by their 'QualName' identity. The first occurrence wins.