{-| FGL To Dot is an automatic translation and labeling
    of FGL graphs (see the 'Graph' class) to graphviz
    Dot format that can be written out to a file and
    displayed.

@
    let dot = showDot (fglToDot graph)
    writeFile \"file.dot\" dot
    system(\"dot -Tpng -ofile.png file.dot\")
@
-}

module Data.Graph.Inductive.Dot
  ( fglToDot, fglToDotString, fglToDotUnlabeled, fglToDotGeneric
  , showDot
  ) where

import Control.Monad
import Data.Graph.Inductive
import Text.Dot

-- |Generate a Dot graph using the show instances of the node and edge labels as displayed graph labels
fglToDot :: (Show a, Show b, Graph gr) => gr a b -> Dot ()
fglToDot :: forall a b (gr :: * -> * -> *).
(Show a, Show b, Graph gr) =>
gr a b -> Dot ()
fglToDot gr a b
gr = gr a b
-> (a -> String)
-> (b -> String)
-> ([(String, String)] -> [(String, String)])
-> Dot ()
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b
-> (a -> String)
-> (b -> String)
-> ([(String, String)] -> [(String, String)])
-> Dot ()
fglToDotGeneric gr a b
gr a -> String
forall a. Show a => a -> String
show b -> String
forall a. Show a => a -> String
show [(String, String)] -> [(String, String)]
forall a. a -> a
id

-- |Generate a Dot graph using the Node and Edge strings as labels
fglToDotString :: Graph gr => gr String String -> Dot ()
fglToDotString :: forall (gr :: * -> * -> *). Graph gr => gr String String -> Dot ()
fglToDotString gr String String
gr = gr String String
-> (String -> String)
-> (String -> String)
-> ([(String, String)] -> [(String, String)])
-> Dot ()
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b
-> (a -> String)
-> (b -> String)
-> ([(String, String)] -> [(String, String)])
-> Dot ()
fglToDotGeneric gr String String
gr String -> String
forall a. a -> a
id String -> String
forall a. a -> a
id [(String, String)] -> [(String, String)]
forall a. a -> a
id

-- |Generate a Dot graph without any edge or node labels
fglToDotUnlabeled :: Graph gr => gr a b -> Dot ()
fglToDotUnlabeled :: forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Dot ()
fglToDotUnlabeled gr a b
gr = gr a b
-> (a -> String)
-> (b -> String)
-> ([(String, String)] -> [(String, String)])
-> Dot ()
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b
-> (a -> String)
-> (b -> String)
-> ([(String, String)] -> [(String, String)])
-> Dot ()
fglToDotGeneric gr a b
gr a -> String
forall a. HasCallStack => a
undefined b -> String
forall a. HasCallStack => a
undefined ([(String, String)] -> [(String, String)] -> [(String, String)]
forall a b. a -> b -> a
const [])

-- |Generate a Dot graph using the provided functions to mutate the node labels, edge labels and list of attributes.
fglToDotGeneric :: Graph gr => gr a b -> (a -> String) -> (b -> String) -> ([(String,String)] -> [(String,String)]) -> Dot ()
fglToDotGeneric :: forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b
-> (a -> String)
-> (b -> String)
-> ([(String, String)] -> [(String, String)])
-> Dot ()
fglToDotGeneric gr a b
gr a -> String
nodeConv b -> String
edgeConv [(String, String)] -> [(String, String)]
attrConv = do
  let es :: [LEdge b]
es = gr a b -> [LEdge b]
forall a b. gr a b -> [LEdge b]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
labEdges gr a b
gr -- :: [(Int, Int, b)]
      ns :: [LNode a]
ns = gr a b -> [LNode a]
forall a b. gr a b -> [LNode a]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes gr a b
gr -- :: [(Int, a)]
  (LNode a -> Dot ()) -> [LNode a] -> Dot ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
n,a
p) -> NodeId -> [(String, String)] -> Dot ()
userNode (Int -> NodeId
userNodeId Int
n) ([(String, String)] -> [(String, String)]
attrConv [(String
"label", a -> String
nodeConv a
p)])) [LNode a]
ns
  (LEdge b -> Dot ()) -> [LEdge b] -> Dot ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
a,Int
b,b
p) -> NodeId -> NodeId -> [(String, String)] -> Dot ()
edge (Int -> NodeId
userNodeId Int
a) (Int -> NodeId
userNodeId Int
b) ([(String, String)] -> [(String, String)]
attrConv [(String
"label", b -> String
edgeConv b
p)])) [LEdge b]
es