import Data.Graph

import Data.Graph.Inductive.Basic

import Data.Array

import qualified Data.Array as A

tabulate :: Bounds -> [Vertex] -> Table Int
tabulate bnds vs = A.array bnds (zip vs [1..])
--
tabOrd :: Graph -> ([Tree Vertex] -> [Vertex]) -> Table Int
tabOrd g ord = tabulate (bounds g) $ ord $ dff g
--
tree :: Graph -> [Edge]
tree g = (concat (map flat ts))
  where
    ts = dff g
    flat (Node v ts) = [ (v,w) | Node w us <- ts] ++ concat (map flat ts)
--
treeG :: Graph -> [Edge]
treeG = tree
--
back :: Graph -> Table Int -> [Edge]
back g post = filter f $ edges g
  where f (v,w) = post ! v < post ! w
--
backG :: Graph -> [Edge]
backG g = back g $ tabOrd g postorderF
--
cross :: Graph -> Table Int -> Table Int -> [Edge]
cross g pre post = filter f $ edges g
  where f (v,w) = post ! v > post ! w && pre ! v > pre ! w
--
crossG :: Graph -> [Edge]
crossG g = cross g (tabOrd g preorderF) (tabOrd g postorderF)
--
forward :: Graph -> Table Int -> [Edge]
forward  g pre = (filter f $ edges g) \\ tree g
  where f (v,w) = pre ! v < pre ! w
--
forwardG :: Graph -> [Edge]
forwardG g = forward g $ tabOrd g preorderF
--
-- basically only used for Edge -> Pattern Int as input for scale
pairfastcat :: (a, a) -> Pattern a
pairfastcat = (\(u,v) -> fastcat $ pure <$> [u,v])
--
nodeEdgePairs :: Graph -> [(Vertex,[Edge])]
nodeEdgePairs g = map (\u -> (u,[(u,v)| v <- g ! u])) $ preorderF $ dff g
--
instrument :: Graph -> Edge -> [Char]
instrument g e
  | p treeG = "clubkick"
  | p forwardG = "superpwm"
  | p backG = "casio"
  | p crossG = "amencutup"
  | otherwise = "sn" -- edge is (x,x)
    where p f = e `elem` (f g)
--
-- complete graph
k n = buildG (1,n) [(u,v)|u <- [1..n],v <- [1..n]]

-- TODO Tiefe
-- TODO Wurzel betonen
-- TODO Blätter betonen?

g1 = buildG (0,6) [(1,5),(1,2),(1,3),(2,4),(3,6),(4,2),(4,3),(5,1),(5,2),(5,6),(6,0),(0,6)]

g2 = buildG (0,6) $ id <$> [(0,1),(1,2),(2,3),(3,4),(4,5),(5,6),(2,1)]

let edgePattern g e = (scale "ritusen" $ pure $ snd e) # (s $ pure $ instrument g e)
                                                     # gain 1
                                                     # end 0.2
    vertexPattern g v = (n $ pure $ toEnum v) # s "juno" -- TODO use a tuned synth instead
                                              # end 0.2
                                              # gain 1
    p g = (\(x,y) -> fastcat $ concat $ transpose [(vertexPattern g x):(replicate (length y - 1) (s "~")), (edgePattern g) <$> y]) <$> (nodeEdgePairs g)
    p' = p g
    g = k 10
in d1 $ id
      $ qtrigger -- restart at the beginning of the preorder
      $ fast 0.4 -- depends on maximum degree
      $ ghost
      $ cat p'
      # size "[0.8|0]"
      # room "[0.7|0]"
      # lpf "[1000|1500|2000]"
      # pan (randcat [-0.5,-0.3,-0.1,0,0.1,0.3,0.5])
      # delay "[0|0.2|0.3|0.4|0.5|0.6|0.7|0.8|0.9|1]"
      # delayfb 0.3

hush

-- testing stuff

d1 $ qtrigger $ fast 2 $ s "<numbers:1 clubkick:4 ~ rave:2 numbers:2 rave:4 ~ casio:2>" # end 0.2

d1 $ timeCat [(1,s "alphabet*4"), (4, fastcat [s "sn", s "bd", s "sn" , s "bd"])]

d1 $ fast 4 $ innerJoin $ fromList $ replicate 5 (cat [s "<alphabet ~ ~ ~>", cat [s "sn", s "jvbass", s "superpiano:0" , s "clubkick"]])

d1 $ fast 2 $ cat [s "<alphabet ~ ~ ~>", cat [s "sn", s "jvbass", s "superpiano:0" , s "clubkick"]]

let g = k 2 in (\(x,y) -> (x, (instrument g) <$> y)) <$> (nodeEdgePairs $ g)