module CsoundExpr.Translator.Score
    (foldScores)
where

import Data.List
import Data.Function


import Temporal.Music(Score, Event(..), render)

import qualified Data.Map as Map

import CsoundExpr.Translator.ExprTree.Tree
import CsoundExpr.Translator.ExprTree.ExprTree
import CsoundExpr.Translator.ExprTree.ExprTree (Purity(..), exprTag)

import CsoundExpr.Translator.Cs.CsTree
import CsoundExpr.Translator.Cs.Utils

import CsoundExpr.Translator.Types


-- import Debug.Trace
-- debug msg x = trace (msg ++ " : " ++ show x) x


type NodeId   = (Int, [Int])
type PfieldId = (Int, IsStringPfield)

type IsStringPfield = Bool


-- | all values in given instrument node
type NodeSlice = (NodeId, [ValueId])

foldScores :: Score Instr -> [(Instr, [Note])]
foldScores x = zip instrs vals
    where instrs = zipWith substPfields ids rawInstrs
          (ids, vals) = unzip $ map (foldVals . formValues) sco
          rawInstrs   = map (thd . head) sco
          sco         = scoreList x


--scoreList :: Events Instr -> [[(Time, Time, Instr)]]
--scoreList = groupBy ((liftPredicateToList equalStructure) `on` thd) . 
--            sortBy (compare `on` thd) . toList

scoreList :: Score Instr -> [[(Time, Dur, Instr)]]
scoreList = iterScoreList [] . toList
    where iterScoreList res s = 
		case s of
		    []     -> res
		    (x:xs) -> let (x1, x2) = partition (pred x) xs
			      in  iterScoreList (res ++ [x : x1]) x2
	  pred = liftPredicateToList equalStructure `on` thd
	  toList x = map (\(Event t d a) -> (t, d, a)) $ render x


foldVals :: [(Time, Time, [(NodeId, ValueId)])] -> ([(NodeId, PfieldId)], [Note])
foldVals xs = (i, subst3 (valList v) xs)
    where (i, v) = assignPfieldIds $ filter (isPfield . snd) $ alignValuesByNodes xs 
          subst3 ys xs = [(a, b, y) | (y, (a, b, _)) <- zip ys xs]
          valList [] = repeat []
          valList xs = transpose xs


isPfield :: [ValueId] -> Bool
isPfield   = p . nub
    where p x = case x of
                    (x0 : x1 : _) -> True
                    _             -> False


alignValuesByNodes :: [(Time, Time, [(NodeId, ValueId)])] -> [NodeSlice]
alignValuesByNodes = map select . transpose . map thd
    where select x = (fst $ head x, map snd x)


substPfields :: [(NodeId, PfieldId)] -> Instr -> Instr
substPfields ids instr = foldl f instr ids  -- zip ids [4..]
    where f xs ((id0, id), n) =
              substListElem id0 (substTreeById id (p n) (xs !! id0)) xs
          p (id, isStr) 
            | isStr     = mapType (const [S]) $ param id
            | otherwise = mapType (const [I]) $ param id
             


substListElem :: Int -> a -> [a] -> [a]
substListElem id x xs = take id xs ++ [x] ++ drop (id+1) xs


             
formValues :: [(Time, Time, Instr)] -> [(Time, Time, [(NodeId, ValueId)])]
formValues = map f . sortBy p
    where f (t, d, expr) = (t, d, toVals expr)
          p (a1, b1, _) (a2, b2, _)
              | a1 < a2              = LT
              | a1 == a2 && a1 < a2  = LT
              | a1 == a2 && a1 == a2 = EQ
              | otherwise            = GT



toVals :: Instr -> [(NodeId, ValueId)]
toVals = (addId0 =<< ) . zip [0..] . map getVals
    where getVals  = map (mapSnd value') . filter (isVal . exprOp . exprTag . snd) . toIdList
          value' x = (exprPurity x, value $ exprOp $ exprTag x)
          addId0 (id0, xs) = [((id0, ids), vs) | (ids, vs) <- xs]
          

assignPfieldIds :: [NodeSlice] -> ([(NodeId, PfieldId)], [[ValueId]])
assignPfieldIds xs = (zip (map fst xs) (zip ids isStr), orderValsWithIds ids vals)
    where ids   = map (+4) $ numerate $ map snd xs
          isStr = map (isStringValueId . head . snd) xs
          vals  = map snd xs
	  


orderValsWithIds :: [Int] -> [[ValueId]] -> [[ValueId]]
orderValsWithIds ids vals = map snd $ sortOn fst $ nubOn fst $ zip ids vals


sortOn :: Ord b => (a -> b) -> [a] -> [a]
sortOn f = sortBy (compare `on` f)

nubOn :: Eq b => (a -> b) -> [a] -> [a]
nubOn f = nubBy ((==) `on` f)


isStringValueId :: ValueId -> Bool
isStringValueId (_, v) = isString v 


-- numerate : 
--   assigns numbers to unique elements of list
--   (it's for (ExprTree -> ExprSeq) optimisation, 
--   pfields with the same values should have same pfield ids)

numerate :: Ord b => [b] -> [Int]
numerate = fst . foldl f ([], Map.empty) 
    where f (s, m) b 
              | Map.member b m = (s ++ [m Map.! b], m)
              | otherwise      = (s ++ [id], mNew)
              where id = Map.size m
                    mNew = Map.insert b id m