vacuum-cairo (empty) → 0.1
raw patch · 4 files changed
+192/−0 lines, 4 filesdep +basedep +cairodep +gtksetup-changed
Dependencies added: base, cairo, gtk, pretty, process, svgcairo, vacuum
Files
- LICENSE +30/−0
- Setup.lhs +3/−0
- System/Vacuum/Cairo.hs +123/−0
- vacuum-cairo.cabal +36/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2009 Don Stewart++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. Neither the name of the author nor the names of his contributors+ may 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 OR CONTRIBUTORS 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.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ System/Vacuum/Cairo.hs view
@@ -0,0 +1,123 @@+--+-- |+-- Module : System.Vacuum.Cairo+-- Copyright : (c) Tim Docker 2006, Don Stewart 2009+-- License : BSD-style+--+-- Interactively visualize Haskell heap values as SVG graphs in a Cairo canvas+-- using graphviz.+--+-- > view [1..10]+--+-- Will display a pop-up window of the data structure produced+--++module System.Vacuum.Cairo (view) where++import qualified Graphics.UI.Gtk as G+import qualified Graphics.UI.Gtk.Gdk.Events as G+import qualified Graphics.Rendering.Cairo as C+import qualified Graphics.Rendering.Cairo.SVG as C+import GHC.Vacuum+import Text.PrettyPrint+import Data.List++import System.Process+import Control.Concurrent+import System.IO+import Control.Monad+import System.Exit+import qualified Control.Exception as C++-- | Render a 'vacuum' image of the heap on a pop-up cairo canvas+view :: a -> IO ()+view a = do+ let dot = render. ppDot . nameGraph $ vacuum a+ svg <- myReadProcess "dot" ["-Tsvg"] dot+ renderableToWindow svg 800 600++------------------------------------------------------------------------+-- UI++-- do action m for any keypress (except meta keys)+anyKey :: (Monad m) => m a -> G.Event -> m Bool+anyKey m (G.Key {G.eventKeyName=key})+ | any (`isPrefixOf` key) ignores = return True+ | otherwise = m >> return True+ where ignores = ["Shift","Control","Alt",+ "Super","Meta","Hyper"]++type SVGString = String++renderableToWindow :: SVGString -> Int -> Int -> IO ()+renderableToWindow chart windowWidth windowHeight = do+ svg <- C.svgNewFromString chart++ G.unsafeInitGUIForThreadedRTS+ -- G.initGUI+ window <- G.windowNew+ canvas <- G.drawingAreaNew+ -- fix size+ -- G.windowSetResizable window False+ G.widgetSetSizeRequest window windowWidth windowHeight+ -- press any key to quit+ G.onKeyPress window $ anyKey (G.widgetDestroy window)+ G.onDestroy window G.mainQuit+ G.onExpose canvas $ const (updateCanvas svg canvas)+ G.set window [G.containerChild G.:= canvas]+ G.widgetShowAll window+ G.mainGUI++updateCanvas :: C.SVG -> G.DrawingArea -> IO Bool+updateCanvas svg canvas = do+ win <- G.widgetGetDrawWindow canvas+ (width, height) <- G.widgetGetSize canvas+ let (w,h) = (fromIntegral width,fromIntegral height)+ let (sw,sh) = C.svgGetSize svg++ G.renderWithDrawable win $ do+ C.scale (w / fromIntegral sw) (h / fromIntegral sh)+ C.svgRender svg+ return True++------------------------------------------------------------------------+-- Talking to dot++myReadProcess+ :: FilePath -- ^ command to run+ -> [String] -- ^ any arguments+ -> String -- ^ standard input+ -> IO String -- ^ stdout + stderr+myReadProcess cmd args input = do+ (Just inh, Just outh, _, pid) <-+ createProcess (proc cmd args){ std_in = CreatePipe,+ std_out = CreatePipe,+ std_err = Inherit }++ -- fork off a thread to start consuming the output+ output <- hGetContents outh+ outMVar <- newEmptyMVar+ forkIO $ C.evaluate (length output) >> putMVar outMVar ()++ -- now write and flush any input+ when (not (null input)) $ do hPutStr inh input; hFlush inh+ hClose inh -- done with stdin++ -- wait on the output+ takeMVar outMVar+ hClose outh++ -- wait on the process+ ex <- waitForProcess pid++ case ex of+ ExitSuccess -> return output+ ExitFailure r -> return output++{-+ ioError (mkIOError OtherError ("readProcess: " ++ cmd ++ + ' ':unwords (map show args) ++ + " (exit " ++ show r ++ ")")+ Nothing Nothing)++-}
+ vacuum-cairo.cabal view
@@ -0,0 +1,36 @@+name: vacuum-cairo+version: 0.1+cabal-version: >= 1.2+build-type: Simple+license: BSD3+license-file: LICENSE+category: Development+author: Don Stewart+copyright: (c) Don Stewart 2009+maintainer: Don Stewart <dons@galois.com>+homepage: http://code.haskell.org/~dons/code/vacuum-cairo+stability: experimental+synopsis: Visualize live Haskell data structures using vacuum, graphviz and cairo+description: Visualize live Haskell data structures using vacuum, graphviz and cairo+ .+ > $ view "hello"+ .+ <http://code.haskell.org/~dons/images/vacuum/hello.png>+ .+ > $ view [1..5]+ .+ <http://code.haskell.org/~dons/images/vacuum/list.png>+ .+ > $ view (IntMap.fromList $ zip [1..10] [1..])+ .+ <http://code.haskell.org/~dons/images/vacuum/intmap.png>++library+ build-depends: base >= 3,+ vacuum,+ gtk,+ cairo,+ svgcairo,+ process,+ pretty+ exposed-modules: System.Vacuum.Cairo