diff --git a/Data/Dot.hs b/Data/Dot.hs new file mode 100644 --- /dev/null +++ b/Data/Dot.hs @@ -0,0 +1,114 @@ +-- | +-- Module: Data.Dot +-- Copyright: Andy Gill +-- License: BSD3 +-- +-- Maintainer: Andy Gill +-- Stability: unstable +-- Portability: portable +-- +-- This module provides a simple interface for building .dot graph files, for input into the dot and graphviz tools. +-- It includes a monadic interface for building graphs. + +module Data.Dot + ( + -- * Dot + Dot -- abstract + -- * Nodes + , node + , NodeId -- abstract + -- * Edges + , edge + , (.->.) + -- * Showing a graph + , showDot + -- * Other combinators + , scope + , attribute + , share + , same + , cluster + ) where + +data DotGraph = DotGraph [GraphElement] + +newtype NodeId = NodeId String + +instance Show NodeId where + show (NodeId str) = str + +data GraphElement = GraphAttribute String String + | GraphNode NodeId [(String,String)] + | GraphEdge NodeId NodeId [(String,String)] + | Scope [GraphElement] + | SubGraph NodeId [GraphElement] + +data Dot a = Dot { unDot :: Int -> ([GraphElement],Int,a) } + +instance Monad Dot where + return a = Dot $ \ uq -> ([],uq,a) + m >>= k = Dot $ \ uq -> case unDot m uq of + (g1,uq',r) -> case unDot (k r) uq' of + (g2,uq2,r2) -> (g1 ++ g2,uq2,r2) + +-- | 'node' takes a list of attributes, generates a new node, and gives a 'NodeId'. +node :: [(String,String)] -> Dot NodeId +node attrs = Dot $ \ uq -> let nid = NodeId $ "n" ++ show uq + in ( [ GraphNode nid attrs ],succ uq,nid) + +-- | 'edge' generates an edge between two 'NodeId's, with attributes. +edge :: NodeId -> NodeId -> [(String,String)] -> Dot () +edge from to attrs = Dot (\ uq -> ( [ GraphEdge from to attrs ],uq,())) + +-- | '.->.' generates an edge between two 'NodeId's. +(.->.) from to = edge from to [] + + +-- | 'scope' groups a subgraph together; in dot these are the subgraphs inside "{" and "}". +scope :: Dot a -> Dot a +scope (Dot fn) = Dot (\ uq -> case fn uq of + ( elems,uq',a) -> ([Scope elems],uq',a)) + +-- | 'share' is when a set of nodes share specific attributes. Usually used for layout tweaking. +share :: [(String,String)] -> [NodeId] -> Dot () +share attrs nodeids = Dot $ \ uq -> + ( [ Scope ( [ GraphAttribute name val | (name,val) <- attrs] + ++ [ GraphNode nodeid [] | nodeid <- nodeids ] + ) + ], uq, ()) + +-- | 'same' provides a combinator for a common pattern; a set of 'NodeId's with the same rank. +same :: [NodeId] -> Dot () +same = share [("rank","same")] + + +-- | 'cluster' builds an explicit, internally named subgraph (called cluster). +cluster :: Dot a -> Dot (NodeId,a) +cluster (Dot fn) = Dot (\ uq -> + let cid = NodeId $ "cluster_" ++ show uq + in case fn (succ uq) of + (elems,uq',a) -> ([SubGraph cid elems],uq',(cid,a))) + +-- | 'attribute' gives a attribute to the current scope. +attribute :: (String,String) -> Dot () +attribute (name,val) = Dot (\ uq -> ( [ GraphAttribute name val ],uq,())) + +-- 'showDot' renders a dot graph as a 'String'. +showDot :: Dot () -> String +showDot (Dot dm) = case dm 0 of + (elems,_,()) -> "digraph G {\n" ++ unlines (map showGraphElement elems) ++ "\n}\n" + +showGraphElement (GraphAttribute name val) = showAttr (name,val) ++ ";" +showGraphElement (GraphNode nid attrs) = show nid ++ showAttrs attrs ++ ";" +showGraphElement (GraphEdge from to attrs) = show from ++ " -> " ++ show to ++ showAttrs attrs ++ ";" +showGraphElement (Scope elems) = "{\n" ++ unlines (map showGraphElement elems) ++ "\n}" +showGraphElement (SubGraph nid elems) = "subgraph " ++ show nid ++ " {\n" ++ unlines (map showGraphElement elems) ++ "\n}" + +showAttrs [] = "" +showAttrs xs = "[" ++ showAttrs' xs ++ "]" + where + -- never empty list + showAttrs' [a] = showAttr a + showAttrs' (a:as) = showAttr a ++ "," ++ showAttrs' as + +showAttr (name,val) = name ++ "=" ++ show val diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,25 @@ +Copyright (c) 2007 Andy Gill +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. The names of the authors may not be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/dotgen.cabal b/dotgen.cabal new file mode 100644 --- /dev/null +++ b/dotgen.cabal @@ -0,0 +1,20 @@ +Name: dotgen +Version: 0.1 +Synopsis: A simple interface for building .dot graph files. +Description: This package provides a simple interface for building .dot graph files, + for input into the dot and graphviz tools. + It includes a monadic interface for building graphs. +Category: Graphics +License: BSD3 +License-file: LICENSE +Author: Andy Gill +Maintainer: Andy Gill +Build-Depends: base +Exposed-Modules: Data.Dot +Stability: alpha +build-type: Simple + +-- Trivial (build) test framework +--Executable: dotgen-test +--hs-source-dirs: test, . +--Main-is: DotTest.hs