Output dot graph
This commit is contained in:
parent
e573e7cf14
commit
238765e28b
14
src/Data/Graphviz.hs
Normal file
14
src/Data/Graphviz.hs
Normal 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))
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue