module CsoundExpr.Translator.InstrOrder
    (instrOrderInfo,
     setInstrIds,
     instrIds)
where

import Data.List
import Data.Function
import qualified Data.Map as Map

import Control.Monad.State

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


import Debug.Trace
debug x = trace (show x) x

setInstrIds :: [Id] -> [(Instr, [Note])] ->
               ([(Id, Instr)], [(Id, [Note])])
setInstrIds ids qs = unzip [((id, q1), (id, q2)) | (id, (q1, q2)) <- xs]
    where xs  = sortBy (compare `on` fst) $ zip ids qs 


instrOrderInfo :: InstrOrder -> [Instr] -> InstrOrderInfo
instrOrderInfo xs qs = Map.fromList $ zip (map fst ps') ids
    where ids = resolveCollisions $ map snd ps'
          ps' = sortBy (compare `on` snd) $ 
                fst $ runState (mapM (f xs) qs) (startId + length xs)


f :: InstrOrder -> Instr -> State Id (Instr, Id)
f xs q = state $ \s -> case findIndex ((liftPredicateToList equalStructureByParams) q) xs of
                         (Just i) -> ((q, startId + i), s)
                         Nothing  -> ((q, s), s + 1)



resolveCollisions :: [Int] -> [Int]
resolveCollisions xs = fst $ runState (mapM f xs) (head xs - 1, 0)
    where f x = state $ \(prev, shift) -> 
                if x + shift == prev
                then (x + shift + 1, (x + shift + 1, shift + 1))
                else (x + shift,     (x + shift    , shift))
                

startId :: Id
startId = 33


instrIds :: InstrOrderInfo -> [Instr] -> [Id]
instrIds f = map (f Map.!)