module FFICXX.Generate.Util.DepGraph
  ( drawDepGraph,
  )
where

import Data.Foldable (for_)
import FFICXX.Generate.Dependency.Graph
  ( constructDepGraph,
  )
import FFICXX.Generate.Type.Class (TopLevel (..))
import FFICXX.Generate.Type.Module (UClass)
import Text.Dot (Dot, NodeId, attribute, node, showDot, (.->.))

src, box, diamond :: String -> Dot NodeId
src :: String -> Dot NodeId
src String
label = [(String, String)] -> Dot NodeId
node forall a b. (a -> b) -> a -> b
$ [(String
"shape", String
"none"), (String
"label", String
label)]
box :: String -> Dot NodeId
box String
label = [(String, String)] -> Dot NodeId
node forall a b. (a -> b) -> a -> b
$ [(String
"shape", String
"box"), (String
"style", String
"rounded"), (String
"label", String
label)]
diamond :: String -> Dot NodeId
diamond String
label = [(String, String)] -> Dot NodeId
node forall a b. (a -> b) -> a -> b
$ [(String
"shape", String
"diamond"), (String
"label", String
label), (String
"fontsize", String
"10")]

-- | Draw dependency graph of modules in graphviz dot format.
drawDepGraph ::
  -- | list of all classes, either template class or ordinary class.
  [UClass] ->
  -- | list of all top-level functions.
  [TopLevel] ->
  -- | dot string
  String
drawDepGraph :: [UClass] -> [TopLevel] -> String
drawDepGraph [UClass]
allclasses [TopLevel]
allTopLevels =
  forall a. Dot a -> String
showDot forall a b. (a -> b) -> a -> b
$ do
    (String, String) -> Dot ()
attribute (String
"size", String
"40,15")
    (String, String) -> Dot ()
attribute (String
"rankdir", String
"LR")
    [NodeId]
cs <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> Dot NodeId
box [String]
allSyms
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(Int, [Int])]
depmap' forall a b. (a -> b) -> a -> b
$ \(Int
i, [Int]
js) ->
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int]
js forall a b. (a -> b) -> a -> b
$ \Int
j ->
        ([NodeId]
cs forall a. [a] -> Int -> a
!! Int
i) NodeId -> NodeId -> Dot ()
.->. ([NodeId]
cs forall a. [a] -> Int -> a
!! Int
j)
  where
    ([String]
allSyms, [(Int, [Int])]
depmap') = [UClass] -> [TopLevel] -> ([String], [(Int, [Int])])
constructDepGraph [UClass]
allclasses [TopLevel]
allTopLevels