New option for json import graph output

src/Analysis/Abstract/ImportGraph.hs

@@ -22,10 +22,32 @@ import qualified Data.Syntax as Syntax
 import           Data.Term
 import           Prologue hiding (empty, packageName)
 
+import Data.Aeson
+import Data.Output
+import Data.Text.Encoding as T
+import Data.ByteString.Lazy (toStrict)
+
 -- | The graph of function variableDefinitions to symbols used in a given program.
 newtype ImportGraph = ImportGraph { unImportGraph :: G.Graph Vertex }
   deriving (Eq, Graph, Show)
 
+instance Output ImportGraph where
+  toOutput = toStrict . (<> "\n") . encode
+
+instance ToJSON ImportGraph where
+  toJSON ImportGraph{..} = object [ "vertices" .= vertices, "edges" .= edges ]
+    where
+      vertices = toJSON (G.vertexList unImportGraph)
+      edges = fmap (\(a, b) -> object [ "source" .= vertexToText a, "target" .= vertexToText b ]) (G.edgeList unImportGraph)
+
+vertexToText :: Vertex -> Text
+vertexToText = decodeUtf8 . vertexName
+
+vertexToType :: Vertex -> Text
+vertexToType Package{..} = "package"
+vertexToType Module{..} = "module"
+vertexToType Variable{..} = "variable"
+
 -- | A vertex of some specific type.
 data Vertex
   = Package  { vertexName :: ByteString }
@@ -33,6 +55,9 @@ data Vertex
   | Variable { vertexName :: ByteString }
   deriving (Eq, Ord, Show)
 
+instance ToJSON Vertex where
+  toJSON v = object [ "name" .= vertexToText v, "type" .= vertexToType v ]
+
 -- | Render a 'ImportGraph' to a 'ByteString' in DOT notation.
 renderImportGraph :: ImportGraph -> ByteString
 renderImportGraph = export style . unImportGraph

src/Rendering/Renderer.hs

@@ -2,6 +2,7 @@
 module Rendering.Renderer
 ( DiffRenderer(..)
 , TermRenderer(..)
+, GraphRenderer(..)
 , SomeRenderer(..)
 , renderSExpressionDiff
 , renderSExpressionTerm
@@ -66,6 +67,13 @@ deriving instance Eq (TermRenderer output)
 deriving instance Show (TermRenderer output)
 
 
+data GraphRenderer output where
+  JSONGraphRenderer :: GraphRenderer ByteString
+  DOTGraphRenderer :: GraphRenderer ByteString
+
+deriving instance Eq (GraphRenderer output)
+deriving instance Show (GraphRenderer output)
+
 -- | Abstraction of some renderer to some 'Monoid'al output which can be serialized to a 'ByteString'.
 --
 --   This type abstracts the type indices of 'DiffRenderer' and 'TermRenderer' s.t. multiple renderers can be present in a single list, alternation, etc., while retaining the ability to render and serialize. (Without 'SomeRenderer', the different output types of individual term/diff renderers prevent them from being used in a homogeneously typed setting.)

src/Semantic/CLI.hs

@@ -18,7 +18,8 @@ import qualified Paths_semantic as Library (version)
 import Semantic.IO (languageForFilePath)
 import qualified Semantic.Diff as Semantic (diffBlobPairs)
 import qualified Semantic.Log as Log
-import qualified Semantic.Parse as Semantic (parseBlobs, graph)
+import qualified Semantic.Parse as Semantic (parseBlobs)
+import qualified Semantic.Graph as Semantic (graph)
 import qualified Semantic.Task as Task
 import System.IO (Handle, stdin, stdout)
 import Text.Read
@@ -33,7 +34,7 @@ runDiff (SomeRenderer diffRenderer) = Semantic.diffBlobPairs diffRenderer <=< Ta
 runParse :: SomeRenderer TermRenderer -> Either Handle [(FilePath, Maybe Language)] -> Task.TaskEff ByteString
 runParse (SomeRenderer parseTreeRenderer) = Semantic.parseBlobs parseTreeRenderer <=< Task.readBlobs
 
-runGraph :: SomeRenderer TermRenderer -> (FilePath, Maybe Language) -> Task.TaskEff ByteString
+runGraph :: SomeRenderer GraphRenderer -> (FilePath, Maybe Language) -> Task.TaskEff ByteString
 runGraph (SomeRenderer r) = Semantic.graph r <=< Task.readBlob
 
 -- | A parser for the application's command-line arguments.
@@ -89,7 +90,9 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar
 
     graphCommand = command "graph" (info graphArgumentsParser (progDesc "Compute import/call graph for an entry point"))
     graphArgumentsParser = runGraph
-      <$> flag (SomeRenderer DOTTermRenderer) (SomeRenderer DOTTermRenderer) (long "dot" <> help "Output in DOT graph format (default)")
+      <$> (   flag (SomeRenderer DOTGraphRenderer) (SomeRenderer DOTGraphRenderer) (long "dot" <> help "Output in DOT graph format (default)")
+          <|> flag'                                (SomeRenderer JSONGraphRenderer) (long "json" <> help "Output JSON graph")
+          )
       <*> argument filePathReader (metavar "ENTRY_FILE")
 
     filePathReader = eitherReader parseFilePath

src/Semantic/Task.hs

@@ -65,7 +65,6 @@ import           Data.Abstract.Module
 import           Data.Abstract.Package as Package
 import           Data.Abstract.Value (Value)
 import           Data.Blob
-import qualified Data.ByteString as B
 import           Data.Diff
 import qualified Data.Error as Error
 import           Data.Record
@@ -133,7 +132,7 @@ render :: Member Task effs => Renderer input output -> input -> Eff effs output
 render renderer = send . Render renderer
 
 
--- | Render and serialize the import graph for a given 'Package'.
+-- | Render the import graph for a given 'Package'.
 graphImports :: (
                   Show ann
                 , Ord ann
@@ -147,15 +146,14 @@ graphImports :: (
                 , Members '[Exc SomeException, Task] effs
                 , term ~ Term (Union syntax) ann
                 )
-             => Package term -> Eff effs B.ByteString
-graphImports package = analyze (Analysis.SomeAnalysis (Analysis.evaluatePackage package `asAnalysisForTypeOfPackage` package)) >>= renderGraph
+             => Package term -> Eff effs Abstract.ImportGraph
+graphImports package = analyze (Analysis.SomeAnalysis (Analysis.evaluatePackage package `asAnalysisForTypeOfPackage` package)) >>= extractGraph
   where asAnalysisForTypeOfPackage :: Abstract.ImportGraphing (Evaluating (Located Precise term) term (Value (Located Precise term))) effects value -> Package term -> Abstract.ImportGraphing (Evaluating (Located Precise term) term (Value (Located Precise term))) effects value
         asAnalysisForTypeOfPackage = const
 
-        renderGraph result = case result of
-          (Right (Right (Right (Right (Right (Right (_, graph)))))), _) -> pure $! Abstract.renderImportGraph graph
-          _ -> throwError (toException (Exc.ErrorCall "graphImports: import graph rendering failed"))
-
+        extractGraph result = case result of
+          (Right (Right (Right (Right (Right (Right (_, graph)))))), _) -> pure $! graph
+          _ -> throwError (toException (Exc.ErrorCall ("graphImports: import graph rendering failed " <> show result)))
 
 -- | Execute a 'Task' with the 'defaultOptions', yielding its result value in 'IO'.
 --