[Haskell-cafe] Re: ANNOUNCE: vacuum-cairo: a cairo frontend to vacuum for live Haskell data visualization

[Don Stewart]

Did you use hubigraph?

    http://ooxo.org/hubigraph/

This cabalized project doesn't appear to be on hackage!

gleb.alexeev:
> Don Stewart wrote:
>> I am pleased to announce the release of vacuum-cairo, a Haskell library
>> for interactive rendering and display of values on the GHC heap using
>> Matt Morrow's vacuum library.
>
> Awesome stuff, kudos to you and Matt Morrow!
>
> I thought it'd be fun to visualize data structures in three dimensions.  
> Attached is quick and dirty hack based on your code and Ubigraph server  
> (http://ubietylab.net/ubigraph/).
>
> The demo video (apologies for poor quality):  
> http://www.youtube.com/watch?v=3mMH1cHWB6c
>
> If someone finds it fun enough, I'll cabalize it and upload to Hackage.

> module Ubigraph where
> 
> import Network.XmlRpc.Client
> 
> type Url = String
> type VertexId = Int
> type EdgeId = Int
> 
> defaultServer = "http://127.0.0.1:20738/RPC2"
> 
> void :: IO Int -> IO ()
> void m = m >> return ()
> 
> clear :: Url -> IO ()
> clear url = void (remote url "ubigraph.clear")
> 
> newVertex :: Url -> IO VertexId
> newVertex url = remote url "ubigraph.new_vertex"
> 
> newEdge :: Url -> VertexId -> VertexId -> IO EdgeId
> newEdge url = remote url "ubigraph.new_edge"
> 
> removeVertex :: Url -> VertexId -> IO ()
> removeVertex url vid = void (remote url "ubigraph.remove_vertex" vid)
> 
> removeEgde :: Url -> EdgeId -> IO ()
> removeEgde url eid= void (remote url "ubigraph.remove_edge" eid)
> 
> 
> zeroOnSuccess :: IO Int -> IO Bool
> zeroOnSuccess = fmap (==0) 
> 
> newVertexWithId :: Url -> VertexId -> IO Bool
> newVertexWithId url vid = zeroOnSuccess (remote url "ubigraph.new_vertex_w_id" vid)
> 
> newEdgeWithId :: Url -> EdgeId -> VertexId -> VertexId -> IO Bool
> newEdgeWithId url eid x y = zeroOnSuccess (remote url "ubigraph.new_edge_w_id" eid x y)
> 
> setVertexAttribute :: Url -> VertexId -> String -> String -> IO Bool
> setVertexAttribute url vid attr val = zeroOnSuccess (remote url "ubigraph.set_vertex_attribute" vid attr val)
> 
> setEdgeAttribute :: Url -> VertexId -> String -> String -> IO Bool
> setEdgeAttribute url eid attr val = zeroOnSuccess (remote url "ubigraph.set_edge_attribute" eid attr val)

> module VacuumUbigraph where
> 
> import GHC.Vacuum
> import Data.Char
> import Text.Printf
> import Data.List
> 
> import qualified Data.IntMap as IntMap
> import qualified Data.IntSet as IntSet
> 
> import qualified Ubigraph as U
> 
> nodeStyle n =
>     case nodeName n of
>       ":"  -> ("(:)", "cube", "#0000ff")
> 
>       -- atomic stuff is special
>       k | k `elem` ["S#" ,"I#" ,"W#"
>                    ,"I8#" ,"I16#" ,"I32#" ,"I64#"
>                    ,"W8#" ,"W16#" ,"W32#" ,"W64#"] -> (showLit n, "sphere", "#00ff00")
>       -- chars
>       "C#" -> (show . chr . fromIntegral . head . nodeLits $ n, "sphere", "#00ff00")
>       "D#" -> ("Double", "sphere", "#009900")
>       "F#" -> ("Float", "sphere", "#009900")
> 
>       -- bytestrings
>       "PS"    -> (printf "ByteString[%d,%d]" (nodeLits n !! 1) (nodeLits n !! 2), "cube", "#ff0000")
>       "Chunk" -> (printf "Chunk[%d,%d]" (nodeLits n !! 1) (nodeLits n !! 2), "cube", "#ff0000")
> 
>       -- otherwise just the constructor and local fields
>       c   | z > 0 ->
>                     (c ++ show (take (fromIntegral z) $ nodeLits n), "cube", "#990000")
>           | otherwise -> (c, "cube", "#990000")
>                     where z = itabLits (nodeInfo n)
>         where
>           showLit n = show (head $ nodeLits n)
> 
> view a = do
>   U.clear srv
>   mapM_ renderNode nodes
>   mapM_ renderEdge edges
>     where      
>       g = vacuum a
>       alist = toAdjList g
>       nodes = nub $ map fst alist ++ concatMap snd alist
>       edges = concatMap (\(n, ns) -> map ((,) n) ns) alist
> 
>       style nid = maybe ("...", "cube", "#ff0000") nodeStyle (IntMap.lookup nid g)
> 
>       renderNode nid = do
>            U.newVertexWithId srv nid
>            let (label, shape, color) = style nid
>            U.setVertexAttribute srv nid "label" label
>            U.setVertexAttribute srv nid "shape" shape
>            U.setVertexAttribute srv nid "color" color
>       
>       renderEdge (a, b) = do
>            e <- U.newEdge srv a b
>            U.setEdgeAttribute srv e "stroke" "dotted"
>            U.setEdgeAttribute srv e "arrow" "true"
> 
>       srv = U.defaultServer
> 

> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe