module Data.GraphViz.Commands
( GraphvizCommand(..)
, dirCommand
, undirCommand
, commandFor
, GraphvizOutput(..)
, runGraphviz
, runGraphvizCommand
, graphvizWithHandle
)
where
import System.IO
import System.Exit
import System.Process
import Data.Array.IO
import Control.Concurrent
import Control.Exception.Extensible
import Data.GraphViz.Types
data GraphvizCommand = Dot | Neato | TwoPi | Circo | Fdp
instance Show GraphvizCommand where
show Dot = "dot"
show Neato = "neato"
show TwoPi = "twopi"
show Circo = "circo"
show Fdp = "fdp"
dirCommand :: GraphvizCommand
dirCommand = Dot
undirCommand :: GraphvizCommand
undirCommand = Neato
commandFor :: DotGraph -> GraphvizCommand
commandFor dg = if (directedGraph dg)
then dirCommand
else undirCommand
data GraphvizOutput = Canon
| Cmap
| Cmapx
| Cmapx_np
| Dia
| DotOutput
| Eps
| Fig
| Gd
| Gd2
| Gif
| Gtk
| Hpgl
| Imap
| Imap_np
| Ismap
| Jpe
| Jpeg
| Jpg
| Mif
| Mp
| Pcl
| Pdf
| Pic
| Plain
| PlainExt
| Png
| Ps
| Ps2
| Svg
| Svgz
| Tk
| Vml
| Vmlz
| Vrml
| Vtx
| Wbmp
| Xdot
| Xlib
instance Show GraphvizOutput where
show Canon = "canon"
show Cmap = "cmap"
show Cmapx = "cmapx"
show Cmapx_np = "cmapx_np"
show Dia = "dia"
show DotOutput = "dot"
show Eps = "eps"
show Fig = "fig"
show Gd = "gd"
show Gd2 = "gd2"
show Gif = "gif"
show Gtk = "gtk"
show Hpgl = "hpgl"
show Imap = "imap"
show Imap_np = "imap_np"
show Ismap = "ismap"
show Jpe = "jpe"
show Jpeg = "jpeg"
show Jpg = "jpg"
show Mif = "mif"
show Mp = "mp"
show Pcl = "pcl"
show Pdf = "pdf"
show Pic = "pic"
show Plain = "plain"
show PlainExt = "plain-ext"
show Png = "png"
show Ps = "ps"
show Ps2 = "ps2"
show Svg = "svg"
show Svgz = "svgz"
show Tk = "tk"
show Vml = "vml"
show Vmlz = "vmlz"
show Vrml = "vrml"
show Vtx = "vtx"
show Wbmp = "wbmp"
show Xdot = "xdot"
show Xlib = "xlib"
runGraphviz :: DotGraph -> GraphvizOutput -> FilePath -> IO Bool
runGraphviz gr t fp = runGraphvizCommand (commandFor gr) gr t fp
runGraphvizCommand :: GraphvizCommand -> DotGraph -> GraphvizOutput
-> FilePath -> IO Bool
runGraphvizCommand cmd gr t fp
= do pipe <- tryJust (\(SomeException _) -> return ())
$ openFile fp WriteMode
case pipe of
(Left _) -> return False
(Right f) -> do file <- graphvizWithHandle cmd gr t (flip squirt f)
hClose f
case file of
(Just _) -> return True
_ -> return False
graphvizWithHandle :: (Show a) => GraphvizCommand -> DotGraph -> GraphvizOutput
-> (Handle -> IO a) -> IO (Maybe a)
graphvizWithHandle cmd gr t f
= do (inp, outp, errp, prc) <- runInteractiveCommand command
forkIO $ hPrint inp gr >> hClose inp
forkIO $ (hGetContents errp >>= hPutStr stderr >> hClose errp)
a <- f outp
a `seq` hClose outp
exitCode <- waitForProcess prc
case exitCode of
ExitSuccess -> return (Just a)
_ -> return Nothing
where
command = (show cmd) ++ " -T" ++ (show t)
squirt :: Handle -> Handle -> IO ()
squirt rd wr = do
arr <- newArray_ (0, bufsize1)
let loop = do
r <- hGetArray rd arr bufsize
if (r == 0)
then return ()
else if (r < bufsize)
then hPutArray wr arr r
else hPutArray wr arr bufsize >> loop
loop
where
bufsize :: Int
bufsize = 4 * 1024