-- | Module to provide graph drawing of unit generator graphs.  The
--   output is in the form of a dot graph, which can be layed out
--   using the @graphviz@ tools, see <http://graphviz.org>.
module Sound.SC3.UGen.Dot ( dot, draw ) where

import Control.Exception hiding (catch)
import Data.List
import Data.Maybe
import Sound.SC3
import System.IO
import System.Cmd
import System.Directory
import System.Environment
import System.FilePath

-- | Generate the dot representation of the provided unit generator graph.
dot :: UGen -> String
dot r = 
    let g = synth r
        (Graph _ _ ks us) = g
        ls = concat [ ["digraph Anonymous {"]
                    , map dot_node_k ks
                    , map (dot_node_u g) us
                    , map (dot_edge g) (edges us)
                    , ["}"] ]
    in unlines ls

-- | Draw the unit generator graph provided using the viewer at the
--   environment variable @DOTVIEWER@, or @dotty@ if that variable is
--   not defined.
draw :: UGen -> IO ()
draw u = get_dot_viewer >>= draw_with u

data ToPort = ToPort Int Int
              deriving (Eq, Show)

type Edge = (FromPort, ToPort)
type Edges = [Edge]

find_node :: Graph -> Int -> Node
find_node (Graph _ cs ks us) n =
    fromJust (find (\x -> node_id x == n) (cs ++ ks ++ us))

edges :: [Node] -> Edges
edges = concatMap f
    where f (NodeU x _ _ i _ _ _) = zip i (map (\n -> ToPort x n) [0..])
          f _ = error "edges"

record :: String -> String -> [[String]] -> String
record lbl clr slt = concat [ lbl
                            , " [shape=\"record\", "
                            , "color=\"", clr, "\", "
                            , "label=\"{", concat (g (map f slt)), "}\"];" ]
    where f l = concat ["{", concat (g l), "}"]
          g l = (intersperse "|" l)

label :: Node -> String
label (NodeC n _) = "N_" ++ show n
label (NodeK n _ _ _ ) = "C_" ++ show n
label (NodeU n _ _ _ _ _ _) = "U_" ++ show n
label (NodeP n _ _) = "U_" ++ show n

port_nid :: FromPort -> Int
port_nid (C n) = n
port_nid (K n) = n
port_nid (U n _) = n

port_indx :: FromPort -> Int
port_indx (U _ x) = x
port_indx _ = 0

is_node_c :: Node -> Bool
is_node_c (NodeC _ _) = True
is_node_c _ = False

is_node_u :: Node -> Bool
is_node_u (NodeU _ _ _ _ _ _ _) = True
is_node_u _ = False

dot_edge :: Graph -> Edge -> [Char]
dot_edge g (l, ToPort ri rn)
    = let ln = find_node g (port_nid l)
      in if is_node_c ln
         then ""
         else concat [ label ln
                     , if is_node_u ln
                       then ":O_" ++ show (port_indx l)
                       else ""
                     , " -> "
                     , label (find_node g ri)
                     , ":I_"
                     , show rn
                     , ";" ]

rate_color :: Rate -> String
rate_color AR = "black"
rate_color KR = "blue"
rate_color IR = "yellow"
rate_color DR = "red"

input :: Graph -> FromPort -> Int -> String
input g (C n) _ = show (node_c_value (find_node g n))
input _ _ i = "<I_" ++ show i ++ ">"

name :: String -> Int -> String
name "UnaryOpUGen" n = unaryName n
name "BinaryOpUGen" n = binaryName n
name n _ = n

is_implicit_control :: Node -> Bool
is_implicit_control (NodeU x _ s _ _ _ _) = x == -1 && s == "Control"
is_implicit_control _ = False

dot_node_u :: Graph -> Node -> String
dot_node_u g u = if is_implicit_control u
                 then ""
                 else record lbl clr [upr,lwr]
    where lbl = label u
          clr = rate_color (node_u_rate u)
          i = node_u_inputs u
          i' = length i - 1
          (Special s) = node_u_special u
          upr = name (node_u_name u) s : zipWith (input g) i [0..i']
          o = length (node_u_outputs u) - 1
          lwr = map (\j -> "<O_" ++ show j ++ ">") [0..o]

dot_node_k :: Node -> String
dot_node_k u = concat [ label u
                      , "[shape=\"trapezium\", color=\""
                      , rate_color (node_k_rate u)
                      , "\",label=\""
                      , node_k_name u, ":", show (node_k_default u)
                      , "\"];" ]

-- Draw the UGen graph and display using the specified viewer.
draw_with :: UGen -> String -> IO ()
draw_with u v =
    do d <- getTemporaryDirectory
       let f = d </> "hsc.dot"
       bracket (openFile f WriteMode)
               hClose
               (flip hPutStr (dot u))
       system $ v ++ " " ++ f
       return ()

-- Read the environment variable @DOTVIEWER@, the default value is @"dotty"@.
get_dot_viewer :: IO String
get_dot_viewer = catch (getEnv "DOTVIEWER") (\_ -> return "dotty")