Output dot graph

This commit is contained in:
Frederik Hanghøj Iversen 2019-10-16 21:51:47 +02:00
parent e573e7cf14
commit 238765e28b
2 changed files with 39 additions and 4 deletions

14
src/Data/Graphviz.hs Normal file
View file

@ -0,0 +1,14 @@
module Data.Graphviz (digraph) where
import Frelude
import qualified Data.Text as Text
digraph :: [NonEmpty Text] -> Text
digraph es = Text.unlines
[ "digraph _ {"
, edges es
, "}"
]
edges :: [NonEmpty Text] -> Text
edges = Text.unlines . fmap ((\(x :| xs) -> Text.unlines $ (\y -> x <> " -> " <> y <> ";") <$> xs))

View file

@ -4,12 +4,16 @@ module Rubyhs (main) where
import Data.Foldable (traverse_) import Data.Foldable (traverse_)
import Data.Language.Ruby (Block) import Data.Language.Ruby (Block)
import qualified Data.Language.Ruby as Ruby import Data.Map (Map)
import Data.Set (Set)
import Data.Tree (Tree(Node), Forest) import Data.Tree (Tree(Node), Forest)
import Frelude import Frelude
import Options.Applicative (Parser) import Options.Applicative (Parser)
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy.Char8 as ByteString import qualified Data.ByteString.Lazy.Char8 as ByteString
import qualified Data.Graphviz as Graphviz
import qualified Data.Language.Ruby as Ruby
import qualified Data.Text.IO as Text
import qualified Options.Applicative as Options import qualified Options.Applicative as Options
import qualified Rubyhs.References import qualified Rubyhs.References
@ -19,9 +23,26 @@ main = do
blocks <- parseInput @Block targets blocks <- parseInput @Block targets
if printAST if printAST
then traverse_ @[] putEncoded blocks then traverse_ @[] putEncoded blocks
else do else traverse_ act blocks
traverse_ (putEncoded . Rubyhs.References.references) blocks where
traverse_ (ByteString.putStrLn . Aeson.encode . toJSONForest . Rubyhs.References.graph) blocks act block = do
let res@(Rubyhs.References.Result x) = Rubyhs.References.references $ block
putEncoded res
ByteString.putStrLn . Aeson.encode . toJSONForest . Rubyhs.References.graph $ block
drawDot x
graphOut :: FilePath
graphOut = "out.dot"
drawDot :: Map Rubyhs.References.Node (Set Rubyhs.References.Node) -> IO ()
drawDot
= Text.writeFile graphOut
. Graphviz.digraph
. fmap (fmap (qoutes . Rubyhs.References.prettyContext) . \(x, xs) -> x :| toList xs)
. toList
qoutes :: Text -> Text
qoutes x = "\"" <> x <> "\""
toJSONForest :: Forest Rubyhs.References.Node -> Aeson.Value toJSONForest :: Forest Rubyhs.References.Node -> Aeson.Value
toJSONForest = Aeson.Object . fromList . fmap go toJSONForest = Aeson.Object . fromList . fmap go