{-# LANGUAGE MultiParamTypeClasses #-}

-- | The Scale module implements scales.
module Music.Diatonic.Scale (
  Scale, Scl(..),
    majorScale, minorScale, majorPentatonicScale, minorPentatonicScale, minorHarmonicScale, minorMelodicScale,
    tetrachord
  ) where 
 

import Music.Diatonic.Note
import Music.Diatonic.Interval
import Music.Diatonic.Quality
import Music.Diatonic.Degree


data Scale = Diatonic Quality Note 
           | Pentatonic Quality Note
           | Harmonic Note
           | Melodic Note
             deriving (Eq)

class Scl a where 
  scale :: a -> Scale


instance Nte Scale where
  noteMap f (Diatonic Major n) = majorScale . f $ n
  noteMap f (Diatonic Minor n) = minorScale . f $ n
  noteMap f (Pentatonic Major n) = majorPentatonicScale . f $ n
  noteMap f (Pentatonic Minor n) = minorPentatonicScale . f $ n
  noteMap f (Harmonic n) = minorHarmonicScale . f $ n
  noteMap f (Melodic n) = minorMelodicScale . f $ n

instance Nts Scale where
  notes (Diatonic Major n) = init $ tc1 ++ tc2
    where tc1 = tetrachord n
          tc2 = tetrachord (Maj2nd `above` last tc1)
  notes (Diatonic Minor n) = zipWith ($) [id, id, lower, id, id, lower, lower] (notes . majorScale $ n)
  notes (Pentatonic Major n) = concat . zipWith ($) [return, return, return, const [], return, return, const []] $ (notes . majorScale $ n)
  notes (Pentatonic Minor n) = concat . zipWith ($) [return, const [], return, return, return, const [], return] $ (notes . minorScale $ n)
  notes (Harmonic n) = zipWith ($) [id, id, id, id, id, id, raise] $ (notes . minorScale $ n)
  notes (Melodic n) = zipWith ($) [id, id, id, id, id, raise, raise] $ (notes . minorScale $ n)

instance Qual Scale where
  quality (Diatonic q _) = q
  quality (Pentatonic q _) = q
  quality (Harmonic _) = Minor
  quality (Melodic _) = Minor

instance Show Scale where
  show s@(Harmonic n) = (show n) ++ "m (harmonic)"
  show s@(Melodic n) = (show n) ++ "m (melodic)"
  show s@(Pentatonic q n) = (show n) ++ (if quality s == Minor then "m" else "") ++ " (pentatonic)"
  show s@(Diatonic q n) = (show n) ++ (if quality s == Minor then "m" else "")
 

instance Deg Scale Note where
  tonic (Diatonic q t) = t
  tonic (Pentatonic q t) = t
  tonic (Harmonic t) = t
  tonic (Melodic t) = t
  degrees s = map (\n -> (intervalDegree . distance (tonic s) $ n, n)) ns
    where ns = notes s

  -- | For a given 'Scale' any 'Note' has a corresponding degree in the scale.
  -- Therefore this instance never returns 'Nothing'.
  degree s n = Just . intervalDegree . distance (tonic s) $ n
  -- | For a given 'Scale' any 'Note' has a corresponding degree in the scale.
  -- Therefore this instance never returns 'Nothing'.
  findDegree s d = Just . above (degreeInterval d) . tonic $ s



-- | Creates a 'Major' diatonic 'Scale' using the given 'Note' as the tonic.
majorScale :: Note -> Scale
majorScale = Diatonic Major 


-- | Creates a 'Minor' diatonic 'Scale' using the given 'Note' as the tonic.
minorScale :: Note -> Scale
minorScale = Diatonic Minor


-- | Creates a 'Major' pentatonic 'Scale' using the given 'Note' as the tonic.
majorPentatonicScale :: Note -> Scale
majorPentatonicScale = Pentatonic Major


-- | Creates a 'Minor' pentatonic 'Scale' using the given 'Note' as the tonic.
minorPentatonicScale :: Note -> Scale
minorPentatonicScale = Pentatonic Minor


-- | Creates a 'Minor' harmonic 'Scale' using the given 'Note' as the tonic.
minorHarmonicScale :: Note -> Scale
minorHarmonicScale = Harmonic


-- | Creates a 'Minor' melodic 'Scale' using the given 'Note' as the tonic.
minorMelodicScale :: Note -> Scale
minorMelodicScale = Melodic


-- | Returns a tetrachord using the given 'Note' as the starting note.
--
-- > tetrachord G == [G,A,B,C]
tetrachord :: Note -> [Note]
tetrachord n = scanl (\n i -> i `above` n) n [Maj2nd, Maj2nd, Min2nd]