-- | Graph analysis
module Sound.DF.Graph where

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

-- | List of nodes, in left biased order.
nodes :: Node -> [Node]
nodes n =
    case n of
      S _ -> [n]
      A _ i _ -> n : concatMap nodes i
      R _ (Left _) -> [n]
      R _ (Right (l, r)) -> n : (nodes l ++ nodes r)
      P i _ -> n : nodes i
      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 =
    case n of
      S _ -> (label ns n, 0)
      A _ _ [_] -> (label ns n, 0)
      A _ _ _ -> error "non unary A"
      R _ (Left _) -> (label ns n, 0)
      R _ (Right (n', _)) -> source ns n'
      P n' i -> (label ns n', i)
      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)