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)
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
degrees :: s -> [(Degree, n)]
degree :: s -> n -> Maybe Degree
degree s n = find (\(d, n') -> n == n') (degrees s) >>= return . fst
findDegree :: s -> Degree -> Maybe n
findDegree s d = find (\(d', n) -> d == d') (degrees s) >>= return . snd
showDegree :: s -> Degree -> Maybe String
showDegree s d = findDegree s d >> (return . show $ d)
tonic :: s -> n
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
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
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