module Music.Diatonic.Harmony (
Harmony,
harmony, harmony7, chords
) where
import Music.Diatonic.Note
import Music.Diatonic.Interval
import Music.Diatonic.Scale
import Music.Diatonic.Quality
import Music.Diatonic.Degree
import Music.Diatonic.Chord
import Data.Char (toLower)
data HarmonyType = Triads | Sevenths
deriving (Eq, Show)
data Harmony = Harmony HarmonyType Scale
deriving (Eq)
instance Show Harmony where
show (Harmony Triads s) = show s ++ " Harmony"
show (Harmony Sevenths s) = show s ++ " Sevenths Harmony"
instance Deg Harmony Chord where
tonic = head . chords
degrees h = map (\c -> (intervalDegree . distance (tonic . scale $ h) . root $ c, c)) (chords h)
showDegree h d = findDegree h d >>= return . showRoman d
instance Qual Harmony where
quality (Harmony t s) = quality s
instance Scl Harmony where
scale (Harmony t s) = s
showRoman :: Degree -> Chord -> String
showRoman d c = prefix ++ roman n ++ suffix
where (n:prefix) = reverse . show $ d
suffix = drop (length . show . root $ c) (show c)
roman '1' = "I"
roman '2' = "II"
roman '3' = "III"
roman '4' = "IV"
roman '5' = "V"
roman '6' = "VI"
roman '7' = "VII"
harmony :: Scale -> Harmony
harmony s = Harmony Triads s
harmony7 :: Scale -> Harmony
harmony7 s = Harmony Sevenths s
chords :: Harmony -> [Chord]
chords (Harmony t s) = zipWith ($) (cs t . quality $ s) (notes s)
where cs Triads Major =
[majorChord, minorChord, minorChord, majorChord, majorChord, minorChord, diminishedChord]
cs Triads Minor | s == (minorScale . tonic $ s) =
[minorChord, diminishedChord, majorChord, minorChord, minorChord, majorChord, majorChord]
cs Triads Minor | s == (minorHarmonicScale . tonic $ s) =
[minorChord, diminishedChord, augmentedChord, minorChord, majorChord, majorChord, diminishedChord]
cs Triads Minor | s == (minorMelodicScale . tonic $ s) =
[minorChord, minorChord, augmentedChord, majorChord, majorChord, diminishedChord, diminishedChord]
cs Sevenths Major =
[major7thChord, minor7thChord, minor7thChord, major7thChord, dominant7thChord, minor7thChord, minor7thFlat5thChord]
cs Sevenths Minor | s == (minorScale . tonic $ s) =
[minor7thChord, minor7thFlat5thChord, major7thChord, minor7thChord, minor7thChord, major7thChord, dominant7thChord]
cs Sevenths Minor | s == (minorHarmonicScale . tonic $ s) =
[minorMajor7thChord, minor7thFlat5thChord, augmentedMajor7thChord, minor7thChord, dominant7thChord, major7thChord, diminished7thChord]
cs Sevenths Minor | s == (minorMelodicScale . tonic $ s) =
[minorMajor7thChord, minor7thChord, augmentedMajor7thChord, dominant7thChord, dominant7thChord, minor7thFlat5thChord, minor7thFlat5thChord]