{-# OPTIONS_GHC -Wall #-} -------------------------------------------------------------------------------- -- | -- Module : HarmTrace.Base.MusicRep -- Copyright : (c) 2012--2016, Chordify BV -- License : LGPL-3 -- -- Maintainer : haskelldevelopers@chordify.net -- Stability : experimental -- Portability : non-portable -- -- Summary: Analyses and transforms musical chords -------------------------------------------------------------------------------- module HarmTrace.Base.Chord.Analysis ( -- * Analysis -- ** Triads and Sevenths analyseTriad , analyseTetra , toTriad , toMajMinChord -- ** Chord components , Third (..) , Fifth (..) , Sevth (..) , analyseThird , analyseFifth , analyseSevth -- ** Misc , toMode , toMajMin , toClassType , isSus2 , isSus4 -- * Scale degree transposition , transposeRoot , transposeCL , transposeSD , toChordDegree , toScaleDegree , intervalToPitch , pitchToInterval , toChord ) where import HarmTrace.Base.Chord.Datatypes import HarmTrace.Base.Chord.PitchClass import HarmTrace.Base.Chord.Intervals import HarmTrace.Base.Chord.Internal import Data.IntSet ( IntSet, toAscList, member, (\\) ) -------------------------------------------------------------------------------- -- Transformation and analysis of chords -------------------------------------------------------------------------------- -- | Returns the 'ClassType' given a 'Chord'. This function uses -- 'analyseDegClassType' to analyse a chord and derive the 'ClassType' toClassType :: Chord a -> ClassType toClassType NoChord = NoClass toClassType UndefChord = NoClass toClassType (Chord _r sh [] _b) = shToClassType sh -- no additions -- combine the degrees and analyse them. N.B., also NoAdd degrees are resolved toClassType c = analyseDegClassType . toIntSet $ c -- | Analyses a degree list and returns 'MajTriad', 'MinTriad' or 'NoTriad' if -- the degrees make a chord a major, minor, or no triad, respectively. analyseDegClassType :: IntSet -> ClassType analyseDegClassType degs = case (analyseThird degs, analyseFifth degs, analyseSevth degs) of -- Triads (MinThird, DimFifth , DimSev) -> DimClass (MajThird, _ , MinSev) -> DomClass (_ , AugFifth , _ ) -> DomClass (MajThird, DimFifth , _ ) -> DomClass (MajThird, _ , _ ) -> MajClass (MinThird, PerfFifth, _ ) -> MinClass (MinThird, _ , _ ) -> MinClass (NoThird, _ , _ ) -> NoClass -- | Categorises a 'Shorthand' into a 'ClassType'. shToClassType :: Shorthand -> ClassType shToClassType Maj = MajClass shToClassType Min = MinClass shToClassType Dim = DimClass shToClassType Aug = DomClass shToClassType Maj7 = MajClass shToClassType Min7 = MinClass shToClassType Sev = DomClass shToClassType Dim7 = DimClass shToClassType HDim7 = MinClass shToClassType MinMaj7 = MinClass shToClassType Aug7 = DomClass shToClassType Maj6 = MajClass shToClassType Min6 = MinClass shToClassType Nin = DomClass shToClassType Maj9 = MajClass shToClassType Min9 = MinClass shToClassType Five = NoClass shToClassType Sus2 = NoClass shToClassType Sus4 = NoClass shToClassType SevSus4 = NoClass shToClassType None = NoClass -- additional Billboard shorthands shToClassType Min11 = MinClass shToClassType Eleven = DomClass shToClassType Min13 = MinClass shToClassType Maj13 = MajClass shToClassType Thirteen = DomClass -- should not be exported, used only in toTriad -- | A 'Third' can by major, minor or absent data Third = MajThird | MinThird | NoThird deriving (Eq, Show) -- | A 'Fifth' can be perfect, diminished, augmented or absent data Fifth = DimFifth | PerfFifth | AugFifth | NoFifth deriving (Eq, Show) -- | A seventh can be major, minor, diminished, or absent data Sevth = DimSev | MinSev | MajSev | NoSev deriving (Eq, Show) triadToSh :: Triad -> Shorthand triadToSh t = case t of MajTriad -> Maj MinTriad -> Min AugTriad -> Aug DimTriad -> Dim NoTriad -> None -- | Analyses the structure of an 'IntSet' and returns an appropriate -- 'ShortHand', if possible analyseTetra :: IntSet -> Shorthand analyseTetra is = case (analyseTriad is, analyseSevth is) of (MajTriad, MinSev) -> Sev (MajTriad, MajSev) -> Maj7 (MinTriad, MinSev) -> Min7 (MinTriad, MajSev) -> MinMaj7 (DimTriad, MinSev) -> HDim7 (DimTriad, DimSev) -> Dim7 (AugTriad, MinSev) -> Aug7 (t , NoSev ) -> triadToSh t _ -> None -- | Takes a 'Chord' and determines the 'Triad' -- -- >>> toTriad (Chord (Note Nat C) Min [NoAdd (Note Fl I3),Add (Note Nat I3)] 0 0) -- maj -- -- >>> toTriad (Chord (Note Nat C) HDim7 [Add (Note Sh I11)] 0 0) -- dim -- -- >>> toTriad (Chord (Note Nat C) Min [NoAdd (Note Fl I3)] 0 0) -- NoTriad -- -- N.B. 'toTriad' throws an error when applied to a 'NoChord' or 'UndefChord'. toTriad :: Chord a -> Triad toTriad NoChord = error "toTriad: a NoChord has no triad to analyse" toTriad UndefChord = error "toTriad: a UndefChord has no triad to analyse" toTriad (Chord _r sh [] _b) = shToTriad sh -- there are no additions -- combine the degrees and analyse them. N.B., also NoAdd degrees are resolved toTriad c = analyseTriad . toIntSet $ c -- | Analyses a degree list and returns 'MajTriad', 'MinTriad' or 'NoTriad' if -- the degrees make a chord a major, minor, or no triad, respectively. analyseTriad :: IntSet -> Triad analyseTriad is = case (analyseThird is, analyseFifth is) of (MajThird, PerfFifth) -> MajTriad (MajThird, AugFifth ) -> AugTriad (MajThird, DimFifth ) -> NoTriad (MinThird, PerfFifth) -> MinTriad (MinThird, AugFifth ) -> NoTriad (MinThird, DimFifth ) -> DimTriad (NoThird, _ ) -> NoTriad (_ , NoFifth ) -> NoTriad -- | analyses the third in a degree list analyseThird :: IntSet -> Third analyseThird is | member 4 is = MajThird | member 3 is = MinThird | otherwise = NoThird -- | analyses the fifth in a degree list analyseFifth :: IntSet -> Fifth analyseFifth is | member 7 is = PerfFifth | member 6 is = DimFifth | member 8 is = AugFifth | otherwise = NoFifth -- | analyses the fifth in a degree list analyseSevth :: IntSet -> Sevth analyseSevth is | member 10 is = MinSev | member 11 is = MajSev | member 9 is = DimSev | otherwise = NoSev -- | Converts a 'Shorthand' to a 'Triad' -- N.B. this function should not be exported because the shorthand alone cannot -- determine the triad shToTriad :: Shorthand -> Triad shToTriad Maj = MajTriad shToTriad Min = MinTriad shToTriad Dim = DimTriad shToTriad Aug = AugTriad shToTriad Maj7 = MajTriad shToTriad Min7 = MinTriad shToTriad Sev = MajTriad shToTriad Dim7 = DimTriad shToTriad HDim7 = DimTriad shToTriad MinMaj7 = MinTriad shToTriad Aug7 = AugTriad shToTriad Maj6 = MajTriad shToTriad Min6 = MinTriad shToTriad Nin = MajTriad shToTriad Maj9 = MajTriad shToTriad Min9 = MinTriad shToTriad Five = NoTriad shToTriad Sus2 = NoTriad shToTriad Sus4 = NoTriad shToTriad SevSus4 = NoTriad shToTriad None = NoTriad -- additional Billboard shorthands shToTriad Min11 = MinTriad shToTriad Eleven = MajTriad shToTriad Min13 = MinTriad shToTriad Maj13 = MajTriad shToTriad Thirteen = MajTriad -- | Converts a 'Shorthand' to a 'Mode' toMode :: Triad -> Mode toMode MajTriad = MajMode toMode MinTriad = MinMode toMode t = error ( "HarmTrace.Base.MusicRep.toMode: cannot convert " ++ " triad to mode: " ++ show t) -- | Converts a 'Shorthand' to either a 'MajClass', 'MinClass' or 'NoClass' -- 'ClassType'. toMajMin :: Triad -> ClassType toMajMin MajTriad = MajClass toMajMin MinTriad = MinClass toMajMin AugTriad = MajClass toMajMin DimTriad = MinClass toMajMin NoTriad = NoClass -- | applies 'toMajMin' to a 'Chord', in case there is no triad, e.g. -- @:sus4@ or @:sus2@, an 'UndefChord' is returned. Also, chord -- additions are removed. 'NoChord's and 'UndefChord's are returned untouched. toMajMinChord :: ChordLabel -> ChordLabel toMajMinChord NoChord = NoChord toMajMinChord UndefChord = UndefChord toMajMinChord c@(Chord r _ _ b) = case toMajMin (toTriad c) of MajClass -> Chord r Maj [] b MinClass -> Chord r Min [] b NoClass -> UndefChord -- catch all: cannot happen, see toMajMin _ -> error ("HarmTrace.Base.MusicRep.toMajMinChord" ++ " unexpected chord " ++ show c) -- | Returns True if the 'ChordLabel' has a major second, no third, -- and no fourth. isSus2 :: ChordLabel -> Bool isSus2 c = let is = toIntSet c in member 2 is && not (member 3 is) && not (member 4 is) && not (member 5 is) -- | Returns True if the 'ChordLabel' has a no major second, no third, -- but has a fourth. isSus4 :: ChordLabel -> Bool isSus4 c = let is = toIntSet c in not (member 2 is) && not (member 3 is) && not (member 4 is) && (member 5 is) -------------------------------------------------------------------------------- -- Value Level Scale Degree Transposition -------------------------------------------------------------------------------- -- Chord root shorthand degrees location duration -- | Given a 'Key', calculates the the 'ChordDegree' (i.e. relative, -- 'ScaleDegree' based 'Chord') for an absolute 'ChordLabel' using -- 'toScaleDegree'. toChordDegree :: Key -> ChordLabel -> ChordDegree toChordDegree k (Chord r sh a b) = Chord (toScaleDegree k r) sh a b toChordDegree _ c = error("HarmTrace.Base.Chord.Analysis: cannot create scale degree for " ++ show c) -- | Transformes a absolute 'Root' 'Note' into a relative 'ScaleDegree', given -- a 'Key'. toScaleDegree :: Key -> Root -> ScaleDegree -- toScaleDegree _ n@(Note _ N) = -- error ("HarmTrace.Base.MusicRep.toScaleDegree: cannot transpose " ++ show n) toScaleDegree (Key kr _) cr = -- Note Nat I scaleDegrees!!(((toPitchClass cr) - (toPitchClass kr)) `mod` 12) -- | Transposes a Root with a 'Int' semitones up transposeRoot :: Root -> Int -> Root transposeRoot = transpose roots -- | Transposes a ChordLabel with a 'Int' semitones up transposeCL :: ChordLabel -> Int -> ChordLabel transposeCL c sem = fmap (flip transposeRoot sem) c -- | Transposes a scale degree with 'Int' semitones up transposeSD :: ScaleDegree -> Int -> ScaleDegree transposeSD = transpose scaleDegrees transpose :: Diatonic a => [Note a] -> Note a -> Int -> Note a transpose ns n sem = ns !! ((sem + (toPitchClass n)) `mod` 12) -- | Similar to 'toScaleDegree', an interval is transformed into an absolute -- 'Root' pitch, given another 'Root' that serves as a basis. -- -- >>> intervalToPitch (Note Sh G) (Note Fl I13) -- >>> E -- -- >>> intervalToPitch (Note Nat C) (Note Sh I11) -- >>> F# -- intervalToPitch :: Root -> Interval -> Root intervalToPitch r = pcToRoot . intValToPitchClss r -- | The inverse of 'intervalToPitch' pitchToInterval :: Root -> Root -> Interval pitchToInterval ra rb = intervals !! ((toPitchClass rb - toPitchClass ra) `mod` 12) -- | Given an 'IntSet' (Interval Set), a 'Root' 'Note' and an optional -- bass 'Interval', returns a 'Chord' toChord :: Root -> IntSet -> Interval -> Chord Root toChord r is mi = Chord r sh add mi where add = map (Add . icToInterval) $ toAscList (is \\ shToIntSet sh) sh = analyseTetra is