module CsoundExpr.Translator.Score
    (foldScores)
where

import Data.List
import Data.Function


import Temporal.Media(EventList(..))

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

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

type IsStringPfield = Bool


foldScores :: EventList Dur 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 :: EventList Dur 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 (EventList _ xs) = xs


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



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 :: [(NodeId, [ValueId])] -> ([(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 . head) $
                    groupBy ((==) `on` fst) $
                    zip ids (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