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