github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 22:31:36 +03:00
Code Issues Projects Releases Wiki Activity

Pick IDs for nodes.

Browse Source
This commit is contained in:
Rob Rix 2017-12-06 09:47:40 -07:00
parent dde473abd1
commit 673dd28537
1 changed files with 6 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/Rendering/DOT.hs
View File

@ -18,16 +18,15 @@ renderDOTDiff :: Both Blob -> Diff syntax ann1 ann2 -> B.ByteString
renderDOTDiff _ _ = ""
renderDOTTerm :: (ConstructorName syntax, Foldable syntax, Functor syntax) => Blob -> Term syntax ann -> B.ByteString
renderDOTTerm Blob{..} term = renderGraph (snd (cata graphAlgebra term)) { graphName = Just (B.pack blobPath) }
renderDOTTerm Blob{..} term = renderGraph (snd (cata graphAlgebra term 0)) { graphName = Just (B.pack blobPath) }
graphAlgebra :: (ConstructorName syntax, Foldable syntax) => TermF syntax ann (Int, Graph) -> (Int, Graph)
graphAlgebra t = (i, Graph
graphAlgebra :: (ConstructorName syntax, Foldable syntax) => TermF syntax ann (Int -> (Int, Graph)) -> Int -> (Int, Graph)
graphAlgebra t i = (succ i, Graph
Nothing
(Node i (unConstructorLabel (constructorLabel t)) : (g >>= graphNodes . snd))
(map (Edge i . fst) g <> (g >>= graphEdges . snd)))
where g = toList t
i = 0
(Node (succ i) (unConstructorLabel (constructorLabel t)) : (g >>= graphNodes . snd))
(map (Edge (succ i) . fst) g <> (g >>= graphEdges . snd)))
where g = map ($ succ i) (toList t)
renderGraph :: Graph -> B.ByteString