{-# 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