Zora-1.1.7: supporting-files/dot.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Data.Graph.Inductive
import Data.GraphViz
import Data.GraphViz.Attributes.Complete
import Data.GraphViz.Types.Generalised as G
import Data.GraphViz.Types.Monadic
import Data.Text.Lazy as L
import Data.Word

import System.IO

-- $ runhaskell dot.hs > graph.dot
-- $ dot -Tpng graph.dot > graph.png'

make_graph :: String -> Gr Text Text
make_graph str = mkGraph v e
	where
		(v, e) = graph . fromList $ str'
		str' = read str :: [Integer]

example_graph :: Gr Text Text
example_graph = mkGraph
	[(1,"one"), (3,"three")]
	[(1,3,"edge label")]

params :: GraphvizParams n L.Text L.Text () L.Text
params = nonClusteredParams { globalAttributes = ga
							, fmtNode			= fn
							, fmtEdge			= fe
							}
	where
		fn (_,l) = [textLabel l]
		fe (_,_,l) = [textLabel l]

		ga = [ GraphAttrs [ RankDir	 FromTop
						  , BgColor	 [toWColor White]
							]
			 , NodeAttrs	[ shape	 BoxShape
							-- , FillColor (some_color 4)
							-- , style	 filled
							, Width	 0.1
							, Height	0.1
							]
			 ]

some_color :: Word8 -> ColorList
some_color n | n == 1 = c $ (RGB 127 108 138)
			 | n == 2 = c $ (RGB 175 177 112)
			 | n == 3 = c $ (RGB 226 206 179)
			 | n == 4 = c $ (RGB 172 126 100)
 where c rgb = toColorList [rgb]

my_color :: Word8 -> Attribute
my_color = Color . some_color

main :: IO ()
main = do
	str <- getLine
	putStr . unpack . printDotGraph . graphToDot params . make_graph $ str