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
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)
label :: [(NodeID, Node)] -> Node -> NodeID
label ns n = let r = find ((== n) . snd) ns
in maybe (error ("label: " ++ show n)) fst r
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
type Edge = ((NodeID, PortID), (NodeID, PortID))
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 _ _ = []
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))
mod_e :: Edge -> (NodeID, NodeID, (PortID, PortID))
mod_e ((l, lp), (r, rp)) = (l, r, (lp, rp))
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
tsort :: Node -> [Node]
tsort s = let g = graph s
in map (fromMaybe (error "tsort") . G.lab g) (G.topsort g)