module Sound.DF.Graph where

import qualified Data.Graph.Inductive as G
import qualified Data.Graph.Inductive.Query.DFS as G
import Data.List
import Data.Maybe
import Sound.DF.Node

-- * Graph analysis

-- | List of nodes, in left biased order.
nodes :: Node -> [Node]
nodes n@(S _) = [n]
nodes n@(A _ i _) = n : concatMap nodes i
nodes n@(R _ (Left _)) = [n]
nodes n@(R _ (Right (l, r))) = n : (nodes l ++ nodes r)
nodes n@(P i _) = n : nodes i
nodes n@(M l r) = n : (nodes l ++ nodes r)

-- | Read label of node.
label :: [(NodeID, Node)] -> Node -> NodeID
label ns n = let r = find ((== n) . snd) ns
                  in maybe (error ("label: " ++ show n)) fst r

-- | Transform node to source, see through rec_r and proxy and mrg.
source :: [(NodeID, Node)] -> Node -> (NodeID, PortID)
source ns n@(S _) = (label ns n, 0)
source ns n@(A _ _ [_]) = (label ns n, 0)
source _ (A _ _ _) = error "non unary A"
source ns n@(R _ (Left _)) = (label ns n, 0)
source ns (R _ (Right (n, _))) = source ns n
source ns (P n i) = (label ns n, i)
source ns (M l _) = source ns l

-- | Edge between ports.
type Edge = ((NodeID, PortID), (NodeID, PortID))

-- | List incoming node edges, 
edges :: [(NodeID, Node)] -> Node -> [Edge]
edges ns r@(A _ is _) = let f i k = (source ns i, (label ns r, k))
                        in zipWith f is [0..]
edges ns r@(R _ (Right (_, rr))) = [(source ns rr, (label ns r, 0))]
edges _ (P _ _) = []
edges _ _ = []

-- | Label nodes and list edges.  Proxy and multiple-root nodes are
--   erased.
analyse :: [Node] -> [((NodeID, Node), [Edge])]
analyse ns = let l_ns = zip [1..] ns
                 w_es (k, n) = ((k, n), edges l_ns n)
                 rem_p ((_, (P _ _)), _) = False
                 rem_p _ = True
                 rem_m ((_, (M _ _)), _) = False
                 rem_m _ = True
            in filter rem_m (filter rem_p (map w_es l_ns))

-- | Transform edge into form required by fgl.
mod_e :: Edge -> (NodeID, NodeID, (PortID, PortID))
mod_e ((l, lp), (r, rp)) = (l, r, (lp, rp))

-- | Generate graph.
graph :: Node -> G.Gr Node (PortID, PortID)
graph n = let a = analyse (nub (nodes n))
              ns = map fst a
              es = concatMap (map mod_e . snd) a
          in G.mkGraph ns es

-- | Topological sort of nodes (via graph).
tsort :: Node -> [Node]
tsort s = let g = graph s
          in map (fromMaybe (error "tsort") . G.lab g) (G.topsort g)