module HarmTrace.Base.Chord.Intervals (
  
    icToInterval
  , toIntervalClss
  
  
  , toIntSet
  
  , addToIntSet
  , shToIntSet
  ) where
import HarmTrace.Base.Chord.Datatypes
import HarmTrace.Base.Chord.Internal
import Data.List                  ( partition )
import Data.IntSet                ( IntSet, fromList, union, insert, singleton
                                  , empty, (\\) )
icToInterval :: Int -> Interval
icToInterval i
  | 0 <= i && i <= 21 = intervals !! i
  | otherwise         = error ("HarmTrace.Base.MusicRep.toInterval " ++
                               "invalid pitch class: " ++ show i)
toIntervalClss :: Interval -> Int
toIntervalClss n@(Note m i) =
  
  let ic = ([0,2,4,5,7,9,11,12,14,16,17,19,21] !! (fromEnum i)) + modToInt m
  in  if ic >= 0 then ic
                 else error ("HarmTrace.Base.MusicRep.toIntervalClss: no "
                          ++ "interval class for " ++ show n)
toIntSet :: Chord a -> IntSet
toIntSet (Chord  _r sh [] _b) = shToIntSet sh
toIntSet (Chord  _r sh a  _b) = let (add, rm) = partition isAddition a
                                in (shToIntSet sh `union` toSet add) \\ toSet rm
toIntSet _ = error ("HarmTrace.Base.MusicRep.toIntValList: cannot create" ++
                        "interval list for N or X")
addToIntSet :: [Addition] -> IntSet
addToIntSet add = toSet adds \\ toSet remv
  where (adds, remv) = partition isAddition add
toSet :: [Addition] -> IntSet
toSet = fromList . map (toIntervalClss . getInt) where
  getInt :: Addition -> Interval
  getInt (NoAdd i) = i
  getInt (Add   i) = i
shToIntSet :: Shorthand -> IntSet
shToIntSet Maj     = fromList [4,7]              
shToIntSet Min     = fromList [3,7]              
shToIntSet Dim     = fromList [3,6]              
shToIntSet Aug     = fromList [4,8]              
shToIntSet Maj7    = insert 11 (shToIntSet Maj)  
shToIntSet Min7    = insert 10 (shToIntSet Min)  
shToIntSet Sev     = insert 10 (shToIntSet Maj)  
shToIntSet Dim7    = insert  9 (shToIntSet Dim)  
shToIntSet HDim7   = insert 10 (shToIntSet Dim)  
shToIntSet MinMaj7 = insert 11 (shToIntSet Min)  
shToIntSet Aug7    = insert 10 (shToIntSet Aug)  
shToIntSet Maj6    = insert  9 (shToIntSet Maj)  
shToIntSet Min6    = insert  8 (shToIntSet Min ) 
shToIntSet Nin     = insert 14 (shToIntSet Sev ) 
shToIntSet Maj9    = insert 14 (shToIntSet Maj7) 
shToIntSet Min9    = insert 14 (shToIntSet Min7) 
shToIntSet Five    = singleton 7                 
shToIntSet Sus2    = fromList [2,7]              
shToIntSet Sus4    = fromList [5,7]              
shToIntSet SevSus4 = insert 10 (shToIntSet Sus4) 
shToIntSet None    = empty
shToIntSet Min11   = insert 17 (shToIntSet Min9  ) 
shToIntSet Eleven  = insert 17 (shToIntSet Nin   ) 
shToIntSet Min13   = insert 21 (shToIntSet Min11 ) 
shToIntSet Maj13   = insert 21 (shToIntSet Maj9  ) 
shToIntSet Thirteen= insert 21 (shToIntSet Eleven)