Graphviz.hs

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}

{-
 GenI surface realiser
 Copyright (C) 2005 Carlos Areces and Eric Kow

 This program is free software; you can redistribute it and/or
 modify it under the terms of the GNU General Public License
 as published by the Free Software Foundation; either version 2
 of the License, or (at your option) any later version.

 This program is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 GNU General Public License for more details.

 You should have received a copy of the GNU General Public License
 along with this program; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
-}

{- | Graphviz is an open source tool which converts an abstract
     representation of a graph (node foo is connected to node bar, etc.)
     into a nicely laid out graphic.  This module contains methods
     to invoke graphviz and to convert graphs and trees to its input format.

     You can download this (open source) tool at
     <http://www.research.att.com/sw/tools/graphviz>
-}

module NLP.GenI.Graphviz
where

import           Control.Arrow                     (second)
import           Data.Text.Lazy                    (Text)
import qualified Data.Text.Lazy                    as T
import qualified Data.Text.Lazy.IO                 as T
import           Data.Tree
import           Prelude                           hiding (writeFile)

import           Data.GraphViz
import           Data.GraphViz.Attributes.Complete
import           Data.GraphViz.Printing            (printIt)

{- |
     Data structures which can be visualised with GraphViz should
     implement this class.  Note the first argument to graphvizShowGraph is
     so that you can parameterise your show function (i.e. pass in
     flags to change the way you show particular object).  Note
     that by default, all graphs are treated as directed graphs.  You
     can hide this by turning off edge arrows.
-}
class GraphvizShow b where
    graphvizShowGraph       :: b -> DotGraph Text
    graphvizShowAsSubgraph  :: Text   -- ^ prefix
                            -> b      -- ^ item
                            -> [DotSubGraph Text] -- ^ gv output
    graphvizLabel           :: b      -- ^ item
                            -> Text   -- ^ gv output
    graphvizParams          :: b -> [GlobalAttributes]

    graphvizShowGraph b  =
        DotGraph False True Nothing $ DotStmts
           (addLabel (graphvizLabel b) $ graphvizParams b)
           (graphvizShowAsSubgraph "_" b)
           []
           []
      where
        addLabel :: Text -> [GlobalAttributes] -> [GlobalAttributes]
        addLabel "" = id
        addLabel l  = (GraphAttrs [Label (StrLabel l)] :)

    graphvizLabel _ = ""
    graphvizParams _ = []

class GraphvizShowNode b where
    graphvizShowNode :: Text   -- ^ prefix
                     -> b      -- ^ item
                     -> DotNode Text -- ^ gv output

-- | Things which are meant to be displayed within some other graph
--   as (part) of a node label
class GraphvizShowString b where
    graphvizShow :: b      -- ^ item
                 -> Text   -- ^ gv output

-- | Note: the 'dotFile' argument allows you to save the intermediary
-- dot output to a file.  You can pass in the empty string if you don't
toGraphviz :: GraphvizShow a
           => a
           -> String -- ^ the 'dotFile'
           -> String -> IO FilePath
toGraphviz x dotFile outputFile = do
    T.writeFile dotFile (printIt g)
    runGraphviz g Png outputFile
  where
    g = graphvizShowGraph x

-- ---------------------------------------------------------------------
-- useful utility functions
-- ---------------------------------------------------------------------

gvUnlines :: [Text] -> Text
gvUnlines = T.intercalate "\n"

-- ---------------------------------------------------------------------
-- some instances
-- ---------------------------------------------------------------------

instance GraphvizShow b => GraphvizShow (Maybe b) where
    graphvizShowAsSubgraph _ Nothing  = []
    graphvizShowAsSubgraph p (Just b) = graphvizShowAsSubgraph p b

    graphvizLabel Nothing  = ""
    graphvizLabel (Just b) = graphvizLabel b

    graphvizParams Nothing = []
    graphvizParams (Just b) = graphvizParams b

-- | Displays a tree in graphviz format.
{- Note that we could make this an
   instance of GraphvizShow, but I'm not too sure about the wisdom of
   such a move.

   Maybe if we had some really super-sophisticated types in Haskell, where
   we can define this as the default instance which could be overrided by
   something more specific, that would be cool.

   The prefix argument is interpreted as the name of the top node.  Node
   names below are basically Gorn addresses (e.g. n0x2x3 means 3rd child of
   the 2nd child of the root) to keep them distinct.  Note : We use the
   letter `x' as seperator because graphviz will choke on `.' or `-', even
   underscore. -}
gvShowTree :: GraphvizShowNode n
           => Text                   -- ^ node prefix
           -> Tree n                 -- ^ the tree
           -> DotSubGraph Text
gvShowTree prefix t =
    DotSG False Nothing $ DotStmts atts [] nodes edges
  where
    atts = [ EdgeAttrs [ ArrowHead noArrow ] ] -- should be none
    (nodes, edges) = second concat . unzip $ walk prefix t
    --
    walk pref (Node node xs) =
        (ns, es) : concat (zipWith walk ps xs)
      where
        mkPrefix i = T.concat [pref, "x", T.pack (show i)]
        ns = graphvizShowNode pref node
        ps = map mkPrefix [1::Int .. length xs]
        es = map (\n -> DotEdge pref n []) ps