dotgen-0.4.2/0000755000000000000000000000000012503161455011165 5ustar0000000000000000dotgen-0.4.2/Setup.hs0000644000000000000000000000005612503161455012622 0ustar0000000000000000import Distribution.Simple main = defaultMain dotgen-0.4.2/dotgen.cabal0000644000000000000000000000257212503161455013437 0ustar0000000000000000Name: dotgen Version: 0.4.2 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. homepage: https://github.com/ku-fpg/dotgen bug-reports: https://github.com/ku-fpg/dotgen/issues Category: Text License: BSD3 License-file: LICENSE Author: Andy Gill Maintainer: Andy Gill Stability: alpha build-type: Simple extra-source-files: CHANGELOG.md, README.md Cabal-Version: >= 1.8 source-repository head type: git location: git://github.com/ku-fpg/dotgen Flag devel Description: Enable full development tree Default: False Library Build-Depends: base >= 3 && < 5, containers Exposed-Modules: Text.Dot ghc-options: -Wall -- Trivial (build) test framework Executable dotgen-test if flag(devel) buildable: True else buildable: False build-depends: base >= 3 && < 5, dotgen == 0.4.2 hs-source-dirs: test Main-is: DotTest.hs ghc-options: -Wall dotgen-0.4.2/README.md0000644000000000000000000000072312503161455012446 0ustar0000000000000000# dotgen [![Hackage version](https://img.shields.io/hackage/v/dotgen.svg?style=flat)](http://hackage.haskell.org/package/dotgen) [![Build Status](https://img.shields.io/travis/ku-fpg/dotgen.svg?style=flat)](https://travis-ci.org/ku-fpg/dotgen) A simple interface for building .dot graph files. 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.dotgen-0.4.2/CHANGELOG.md0000644000000000000000000000004412503161455012774 0ustar0000000000000000## 0.4.2 * Fixed build with GHC 7.10dotgen-0.4.2/LICENSE0000644000000000000000000000256112503161455012176 0ustar0000000000000000Copyright (c) 2008 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. dotgen-0.4.2/Text/0000755000000000000000000000000012503161455012111 5ustar0000000000000000dotgen-0.4.2/Text/Dot.hs0000644000000000000000000001563512503161455013205 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | -- Module: Text.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 Text.Dot ( -- * Dot Dot -- abstract -- * Nodes , node , NodeId -- abstract , userNodeId , userNode -- * Edges , edge , edge' , (.->.) -- * Showing a graph , showDot -- * Other combinators , scope , attribute , share , same , cluster -- * Simple netlist generation , netlistGraph ) where #if !(MIN_VERSION_base(4,8,0)) import Control.Applicative #endif import Control.Monad import Data.Char import qualified Data.Map as M import qualified Data.Set as S -- data DotGraph = DotGraph [GraphElement] data NodeId = NodeId String | UserNodeId Int instance Show NodeId where show (NodeId str) = str show (UserNodeId i) | i < 0 = "u_" ++ show (negate i) | otherwise = "u" ++ show i data GraphElement = GraphAttribute String String | GraphNode NodeId [(String,String)] | GraphEdge NodeId NodeId [(String,String)] | GraphEdge' NodeId (Maybe String) NodeId (Maybe String) [(String,String)] | Scope [GraphElement] | SubGraph NodeId [GraphElement] data Dot a = Dot { unDot :: Int -> ([GraphElement],Int,a) } -- Support 7.10 instance Functor Dot where fmap = liftM instance Applicative Dot where pure = return (<*>) = ap 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) -- | 'userNodeId' allows a user to use their own (Int-based) node id's, without needing to remap them. userNodeId :: Int -> NodeId userNodeId i = UserNodeId i -- | 'userNode' takes a NodeId, and adds some attributes to that node. userNode :: NodeId -> [(String,String)] -> Dot () userNode nId attrs = Dot $ \ uq -> ( [GraphNode nId attrs ],uq,()) -- | '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,())) -- | 'edge' generates an edge between two 'NodeId's, with optional node sub-labels, and attributes. edge' :: NodeId -> Maybe String -> NodeId -> Maybe String -> [(String,String)] -> Dot () edge' from optF to optT attrs = Dot (\ uq -> ( [ GraphEdge' from optF to optT attrs ],uq,())) -- | '.->.' generates an edge between two 'NodeId's. (.->.) :: NodeId -> NodeId -> Dot () (.->.) 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 a -> String showDot (Dot dm) = case dm 0 of (elems,_,_) -> "digraph G {\n" ++ unlines (map showGraphElement elems) ++ "\n}\n" showGraphElement :: GraphElement -> String 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 (GraphEdge' from optF to optT attrs) = showName from optF ++ " -> " ++ showName to optT ++ showAttrs attrs ++ ";" where showName n Nothing = show n showName n (Just t) = show n ++ ":" ++ t showGraphElement (Scope elems) = "{\n" ++ unlines (map showGraphElement elems) ++ "\n}" showGraphElement (SubGraph nid elems) = "subgraph " ++ show nid ++ " {\n" ++ unlines (map showGraphElement elems) ++ "\n}" showAttrs :: [(String, String)] -> String showAttrs [] = "" showAttrs xs = "[" ++ showAttrs' xs ++ "]" where -- never empty list showAttrs' [a] = showAttr a showAttrs' (a:as) = showAttr a ++ "," ++ showAttrs' as showAttr :: (String, String) -> String showAttr (name,val) = name ++ "=\"" ++ foldr showsDotChar "" val ++ "\"" showsDotChar :: Char -> ShowS showsDotChar '"' = ("\\\"" ++) showsDotChar '\\' = ("\\\\" ++) showsDotChar x = showLitChar x -- | 'netlistGraph' generates a simple graph from a netlist. netlistGraph :: (Ord a) => (b -> [(String,String)]) -- ^ Attributes for each node -> (b -> [a]) -- ^ Out edges leaving each node -> [(a,b)] -- ^ The netlist -> Dot () netlistGraph attrFn outFn assocs = do let nodes = S.fromList $ [ a | (a,_) <- assocs ] let outs = S.fromList $ [ o | (_,b) <- assocs , o <- outFn b ] nodeTab <- sequence [ do nd <- node (attrFn b) return (a,nd) | (a,b) <- assocs ] otherTab <- sequence [ do nd <- node [] return (o,nd) | o <- S.toList outs , o `S.notMember` nodes ] let fm = M.fromList (nodeTab ++ otherTab) sequence_ [ (fm M.! src) .->. (fm M.! dst) | (dst,b) <- assocs , src <- outFn b ] return () dotgen-0.4.2/test/0000755000000000000000000000000012503161455012144 5ustar0000000000000000dotgen-0.4.2/test/DotTest.hs0000644000000000000000000000446312503161455014075 0ustar0000000000000000module Main (main) where import Text.Dot -- data Animation = Start src, box, diamond :: String -> Dot NodeId src label = node $ [ ("shape","none"),("label",label) ] box label = node $ [ ("shape","box"),("style","rounded"),("label",label) ] diamond label = node $ [("shape","diamond"),("label",label),("fontsize","10")] main :: IO () main = putStrLn $ showDot $ do attribute ("size","40,15") attribute ("rankdir","LR") refSpec <- src "S" tarSpec <- src "T" same [refSpec,tarSpec] c1 <- box "S" c2 <- box "C" c3 <- box "F" same [c1,c2,c3] refSpec .->. c1 tarSpec .->. c2 tarSpec .->. c3 m1 <- box "x" m2 <- box "y" ntm <- box "z" same [m1,m2,ntm] c1 .->. m1 c2 .->. m2 xilinxSynthesis <- box "x" c3 .->. xilinxSynthesis gns <- box "G" xilinxSynthesis .->. gns gns .->. ntm ecs <- sequence [ diamond "E" , diamond "E" , diamond "Eq" ] same ecs m1 .->. (ecs !! 0) m1 .->. (ecs !! 1) m2 .->. (ecs !! 0) m2 .->. (ecs !! 2) ntm .->. (ecs !! 1) ntm .->. (ecs !! 2) _ <- sequence [ do evidence <- src "EE" n .->. evidence | n <- ecs ] edge refSpec tarSpec [("label","Engineering\nEffort"),("style","dotted")] () <- scope $ do v1 <- box "Hello" v2 <- box "World" v1 .->. v2 (x,()) <- cluster $ do v1 <- box "Hello" v2 <- box "World" v1 .->. v2 -- x .->. m2 -- for hpc () <- same [x,x] v <- box "XYZ" v .->. v () <- attribute ("rankdir","LR") let n1 = userNodeId 1 let n2 = userNodeId (-1) () <- n1 `userNode` [ ("shape","box")] n1 .->. n2 _ <- box "XYZ" _ <- box "(\n\\n)\"(/\\)" netlistGraph (\ a -> [("label","X" ++ show a)]) (\ a -> [succ a `mod` 10,pred a `mod` 10]) [ (n,n) | n <- [0..9] :: [Int] ] return ()