{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}

-- | This module implements scale degrees.

module Music.Diatonic.Degree (
    Degree(
      First,Second,Third,Fourth,Fifth,Sixth,Seventh
    ), Deg(..),
    intervalDegree, degreeInterval
  ) where


import Music.Diatonic.Note
import Music.Diatonic.Interval
import Music.Diatonic.Quality
import List (find)


-- | Use these constructors to create 'Degree's. To alter them, use the 'flat' or 'sharp' functions along
-- with the '$#' operator.
data Degree = First | Second | Third | Fourth | Fifth | Sixth | Seventh | Degree Accidental Degree
              deriving (Eq, Ord)

instance Show Degree where
  show First = "1" ; show Second = "2" ; show Third = "3" ; show Fourth = "4" 
  show Fifth = "5" ; show Sixth = "6" ; show Seventh = "7" 
  show (Degree a d) = show a ++ show d

instance Nte Degree where
  noteMap f = intervalDegree . distance C . f . (\d -> degreeInterval d `above` C)


class Eq n => Deg s n | s -> n where
  -- | Returns all the naturally occuring 'Degree's in s, along with the element that 
  -- corresponds to the 'Degree'.
  degrees :: s -> [(Degree, n)]

  -- | Returns the degree of n in s.
  degree :: s -> n -> Maybe Degree
  degree s n = find (\(d, n') -> n == n') (degrees s) >>= return . fst

  -- | Returns the n in s that correcponds to the specified 'Degree'.
  findDegree :: s -> Degree -> Maybe n
  findDegree s d = find (\(d', n) -> d == d') (degrees s) >>= return . snd

  -- | Returns a string representation of the 'Degree' within the context of s.
  showDegree :: s -> Degree -> Maybe String 
  showDegree s d = findDegree s d >> (return . show $ d)

  -- | Returns the tonic of s.
  tonic :: s -> n

  -- | Alias for tonic.
  first :: s -> n
  first = tonic

  supertonic, mediant, subdominant, dominant, submediant, subtonic, leadingTone :: s -> Maybe n
  second, third, fourth, fifth, sixth, seventh :: s -> Maybe n
  supertonic = findVariant Second
  second = supertonic
  mediant = findVariant Third
  third = mediant
  subdominant = findVariant Fourth
  fourth = subdominant
  dominant = findVariant Fifth
  fifth = dominant
  submediant = findVariant Sixth
  sixth = submediant
  subtonic s = findDegree s $ flat $# Seventh
  leadingTone s = findDegree s Seventh
  seventh = findVariant Seventh


findVariant :: Deg s n => Degree -> s -> Maybe n
findVariant d s = (find (\(d', n) -> natural $# d' == d) . degrees $ s) >>= return . snd


-- | Returns the 'Degree' that corresponds to the specified 'Interval'.
--
-- > intervalDegree Maj3rd == Third
-- > intervalDegree Min3rd == (flat $# Third)
intervalDegree :: Interval -> Degree
intervalDegree Unison  = First
intervalDegree Maj2nd  = Second
intervalDegree Min2nd  = Degree Flat Second
intervalDegree Maj3rd  = Third
intervalDegree Min3rd  = Degree Flat Third
intervalDegree Perf4th = Fourth
intervalDegree Perf5th = Fifth
intervalDegree Maj6th  = Sixth
intervalDegree Min6th  = Degree Flat Sixth
intervalDegree Maj7th  = Seventh
intervalDegree Min7th  = Degree Flat Seventh
intervalDegree i | quality i == Augmented  = Degree Sharp . intervalDegree . diminish $ i
intervalDegree i | quality i == Diminished = Degree Flat . intervalDegree . augment $ i


-- | Returns the 'Interval' that corresponds to the specified 'Degree'.
--
-- > degreeInterval Third == Maj3rd
-- > degreeInterval (flat $# Third) == Min3rd
degreeInterval :: Degree -> Interval
degreeInterval First                 = Unison
degreeInterval Second                = Maj2nd
degreeInterval (Degree Flat Second)  = Min2nd
degreeInterval Third                 = Maj3rd
degreeInterval (Degree Flat Third)   = Min3rd 
degreeInterval Fourth                = Perf4th 
degreeInterval Fifth                 = Perf5th
degreeInterval Sixth                 = Maj6th
degreeInterval (Degree Flat Sixth)   = Min6th
degreeInterval Seventh               = Maj7th
degreeInterval (Degree Flat Seventh) = Min7th
degreeInterval (Degree Sharp d) = augment . degreeInterval $ d
degreeInterval (Degree Flat d)  = diminish . degreeInterval $ d