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@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
