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 ([(String, String)] -> Dot NodeId)
-> [(String, String)] -> Dot NodeId
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 ([(String, String)] -> Dot NodeId)
-> [(String, String)] -> Dot NodeId
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 ([(String, String)] -> Dot NodeId)
-> [(String, String)] -> Dot NodeId
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 =
  Dot () -> String
forall a. Dot a -> String
showDot (Dot () -> String) -> Dot () -> String
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 <- (String -> Dot NodeId) -> [String] -> Dot [NodeId]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse String -> Dot NodeId
box [String]
allSyms
    [(Int, [Int])] -> ((Int, [Int]) -> Dot ()) -> Dot ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(Int, [Int])]
depmap' (((Int, [Int]) -> Dot ()) -> Dot ())
-> ((Int, [Int]) -> Dot ()) -> Dot ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, [Int]
js) ->
      [Int] -> (Int -> Dot ()) -> Dot ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int]
js ((Int -> Dot ()) -> Dot ()) -> (Int -> Dot ()) -> Dot ()
forall a b. (a -> b) -> a -> b
$ \Int
j ->
        ([NodeId]
cs [NodeId] -> Int -> NodeId
forall a. HasCallStack => [a] -> Int -> a
!! Int
i) NodeId -> NodeId -> Dot ()
.->. ([NodeId]
cs [NodeId] -> Int -> NodeId
forall a. HasCallStack => [a] -> Int -> a
!! Int
j)
  where
    ([String]
allSyms, [(Int, [Int])]
depmap') = [UClass] -> [TopLevel] -> ([String], [(Int, [Int])])
constructDepGraph [UClass]
allclasses [TopLevel]
allTopLevels