{-# LANGUAGE MultiParamTypeClasses, OverloadedStrings #-}
module Data.GraphViz.Commands
(
GraphvizCommand(..)
, dirCommand
, undirCommand
, commandFor
, GraphvizOutput(..)
, GraphvizCanvas(..)
, runGraphviz
, runGraphvizCommand
, addExtension
, runGraphvizCanvas
, runGraphvizCanvas'
, graphvizWithHandle
, isGraphvizInstalled
, quitWithoutGraphviz
) where
import Data.GraphViz.Types
import Data.GraphViz.Commands.Available
import Data.GraphViz.Commands.IO (runCommand)
import Data.GraphViz.Exception
import Control.Monad (liftM, unless)
import qualified Data.ByteString as SB
import Data.Maybe (isJust)
import Data.Version (Version (..), showVersion)
import System.Directory (findExecutable)
import System.Exit (ExitCode (..), exitWith)
import System.FilePath ((<.>))
import System.IO (Handle, hPutStrLn, hSetBinaryMode, stderr)
showCmd :: GraphvizCommand -> String
showCmd :: GraphvizCommand -> String
showCmd GraphvizCommand
Dot = String
"dot"
showCmd GraphvizCommand
Neato = String
"neato"
showCmd GraphvizCommand
TwoPi = String
"twopi"
showCmd GraphvizCommand
Circo = String
"circo"
showCmd GraphvizCommand
Fdp = String
"fdp"
showCmd GraphvizCommand
Sfdp = String
"sfdp"
showCmd GraphvizCommand
Osage = String
"osage"
showCmd GraphvizCommand
Patchwork = String
"patchwork"
dirCommand :: GraphvizCommand
dirCommand :: GraphvizCommand
dirCommand = GraphvizCommand
Dot
undirCommand :: GraphvizCommand
undirCommand :: GraphvizCommand
undirCommand = GraphvizCommand
Neato
commandFor :: (DotRepr dg n) => dg n -> GraphvizCommand
commandFor :: forall (dg :: * -> *) n. DotRepr dg n => dg n -> GraphvizCommand
commandFor dg n
dg = if forall (dg :: * -> *) n. DotRepr dg n => dg n -> Bool
graphIsDirected dg n
dg
then GraphvizCommand
dirCommand
else GraphvizCommand
undirCommand
class GraphvizResult o where
outputCall :: o -> String
data GraphvizOutput = Bmp
| Canon
| DotOutput
| XDot (Maybe Version)
| Eps
| Fig
| Gd
| Gd2
| Gif
| Ico
| Imap
| Cmapx
| ImapNP
| CmapxNP
| Jpeg
| Pdf
| Plain
| PlainExt
| Png
| Ps
| Ps2
| Svg
| SvgZ
| Tiff
| Vml
| VmlZ
| Vrml
| WBmp
| WebP
deriving (GraphvizOutput -> GraphvizOutput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GraphvizOutput -> GraphvizOutput -> Bool
$c/= :: GraphvizOutput -> GraphvizOutput -> Bool
== :: GraphvizOutput -> GraphvizOutput -> Bool
$c== :: GraphvizOutput -> GraphvizOutput -> Bool
Eq, Eq GraphvizOutput
GraphvizOutput -> GraphvizOutput -> Bool
GraphvizOutput -> GraphvizOutput -> Ordering
GraphvizOutput -> GraphvizOutput -> GraphvizOutput
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GraphvizOutput -> GraphvizOutput -> GraphvizOutput
$cmin :: GraphvizOutput -> GraphvizOutput -> GraphvizOutput
max :: GraphvizOutput -> GraphvizOutput -> GraphvizOutput
$cmax :: GraphvizOutput -> GraphvizOutput -> GraphvizOutput
>= :: GraphvizOutput -> GraphvizOutput -> Bool
$c>= :: GraphvizOutput -> GraphvizOutput -> Bool
> :: GraphvizOutput -> GraphvizOutput -> Bool
$c> :: GraphvizOutput -> GraphvizOutput -> Bool
<= :: GraphvizOutput -> GraphvizOutput -> Bool
$c<= :: GraphvizOutput -> GraphvizOutput -> Bool
< :: GraphvizOutput -> GraphvizOutput -> Bool
$c< :: GraphvizOutput -> GraphvizOutput -> Bool
compare :: GraphvizOutput -> GraphvizOutput -> Ordering
$ccompare :: GraphvizOutput -> GraphvizOutput -> Ordering
Ord, Int -> GraphvizOutput -> ShowS
[GraphvizOutput] -> ShowS
GraphvizOutput -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GraphvizOutput] -> ShowS
$cshowList :: [GraphvizOutput] -> ShowS
show :: GraphvizOutput -> String
$cshow :: GraphvizOutput -> String
showsPrec :: Int -> GraphvizOutput -> ShowS
$cshowsPrec :: Int -> GraphvizOutput -> ShowS
Show, ReadPrec [GraphvizOutput]
ReadPrec GraphvizOutput
Int -> ReadS GraphvizOutput
ReadS [GraphvizOutput]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GraphvizOutput]
$creadListPrec :: ReadPrec [GraphvizOutput]
readPrec :: ReadPrec GraphvizOutput
$creadPrec :: ReadPrec GraphvizOutput
readList :: ReadS [GraphvizOutput]
$creadList :: ReadS [GraphvizOutput]
readsPrec :: Int -> ReadS GraphvizOutput
$creadsPrec :: Int -> ReadS GraphvizOutput
Read)
instance GraphvizResult GraphvizOutput where
outputCall :: GraphvizOutput -> String
outputCall GraphvizOutput
Bmp = String
"bmp"
outputCall GraphvizOutput
Canon = String
"canon"
outputCall GraphvizOutput
DotOutput = String
"dot"
outputCall (XDot Maybe Version
mv) = String
"xdot" forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" Version -> String
showVersion Maybe Version
mv
outputCall GraphvizOutput
Eps = String
"eps"
outputCall GraphvizOutput
Fig = String
"fig"
outputCall GraphvizOutput
Gd = String
"gd"
outputCall GraphvizOutput
Gd2 = String
"gd2"
outputCall GraphvizOutput
Gif = String
"gif"
outputCall GraphvizOutput
Ico = String
"ico"
outputCall GraphvizOutput
Imap = String
"imap"
outputCall GraphvizOutput
Cmapx = String
"cmapx"
outputCall GraphvizOutput
ImapNP = String
"imap_np"
outputCall GraphvizOutput
CmapxNP = String
"cmapx_np"
outputCall GraphvizOutput
Jpeg = String
"jpeg"
outputCall GraphvizOutput
Pdf = String
"pdf"
outputCall GraphvizOutput
Plain = String
"plain"
outputCall GraphvizOutput
PlainExt = String
"plain-ext"
outputCall GraphvizOutput
Png = String
"png"
outputCall GraphvizOutput
Ps = String
"ps"
outputCall GraphvizOutput
Ps2 = String
"ps2"
outputCall GraphvizOutput
Svg = String
"svg"
outputCall GraphvizOutput
SvgZ = String
"svgz"
outputCall GraphvizOutput
Tiff = String
"tiff"
outputCall GraphvizOutput
Vml = String
"vml"
outputCall GraphvizOutput
VmlZ = String
"vmlz"
outputCall GraphvizOutput
Vrml = String
"vrml"
outputCall GraphvizOutput
WBmp = String
"wbmp"
outputCall GraphvizOutput
WebP = String
"webp"
defaultExtension :: GraphvizOutput -> String
defaultExtension :: GraphvizOutput -> String
defaultExtension GraphvizOutput
Bmp = String
"bmp"
defaultExtension GraphvizOutput
Canon = String
"gv"
defaultExtension GraphvizOutput
DotOutput = String
"gv"
defaultExtension XDot{} = String
"gv"
defaultExtension GraphvizOutput
Eps = String
"eps"
defaultExtension GraphvizOutput
Fig = String
"fig"
defaultExtension GraphvizOutput
Gd = String
"gd"
defaultExtension GraphvizOutput
Gd2 = String
"gd2"
defaultExtension GraphvizOutput
Gif = String
"gif"
defaultExtension GraphvizOutput
Ico = String
"ico"
defaultExtension GraphvizOutput
Imap = String
"map"
defaultExtension GraphvizOutput
Cmapx = String
"map"
defaultExtension GraphvizOutput
ImapNP = String
"map"
defaultExtension GraphvizOutput
CmapxNP = String
"map"
defaultExtension GraphvizOutput
Jpeg = String
"jpg"
defaultExtension GraphvizOutput
Pdf = String
"pdf"
defaultExtension GraphvizOutput
Plain = String
"txt"
defaultExtension GraphvizOutput
PlainExt = String
"txt"
defaultExtension GraphvizOutput
Png = String
"png"
defaultExtension GraphvizOutput
Ps = String
"ps"
defaultExtension GraphvizOutput
Ps2 = String
"ps"
defaultExtension GraphvizOutput
Svg = String
"svg"
defaultExtension GraphvizOutput
SvgZ = String
"svgz"
defaultExtension GraphvizOutput
Tiff = String
"tif"
defaultExtension GraphvizOutput
Vml = String
"vml"
defaultExtension GraphvizOutput
VmlZ = String
"vmlz"
defaultExtension GraphvizOutput
Vrml = String
"vrml"
defaultExtension GraphvizOutput
WBmp = String
"wbmp"
defaultExtension GraphvizOutput
WebP = String
"webp"
data GraphvizCanvas = Gtk | Xlib
deriving (GraphvizCanvas -> GraphvizCanvas -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GraphvizCanvas -> GraphvizCanvas -> Bool
$c/= :: GraphvizCanvas -> GraphvizCanvas -> Bool
== :: GraphvizCanvas -> GraphvizCanvas -> Bool
$c== :: GraphvizCanvas -> GraphvizCanvas -> Bool
Eq, Eq GraphvizCanvas
GraphvizCanvas -> GraphvizCanvas -> Bool
GraphvizCanvas -> GraphvizCanvas -> Ordering
GraphvizCanvas -> GraphvizCanvas -> GraphvizCanvas
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GraphvizCanvas -> GraphvizCanvas -> GraphvizCanvas
$cmin :: GraphvizCanvas -> GraphvizCanvas -> GraphvizCanvas
max :: GraphvizCanvas -> GraphvizCanvas -> GraphvizCanvas
$cmax :: GraphvizCanvas -> GraphvizCanvas -> GraphvizCanvas
>= :: GraphvizCanvas -> GraphvizCanvas -> Bool
$c>= :: GraphvizCanvas -> GraphvizCanvas -> Bool
> :: GraphvizCanvas -> GraphvizCanvas -> Bool
$c> :: GraphvizCanvas -> GraphvizCanvas -> Bool
<= :: GraphvizCanvas -> GraphvizCanvas -> Bool
$c<= :: GraphvizCanvas -> GraphvizCanvas -> Bool
< :: GraphvizCanvas -> GraphvizCanvas -> Bool
$c< :: GraphvizCanvas -> GraphvizCanvas -> Bool
compare :: GraphvizCanvas -> GraphvizCanvas -> Ordering
$ccompare :: GraphvizCanvas -> GraphvizCanvas -> Ordering
Ord, GraphvizCanvas
forall a. a -> a -> Bounded a
maxBound :: GraphvizCanvas
$cmaxBound :: GraphvizCanvas
minBound :: GraphvizCanvas
$cminBound :: GraphvizCanvas
Bounded, Int -> GraphvizCanvas
GraphvizCanvas -> Int
GraphvizCanvas -> [GraphvizCanvas]
GraphvizCanvas -> GraphvizCanvas
GraphvizCanvas -> GraphvizCanvas -> [GraphvizCanvas]
GraphvizCanvas
-> GraphvizCanvas -> GraphvizCanvas -> [GraphvizCanvas]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GraphvizCanvas
-> GraphvizCanvas -> GraphvizCanvas -> [GraphvizCanvas]
$cenumFromThenTo :: GraphvizCanvas
-> GraphvizCanvas -> GraphvizCanvas -> [GraphvizCanvas]
enumFromTo :: GraphvizCanvas -> GraphvizCanvas -> [GraphvizCanvas]
$cenumFromTo :: GraphvizCanvas -> GraphvizCanvas -> [GraphvizCanvas]
enumFromThen :: GraphvizCanvas -> GraphvizCanvas -> [GraphvizCanvas]
$cenumFromThen :: GraphvizCanvas -> GraphvizCanvas -> [GraphvizCanvas]
enumFrom :: GraphvizCanvas -> [GraphvizCanvas]
$cenumFrom :: GraphvizCanvas -> [GraphvizCanvas]
fromEnum :: GraphvizCanvas -> Int
$cfromEnum :: GraphvizCanvas -> Int
toEnum :: Int -> GraphvizCanvas
$ctoEnum :: Int -> GraphvizCanvas
pred :: GraphvizCanvas -> GraphvizCanvas
$cpred :: GraphvizCanvas -> GraphvizCanvas
succ :: GraphvizCanvas -> GraphvizCanvas
$csucc :: GraphvizCanvas -> GraphvizCanvas
Enum, ReadPrec [GraphvizCanvas]
ReadPrec GraphvizCanvas
Int -> ReadS GraphvizCanvas
ReadS [GraphvizCanvas]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GraphvizCanvas]
$creadListPrec :: ReadPrec [GraphvizCanvas]
readPrec :: ReadPrec GraphvizCanvas
$creadPrec :: ReadPrec GraphvizCanvas
readList :: ReadS [GraphvizCanvas]
$creadList :: ReadS [GraphvizCanvas]
readsPrec :: Int -> ReadS GraphvizCanvas
$creadsPrec :: Int -> ReadS GraphvizCanvas
Read, Int -> GraphvizCanvas -> ShowS
[GraphvizCanvas] -> ShowS
GraphvizCanvas -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GraphvizCanvas] -> ShowS
$cshowList :: [GraphvizCanvas] -> ShowS
show :: GraphvizCanvas -> String
$cshow :: GraphvizCanvas -> String
showsPrec :: Int -> GraphvizCanvas -> ShowS
$cshowsPrec :: Int -> GraphvizCanvas -> ShowS
Show)
instance GraphvizResult GraphvizCanvas where
outputCall :: GraphvizCanvas -> String
outputCall GraphvizCanvas
Gtk = String
"gtk"
outputCall GraphvizCanvas
Xlib = String
"xlib"
runGraphviz :: (PrintDotRepr dg n) => dg n -> GraphvizOutput -> FilePath
-> IO FilePath
runGraphviz :: forall (dg :: * -> *) n.
PrintDotRepr dg n =>
dg n -> GraphvizOutput -> String -> IO String
runGraphviz dg n
gr = forall (dg :: * -> *) n.
PrintDotRepr dg n =>
GraphvizCommand -> dg n -> GraphvizOutput -> String -> IO String
runGraphvizCommand (forall (dg :: * -> *) n. DotRepr dg n => dg n -> GraphvizCommand
commandFor dg n
gr) dg n
gr
runGraphvizCommand :: (PrintDotRepr dg n) => GraphvizCommand -> dg n
-> GraphvizOutput -> FilePath
-> IO FilePath
runGraphvizCommand :: forall (dg :: * -> *) n.
PrintDotRepr dg n =>
GraphvizCommand -> dg n -> GraphvizOutput -> String -> IO String
runGraphvizCommand GraphvizCommand
cmd dg n
gr GraphvizOutput
t String
fp
= forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphvizException -> GraphvizException
addExc) forall a b. (a -> b) -> a -> b
$ forall (dg :: * -> *) n a.
PrintDotRepr dg n =>
GraphvizCommand
-> dg n -> GraphvizOutput -> (Handle -> IO a) -> IO a
graphvizWithHandle GraphvizCommand
cmd dg n
gr GraphvizOutput
t Handle -> IO String
toFile
where
addFl :: ShowS
addFl = forall a. [a] -> [a] -> [a]
(++) (String
"Unable to create " forall a. [a] -> [a] -> [a]
++ String
fp forall a. [a] -> [a] -> [a]
++ String
"\n")
toFile :: Handle -> IO String
toFile Handle
h = Handle -> IO ByteString
SB.hGetContents Handle
h forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ByteString -> IO ()
SB.writeFile String
fp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return String
fp
addExc :: GraphvizException -> GraphvizException
addExc (GVProgramExc String
e) = String -> GraphvizException
GVProgramExc forall a b. (a -> b) -> a -> b
$ ShowS
addFl String
e
addExc GraphvizException
e = GraphvizException
e
addExtension :: (GraphvizOutput -> FilePath -> a)
-> GraphvizOutput -> FilePath -> a
addExtension :: forall a.
(GraphvizOutput -> String -> a) -> GraphvizOutput -> String -> a
addExtension GraphvizOutput -> String -> a
cmd GraphvizOutput
t String
fp = GraphvizOutput -> String -> a
cmd GraphvizOutput
t String
fp'
where
fp' :: String
fp' = String
fp String -> ShowS
<.> GraphvizOutput -> String
defaultExtension GraphvizOutput
t
graphvizWithHandle :: (PrintDotRepr dg n)
=> GraphvizCommand
-> dg n
-> GraphvizOutput
-> (Handle -> IO a)
-> IO a
graphvizWithHandle :: forall (dg :: * -> *) n a.
PrintDotRepr dg n =>
GraphvizCommand
-> dg n -> GraphvizOutput -> (Handle -> IO a) -> IO a
graphvizWithHandle = forall (dg :: * -> *) n o a.
(PrintDotRepr dg n, GraphvizResult o) =>
GraphvizCommand -> dg n -> o -> (Handle -> IO a) -> IO a
graphvizWithHandle'
graphvizWithHandle' :: (PrintDotRepr dg n, GraphvizResult o)
=> GraphvizCommand -> dg n -> o
-> (Handle -> IO a) -> IO a
graphvizWithHandle' :: forall (dg :: * -> *) n o a.
(PrintDotRepr dg n, GraphvizResult o) =>
GraphvizCommand -> dg n -> o -> (Handle -> IO a) -> IO a
graphvizWithHandle' GraphvizCommand
cmd dg n
dg o
t Handle -> IO a
f = forall (dg :: * -> *) n a.
PrintDotRepr dg n =>
String -> [String] -> (Handle -> IO a) -> dg n -> IO a
runCommand (GraphvizCommand -> String
showCmd GraphvizCommand
cmd)
[String
"-T" forall a. [a] -> [a] -> [a]
++ forall o. GraphvizResult o => o -> String
outputCall o
t]
Handle -> IO a
f'
dg n
dg
where
f' :: Handle -> IO a
f' Handle
h = Handle -> Bool -> IO ()
hSetBinaryMode Handle
h Bool
True forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO a
f Handle
h
runGraphvizCanvas :: (PrintDotRepr dg n) => GraphvizCommand -> dg n
-> GraphvizCanvas -> IO ()
runGraphvizCanvas :: forall (dg :: * -> *) n.
PrintDotRepr dg n =>
GraphvizCommand -> dg n -> GraphvizCanvas -> IO ()
runGraphvizCanvas GraphvizCommand
cmd dg n
gr GraphvizCanvas
c = forall (dg :: * -> *) n o a.
(PrintDotRepr dg n, GraphvizResult o) =>
GraphvizCommand -> dg n -> o -> (Handle -> IO a) -> IO a
graphvizWithHandle' GraphvizCommand
cmd dg n
gr GraphvizCanvas
c Handle -> IO ()
nullHandle
where
nullHandle :: Handle -> IO ()
nullHandle :: Handle -> IO ()
nullHandle = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a b. a -> b -> a
const ()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ByteString
SB.hGetContents
runGraphvizCanvas' :: (PrintDotRepr dg n) => dg n -> GraphvizCanvas -> IO ()
runGraphvizCanvas' :: forall (dg :: * -> *) n.
PrintDotRepr dg n =>
dg n -> GraphvizCanvas -> IO ()
runGraphvizCanvas' dg n
d = forall (dg :: * -> *) n.
PrintDotRepr dg n =>
GraphvizCommand -> dg n -> GraphvizCanvas -> IO ()
runGraphvizCanvas (forall (dg :: * -> *) n. DotRepr dg n => dg n -> GraphvizCommand
commandFor dg n
d) dg n
d
isGraphvizInstalled :: IO Bool
isGraphvizInstalled :: IO Bool
isGraphvizInstalled = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe String)
findExecutable forall a b. (a -> b) -> a -> b
$ GraphvizCommand -> String
showCmd GraphvizCommand
Dot
quitWithoutGraphviz :: String -> IO ()
quitWithoutGraphviz :: String -> IO ()
quitWithoutGraphviz String
err = do Bool
hasGraphviz <- IO Bool
isGraphvizInstalled
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasGraphviz
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr String
err forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)