{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}

-- | This module implements scale degrees.

module Music.Diatonic.Degree (
    Degree(
      First,Second,Third,Fourth,Fifth,Sixth,Seventh
    ), 
    Deg(..), degree, from,
    second, third, fourth, fifth, sixth, seventh,
    tonic, supertonic, mediant, subdominant, dominant, submediant, subtonic, leadingTone
  ) where


import Music.Diatonic.Note
import Music.Diatonic.Interval
import Music.Diatonic.Equivalence
import Control.Monad (mplus)
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 = fromNote . f . toNote
  notePlus f d1 d2 = f (toNote d1) (toNote d2)


instance Equiv Degree where 
  equiv d1 d2 = notePlus equiv d1 d2


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 'First' 'Degree' of s.
  first :: s -> n



-- | Assuming n1 as the tonic, returns the 'Degree' of n2.
degree :: Note -> Note -> Degree
degree n1 n2 = head . drop (abs d) . iterate f $ base
  where
    i = distance n1 $ n2
    (stp, smt) = (steps i, semitones i)
    base = start stp
    start 0 = First ; start 1 = Second ; start 2 = Third ; start 3 = Fourth
    start 4 = Fifth ; start 5 = Sixth ; start 6 = Seventh
    d = smt - (semitones . notePlus distance First $ base)
    f = if d < 0 then (lower $#) else (raise $#)


-- | Returns the 'Note' that corresponds to 'Degree' d in a scale where the specified 'Note' is the 'tonic'.
from :: Degree -> Note -> Note
from d n = above i n
  where i = notePlus distance First $ d


-- | Returns the 'Second' 'Degree' of s.
second :: Deg s n => s -> Maybe n
second = findVariant Second 


-- | Returns the 'Third' 'Degree' of s.
third :: Deg s n => s -> Maybe n
third = findVariant Third


-- | Returns the 'Fourth' 'Degree' of s.
fourth :: Deg s n => s -> Maybe n
fourth = findVariant Fourth


-- | Returns the 'Fifth' 'Degree' of s.
fifth :: Deg s n => s -> Maybe n
fifth = findVariant Fifth


-- | Returns the 'Sixth' 'Degree' of s.
sixth :: Deg s n => s -> Maybe n
sixth = findVariant Sixth


-- | Returns the 'Seventh' 'Degree' of s.
seventh :: Deg s n => s -> Maybe n
seventh = findVariant Seventh


-- | An alias for 'first'.
tonic :: Deg s n => s -> n
tonic = first


-- | An alias for 'second'.
supertonic :: Deg s n => s -> Maybe n
supertonic = second


-- | An alias for 'third'.
mediant :: Deg s n => s -> Maybe n
mediant = third


-- | An alias for 'fourth'.
subdominant :: Deg s n => s -> Maybe n
subdominant = fourth


-- | An alias for 'fifth'.
dominant :: Deg s n => s -> Maybe n
dominant = fifth


-- | An alias for 'sixth'.
submediant :: Deg s n => s -> Maybe n
submediant = sixth


-- | An alias for 'seventh', but only if the 'Seventh' is a 'Min7th' above the 'tonic'.
subtonic :: (Deg s n, Nte n) => s -> Maybe n
subtonic s = do
  let ton = tonic s
  svn <- seventh s
  if notePlus distance ton svn == Min7th 
    then return svn 
    else Nothing


-- | An alias for 'seventh', but only if the 'Seventh' is a 'Maj7th' above the 'tonic'.
leadingTone :: (Deg s n, Nte n) => s -> Maybe n
leadingTone s = seventh s >>= \svn -> (subtonic s `mplus` return svn)
  

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


toNote :: Degree -> Note
toNote First   = C ; toNote Second = D ; toNote Third = E
toNote Fourth  = F ; toNote Fifth  = G ; toNote Sixth = A
toNote Seventh = B
toNote (Degree Sharp d) = sharp . toNote $ d
toNote (Degree Flat d)  = flat . toNote $ d


fromNote :: Note -> Degree
fromNote C = First  ; fromNote D = Second ; fromNote E = Third
fromNote F = Fourth ; fromNote G = Fifth  ; fromNote A = Sixth
fromNote B = Seventh
fromNote n | accidental n == Sharp = Degree Sharp . fromNote . lower $ n
fromNote n | accidental n == Flat  = Degree Flat . fromNote . raise $ n