vacuum-ubigraph 0.2.0.0 → 0.2.0.1

raw patch · 2 files changed

+112/−1 lines, 2 files

Files

• System/Vacuum/Ubigraph.hs +111/−0
• vacuum-ubigraph.cabal +1/−1

@@ -0,0 +1,111 @@+module System.Vacuum.Ubigraph (+    Options(..),+    hubigraphView,+    defaultNodeStyle,+    defaultEdgeStyle,+    defaultExternNodeStyle,+    defaultOptions,+    defaultServer,+    customView,+    view+) where++import Graphics.Ubigraph++import GHC.Vacuum+import Data.Char+import Text.Printf+import Data.List++import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet++data Options = Options+    { nodeStyle :: HNode -> [VAttr],+      edgeStyle :: Maybe HNode -> Maybe HNode -> [EAttr],+      externNodeStyle :: [VAttr]+    }++-- | hubigraphView - render a value in the Hubigraph monad+hubigraphView :: a -> Options -> Hubigraph ()+hubigraphView a options =+    do clear+       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++      lookupNode n = IntMap.lookup n g++      renderNode nid = do+	   newVertexWithID nid+	   mapM_ (flip setVAttr nid) $ maybe (externNodeStyle options) (nodeStyle options) (lookupNode nid)++      renderEdge (a, b) = do+	   eid <- newEdge (a, b)+	   mapM_ (flip setEAttr eid) (edgeStyle options (lookupNode a) (lookupNode b))++defaultNodeStyle :: HNode -> [VAttr]+defaultNodeStyle n =+    case nodeName n of+      ":"  ->+	  [VLabel "(:)", VShape Cube, VColor "#0000ff"]++      k | k `elem` ["S#" ,"I#" ,"W#"+		   ,"I8#" ,"I16#" ,"I32#" ,"I64#"+		   ,"W8#" ,"W16#" ,"W32#" ,"W64#"] ->+	  [VLabel (showLit n), VShape Sphere, VColor "#00ff00"]++      "C#" ->+	  [VLabel $ show . chr . fromIntegral . head . nodeLits $ n,+	   VShape Sphere,+	   VColor "#00ff00"]+      "D#" ->+	  [VLabel "Double", VShape Sphere, VColor "#009900"]+      "F#" ->+	  [VLabel "Float", VShape Sphere, VColor "#009900"]+++      "PS" ->+	  [VLabel $ printf "ByteString[%d,%d]" (nodeLits n !! 1) (nodeLits n !! 2),+	   VShape Cube,+	   VColor "#ff0000"]+      "Chunk" ->+	  [VLabel $ printf "Chunk[%d,%d]" (nodeLits n !! 1) (nodeLits n !! 2),+	   VShape Cube,+	   VColor "#ff0000"]++      c+	  | z > 0 ->+	      [VLabel $ c ++ show (take (fromIntegral z) $ nodeLits n),+	       VShape Cube,+	       VColor "#990000"]+	  | otherwise ->+	      [VLabel c, VShape Cube,VColor "#990000"]+    where+      showLit n = show (head $ nodeLits n)+      z = itabLits (nodeInfo n)++defaultEdgeStyle :: Maybe HNode -> Maybe HNode -> [EAttr]+defaultEdgeStyle _ _ = [EStroke Dotted, EArrow True]+defaultExternNodeStyle = [VShape Cube, VColor "#ff0000"]++defaultOptions = Options {+                   nodeStyle = defaultNodeStyle,+                   edgeStyle = defaultEdgeStyle,+                   externNodeStyle = defaultExternNodeStyle+                 }++-- | defaultServer is "http://127.0.0.1:20738/RPC2"+defaultServer = "http://127.0.0.1:20738/RPC2"++-- | customView - render value+customView :: Options -> String -> a -> IO ()+customView options server a = runHubigraph (hubigraphView a options) (Ubigraph server)++-- | view - render value with default settings+view :: a -> IO ()+view = customView defaultOptions defaultServer

@@ -1,5 +1,5 @@ name:               vacuum-ubigraph-version:            0.2.0.0+version:            0.2.0.1 cabal-version:      >= 1.2 build-type:         Simple license:            BSD3