HarmTrace-Base 1.1.0.1 → 1.1.0.2
raw patch · 7 files changed
+1448/−1448 lines, 7 filesdep ~basedep ~uu-parsinglibsetup-changedPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, uu-parsinglib
API changes (from Hackage documentation)
Files
- HarmTrace-Base.cabal +33/−33
- LICENSE +165/−165
- Setup.hs +2/−2
- src/HarmTrace/Base/ChordTokenizer.hs +194/−194
- src/HarmTrace/Base/MusicRep.hs +656/−656
- src/HarmTrace/Base/MusicTime.hs +308/−308
- src/HarmTrace/Base/Parsing.hs +90/−90
HarmTrace-Base.cabal view
@@ -1,33 +1,33 @@-name: HarmTrace-Base -version: 1.1.0.1 -synopsis: Parsing and unambiguously representing musical chords. -description: HarmTrace: Harmony Analysis and Retrieval of Music - with Type-level Representations of Abstract - Chords Entities - . - We present HarmTrace-Base, a library for parsing and - unambiguously representing musical chords. - -copyright: (c) 2012--2013 W. Bas de Haas and Jose Pedro Magalhaes -license: LGPL-3 -license-file: LICENSE -author: W. Bas de Haas and Jose Pedro Magalhaes -maintainer: bas@chordify.net, dreixel@chordify.net - -category: Music -build-type: Simple -tested-with: GHC == 7.4.1, GHC == 7.6.1 -cabal-version: >=1.8 - -library - exposed-modules: HarmTrace.Base.Parsing, HarmTrace.Base.MusicTime, - HarmTrace.Base.MusicRep, HarmTrace.Base.ChordTokenizer - - hs-source-dirs: src - - build-depends: base >= 4.4 && < 4.8, uu-parsinglib ==2.7.4.*, - ListLike >=3.1, binary >= 0.6.4, ghc-prim >= 0.2 - - - ghc-options: -Wall - -O2 +name: HarmTrace-Base+version: 1.1.0.2+synopsis: Parsing and unambiguously representing musical chords.+description: HarmTrace: Harmony Analysis and Retrieval of Music + with Type-level Representations of Abstract+ Chords Entities+ .+ We present HarmTrace-Base, a library for parsing and + unambiguously representing musical chords.++copyright: (c) 2012--2013 W. Bas de Haas and Jose Pedro Magalhaes+license: LGPL-3+license-file: LICENSE+author: W. Bas de Haas and Jose Pedro Magalhaes+maintainer: bas@chordify.net, dreixel@chordify.net ++category: Music+build-type: Simple+tested-with: GHC == 7.4.1, GHC == 7.6.1+cabal-version: >=1.8++library+ exposed-modules: HarmTrace.Base.Parsing, HarmTrace.Base.MusicTime, + HarmTrace.Base.MusicRep, HarmTrace.Base.ChordTokenizer+ + hs-source-dirs: src + + build-depends: base >= 4.4 && < 4.8, uu-parsinglib >=2.7.4, + ListLike >=3.1, binary >= 0.6.4, ghc-prim >= 0.2+ + + ghc-options: -Wall+ -O2
LICENSE view
@@ -1,165 +1,165 @@- GNU LESSER GENERAL PUBLIC LICENSE - Version 3, 29 June 2007 - - Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/> - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - - This version of the GNU Lesser General Public License incorporates -the terms and conditions of version 3 of the GNU General Public -License, supplemented by the additional permissions listed below. - - 0. Additional Definitions. - - As used herein, "this License" refers to version 3 of the GNU Lesser -General Public License, and the "GNU GPL" refers to version 3 of the GNU -General Public License. - - "The Library" refers to a covered work governed by this License, -other than an Application or a Combined Work as defined below. - - An "Application" is any work that makes use of an interface provided -by the Library, but which is not otherwise based on the Library. -Defining a subclass of a class defined by the Library is deemed a mode -of using an interface provided by the Library. - - A "Combined Work" is a work produced by combining or linking an -Application with the Library. The particular version of the Library -with which the Combined Work was made is also called the "Linked -Version". - - The "Minimal Corresponding Source" for a Combined Work means the -Corresponding Source for the Combined Work, excluding any source code -for portions of the Combined Work that, considered in isolation, are -based on the Application, and not on the Linked Version. - - The "Corresponding Application Code" for a Combined Work means the -object code and/or source code for the Application, including any data -and utility programs needed for reproducing the Combined Work from the -Application, but excluding the System Libraries of the Combined Work. - - 1. Exception to Section 3 of the GNU GPL. - - You may convey a covered work under sections 3 and 4 of this License -without being bound by section 3 of the GNU GPL. - - 2. Conveying Modified Versions. - - If you modify a copy of the Library, and, in your modifications, a -facility refers to a function or data to be supplied by an Application -that uses the facility (other than as an argument passed when the -facility is invoked), then you may convey a copy of the modified -version: - - a) under this License, provided that you make a good faith effort to - ensure that, in the event an Application does not supply the - function or data, the facility still operates, and performs - whatever part of its purpose remains meaningful, or - - b) under the GNU GPL, with none of the additional permissions of - this License applicable to that copy. - - 3. Object Code Incorporating Material from Library Header Files. - - The object code form of an Application may incorporate material from -a header file that is part of the Library. You may convey such object -code under terms of your choice, provided that, if the incorporated -material is not limited to numerical parameters, data structure -layouts and accessors, or small macros, inline functions and templates -(ten or fewer lines in length), you do both of the following: - - a) Give prominent notice with each copy of the object code that the - Library is used in it and that the Library and its use are - covered by this License. - - b) Accompany the object code with a copy of the GNU GPL and this license - document. - - 4. Combined Works. - - You may convey a Combined Work under terms of your choice that, -taken together, effectively do not restrict modification of the -portions of the Library contained in the Combined Work and reverse -engineering for debugging such modifications, if you also do each of -the following: - - a) Give prominent notice with each copy of the Combined Work that - the Library is used in it and that the Library and its use are - covered by this License. - - b) Accompany the Combined Work with a copy of the GNU GPL and this license - document. - - c) For a Combined Work that displays copyright notices during - execution, include the copyright notice for the Library among - these notices, as well as a reference directing the user to the - copies of the GNU GPL and this license document. - - d) Do one of the following: - - 0) Convey the Minimal Corresponding Source under the terms of this - License, and the Corresponding Application Code in a form - suitable for, and under terms that permit, the user to - recombine or relink the Application with a modified version of - the Linked Version to produce a modified Combined Work, in the - manner specified by section 6 of the GNU GPL for conveying - Corresponding Source. - - 1) Use a suitable shared library mechanism for linking with the - Library. A suitable mechanism is one that (a) uses at run time - a copy of the Library already present on the user's computer - system, and (b) will operate properly with a modified version - of the Library that is interface-compatible with the Linked - Version. - - e) Provide Installation Information, but only if you would otherwise - be required to provide such information under section 6 of the - GNU GPL, and only to the extent that such information is - necessary to install and execute a modified version of the - Combined Work produced by recombining or relinking the - Application with a modified version of the Linked Version. (If - you use option 4d0, the Installation Information must accompany - the Minimal Corresponding Source and Corresponding Application - Code. If you use option 4d1, you must provide the Installation - Information in the manner specified by section 6 of the GNU GPL - for conveying Corresponding Source.) - - 5. Combined Libraries. - - You may place library facilities that are a work based on the -Library side by side in a single library together with other library -facilities that are not Applications and are not covered by this -License, and convey such a combined library under terms of your -choice, if you do both of the following: - - a) Accompany the combined library with a copy of the same work based - on the Library, uncombined with any other library facilities, - conveyed under the terms of this License. - - b) Give prominent notice with the combined library that part of it - is a work based on the Library, and explaining where to find the - accompanying uncombined form of the same work. - - 6. Revised Versions of the GNU Lesser General Public License. - - The Free Software Foundation may publish revised and/or new versions -of the GNU Lesser General Public License from time to time. Such new -versions will be similar in spirit to the present version, but may -differ in detail to address new problems or concerns. - - Each version is given a distinguishing version number. If the -Library as you received it specifies that a certain numbered version -of the GNU Lesser General Public License "or any later version" -applies to it, you have the option of following the terms and -conditions either of that published version or of any later version -published by the Free Software Foundation. If the Library as you -received it does not specify a version number of the GNU Lesser -General Public License, you may choose any version of the GNU Lesser -General Public License ever published by the Free Software Foundation. - - If the Library as you received it specifies that a proxy can decide -whether future versions of the GNU Lesser General Public License shall -apply, that proxy's public statement of acceptance of any version is -permanent authorization for you to choose that version for the -Library. + GNU LESSER GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.+++ This version of the GNU Lesser General Public License incorporates+the terms and conditions of version 3 of the GNU General Public+License, supplemented by the additional permissions listed below.++ 0. Additional Definitions.++ As used herein, "this License" refers to version 3 of the GNU Lesser+General Public License, and the "GNU GPL" refers to version 3 of the GNU+General Public License.++ "The Library" refers to a covered work governed by this License,+other than an Application or a Combined Work as defined below.++ An "Application" is any work that makes use of an interface provided+by the Library, but which is not otherwise based on the Library.+Defining a subclass of a class defined by the Library is deemed a mode+of using an interface provided by the Library.++ A "Combined Work" is a work produced by combining or linking an+Application with the Library. The particular version of the Library+with which the Combined Work was made is also called the "Linked+Version".++ The "Minimal Corresponding Source" for a Combined Work means the+Corresponding Source for the Combined Work, excluding any source code+for portions of the Combined Work that, considered in isolation, are+based on the Application, and not on the Linked Version.++ The "Corresponding Application Code" for a Combined Work means the+object code and/or source code for the Application, including any data+and utility programs needed for reproducing the Combined Work from the+Application, but excluding the System Libraries of the Combined Work.++ 1. Exception to Section 3 of the GNU GPL.++ You may convey a covered work under sections 3 and 4 of this License+without being bound by section 3 of the GNU GPL.++ 2. Conveying Modified Versions.++ If you modify a copy of the Library, and, in your modifications, a+facility refers to a function or data to be supplied by an Application+that uses the facility (other than as an argument passed when the+facility is invoked), then you may convey a copy of the modified+version:++ a) under this License, provided that you make a good faith effort to+ ensure that, in the event an Application does not supply the+ function or data, the facility still operates, and performs+ whatever part of its purpose remains meaningful, or++ b) under the GNU GPL, with none of the additional permissions of+ this License applicable to that copy.++ 3. Object Code Incorporating Material from Library Header Files.++ The object code form of an Application may incorporate material from+a header file that is part of the Library. You may convey such object+code under terms of your choice, provided that, if the incorporated+material is not limited to numerical parameters, data structure+layouts and accessors, or small macros, inline functions and templates+(ten or fewer lines in length), you do both of the following:++ a) Give prominent notice with each copy of the object code that the+ Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the object code with a copy of the GNU GPL and this license+ document.++ 4. Combined Works.++ You may convey a Combined Work under terms of your choice that,+taken together, effectively do not restrict modification of the+portions of the Library contained in the Combined Work and reverse+engineering for debugging such modifications, if you also do each of+the following:++ a) Give prominent notice with each copy of the Combined Work that+ the Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the Combined Work with a copy of the GNU GPL and this license+ document.++ c) For a Combined Work that displays copyright notices during+ execution, include the copyright notice for the Library among+ these notices, as well as a reference directing the user to the+ copies of the GNU GPL and this license document.++ d) Do one of the following:++ 0) Convey the Minimal Corresponding Source under the terms of this+ License, and the Corresponding Application Code in a form+ suitable for, and under terms that permit, the user to+ recombine or relink the Application with a modified version of+ the Linked Version to produce a modified Combined Work, in the+ manner specified by section 6 of the GNU GPL for conveying+ Corresponding Source.++ 1) Use a suitable shared library mechanism for linking with the+ Library. A suitable mechanism is one that (a) uses at run time+ a copy of the Library already present on the user's computer+ system, and (b) will operate properly with a modified version+ of the Library that is interface-compatible with the Linked+ Version.++ e) Provide Installation Information, but only if you would otherwise+ be required to provide such information under section 6 of the+ GNU GPL, and only to the extent that such information is+ necessary to install and execute a modified version of the+ Combined Work produced by recombining or relinking the+ Application with a modified version of the Linked Version. (If+ you use option 4d0, the Installation Information must accompany+ the Minimal Corresponding Source and Corresponding Application+ Code. If you use option 4d1, you must provide the Installation+ Information in the manner specified by section 6 of the GNU GPL+ for conveying Corresponding Source.)++ 5. Combined Libraries.++ You may place library facilities that are a work based on the+Library side by side in a single library together with other library+facilities that are not Applications and are not covered by this+License, and convey such a combined library under terms of your+choice, if you do both of the following:++ a) Accompany the combined library with a copy of the same work based+ on the Library, uncombined with any other library facilities,+ conveyed under the terms of this License.++ b) Give prominent notice with the combined library that part of it+ is a work based on the Library, and explaining where to find the+ accompanying uncombined form of the same work.++ 6. Revised Versions of the GNU Lesser General Public License.++ The Free Software Foundation may publish revised and/or new versions+of the GNU Lesser General Public License from time to time. Such new+versions will be similar in spirit to the present version, but may+differ in detail to address new problems or concerns.++ Each version is given a distinguishing version number. If the+Library as you received it specifies that a certain numbered version+of the GNU Lesser General Public License "or any later version"+applies to it, you have the option of following the terms and+conditions either of that published version or of any later version+published by the Free Software Foundation. If the Library as you+received it does not specify a version number of the GNU Lesser+General Public License, you may choose any version of the GNU Lesser+General Public License ever published by the Free Software Foundation.++ If the Library as you received it specifies that a proxy can decide+whether future versions of the GNU Lesser General Public License shall+apply, that proxy's public statement of acceptance of any version is+permanent authorization for you to choose that version for the+Library.
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple -main = defaultMain +import Distribution.Simple+main = defaultMain
src/HarmTrace/Base/ChordTokenizer.hs view
@@ -1,194 +1,194 @@-{-# OPTIONS_GHC -Wall #-} -{-# LANGUAGE FlexibleContexts #-} - --------------------------------------------------------------------------------- --- | --- Module : HarmTrace.Base.Parsing --- Copyright : (c) 2012--2013 W. Bas de Haas and Jose Pedro Magalhaes --- License : LGPL-3 --- --- Maintainer : bas@chordify.net, dreixel@chordify.net --- Stability : experimental --- Portability : non-portable --- --- Summary: Some general parsing utilities used for parsing textual chord --- representations. --------------------------------------------------------------------------------- - -module HarmTrace.Base.ChordTokenizer ( -- * Top level parser - parseChordSeq - -- * Parsing (elements of) chords - , pChord - , pShorthand - , pSongAbs - , pRoot - , pAdditions - , pAddition - , pKey - ) where - -import HarmTrace.Base.Parsing -import HarmTrace.Base.MusicRep - --------------------------------------------------------------------------------- --- Top level Chord sequence parser --------------------------------------------------------------------------------- - --- | Top level parser that parsers a string into a 'PieceLabel' and a posibly --- empty list of errors -parseChordSeq :: String -> (PieceLabel, [Error LineColPos]) -parseChordSeq = parseDataWithErrors pSongAbs - --------------------------------------------------------------------------------- --- Tokenizing: parsing strings into tokens --------------------------------------------------------------------------------- - --- | Parser that parses a string of whitespace-separated 'Chord's, e.g. --- @C:maj Bb:9(s11);1 E:min7;1 Eb:min7;1 Ab:7;1 D:min7;1 G:7(13);1 C:maj6(9);1@ --- The first 'Chord' must be the key of the piece, and the after each chord --- the semicolumn and an Integer representing the duration of the chord must --- be presented -pSongAbs :: Parser PieceLabel -- PieceRelToken -- -pSongAbs = PieceLabel <$> pKey <* pLineEnd - <*> (setLoc 0 <$> pListSep_ng pLineEnd pChordDur ) - <* pList pLineEnd where - setLoc :: Int -> [Chord a] -> [Chord a] - setLoc _ [] = [] - setLoc ix (Chord r c d _ l :cs) = (Chord r c d ix l) : setLoc (ix+1) cs - --- parses chords with a duration (separated by a ';') -pChordDur :: Parser ChordLabel -pChordDur = setDur <$> pChord <*> (pSym ';' *> pNaturalRaw) <?> "Chord;Int" - where setDur c d = c {duration = d} - --- | Parses a 'ChordLabel' in Harte et al. syntax including possible additions, --- and removal of chord additions. If a chord has no 'Shorthand', the 'Degree' --- list (if any) is analysed and depending on the 'Triad' (if any) a --- 'Maj', 'Min','Aug', or 'Dim' 'Shorthand' is stored. By default all the --- duration stored in every 'Chord' is 1 (where the unit is application --- dependend, often these are beats, but they can also be eightnotes) -pChord :: Parser ChordLabel -{-# INLINE pChord #-} -pChord = pChordLabel - <|> (noneLabel <$ (pString "N" <|> pString "&pause")) - <|> (unknownLabel <$ (pSym '*' <|> pSym 'X')) - <?> "Chord" - --- Parses a chord label --- TODO add support for inversion -pChordLabel :: Parser ChordLabel -{-# INLINE pChordLabel #-} -pChordLabel = toChord <$> pRoot <* (pSym ':' `opt` ':') <*> pMaybe pShorthand - -- we ignore optional inversions for now - <*> ((pAdditions `opt` []) <* pInversion) - - where toChord :: Root -> Maybe Shorthand -> [Addition] -> ChordLabel - -- if there are no degrees and no shorthand, following Harte it - -- should be labelled a Maj chord - toChord r Nothing [] = Chord r Maj [] 0 1 - toChord r Nothing d = case analyseDegTriad d of - MajTriad -> Chord r Maj (remTriadDeg d) 0 1 - MinTriad -> Chord r Min (remTriadDeg d) 0 1 - AugTriad -> Chord r Aug (remTriadDeg d) 0 1 - DimTriad -> Chord r Dim (remTriadDeg d) 0 1 - NoTriad -> Chord r None d 0 1 - toChord r (Just s) d = Chord r s d 0 1 - - -- removes the third and the fifth from a Addtion list - remTriadDeg :: [Addition] -> [Addition] - remTriadDeg = filter (\(Add (Note _ i)) -> i /= I3 || i /= I5) - --- Parses an inversion, but inversionsion are ignored for now. -pInversion :: Parser (Maybe (Note Interval)) -pInversion = (Just <$> (pSym '/' *> (Note <$> pMaybe pAccidental <*> pInterval)) - <?> "/Inversion") `opt` Nothing - --- | parses a musical key description, e.g. @C:maj@, or @D:min@ -pKey :: Parser Key -pKey = f <$> pRoot <* pSym ':' <*> pShorthand <?> "Key" - where f r m | m == Maj = Key r MajMode - | m == Min = Key r MinMode - | otherwise = error ("Tokenizer: key must be Major or Minor, " - ++ "found: " ++ show m) - --- | Parses a shorthand following Harte et al. syntax, but also the shorthands --- added to the Billboard dataset, e.g. @maj@, @min@, or @9@. -pShorthand :: Parser Shorthand -{-# INLINE pShorthand #-} -pShorthand = Maj <$ pString "maj" - <|> Min <$ pString "min" - <|> Dim <$ pString "dim" - <|> Aug <$ pString "aug" - <|> Maj7 <$ pString "maj7" - <|> Min7 <$ pString "min7" - <|> Sev <$ pString "7" - <|> Dim7 <$ pString "dim7" - <|> HDim7 <$ pString "hdim" <* opt (pSym '7') '7' - <|> MinMaj7 <$ pString "minmaj7" - <|> Maj6 <$ pString "maj6" - <|> Maj6 <$ pString "6" - <|> Min6 <$ pString "min6" - <|> Nin <$ pString "9" - <|> Maj9 <$ pString "maj9" - <|> Min9 <$ pString "min9" - <|> Five <$ pString "5" - <|> Sus2 <$ pString "sus2" - <|> Sus4 <$ pString "sus4" - -- additional Billboard shorthands - <|> Min11 <$ pString "min11" - <|> Min13 <$ pString "min13" - <|> Maj13 <$ pString "maj13" - <|> Eleven <$ pString "11" - <|> Thirteen <$ pString "13" - <|> None <$ pString "1" -- no shorthand: used in billboard to - -- denote a rootnote only - <?> "Shorthand" - --- | Parses a list of 'Chord' 'Addition's within parenthesis -pAdditions :: Parser [Addition] -pAdditions = pPacked (pSym '(') (pSym ')') ( pListSep (pSym ',') pAddition ) - <?> "Addition List" - --- | Parses the a 'Chord' 'Addition' (or the removal of a chord addition, --- prefixed by a @*@) -pAddition :: Parser Addition -pAddition = (Add <$> (Note <$> pMaybe pAccidental <*> pInterval)) - <|> (NoAdd <$> (pSym '*'*> (Note <$> pMaybe pAccidental <*> pInterval))) - <?> "Addition" - --- | Parses in 'Accidental' -pAccidental :: Parser Accidental -pAccidental = Sh <$ pSym 's' - <|> Sh <$ pSym '#' - <|> Fl <$ pSym 'b' - <|> SS <$ pString "ss" - <|> FF <$ pString "bb" <?> "Accidental" - --- | Parses an 'Interval' -pInterval :: Parser Interval -pInterval = ((!!) [minBound..] ) . pred <$> pNaturalRaw <?> "Interval" - --- | Parses a 'Root' 'Note', e.g. @A@, @Bb@, or @F#@. -pRoot :: Parser Root -{-# INLINE pRoot #-} -pRoot = Note Nothing A <$ pSym 'A' - <|> Note Nothing B <$ pSym 'B' - <|> Note Nothing C <$ pSym 'C' - <|> Note Nothing D <$ pSym 'D' - <|> Note Nothing E <$ pSym 'E' - <|> Note Nothing F <$ pSym 'F' - <|> Note Nothing G <$ pSym 'G' - <|> Note (Just Fl) A <$ pString "Ab" - <|> Note (Just Fl) B <$ pString "Bb" - <|> Note (Just Fl) C <$ pString "Cb" - <|> Note (Just Fl) D <$ pString "Db" - <|> Note (Just Fl) E <$ pString "Eb" - <|> Note (Just Fl) F <$ pString "Fb" - <|> Note (Just Fl) G <$ pString "Gb" - <|> Note (Just Sh) A <$ pString "A#" - <|> Note (Just Sh) B <$ pString "B#" - <|> Note (Just Sh) C <$ pString "C#" - <|> Note (Just Sh) D <$ pString "D#" - <|> Note (Just Sh) E <$ pString "E#" - <|> Note (Just Sh) F <$ pString "F#" - <|> Note (Just Sh) G <$ pString "G#" <?> "Chord root" +{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE FlexibleContexts #-}++--------------------------------------------------------------------------------+-- |+-- Module : HarmTrace.Base.Parsing+-- Copyright : (c) 2012--2013 W. Bas de Haas and Jose Pedro Magalhaes+-- License : LGPL-3+--+-- Maintainer : bas@chordify.net, dreixel@chordify.net +-- Stability : experimental+-- Portability : non-portable+--+-- Summary: Some general parsing utilities used for parsing textual chord+-- representations.+--------------------------------------------------------------------------------++module HarmTrace.Base.ChordTokenizer ( -- * Top level parser+ parseChordSeq + -- * Parsing (elements of) chords+ , pChord+ , pShorthand+ , pSongAbs+ , pRoot+ , pAdditions+ , pAddition+ , pKey+ ) where++import HarmTrace.Base.Parsing+import HarmTrace.Base.MusicRep++--------------------------------------------------------------------------------+-- Top level Chord sequence parser+--------------------------------------------------------------------------------++-- | Top level parser that parsers a string into a 'PieceLabel' and a posibly+-- empty list of errors+parseChordSeq :: String -> (PieceLabel, [Error LineColPos])+parseChordSeq = parseDataWithErrors pSongAbs++--------------------------------------------------------------------------------+-- Tokenizing: parsing strings into tokens+-------------------------------------------------------------------------------- ++-- | Parser that parses a string of whitespace-separated 'Chord's, e.g.+-- @C:maj Bb:9(s11);1 E:min7;1 Eb:min7;1 Ab:7;1 D:min7;1 G:7(13);1 C:maj6(9);1@+-- The first 'Chord' must be the key of the piece, and the after each chord+-- the semicolumn and an Integer representing the duration of the chord must +-- be presented+pSongAbs :: Parser PieceLabel -- PieceRelToken -- +pSongAbs = PieceLabel <$> pKey <* pLineEnd + <*> (setLoc 0 <$> pListSep_ng pLineEnd pChordDur )+ <* pList pLineEnd where+ setLoc :: Int -> [Chord a] -> [Chord a] + setLoc _ [] = []+ setLoc ix (Chord r c d _ l :cs) = (Chord r c d ix l) : setLoc (ix+1) cs ++-- parses chords with a duration (separated by a ';')+pChordDur :: Parser ChordLabel+pChordDur = setDur <$> pChord <*> (pSym ';' *> pNaturalRaw) <?> "Chord;Int"+ where setDur c d = c {duration = d}++-- | Parses a 'ChordLabel' in Harte et al. syntax including possible additions, +-- and removal of chord additions. If a chord has no 'Shorthand', the 'Degree' +-- list (if any) is analysed and depending on the 'Triad' (if any) a +-- 'Maj', 'Min','Aug', or 'Dim' 'Shorthand' is stored. By default all the +-- duration stored in every 'Chord' is 1 (where the unit is application +-- dependend, often these are beats, but they can also be eightnotes)+pChord :: Parser ChordLabel +{-# INLINE pChord #-}+pChord = pChordLabel + <|> (noneLabel <$ (pString "N" <|> pString "&pause"))+ <|> (unknownLabel <$ (pSym '*' <|> pSym 'X'))+ <?> "Chord"+ +-- Parses a chord label+-- TODO add support for inversion+pChordLabel :: Parser ChordLabel+{-# INLINE pChordLabel #-}+pChordLabel = toChord <$> pRoot <* (pSym ':' `opt` ':') <*> pMaybe pShorthand+ -- we ignore optional inversions for now+ <*> ((pAdditions `opt` []) <* pInversion)+ + where toChord :: Root -> Maybe Shorthand -> [Addition] -> ChordLabel+ -- if there are no degrees and no shorthand, following Harte it + -- should be labelled a Maj chord+ toChord r Nothing [] = Chord r Maj [] 0 1+ toChord r Nothing d = case analyseDegTriad d of+ MajTriad -> Chord r Maj (remTriadDeg d) 0 1+ MinTriad -> Chord r Min (remTriadDeg d) 0 1+ AugTriad -> Chord r Aug (remTriadDeg d) 0 1+ DimTriad -> Chord r Dim (remTriadDeg d) 0 1+ NoTriad -> Chord r None d 0 1+ toChord r (Just s) d = Chord r s d 0 1+ + -- removes the third and the fifth from a Addtion list+ remTriadDeg :: [Addition] -> [Addition]+ remTriadDeg = filter (\(Add (Note _ i)) -> i /= I3 || i /= I5)++-- Parses an inversion, but inversionsion are ignored for now.+pInversion :: Parser (Maybe (Note Interval))+pInversion = (Just <$> (pSym '/' *> (Note <$> pMaybe pAccidental <*> pInterval))+ <?> "/Inversion") `opt` Nothing + +-- | parses a musical key description, e.g. @C:maj@, or @D:min@+pKey :: Parser Key +pKey = f <$> pRoot <* pSym ':' <*> pShorthand <?> "Key"+ where f r m | m == Maj = Key r MajMode+ | m == Min = Key r MinMode+ | otherwise = error ("Tokenizer: key must be Major or Minor, "+ ++ "found: " ++ show m)++-- | Parses a shorthand following Harte et al. syntax, but also the shorthands+-- added to the Billboard dataset, e.g. @maj@, @min@, or @9@.+pShorthand :: Parser Shorthand+{-# INLINE pShorthand #-}+pShorthand = Maj <$ pString "maj"+ <|> Min <$ pString "min"+ <|> Dim <$ pString "dim"+ <|> Aug <$ pString "aug"+ <|> Maj7 <$ pString "maj7"+ <|> Min7 <$ pString "min7"+ <|> Sev <$ pString "7"+ <|> Dim7 <$ pString "dim7"+ <|> HDim7 <$ pString "hdim" <* opt (pSym '7') '7'+ <|> MinMaj7 <$ pString "minmaj7"+ <|> Maj6 <$ pString "maj6"+ <|> Maj6 <$ pString "6"+ <|> Min6 <$ pString "min6"+ <|> Nin <$ pString "9"+ <|> Maj9 <$ pString "maj9"+ <|> Min9 <$ pString "min9"+ <|> Five <$ pString "5" + <|> Sus2 <$ pString "sus2" + <|> Sus4 <$ pString "sus4" + -- additional Billboard shorthands+ <|> Min11 <$ pString "min11" + <|> Min13 <$ pString "min13" + <|> Maj13 <$ pString "maj13" + <|> Eleven <$ pString "11" + <|> Thirteen <$ pString "13" + <|> None <$ pString "1" -- no shorthand: used in billboard to + -- denote a rootnote only+ <?> "Shorthand"++-- | Parses a list of 'Chord' 'Addition's within parenthesis +pAdditions :: Parser [Addition]+pAdditions = pPacked (pSym '(') (pSym ')') ( pListSep (pSym ',') pAddition ) + <?> "Addition List"++-- | Parses the a 'Chord' 'Addition' (or the removal of a chord addition, +-- prefixed by a @*@)+pAddition :: Parser Addition+pAddition = (Add <$> (Note <$> pMaybe pAccidental <*> pInterval))+ <|> (NoAdd <$> (pSym '*'*> (Note <$> pMaybe pAccidental <*> pInterval)))+ <?> "Addition"++-- | Parses in 'Accidental' +pAccidental :: Parser Accidental+pAccidental = Sh <$ pSym 's'+ <|> Sh <$ pSym '#'+ <|> Fl <$ pSym 'b'+ <|> SS <$ pString "ss"+ <|> FF <$ pString "bb" <?> "Accidental"++-- | Parses an 'Interval'+pInterval :: Parser Interval+pInterval = ((!!) [minBound..] ) . pred <$> pNaturalRaw <?> "Interval"++-- | Parses a 'Root' 'Note', e.g. @A@, @Bb@, or @F#@.+pRoot :: Parser Root+{-# INLINE pRoot #-}+pRoot = Note Nothing A <$ pSym 'A'+ <|> Note Nothing B <$ pSym 'B'+ <|> Note Nothing C <$ pSym 'C'+ <|> Note Nothing D <$ pSym 'D'+ <|> Note Nothing E <$ pSym 'E'+ <|> Note Nothing F <$ pSym 'F'+ <|> Note Nothing G <$ pSym 'G'+ <|> Note (Just Fl) A <$ pString "Ab"+ <|> Note (Just Fl) B <$ pString "Bb"+ <|> Note (Just Fl) C <$ pString "Cb"+ <|> Note (Just Fl) D <$ pString "Db"+ <|> Note (Just Fl) E <$ pString "Eb"+ <|> Note (Just Fl) F <$ pString "Fb"+ <|> Note (Just Fl) G <$ pString "Gb"+ <|> Note (Just Sh) A <$ pString "A#"+ <|> Note (Just Sh) B <$ pString "B#"+ <|> Note (Just Sh) C <$ pString "C#"+ <|> Note (Just Sh) D <$ pString "D#"+ <|> Note (Just Sh) E <$ pString "E#"+ <|> Note (Just Sh) F <$ pString "F#"+ <|> Note (Just Sh) G <$ pString "G#" <?> "Chord root"
src/HarmTrace/Base/MusicRep.hs view
@@ -1,656 +1,656 @@-{-# OPTIONS_GHC -Wall #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE DeriveGeneric #-} - --------------------------------------------------------------------------------- --- | --- Module : HarmTrace.Base.MusicRep --- Copyright : (c) 2012--2013 W. Bas de Haas and Jose Pedro Magalhaes --- License : LGPL-3 --- --- Maintainer : bas@chordify.net, dreixel@chordify.net --- Stability : experimental --- Portability : non-portable --- --- Summary: A set of types and classes for representing musical chords. The --- chord datatypes are based on the unambiguous chord representation presented --- in: Christopher Harte, Mark Sandler and Samer Abdallah (2005), --- /Symbolic representation of musical chords: a proposed syntax for text annotations/, --- In: Proceedings of 6th International Conference on Music Information --- Retrieval (<http://ismir2005.ismir.net/proceedings/1080.pdf>). --------------------------------------------------------------------------------- - -module HarmTrace.Base.MusicRep ( - -- * Representing musical chords and keys - PieceLabel (..) - , Note (..) - , Accidental (..) - , Root - , DiatonicNatural (..) - , ScaleDegree - , DiatonicDegree (..) - -- ** Keys - , Key (..) - , Mode (..) - -- ** Chords - , Chord (..) - -- , Class - , Shorthand (..) - , Addition (..) - , Interval (..) - , ChordLabel - , ChordDegree - , noneLabel - , unknownLabel - -- * Derived types for classification of chords - , ClassType (..) - , Triad (..) - -- * Tests - , isNone - , isNoneChord - , isUnknown - , isRoot - , isAddition - -- * Transformation and analysis of chords - , toClassType - , toTriad - , analyseDegTriad - , toDegreeList - , toMode - , toMajMin - , toMajMinChord - , simplifyRoot - -- * Scale degree transposition - , toChordDegree - , toScaleDegree - , transposeSem - , toSemitone - , toRoot - ) where - -import Data.Maybe (fromJust) -import Data.List (elemIndex, intercalate, (\\), partition) -import Data.Binary (Binary) -import GHC.Generics (Generic) - --------------------------------------------------------------------------------- --- Representing musical information at the value level --------------------------------------------------------------------------------- - - --- | A musical key consising of a 'Root' and 'Mode' -data Key = Key { keyRoot :: Root, keyMode :: Mode } deriving (Eq, Ord, Generic) - --- | The 'Mode' of a key, which can be major or minor -data Mode = MajMode | MinMode deriving (Eq, Ord, Generic) - --- | A container type combinint a key and a list of 'ChordLabel's -data PieceLabel = PieceLabel Key [ChordLabel] deriving Generic - --- | A chord based on absolute 'Root' notes -type ChordLabel = Chord Root - --- rename to noLabel? --- | No Chord label -noneLabel :: ChordLabel -noneLabel = (Chord (Note Nothing N) None [] 0 1) - --- | Unknown Chord label -unknownLabel :: ChordLabel -unknownLabel = (Chord (Note Nothing X) None [] 0 1) - --- | A chord based on relative 'ScaleDegree's -type ChordDegree = Chord ScaleDegree - --- | The representation for a single chord -data Chord a = Chord { chordRoot :: a - , chordShorthand :: Shorthand - , chordAdditions :: [Addition] - -- | the index of the chord in the list of tokens - , getLoc :: Int - -- | the duration of the chord - , duration :: Int - } deriving Generic - --- | We introduce four chord categories: major chords, minor chords, dominant --- seventh chords, and diminshed seventh chords -data ClassType = MajClass | MinClass | DomClass | DimClass | NoClass - deriving (Eq, Enum, Ord, Bounded, Generic) - --- Following Harte et al., we define a number of chord 'Shorthand's -data Shorthand = -- | Triadic chords - Maj | Min | Dim | Aug - -- | Seventh chords - | Maj7 | Min7 | Sev | Dim7 | HDim7 | MinMaj7 - -- | Sixth chords - | Maj6 | Min6 - -- | Extended chords - | Nin | Maj9 | Min9 - -- | Suspended chords - | Sus4 | Sus2 - -- | Power chords - | Five - -- In some cases there is no chord a certain position - -- This is especially important for the chroma processing - | None - -- Additional shorthands in billboard collection - | Eleven | Thirteen | Min11 | Maj13 | Min13 - - deriving (Eq, Ord, Enum, Bounded, Generic) - - --- | Key relative scale degrees to abstract from the absolute Root notes -type ScaleDegree = Note DiatonicDegree - --- | All Diatonic scale degrees -data DiatonicDegree = I | II | III | IV | V | VI | VII - | Imp -- ^ for unrepresentable scale degrees - deriving (Show, Eq, Enum, Ord, Bounded, Generic) - --- | Representing absolute 'Root' notes -type Root = Note DiatonicNatural - --- | The seven diatonic naturals -data DiatonicNatural = C | D | E | F | G | A | B - | N -- ^ for no root - | X -- ^ for representing unknown roots (used in MIREX) - deriving (Show, Eq, Enum, Ord, Bounded, Generic) - --- | Intervals for additonal chord notes -data Addition = Add (Note Interval) - | NoAdd (Note Interval) deriving (Eq, Ord, Generic) - --- | Diatonic major intervals used to denote 'Chord' 'Addition's -data Interval = I1 | I2 | I3 | I4 | I5 | I6 | I7 | I8 | I9 | I10 - | I11 | I12 | I13 - deriving (Eq, Enum, Ord, Bounded, Generic) - --- | A musical note is a pitch (either absolute or relative) posibly modified --- by an 'Accidental' -data Note a = Note (Maybe Accidental) a deriving (Eq, Ord, Generic) - --- | A musical 'Accidental' -data Accidental = Sh -- ^ sharp - | Fl -- ^ flat - | SS -- ^ double sharp - | FF -- ^ double flat - deriving (Eq, Ord, Generic) - --- | A 'Triad' comes in four flavours: major, minor, augmented, dimished, and --- sometimes a chord does not have a triad (e.g. suspended chords, etc.) -data Triad = MajTriad | MinTriad | AugTriad | DimTriad | NoTriad - deriving (Ord, Eq, Generic) - --------------------------------------------------------------------------------- --- Instances for the general music datatypes --------------------------------------------------------------------------------- - -instance Show Key where - show (Key r m) = show r ++ show m - -instance Show Mode where - show MajMode = "" - show MinMode = "m" - --- TODO: it is probably best to derive eq for Chord and define other eq's --- for specific tasks if needed. -instance Eq a => Eq (Chord a) where - (Chord ra sha dega _loc _d) == (Chord rb shb degb _locb _db) - = ra == rb && sha == shb && dega == degb - --- In showing chords, we obey Harte et al.'s syntax as much as possible -instance Show ChordLabel where - show (Chord r None [] _loc _d) = show r ++ (if isRoot r then ":1" else "") - show (Chord r None add _loc _d) = show r ++ ':' : showAdd add - show (Chord r sh add _loc _d) = show r ++ ':' : show sh ++ showAdd add - - -instance Show ChordDegree where - show (Chord r None [] _loc _d) = show r ++ ":1" - show (Chord r None add _loc _d) = show r ++ ':' : showAdd add - show (Chord r sh add _loc _d) = show r ++ ':' : show sh ++ showAdd add - -showAdd :: [Addition] -> String -showAdd [] = "" -showAdd x = '(' : intercalate "," (map show x) ++ ")" - -instance Show Shorthand where - show Maj = "maj" - show Min = "min" - show Dim = "dim" - show Aug = "aug" - show Maj7 = "maj7" - show Min7 = "min7" - show Sev = "7" - show Dim7 = "dim7" - show HDim7 = "hdim7" - show MinMaj7 = "minmaj7" - show Maj6 = "maj6" - show Min6 = "min6" - show Maj9 = "maj9" - show Min9 = "min9" - show Min11 = "min11" - show Min13 = "min13" - show Maj13 = "maj13" - show Sus4 = "sus4" - show Sus2 = "sus2" - show Five = "5" - show Nin = "9" - show Eleven = "11" - show Thirteen = "13" - show None = "" - -instance Show ClassType where - show MajClass = "" - show MinClass = "m" - show DomClass = "7" - show DimClass = "0" - show NoClass = "N" - - -instance Show (Note Interval) where - show (Note m i) = maybe "" show m ++ show i - -instance Show (Note DiatonicNatural) where - show (Note m r) = show r ++ maybe "" show m - -instance Show (Note DiatonicDegree) where - show (Note m r) = show r ++ maybe "" show m - -instance Show Interval where - show a = show . ((!!) ([1..13]::[Integer])) - . fromJust $ elemIndex a [minBound..] - - -instance Show Accidental where - show Sh = "#" - show Fl = "b" - show SS = "##" - show FF = "bb" - -instance Show Addition where - show (Add n) = show n - show (NoAdd n) = '*' : show n - -instance Show Triad where - show MajTriad = "maj" - show MinTriad = "min" - show AugTriad = "aug" - show DimTriad = "dim" - show NoTriad = "NoTriad" - --------------------------------------------------------------------------------- --- Tests --------------------------------------------------------------------------------- --- | Returns True if the 'Root' is not unknown or none -isRoot :: Root -> Bool -isRoot r | isNone r = False - | isUnknown r = False - | otherwise = True - --- | Returns True if the 'Root' is 'N', and False otherwise -isNone :: Root -> Bool -isNone (Note _ N) = True -isNone _ = False - --- | Returns True if the 'ChordLabel' is not a chord, and False otherwise -isNoneChord :: ChordLabel -> Bool -isNoneChord = isNone . chordRoot - --- | Returns True if the 'Root' is unknown, and False otherwise -isUnknown :: Root -> Bool -isUnknown (Note _ X) = True -isUnknown _ = False - --- | Returns true if the 'Chord' 'Addition' represents an addition and not --- a degree that has to be removed (*). -isAddition :: Addition -> Bool -isAddition (Add _) = True -isAddition (NoAdd _) = False - --------------------------------------------------------------------------------- --- 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 (Chord _r sh [] _loc _d) = shToClassType sh -- no additions --- combine the degrees and analyse them. N.B., also NoAdd degrees are resolved -toClassType c = analyseDegClassType . toDegreeList $ c - --- | Analyses a degree list and returns 'MajTriad', 'MinTriad' or 'NoTriad' if --- the degrees make a chord a major, minor, or no triad, respectivly. -analyseDegClassType :: [Addition] -> ClassType -analyseDegClassType degs = - case (analyseThird degs, analyseFifth degs, analyseSevth degs) of - -- Triads - (_ , _ , MinSev) -> DomClass - (_ , AugFifth , _ ) -> DomClass - (MajThird, DimFifth , _ ) -> DomClass - (MajThird, _ , _ ) -> MajClass - (MinThird, PerfFifth, _ ) -> MinClass - (MinThird, DimFifth , DimSev) -> DimClass - (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 Maj6 = MajClass -shToClassType Min6 = MinClass -shToClassType Nin = DomClass -shToClassType Maj9 = MajClass -shToClassType Min9 = MinClass -shToClassType Five = NoClass -shToClassType Sus2 = NoClass -shToClassType Sus4 = 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 -data Third = MajThird | MinThird | NoThird deriving (Eq, Show) -data Fifth = DimFifth | PerfFifth | AugFifth | NoFifth deriving (Eq, Show) -data Sevth = DimSev | MinSev | MajSev | NoSev deriving (Eq, Show) - --- | Takes a 'Chord' and determines the 'Triad' --- --- >>> toTriad (Chord (Note Nothing C) Min [NoAdd (Note (Just Fl) I3),Add (Note Nothing I3)] 0 0) --- maj --- --- >>> toTriad (Chord (Note Nothing C) HDim7 [Add (Note (Just Sh) I11)] 0 0) --- dim --- --- >>> toTriad (Chord (Note Nothing C) Min [NoAdd (Note (Just Fl) I3)] 0 0) --- NoTriad --- -toTriad :: Chord a -> Triad -toTriad (Chord _r sh [] _loc _d) = shToTriad sh -- there are no additions --- combine the degrees and analyse them. N.B., also NoAdd degrees are resolved -toTriad c = analyseDegTriad . toDegreeList $ c - --- | Analyses a degree list and returns 'MajTriad', 'MinTriad' or 'NoTriad' if --- the degrees make a chord a major, minor, or no triad, respectivly. -analyseDegTriad :: [Addition] -> Triad -analyseDegTriad degs = - case (analyseThird degs, analyseFifth degs) 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 :: [Addition] -> Third -analyseThird d - | (Add (Note (Just Fl) I3)) `elem` d = MinThird - | (Add (Note Nothing I3)) `elem` d = MajThird - | otherwise = NoThird - --- analyses the fifth in a degree list -analyseFifth :: [Addition] -> Fifth -analyseFifth d - | (Add (Note (Just Fl) I5)) `elem` d = DimFifth - | (Add (Note (Just Sh) I5)) `elem` d = AugFifth - | (Add (Note Nothing I5)) `elem` d = PerfFifth - | otherwise = NoFifth - --- analyses the fifth in a degree list -analyseSevth :: [Addition] -> Sevth -analyseSevth d - | (Add (Note (Just FF) I7)) `elem` d = DimSev - | (Add (Note (Just Fl) I7)) `elem` d = MinSev - | (Add (Note Nothing I7)) `elem` d = MajSev - | 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 = MinTriad -shToTriad HDim7 = MinTriad -shToTriad MinMaj7 = MinTriad -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 None = NoTriad --- additional Billboard shorthands -shToTriad Min11 = MinTriad -shToTriad Eleven = MajTriad -shToTriad Min13 = MinTriad -shToTriad Maj13 = MajTriad -shToTriad Thirteen = MajTriad - --- | Transforms a Chord into a list of relative degrees (i.e. 'Addition's, --- without the root note). --- --- >>> toDegreeList (Chord (Note Nothing C) HDim7 [Add (Note (Just Sh) I11)] 0 0) --- [3b,5b,7b,11#] --- --- >>> toDegreeList (Chord (Note Nothing C) Min13 [NoAdd (Note Nothing I11)] 0 0) --- [3b,5,7b,9,13] --- --- >>> toDegreeList (parseData pChord "D:7(b9)") --- [3,5,7b,9b] --- -toDegreeList :: Chord a -> [Addition] -toDegreeList (Chord _r sh [] _loc _d) = map Add (shToDeg sh) -toDegreeList (Chord _r sh deg _loc _d) = adds \\ (toAdds remv) where - - (adds, remv) = partition isAddition ((map Add . shToDeg $ sh) ++ deg) - - toAdds :: [Addition] -> [Addition] - toAdds = map (\(NoAdd x) -> (Add x)) - --- | Expands a 'Shorthand' to its list of degrees -shToDeg :: Shorthand -> [Note Interval] -shToDeg Maj = [Note Nothing I3, Note Nothing I5] -shToDeg Min = [Note (Just Fl) I3, Note Nothing I5] -shToDeg Dim = [Note (Just Fl) I3, Note (Just Fl) I5] -shToDeg Aug = [Note Nothing I3, Note (Just Sh) I5] -shToDeg Maj7 = shToDeg Maj ++ [Note Nothing I7] -shToDeg Min7 = shToDeg Min ++ [Note (Just Fl) I7] -shToDeg Sev = shToDeg Maj ++ [Note (Just Fl) I7] -shToDeg Dim7 = shToDeg Dim ++ [Note (Just FF) I7] -shToDeg HDim7 = shToDeg Dim ++ [Note (Just Fl) I7] -shToDeg MinMaj7 = shToDeg Min ++ [Note Nothing I7] -shToDeg Maj6 = shToDeg Maj ++ [Note Nothing I6] -shToDeg Min6 = shToDeg Min ++ [Note (Just Fl) I6] -shToDeg Nin = shToDeg Sev ++ [Note Nothing I9] -shToDeg Maj9 = shToDeg Maj7 ++ [Note Nothing I9] -shToDeg Min9 = shToDeg Min7 ++ [Note Nothing I9] -shToDeg Five = [Note Nothing I5] -shToDeg Sus2 = [Note Nothing I2, Note Nothing I5] -shToDeg Sus4 = [Note Nothing I4, Note Nothing I5] -shToDeg None = [] --- additional Billboard shorthands -shToDeg Min11 = shToDeg Min9 ++ [Note Nothing I11] -shToDeg Eleven = shToDeg Nin ++ [Note Nothing I11] -shToDeg Min13 = shToDeg Min11 ++ [Note Nothing I13] -shToDeg Maj13 = shToDeg Maj9 ++ [Note Nothing I13] -shToDeg Thirteen = shToDeg Eleven ++ [Note Nothing I13] - - --- | 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' -toMajMinChord :: ChordLabel -> ChordLabel -toMajMinChord c = c {chordShorthand = majMinSh} - where majMinSh = case toMajMin (toTriad c) of - MajClass -> Maj - MinClass -> Min - NoClass -> None - -- catch all: cannot happen, see toMajMin - _ -> error ("HarmTrace.Base.MusicRep.toMajMinChord" - ++ " unexpected chord " ++ show c) --------------------------------------------------------------------------------- --- 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 degs loc d) = - Chord (toScaleDegree k r) sh degs loc d - --- | 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 Nothing I - scaleDegrees!!(((toSemitone cr) - (toSemitone kr)) `mod` 12) - --- | Simplify note roots to a single enharmonic representation. --- For instance, D♭ becomes C♯, E♯ becomes F, and G𝄫 becomes F. -simplifyRoot :: Root -> Root --- Simplify double sharps -simplifyRoot (Note (Just SS) x) | x == E = Note (Just Sh) F - | x == B = Note (Just Sh) C - | otherwise = Note Nothing (succ x) --- Simplify double flats -simplifyRoot (Note (Just FF) x) | x == F = Note (Just Fl) E - | x == C = Note (Just Fl) B - | otherwise = Note Nothing (pred x) --- Simplify sharps -simplifyRoot (Note (Just Sh) D) = Note (Just Fl) E -simplifyRoot (Note (Just Sh) E) = Note Nothing F -simplifyRoot (Note (Just Sh) G) = Note (Just Fl) A -simplifyRoot (Note (Just Sh) A) = Note (Just Fl) B -simplifyRoot (Note (Just Sh) B) = Note Nothing C --- Simplify flats -simplifyRoot (Note (Just Fl) C) = Note Nothing B -simplifyRoot (Note (Just Fl) D) = Note (Just Sh) C -simplifyRoot (Note (Just Fl) F) = Note Nothing E -simplifyRoot (Note (Just Fl) G) = Note (Just Sh) F --- Everything else must be simple already -simplifyRoot x = x - --- | Transposes a scale degree with @sem@ semitones up -transposeSem :: ScaleDegree -> Int -> ScaleDegree -transposeSem deg sem = scaleDegrees!!((sem + (toSemitone deg)) `mod` 12) where - --- | Returns the semitone value [0 .. 11] of a 'ScaleDegree' where --- 0 = C, e.g. F# = 6. For the constructors 'N' and 'X' an error is thrown. -toSemitone :: (Show a, Enum a) => Note a -> Int -toSemitone (Note m p) - | ix <= 6 = noNegatives (([0,2,4,5,7,9,11] !! ix) + modToSemi m) `mod` 12 - | otherwise = error ("HarmTrace.Base.MusicRep.toSemitone: no semitone for " - ++ show p ++ maybe "" show m ) - where ix = fromEnum p - noNegatives s | s < 0 = 12 + s - | otherwise = s - --- | The reverse of 'toSemitone' returning the 'Note DiatonicNatural' given a --- Integer [0..11] semitone, where 0 represents C. When the integer is out --- of the range [0..11] an error is thrown. -toRoot :: Int -> Root -toRoot i - | 0 <= i && i <= 11 = roots !! i - | otherwise = error ("HarmTrace.Base.MusicRep.toRoot " ++ - "invalid semitone: " ++ show i) - --- | Transforms type-level Accidentals to semitones (Int values) -modToSemi :: Maybe Accidental -> Int -modToSemi Nothing = 0 -modToSemi (Just Sh) = 1 -modToSemi (Just Fl) = -1 -modToSemi (Just SS) = 2 -modToSemi (Just FF) = -2 - --- | A list of 12 'ScaleDegree's, ignoring pitch spelling. -scaleDegrees ::[ ScaleDegree ] -scaleDegrees = [ Note Nothing I - , Note (Just Sh) I - , Note Nothing II - , Note (Just Fl) III - , Note Nothing III - , Note Nothing IV - , Note (Just Sh) IV - , Note Nothing V - , Note (Just Fl) VI - , Note Nothing VI - , Note (Just Fl) VII - , Note Nothing VII - ] - - --- | A list of 12 'Note DiatonicNatural's, ignoring pitch spelling. -roots :: [ Root ] -roots = [ Note Nothing C - , Note (Just Sh) C - , Note Nothing D - , Note (Just Fl) E - , Note Nothing E - , Note Nothing F - , Note (Just Sh) F - , Note Nothing G - , Note (Just Fl) A - , Note Nothing A - , Note (Just Fl) B - , Note Nothing B - ] - --------------------------------------------------------------------------------- --- Binary instances --------------------------------------------------------------------------------- - -instance Binary Key -instance Binary Mode -instance Binary PieceLabel -instance Binary a => Binary (Chord a) -instance Binary ClassType -instance Binary Shorthand -instance Binary DiatonicDegree -instance Binary DiatonicNatural -instance Binary Addition -instance Binary Interval -instance Binary a => Binary (Note a) -instance Binary Accidental -instance Binary Triad +{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveGeneric #-}++--------------------------------------------------------------------------------+-- |+-- Module : HarmTrace.Base.MusicRep+-- Copyright : (c) 2012--2013 W. Bas de Haas and Jose Pedro Magalhaes+-- License : LGPL-3+--+-- Maintainer : bas@chordify.net, dreixel@chordify.net +-- Stability : experimental+-- Portability : non-portable+--+-- Summary: A set of types and classes for representing musical chords. The +-- chord datatypes are based on the unambiguous chord representation presented +-- in: Christopher Harte, Mark Sandler and Samer Abdallah (2005), +-- /Symbolic representation of musical chords: a proposed syntax for text annotations/, +-- In: Proceedings of 6th International Conference on Music Information +-- Retrieval (<http://ismir2005.ismir.net/proceedings/1080.pdf>). +--------------------------------------------------------------------------------++module HarmTrace.Base.MusicRep (+ -- * Representing musical chords and keys+ PieceLabel (..)+ , Note (..)+ , Accidental (..)+ , Root + , DiatonicNatural (..)+ , ScaleDegree + , DiatonicDegree (..)+ -- ** Keys+ , Key (..)+ , Mode (..)+ -- ** Chords+ , Chord (..)+ -- , Class+ , Shorthand (..)+ , Addition (..)+ , Interval (..)+ , ChordLabel+ , ChordDegree+ , noneLabel+ , unknownLabel+ -- * Derived types for classification of chords+ , ClassType (..)+ , Triad (..)+ -- * Tests+ , isNone+ , isNoneChord+ , isUnknown+ , isRoot+ , isAddition+ -- * Transformation and analysis of chords+ , toClassType+ , toTriad+ , analyseDegTriad+ , toDegreeList+ , toMode+ , toMajMin+ , toMajMinChord+ , simplifyRoot+ -- * Scale degree transposition+ , toChordDegree+ , toScaleDegree+ , transposeSem+ , toSemitone+ , toRoot+ ) where+ +import Data.Maybe (fromJust)+import Data.List (elemIndex, intercalate, (\\), partition)+import Data.Binary (Binary)+import GHC.Generics (Generic)++--------------------------------------------------------------------------------+-- Representing musical information at the value level+--------------------------------------------------------------------------------+++-- | A musical key consising of a 'Root' and 'Mode'+data Key = Key { keyRoot :: Root, keyMode :: Mode } deriving (Eq, Ord, Generic)++-- | The 'Mode' of a key, which can be major or minor+data Mode = MajMode | MinMode deriving (Eq, Ord, Generic)++-- | A container type combinint a key and a list of 'ChordLabel's+data PieceLabel = PieceLabel Key [ChordLabel] deriving Generic++-- | A chord based on absolute 'Root' notes+type ChordLabel = Chord Root++-- rename to noLabel?+-- | No Chord label+noneLabel :: ChordLabel+noneLabel = (Chord (Note Nothing N) None [] 0 1)++-- | Unknown Chord label+unknownLabel :: ChordLabel+unknownLabel = (Chord (Note Nothing X) None [] 0 1)++-- | A chord based on relative 'ScaleDegree's+type ChordDegree = Chord ScaleDegree++-- | The representation for a single chord +data Chord a = Chord { chordRoot :: a+ , chordShorthand :: Shorthand+ , chordAdditions :: [Addition]+ -- | the index of the chord in the list of tokens+ , getLoc :: Int + -- | the duration of the chord + , duration :: Int + } deriving Generic++-- | We introduce four chord categories: major chords, minor chords, dominant+-- seventh chords, and diminshed seventh chords+data ClassType = MajClass | MinClass | DomClass | DimClass | NoClass+ deriving (Eq, Enum, Ord, Bounded, Generic)++-- Following Harte et al., we define a number of chord 'Shorthand's+data Shorthand = -- | Triadic chords+ Maj | Min | Dim | Aug+ -- | Seventh chords+ | Maj7 | Min7 | Sev | Dim7 | HDim7 | MinMaj7+ -- | Sixth chords+ | Maj6 | Min6+ -- | Extended chords+ | Nin | Maj9 | Min9+ -- | Suspended chords+ | Sus4 | Sus2+ -- | Power chords+ | Five+ -- In some cases there is no chord a certain position+ -- This is especially important for the chroma processing+ | None+ -- Additional shorthands in billboard collection+ | Eleven | Thirteen | Min11 | Maj13 | Min13+ + deriving (Eq, Ord, Enum, Bounded, Generic) +++-- | Key relative scale degrees to abstract from the absolute Root notes+type ScaleDegree = Note DiatonicDegree++-- | All Diatonic scale degrees +data DiatonicDegree = I | II | III | IV | V | VI | VII + | Imp -- ^ for unrepresentable scale degrees+ deriving (Show, Eq, Enum, Ord, Bounded, Generic)++-- | Representing absolute 'Root' notes +type Root = Note DiatonicNatural++-- | The seven diatonic naturals+data DiatonicNatural = C | D | E | F | G | A | B + | N -- ^ for no root+ | X -- ^ for representing unknown roots (used in MIREX)+ deriving (Show, Eq, Enum, Ord, Bounded, Generic)+ +-- | Intervals for additonal chord notes +data Addition = Add (Note Interval)+ | NoAdd (Note Interval) deriving (Eq, Ord, Generic)++-- | Diatonic major intervals used to denote 'Chord' 'Addition's+data Interval = I1 | I2 | I3 | I4 | I5 | I6 | I7 | I8 | I9 | I10 + | I11 | I12 | I13 + deriving (Eq, Enum, Ord, Bounded, Generic) ++-- | A musical note is a pitch (either absolute or relative) posibly modified+-- by an 'Accidental'+data Note a = Note (Maybe Accidental) a deriving (Eq, Ord, Generic) + +-- | A musical 'Accidental'+data Accidental = Sh -- ^ sharp + | Fl -- ^ flat+ | SS -- ^ double sharp+ | FF -- ^ double flat+ deriving (Eq, Ord, Generic)++-- | A 'Triad' comes in four flavours: major, minor, augmented, dimished, and +-- sometimes a chord does not have a triad (e.g. suspended chords, etc.)+data Triad = MajTriad | MinTriad | AugTriad | DimTriad | NoTriad + deriving (Ord, Eq, Generic)+ +--------------------------------------------------------------------------------+-- Instances for the general music datatypes+-------------------------------------------------------------------------------- ++instance Show Key where+ show (Key r m) = show r ++ show m+ +instance Show Mode where+ show MajMode = ""+ show MinMode = "m" ++-- TODO: it is probably best to derive eq for Chord and define other eq's +-- for specific tasks if needed. +instance Eq a => Eq (Chord a) where+ (Chord ra sha dega _loc _d) == (Chord rb shb degb _locb _db) + = ra == rb && sha == shb && dega == degb ++-- In showing chords, we obey Harte et al.'s syntax as much as possible+instance Show ChordLabel where+ show (Chord r None [] _loc _d) = show r ++ (if isRoot r then ":1" else "")+ show (Chord r None add _loc _d) = show r ++ ':' : showAdd add+ show (Chord r sh add _loc _d) = show r ++ ':' : show sh ++ showAdd add+ + +instance Show ChordDegree where+ show (Chord r None [] _loc _d) = show r ++ ":1"+ show (Chord r None add _loc _d) = show r ++ ':' : showAdd add+ show (Chord r sh add _loc _d) = show r ++ ':' : show sh ++ showAdd add + +showAdd :: [Addition] -> String+showAdd [] = ""+showAdd x = '(' : intercalate "," (map show x) ++ ")"++instance Show Shorthand where+ show Maj = "maj"+ show Min = "min"+ show Dim = "dim"+ show Aug = "aug"+ show Maj7 = "maj7"+ show Min7 = "min7"+ show Sev = "7"+ show Dim7 = "dim7"+ show HDim7 = "hdim7"+ show MinMaj7 = "minmaj7"+ show Maj6 = "maj6"+ show Min6 = "min6"+ show Maj9 = "maj9"+ show Min9 = "min9"+ show Min11 = "min11"+ show Min13 = "min13"+ show Maj13 = "maj13" + show Sus4 = "sus4"+ show Sus2 = "sus2"+ show Five = "5" + show Nin = "9" + show Eleven = "11"+ show Thirteen = "13"+ show None = ""+ +instance Show ClassType where+ show MajClass = ""+ show MinClass = "m"+ show DomClass = "7"+ show DimClass = "0"+ show NoClass = "N"+++instance Show (Note Interval) where+ show (Note m i) = maybe "" show m ++ show i++instance Show (Note DiatonicNatural) where+ show (Note m r) = show r ++ maybe "" show m + +instance Show (Note DiatonicDegree) where+ show (Note m r) = show r ++ maybe "" show m + +instance Show Interval where+ show a = show . ((!!) ([1..13]::[Integer])) + . fromJust $ elemIndex a [minBound..]+ + +instance Show Accidental where + show Sh = "#"+ show Fl = "b"+ show SS = "##"+ show FF = "bb" ++instance Show Addition where+ show (Add n) = show n+ show (NoAdd n) = '*' : show n ++instance Show Triad where+ show MajTriad = "maj"+ show MinTriad = "min"+ show AugTriad = "aug"+ show DimTriad = "dim"+ show NoTriad = "NoTriad"+ +--------------------------------------------------------------------------------+-- Tests +--------------------------------------------------------------------------------+-- | Returns True if the 'Root' is not unknown or none+isRoot :: Root -> Bool+isRoot r | isNone r = False+ | isUnknown r = False+ | otherwise = True++-- | Returns True if the 'Root' is 'N', and False otherwise +isNone :: Root -> Bool+isNone (Note _ N) = True+isNone _ = False++-- | Returns True if the 'ChordLabel' is not a chord, and False otherwise +isNoneChord :: ChordLabel -> Bool+isNoneChord = isNone . chordRoot++-- | Returns True if the 'Root' is unknown, and False otherwise +isUnknown :: Root -> Bool+isUnknown (Note _ X) = True+isUnknown _ = False++-- | Returns true if the 'Chord' 'Addition' represents an addition and not +-- a degree that has to be removed (*).+isAddition :: Addition -> Bool+isAddition (Add _) = True+isAddition (NoAdd _) = False++--------------------------------------------------------------------------------+-- 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 (Chord _r sh [] _loc _d) = shToClassType sh -- no additions+-- combine the degrees and analyse them. N.B., also NoAdd degrees are resolved+toClassType c = analyseDegClassType . toDegreeList $ c++-- | Analyses a degree list and returns 'MajTriad', 'MinTriad' or 'NoTriad' if+-- the degrees make a chord a major, minor, or no triad, respectivly.+analyseDegClassType :: [Addition] -> ClassType+analyseDegClassType degs = + case (analyseThird degs, analyseFifth degs, analyseSevth degs) of+ -- Triads+ (_ , _ , MinSev) -> DomClass+ (_ , AugFifth , _ ) -> DomClass+ (MajThird, DimFifth , _ ) -> DomClass+ (MajThird, _ , _ ) -> MajClass+ (MinThird, PerfFifth, _ ) -> MinClass+ (MinThird, DimFifth , DimSev) -> DimClass+ (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 Maj6 = MajClass +shToClassType Min6 = MinClass+shToClassType Nin = DomClass+shToClassType Maj9 = MajClass+shToClassType Min9 = MinClass+shToClassType Five = NoClass+shToClassType Sus2 = NoClass+shToClassType Sus4 = 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+data Third = MajThird | MinThird | NoThird deriving (Eq, Show)+data Fifth = DimFifth | PerfFifth | AugFifth | NoFifth deriving (Eq, Show)+data Sevth = DimSev | MinSev | MajSev | NoSev deriving (Eq, Show)+ +-- | Takes a 'Chord' and determines the 'Triad'+--+-- >>> toTriad (Chord (Note Nothing C) Min [NoAdd (Note (Just Fl) I3),Add (Note Nothing I3)] 0 0)+-- maj +--+-- >>> toTriad (Chord (Note Nothing C) HDim7 [Add (Note (Just Sh) I11)] 0 0)+-- dim+--+-- >>> toTriad (Chord (Note Nothing C) Min [NoAdd (Note (Just Fl) I3)] 0 0)+-- NoTriad+--+toTriad :: Chord a -> Triad+toTriad (Chord _r sh [] _loc _d) = shToTriad sh -- there are no additions+-- combine the degrees and analyse them. N.B., also NoAdd degrees are resolved+toTriad c = analyseDegTriad . toDegreeList $ c++-- | Analyses a degree list and returns 'MajTriad', 'MinTriad' or 'NoTriad' if+-- the degrees make a chord a major, minor, or no triad, respectivly.+analyseDegTriad :: [Addition] -> Triad+analyseDegTriad degs = + case (analyseThird degs, analyseFifth degs) 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 :: [Addition] -> Third+analyseThird d + | (Add (Note (Just Fl) I3)) `elem` d = MinThird+ | (Add (Note Nothing I3)) `elem` d = MajThird+ | otherwise = NoThird+ +-- analyses the fifth in a degree list +analyseFifth :: [Addition] -> Fifth+analyseFifth d + | (Add (Note (Just Fl) I5)) `elem` d = DimFifth+ | (Add (Note (Just Sh) I5)) `elem` d = AugFifth+ | (Add (Note Nothing I5)) `elem` d = PerfFifth+ | otherwise = NoFifth++-- analyses the fifth in a degree list +analyseSevth :: [Addition] -> Sevth+analyseSevth d + | (Add (Note (Just FF) I7)) `elem` d = DimSev+ | (Add (Note (Just Fl) I7)) `elem` d = MinSev+ | (Add (Note Nothing I7)) `elem` d = MajSev+ | 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 = MinTriad+shToTriad HDim7 = MinTriad+shToTriad MinMaj7 = MinTriad+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 None = NoTriad+-- additional Billboard shorthands+shToTriad Min11 = MinTriad+shToTriad Eleven = MajTriad+shToTriad Min13 = MinTriad+shToTriad Maj13 = MajTriad+shToTriad Thirteen = MajTriad++-- | Transforms a Chord into a list of relative degrees (i.e. 'Addition's,+-- without the root note).+-- +-- >>> toDegreeList (Chord (Note Nothing C) HDim7 [Add (Note (Just Sh) I11)] 0 0)+-- [3b,5b,7b,11#]+--+-- >>> toDegreeList (Chord (Note Nothing C) Min13 [NoAdd (Note Nothing I11)] 0 0)+-- [3b,5,7b,9,13]+--+-- >>> toDegreeList (parseData pChord "D:7(b9)")+-- [3,5,7b,9b]+--+toDegreeList :: Chord a -> [Addition]+toDegreeList (Chord _r sh [] _loc _d) = map Add (shToDeg sh)+toDegreeList (Chord _r sh deg _loc _d) = adds \\ (toAdds remv) where++ (adds, remv) = partition isAddition ((map Add . shToDeg $ sh) ++ deg)++ toAdds :: [Addition] -> [Addition]+ toAdds = map (\(NoAdd x) -> (Add x))+ +-- | Expands a 'Shorthand' to its list of degrees+shToDeg :: Shorthand -> [Note Interval] +shToDeg Maj = [Note Nothing I3, Note Nothing I5]+shToDeg Min = [Note (Just Fl) I3, Note Nothing I5]+shToDeg Dim = [Note (Just Fl) I3, Note (Just Fl) I5]+shToDeg Aug = [Note Nothing I3, Note (Just Sh) I5]+shToDeg Maj7 = shToDeg Maj ++ [Note Nothing I7]+shToDeg Min7 = shToDeg Min ++ [Note (Just Fl) I7]+shToDeg Sev = shToDeg Maj ++ [Note (Just Fl) I7]+shToDeg Dim7 = shToDeg Dim ++ [Note (Just FF) I7]+shToDeg HDim7 = shToDeg Dim ++ [Note (Just Fl) I7]+shToDeg MinMaj7 = shToDeg Min ++ [Note Nothing I7]+shToDeg Maj6 = shToDeg Maj ++ [Note Nothing I6]+shToDeg Min6 = shToDeg Min ++ [Note (Just Fl) I6]+shToDeg Nin = shToDeg Sev ++ [Note Nothing I9]+shToDeg Maj9 = shToDeg Maj7 ++ [Note Nothing I9]+shToDeg Min9 = shToDeg Min7 ++ [Note Nothing I9]+shToDeg Five = [Note Nothing I5]+shToDeg Sus2 = [Note Nothing I2, Note Nothing I5]+shToDeg Sus4 = [Note Nothing I4, Note Nothing I5]+shToDeg None = []+-- additional Billboard shorthands+shToDeg Min11 = shToDeg Min9 ++ [Note Nothing I11]+shToDeg Eleven = shToDeg Nin ++ [Note Nothing I11]+shToDeg Min13 = shToDeg Min11 ++ [Note Nothing I13]+shToDeg Maj13 = shToDeg Maj9 ++ [Note Nothing I13]+shToDeg Thirteen = shToDeg Eleven ++ [Note Nothing I13]+ + +-- | 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'+toMajMinChord :: ChordLabel -> ChordLabel+toMajMinChord c = c {chordShorthand = majMinSh}+ where majMinSh = case toMajMin (toTriad c) of+ MajClass -> Maj+ MinClass -> Min+ NoClass -> None+ -- catch all: cannot happen, see toMajMin+ _ -> error ("HarmTrace.Base.MusicRep.toMajMinChord"+ ++ " unexpected chord " ++ show c)+--------------------------------------------------------------------------------+-- 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 degs loc d) = + Chord (toScaleDegree k r) sh degs loc d + +-- | 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 Nothing I+ scaleDegrees!!(((toSemitone cr) - (toSemitone kr)) `mod` 12)++-- | Simplify note roots to a single enharmonic representation.+-- For instance, D♭ becomes C♯, E♯ becomes F, and G𝄫 becomes F.+simplifyRoot :: Root -> Root+-- Simplify double sharps+simplifyRoot (Note (Just SS) x) | x == E = Note (Just Sh) F+ | x == B = Note (Just Sh) C+ | otherwise = Note Nothing (succ x)+-- Simplify double flats+simplifyRoot (Note (Just FF) x) | x == F = Note (Just Fl) E+ | x == C = Note (Just Fl) B+ | otherwise = Note Nothing (pred x)+-- Simplify sharps+simplifyRoot (Note (Just Sh) D) = Note (Just Fl) E+simplifyRoot (Note (Just Sh) E) = Note Nothing F+simplifyRoot (Note (Just Sh) G) = Note (Just Fl) A+simplifyRoot (Note (Just Sh) A) = Note (Just Fl) B+simplifyRoot (Note (Just Sh) B) = Note Nothing C+-- Simplify flats+simplifyRoot (Note (Just Fl) C) = Note Nothing B+simplifyRoot (Note (Just Fl) D) = Note (Just Sh) C+simplifyRoot (Note (Just Fl) F) = Note Nothing E+simplifyRoot (Note (Just Fl) G) = Note (Just Sh) F+-- Everything else must be simple already+simplifyRoot x = x+ +-- | Transposes a scale degree with @sem@ semitones up+transposeSem :: ScaleDegree -> Int -> ScaleDegree+transposeSem deg sem = scaleDegrees!!((sem + (toSemitone deg)) `mod` 12) where++-- | Returns the semitone value [0 .. 11] of a 'ScaleDegree' where+-- 0 = C, e.g. F# = 6. For the constructors 'N' and 'X' an error is thrown.+toSemitone :: (Show a, Enum a) => Note a -> Int+toSemitone (Note m p) + | ix <= 6 = noNegatives (([0,2,4,5,7,9,11] !! ix) + modToSemi m) `mod` 12+ | otherwise = error ("HarmTrace.Base.MusicRep.toSemitone: no semitone for "+ ++ show p ++ maybe "" show m )+ where ix = fromEnum p+ noNegatives s | s < 0 = 12 + s+ | otherwise = s++-- | The reverse of 'toSemitone' returning the 'Note DiatonicNatural' given a +-- Integer [0..11] semitone, where 0 represents C. When the integer is out +-- of the range [0..11] an error is thrown.+toRoot :: Int -> Root+toRoot i + | 0 <= i && i <= 11 = roots !! i+ | otherwise = error ("HarmTrace.Base.MusicRep.toRoot " +++ "invalid semitone: " ++ show i)+ +-- | Transforms type-level Accidentals to semitones (Int values)+modToSemi :: Maybe Accidental -> Int+modToSemi Nothing = 0+modToSemi (Just Sh) = 1+modToSemi (Just Fl) = -1+modToSemi (Just SS) = 2+modToSemi (Just FF) = -2++-- | A list of 12 'ScaleDegree's, ignoring pitch spelling.+scaleDegrees ::[ ScaleDegree ] +scaleDegrees = [ Note Nothing I+ , Note (Just Sh) I+ , Note Nothing II+ , Note (Just Fl) III+ , Note Nothing III+ , Note Nothing IV+ , Note (Just Sh) IV+ , Note Nothing V+ , Note (Just Fl) VI+ , Note Nothing VI+ , Note (Just Fl) VII+ , Note Nothing VII+ ]+ ++-- | A list of 12 'Note DiatonicNatural's, ignoring pitch spelling.+roots :: [ Root ] +roots = [ Note Nothing C+ , Note (Just Sh) C+ , Note Nothing D+ , Note (Just Fl) E+ , Note Nothing E+ , Note Nothing F+ , Note (Just Sh) F+ , Note Nothing G+ , Note (Just Fl) A+ , Note Nothing A+ , Note (Just Fl) B+ , Note Nothing B+ ]++--------------------------------------------------------------------------------+-- Binary instances+--------------------------------------------------------------------------------++instance Binary Key+instance Binary Mode +instance Binary PieceLabel+instance Binary a => Binary (Chord a)+instance Binary ClassType+instance Binary Shorthand+instance Binary DiatonicDegree+instance Binary DiatonicNatural+instance Binary Addition+instance Binary Interval+instance Binary a => Binary (Note a)+instance Binary Accidental+instance Binary Triad
src/HarmTrace/Base/MusicTime.hs view
@@ -1,308 +1,308 @@-{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE DeriveFunctor #-} - --------------------------------------------------------------------------------- --- | --- Module : HarmTrace.Base.MusicTime --- Copyright : (c) 2012--2013 W. Bas de Haas and Jose Pedro Magalhaes --- License : LGPL-3 --- --- Maintainer : bas@chordify.net, dreixel@chordify.net --- Stability : experimental --- Portability : non-portable --- --- Summary: A set of types and classes for representing musical time, mainly --- (but not necessarily) in the context of recognising chords --- from an arbitrary audio source. --------------------------------------------------------------------------------- - -module HarmTrace.Base.MusicTime ( - - -- * Datatypes - -- ** Types for representing Chords and their probabilities - ChordAnnotation - , ProbChordSeg (..) - , ProbChord (..) - , ChordCand (..) - - -- ** Representing musical time - , TimedData (..) - , Beat (..) - , BarTime (..) - , BarTimeTrackData - , NumData - - -- ** Representing raw audio data - , AudioFeat (..) - , ChordinoData - , ChordinoLine (..) - , KeyStrengthData - , BeatTrackerData - , BeatChroma - , ChordStruct - - -- * Functions - -- ** Data access - , timedData - , timedDataBT - , getBarTime - , getBeat - , onset - , offset - , setData - -- ** Type conversion and other utilities - , getBeatTrack - , concatTimedData - , nextBeat - , prevBeat - , updateTPChord - , dropProb - , dropTimed - , timeStamp - , beat - , prettyPrint - -) where - -import HarmTrace.Base.MusicRep -import Data.List (intercalate) - --- | When reducing and expaninding 'TimedData' types there might be rounding --- errors in the floating point time stamps. The 'roundingError' parameter --- sets the acceptable rounding error that is used in the comparison of --- time stamps (e.g. see 'timeComp') -roundingError :: NumData -roundingError = 0.0001 -- = one milisecond - --- | A type synonym is defined for our main numerical representation, this --- allows us to easily change the precision. -type NumData = Double - --------------------------------------------------------------------------------- --- High-level structure --------------------------------------------------------------------------------- - --- | A chord annotation consists of a --- list with chords and segment boundaries. -type ChordAnnotation = [TimedData ProbChord] - --- | A datatype that wraps around an (musical) datatype, adding information --- about the musical time to this datatype. Musical time is stored as --- a list of 'BarTime' time stamps that can optionally be augmented --- with information about the 'Beat' position of the particular time stamp --- inside the bar. -data TimedData a = TimedData { -- | Returns the contained datatype - getData :: a - -- | Returns the list of TimeStamps - , getTimeStamps :: [BarTime] - } deriving (Functor, Show, Eq) - --- | Clustering 'ProbChord's in a collection of chords that share a key -data ProbChordSeg = Segment { segKey :: Key - , segChords :: [TimedData [ProbChord]] - } deriving (Show, Eq) - - --- | Combines a 'ChordLabel' with a probability. -data ProbChord = ProbChord { chordLab :: ChordLabel - , prob :: NumData - } - --- | A chord candidate: an intermediate datatype that matches shorthand, --- chord structure and root note (plus inversion) -data ChordCand = ChordCand { originalRootCC :: Root - , inversionRootCC :: Root - , shorthardCC :: Shorthand - , chordStructCC :: ChordStruct - } deriving (Show, Eq) - --- | A chord template is list of 'NumData's -type ChordStruct = [NumData] - --- | For now, we fix the number of available beats to four, because this is also --- hard-coded into the bar and beat-tracker. -data Beat = One | Two | Three | Four | NoBeat deriving (Eq, Enum) - --------------------------------------------------------------------------------- --- Instances of high-level data structure --------------------------------------------------------------------------------- - --- TODO to be replaced by a deriving instance -instance Eq (ProbChord) where - a == b = chordLab a == chordLab b - -instance Show (ProbChord) where - show (ProbChord c p) = show c ++ ':' : show p - -instance Show Beat where - show One = "1" - show Two = "2" - show Three = "3" - show Four = "4" - show NoBeat = "x" - -instance Show BarTime where - show (BarTime t bt) = '(' : show t ++ ", " ++ show bt ++ ")" - show (Time t) = '(' : show t ++ ")" - - --------------------------------------------------------------------------------- --- numerical data representation --------------------------------------------------------------------------------- - --- | Groups the three types of VAMP plug-in data: 'ChordinoData', --- 'BarTimeTrackData', and 'KeyStrengthData'. See for more information: --- --- * <http://www.vamp-plugins.org> --- --- * <http://isophonics.net/nnls-chroma> --- --- * <http://omras2.org/SonicAnnotator> -data AudioFeat = AudioFeat { getChroma :: ChordinoData - , getBeats :: BarTimeTrackData - , getKeys :: KeyStrengthData - , getAudioFeatId :: FilePath} - -type ChordinoData = [ChordinoLine] - --- | Represents two chroma features and a time stamp. -data ChordinoLine = ChordinoLine -- TODO remove useless type synonym - { - -- | Returns the time stamp of the chroma features - time :: NumData - -- | Returns the bass chroma feature - , bass :: [NumData] -- each of the lists has always 12 elements - -- | Returns the treble chroma feature - , treb :: [NumData] -- A, Bb, B, C, Db, D, Eb, E, F, F#, G, Ab - } deriving (Eq, Show) -- and is shifted 3 positions to match C, Db, .., B - -type KeyStrengthData = ChordinoData - -type BeatTrackerData = [NumData] - --- TODO Rename to BeatTime --- | Represents a musical time stamp, which is a 'NumData' possibly augmented --- with a 'Beat' denoting the position of the time stamp within a bar. -data BarTime = BarTime NumData Beat - | Time NumData deriving Eq - -type BarTimeTrackData = [BarTime] - -type BeatChroma = TimedData [ChordinoLine] -- one list per beat - --- we compare based on the timestamp only -instance Ord BarTime where - compare a b = compare (timeStamp a) (timeStamp b) - --------------------------------------------------------------------------------- --- Some type conversion utilities --------------------------------------------------------------------------------- - --- | alternative 'TimedData' constructor -timedData :: a -> NumData -> NumData -> TimedData a -timedData d x y = TimedData d [Time x, Time y] - --- | alternative 'TimedData' constructor -timedDataBT :: a -> BarTime -> BarTime -> TimedData a -timedDataBT d x y = TimedData d [x, y] - --- | concatenates the 'BarTime' timestamps of two 'TimedData's and --- creates a new 'TimedData' that stores the first argument. -concatTimedData :: a -> TimedData a -> TimedData a -> TimedData a -concatTimedData dat (TimedData _ ta) (TimedData _ tb) = - TimedData dat (mergeBeatTime ta tb) where - - mergeBeatTime :: [BarTime] -> [BarTime] -> [BarTime] - mergeBeatTime [] b = b - mergeBeatTime a [] = a - mergeBeatTime a b = case timeComp (timeStamp . last $ a) - (timeStamp . head $ b) of - GT -> error ("HarmTrace.Base.MusicTime.mergeBeatTime: " ++ - "cannot merge BeatTimes " ++ show a ++ " and " ++ show b) - EQ -> a ++ tail b -- do not include the same timestamp twice - LT -> a ++ b - --- | compares to 'NumData' timestamps taking a rounding error 'roundingError' --- into account. -timeComp :: NumData -> NumData -> Ordering -timeComp a b - | a > (b + roundingError) = GT - | a < (b - roundingError) = LT - | otherwise = EQ - --- | Converts 'BarTimeTrackData' into 'BeatTrackerData' -getBeatTrack :: BarTimeTrackData -> BeatTrackerData -getBeatTrack = map timeStamp - --- | wraps a datatype in 'TimedData' -setData :: TimedData a -> b -> TimedData b -setData td d = td {getData = d} - --- | Returns the start time stamp -getBarTime :: TimedData a -> BarTime -getBarTime td = case getTimeStamps td of - [] -> error "HarmTrace.Base.MusicTime.getBarTime: no timestamps are stored" - (h:_) -> h - --- | Returns the start 'Beat' -getBeat :: TimedData a -> Beat -getBeat = beat . getBarTime - --- | Returns the 'NumData' timestamp, given a 'BarTime' -timeStamp :: BarTime -> NumData -timeStamp (BarTime t _bt) = t -timeStamp (Time t ) = t - --- | Returns the 'NumData' timestamp, given a 'BarTime' -beat :: BarTime -> Beat -beat (BarTime _t bt) = bt -beat (Time _t ) = NoBeat - --- | Returns the onset time stamp -onset :: TimedData a -> NumData -onset = timeStamp . getBarTime - --- | Returns the offset time stamp -offset :: TimedData a -> NumData -offset td = case getTimeStamps td of - [] -> error "HarmTrace.Base.MusicTime.offset: no timestamps are stored" - l -> timeStamp . last $ l - --- TODO: replace by ad-hoc enum instance? --- | returns the next beat, e.g. @ nextBeat Two = Three @. --- Following the (current) definition of 'Beat', we still assume 4/4, in the --- future this function should also have the meter as an argument. -nextBeat, prevBeat :: Beat -> Beat -nextBeat Four = One -nextBeat b = succ b - --- | returns the previous 'Beat', similar to 'prevBeat'. -prevBeat One = Four -prevBeat b = pred b - --- | Updates transforms ChordLabel wrapped in a 'ProbChord' and 'TimedData' -updateTPChord :: (ChordLabel -> ChordLabel) -> TimedData ProbChord - -> TimedData ProbChord -updateTPChord f = fmap (update f) where - update g (ProbChord c p) = (ProbChord (g c) p) - --- | drops the probabilties paired with chordlabels (in a list of 'ProbChord's) --- and returns a list of 'ChordLabel's -dropProb :: [TimedData ProbChord] -> [TimedData ChordLabel] -dropProb = map (fmap chordLab) - --- | drops the time (with or without 'Beat') information of a list --- 'Timed' data structure -dropTimed :: [TimedData a] -> [a] -dropTimed = map getData - --- | Pretty prints a list of 'TimedData's, one per line -prettyPrint :: Show a => [TimedData a] -> String -prettyPrint = intercalate "\n" . map pprint where - - pprint :: Show a => TimedData a -> String - pprint (TimedData d [ ]) = "not set - not set: " ++ show d - pprint (TimedData d [x]) = show x ++" - not set: " ++ show d - pprint (TimedData d ts ) = show (head ts) ++ " - " ++ show (last ts) - ++ ": " ++ show d +{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveFunctor #-}++--------------------------------------------------------------------------------+-- |+-- Module : HarmTrace.Base.MusicTime+-- Copyright : (c) 2012--2013 W. Bas de Haas and Jose Pedro Magalhaes+-- License : LGPL-3+--+-- Maintainer : bas@chordify.net, dreixel@chordify.net +-- Stability : experimental+-- Portability : non-portable+--+-- Summary: A set of types and classes for representing musical time, mainly+-- (but not necessarily) in the context of recognising chords +-- from an arbitrary audio source.+--------------------------------------------------------------------------------++module HarmTrace.Base.MusicTime (+ + -- * Datatypes+ -- ** Types for representing Chords and their probabilities+ ChordAnnotation + , ProbChordSeg (..)+ , ProbChord (..)+ , ChordCand (..)+ + -- ** Representing musical time+ , TimedData (..)+ , Beat (..)+ , BarTime (..)+ , BarTimeTrackData + , NumData + + -- ** Representing raw audio data + , AudioFeat (..)+ , ChordinoData + , ChordinoLine (..)+ , KeyStrengthData + , BeatTrackerData + , BeatChroma + , ChordStruct ++ -- * Functions+ -- ** Data access+ , timedData+ , timedDataBT+ , getBarTime + , getBeat + , onset+ , offset+ , setData+ -- ** Type conversion and other utilities+ , getBeatTrack+ , concatTimedData+ , nextBeat+ , prevBeat + , updateTPChord+ , dropProb+ , dropTimed+ , timeStamp+ , beat + , prettyPrint++) where+ +import HarmTrace.Base.MusicRep+import Data.List (intercalate)++-- | When reducing and expaninding 'TimedData' types there might be rounding+-- errors in the floating point time stamps. The 'roundingError' parameter+-- sets the acceptable rounding error that is used in the comparison of +-- time stamps (e.g. see 'timeComp')+roundingError :: NumData +roundingError = 0.0001 -- = one milisecond ++-- | A type synonym is defined for our main numerical representation, this +-- allows us to easily change the precision.+type NumData = Double++--------------------------------------------------------------------------------+-- High-level structure+--------------------------------------------------------------------------------++-- | A chord annotation consists of a+-- list with chords and segment boundaries.+type ChordAnnotation = [TimedData ProbChord]++-- | A datatype that wraps around an (musical) datatype, adding information +-- about the musical time to this datatype. Musical time is stored as +-- a list of 'BarTime' time stamps that can optionally be augmented+-- with information about the 'Beat' position of the particular time stamp +-- inside the bar.+data TimedData a = TimedData { -- | Returns the contained datatype + getData :: a + -- | Returns the list of TimeStamps+ , getTimeStamps :: [BarTime]+ } deriving (Functor, Show, Eq)++-- | Clustering 'ProbChord's in a collection of chords that share a key+data ProbChordSeg = Segment { segKey :: Key + , segChords :: [TimedData [ProbChord]] + } deriving (Show, Eq)+ + +-- | Combines a 'ChordLabel' with a probability.+data ProbChord = ProbChord { chordLab :: ChordLabel+ , prob :: NumData+ }++-- | A chord candidate: an intermediate datatype that matches shorthand, +-- chord structure and root note (plus inversion)+data ChordCand = ChordCand { originalRootCC :: Root+ , inversionRootCC :: Root+ , shorthardCC :: Shorthand+ , chordStructCC :: ChordStruct + } deriving (Show, Eq)++-- | A chord template is list of 'NumData's+type ChordStruct = [NumData] ++-- | For now, we fix the number of available beats to four, because this is also+-- hard-coded into the bar and beat-tracker.+data Beat = One | Two | Three | Four | NoBeat deriving (Eq, Enum)++--------------------------------------------------------------------------------+-- Instances of high-level data structure+--------------------------------------------------------------------------------++-- TODO to be replaced by a deriving instance+instance Eq (ProbChord) where+ a == b = chordLab a == chordLab b+ +instance Show (ProbChord) where+ show (ProbChord c p) = show c ++ ':' : show p+ +instance Show Beat where+ show One = "1"+ show Two = "2"+ show Three = "3"+ show Four = "4"+ show NoBeat = "x"++instance Show BarTime where+ show (BarTime t bt) = '(' : show t ++ ", " ++ show bt ++ ")"+ show (Time t) = '(' : show t ++ ")"++ +--------------------------------------------------------------------------------+-- numerical data representation+--------------------------------------------------------------------------------++-- | Groups the three types of VAMP plug-in data: 'ChordinoData', +-- 'BarTimeTrackData', and 'KeyStrengthData'. See for more information:+--+-- * <http://www.vamp-plugins.org>+--+-- * <http://isophonics.net/nnls-chroma>+--+-- * <http://omras2.org/SonicAnnotator>+data AudioFeat = AudioFeat { getChroma :: ChordinoData + , getBeats :: BarTimeTrackData+ , getKeys :: KeyStrengthData + , getAudioFeatId :: FilePath}++type ChordinoData = [ChordinoLine] ++-- | Represents two chroma features and a time stamp. +data ChordinoLine = ChordinoLine -- TODO remove useless type synonym+ { + -- | Returns the time stamp of the chroma features+ time :: NumData + -- | Returns the bass chroma feature+ , bass :: [NumData] -- each of the lists has always 12 elements + -- | Returns the treble chroma feature+ , treb :: [NumData] -- A, Bb, B, C, Db, D, Eb, E, F, F#, G, Ab + } deriving (Eq, Show) -- and is shifted 3 positions to match C, Db, .., B+ +type KeyStrengthData = ChordinoData ++type BeatTrackerData = [NumData]++-- TODO Rename to BeatTime+-- | Represents a musical time stamp, which is a 'NumData' possibly augmented+-- with a 'Beat' denoting the position of the time stamp within a bar.+data BarTime = BarTime NumData Beat+ | Time NumData deriving Eq++type BarTimeTrackData = [BarTime]++type BeatChroma = TimedData [ChordinoLine] -- one list per beat++-- we compare based on the timestamp only+instance Ord BarTime where+ compare a b = compare (timeStamp a) (timeStamp b)++--------------------------------------------------------------------------------+-- Some type conversion utilities+--------------------------------------------------------------------------------++-- | alternative 'TimedData' constructor+timedData :: a -> NumData -> NumData -> TimedData a+timedData d x y = TimedData d [Time x, Time y]++-- | alternative 'TimedData' constructor+timedDataBT :: a -> BarTime -> BarTime -> TimedData a+timedDataBT d x y = TimedData d [x, y]++-- | concatenates the 'BarTime' timestamps of two 'TimedData's and +-- creates a new 'TimedData' that stores the first argument. +concatTimedData :: a -> TimedData a -> TimedData a -> TimedData a+concatTimedData dat (TimedData _ ta) (TimedData _ tb) = + TimedData dat (mergeBeatTime ta tb) where++ mergeBeatTime :: [BarTime] -> [BarTime] -> [BarTime]+ mergeBeatTime [] b = b+ mergeBeatTime a [] = a+ mergeBeatTime a b = case timeComp (timeStamp . last $ a) + (timeStamp . head $ b) of+ GT -> error ("HarmTrace.Base.MusicTime.mergeBeatTime: " +++ "cannot merge BeatTimes " ++ show a ++ " and " ++ show b)+ EQ -> a ++ tail b -- do not include the same timestamp twice+ LT -> a ++ b + +-- | compares to 'NumData' timestamps taking a rounding error 'roundingError'+-- into account.+timeComp :: NumData -> NumData -> Ordering+timeComp a b + | a > (b + roundingError) = GT+ | a < (b - roundingError) = LT+ | otherwise = EQ++-- | Converts 'BarTimeTrackData' into 'BeatTrackerData'+getBeatTrack :: BarTimeTrackData -> BeatTrackerData+getBeatTrack = map timeStamp++-- | wraps a datatype in 'TimedData'+setData :: TimedData a -> b -> TimedData b+setData td d = td {getData = d}++-- | Returns the start time stamp+getBarTime :: TimedData a -> BarTime+getBarTime td = case getTimeStamps td of+ [] -> error "HarmTrace.Base.MusicTime.getBarTime: no timestamps are stored"+ (h:_) -> h++-- | Returns the start 'Beat'+getBeat :: TimedData a -> Beat+getBeat = beat . getBarTime ++-- | Returns the 'NumData' timestamp, given a 'BarTime'+timeStamp :: BarTime -> NumData+timeStamp (BarTime t _bt) = t+timeStamp (Time t ) = t ++-- | Returns the 'NumData' timestamp, given a 'BarTime'+beat :: BarTime -> Beat+beat (BarTime _t bt) = bt+beat (Time _t ) = NoBeat++-- | Returns the onset time stamp+onset :: TimedData a -> NumData+onset = timeStamp . getBarTime ++-- | Returns the offset time stamp+offset :: TimedData a -> NumData+offset td = case getTimeStamps td of+ [] -> error "HarmTrace.Base.MusicTime.offset: no timestamps are stored"+ l -> timeStamp . last $ l++-- TODO: replace by ad-hoc enum instance?+-- | returns the next beat, e.g. @ nextBeat Two = Three @. +-- Following the (current) definition of 'Beat', we still assume 4/4, in the +-- future this function should also have the meter as an argument.+nextBeat, prevBeat :: Beat -> Beat +nextBeat Four = One+nextBeat b = succ b++-- | returns the previous 'Beat', similar to 'prevBeat'.+prevBeat One = Four+prevBeat b = pred b++-- | Updates transforms ChordLabel wrapped in a 'ProbChord' and 'TimedData'+updateTPChord :: (ChordLabel -> ChordLabel) -> TimedData ProbChord + -> TimedData ProbChord+updateTPChord f = fmap (update f) where+ update g (ProbChord c p) = (ProbChord (g c) p)++-- | drops the probabilties paired with chordlabels (in a list of 'ProbChord's)+-- and returns a list of 'ChordLabel's+dropProb :: [TimedData ProbChord] -> [TimedData ChordLabel]+dropProb = map (fmap chordLab)++-- | drops the time (with or without 'Beat') information of a list +-- 'Timed' data structure +dropTimed :: [TimedData a] -> [a]+dropTimed = map getData++-- | Pretty prints a list of 'TimedData's, one per line+prettyPrint :: Show a => [TimedData a] -> String+prettyPrint = intercalate "\n" . map pprint where++ pprint :: Show a => TimedData a -> String+ pprint (TimedData d [ ]) = "not set - not set: " ++ show d+ pprint (TimedData d [x]) = show x ++" - not set: " ++ show d+ pprint (TimedData d ts ) = show (head ts) ++ " - " ++ show (last ts) + ++ ": " ++ show d
src/HarmTrace/Base/Parsing.hs view
@@ -1,90 +1,90 @@-{-# OPTIONS_GHC -Wall #-} -{-# LANGUAGE FlexibleContexts #-} - --------------------------------------------------------------------------------- --- | --- Module : HarmTrace.Base.Parsing --- Copyright : (c) 2012--2013 W. Bas de Haas and Jose Pedro Magalhaes --- License : LGPL-3 --- --- Maintainer : bas@chordify.net, dreixel@chordify.net --- Stability : experimental --- Portability : non-portable --- --- Summary: Some general parsing utilities used for parsing textual chord --- representations. --------------------------------------------------------------------------------- - - -module HarmTrace.Base.Parsing ( -- * Top level parsers - parseData - , parseDataWithErrors - , parseDataSafe - -- * Some general parsers - , pString - , pLineEnd - , pManyTill - -- Re-exporting the uu-parsinglib - , module Data.ListLike.Base - , module Text.ParserCombinators.UU - , module Text.ParserCombinators.UU.Utils - , module Text.ParserCombinators.UU.BasicInstances - ) where - -import Text.ParserCombinators.UU -import Text.ParserCombinators.UU.Utils hiding (pSpaces) -import Text.ParserCombinators.UU.BasicInstances hiding (IsLocationUpdatedBy) -import Data.ListLike.Base (ListLike) -import Data.List (intersperse) - --------------------------------------------------------------------------------- --- A collection of parsing functions used by parsers throughout the project --------------------------------------------------------------------------------- - --- | This is identical to 'parseData' however it will throw an 'error' when --- the the list with parsing errors is not empty. No, this will not make your --- program more \safe\. However, in certain cases you really want to be sure --- that parsing has finished without errors. In those cases you should use --- 'parseDataSafe'. -parseDataSafe :: (ListLike s a, Show a, Show s) => - P (Str a s LineColPos) b -> s -> b -parseDataSafe p inp = case parseDataWithErrors p inp of - (dat, [] ) -> dat - (_ , err) -> error ("HarmTrace.Base.Parsing: a parsing" - ++ " function did not finish without errors. While" - ++ " parsing the data starting with:\n" - ++ (take 80 $ show inp) - ++ "\nThe following errors were encountered:\n" - ++ (concat . intersperse "\n" . take 50 - . map show $ err)) - --- | Toplevel parser that ignores error-reporting, regardless of there were --- error in the parse -parseData :: (ListLike s a, Show a) => P (Str a s LineColPos) b -> s -> b -parseData p inp = fst ( parseDataWithErrors p inp ) - --- | Toplevel parser that returns both the result as well as a (possibly empty) --- list of error-corrections. -parseDataWithErrors :: (ListLike s a, Show a) - => P (Str a s LineColPos) b -> s -> (b, [Error LineColPos]) -parseDataWithErrors p inp = (parse ( (,) <$> p <*> pEnd) - (createStr (LineColPos 0 0 0) inp)) - --- | Parses a specific string -pString :: (ListLike state a, IsLocationUpdatedBy loc a, Show a, Eq a) - => [a] -> P (Str a state loc) [a] -{-# INLINABLE pString #-} -pString s = foldr (\a b -> (:) <$> a <*> b) (pure []) (map pSym s) - --- | Parses UNIX and DOS/WINDOWS line endings including trailing whitespace -pLineEnd :: Parser String -pLineEnd = pString "\n" <|> pString "\r\n" <|> pString " " <|> pString "\t" - --- | Parses an arbitrary times the first parsing combinator until the parsing --- second parsing combinator is encountered. The result of the second parsing --- combinator is ignored. -pManyTill :: P st a -> P st b -> P st [a] -pManyTill p end = [] <$ end - <<|> - (:) <$> p <*> pManyTill p end - +{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE FlexibleContexts #-}++--------------------------------------------------------------------------------+-- |+-- Module : HarmTrace.Base.Parsing+-- Copyright : (c) 2012--2013 W. Bas de Haas and Jose Pedro Magalhaes+-- License : LGPL-3+--+-- Maintainer : bas@chordify.net, dreixel@chordify.net +-- Stability : experimental+-- Portability : non-portable+--+-- Summary: Some general parsing utilities used for parsing textual chord+-- representations.+--------------------------------------------------------------------------------+++module HarmTrace.Base.Parsing ( -- * Top level parsers + parseData+ , parseDataWithErrors+ , parseDataSafe+ -- * Some general parsers+ , pString+ , pLineEnd+ , pManyTill+ -- Re-exporting the uu-parsinglib+ , module Data.ListLike.Base+ , module Text.ParserCombinators.UU + , module Text.ParserCombinators.UU.Utils+ , module Text.ParserCombinators.UU.BasicInstances+ ) where++import Text.ParserCombinators.UU+import Text.ParserCombinators.UU.Utils hiding (pSpaces)+import Text.ParserCombinators.UU.BasicInstances hiding (IsLocationUpdatedBy)+import Data.ListLike.Base (ListLike)+import Data.List (intersperse)++--------------------------------------------------------------------------------+-- A collection of parsing functions used by parsers throughout the project+-------------------------------------------------------------------------------- ++-- | This is identical to 'parseData' however it will throw an 'error' when+-- the the list with parsing errors is not empty. No, this will not make your+-- program more \safe\. However, in certain cases you really want to be sure+-- that parsing has finished without errors. In those cases you should use+-- 'parseDataSafe'.+parseDataSafe :: (ListLike s a, Show a, Show s) => + P (Str a s LineColPos) b -> s -> b+parseDataSafe p inp = case parseDataWithErrors p inp of+ (dat, [] ) -> dat+ (_ , err) -> error ("HarmTrace.Base.Parsing: a parsing"+ ++ " function did not finish without errors. While" + ++ " parsing the data starting with:\n"+ ++ (take 80 $ show inp)+ ++ "\nThe following errors were encountered:\n"+ ++ (concat . intersperse "\n" . take 50 + . map show $ err))++-- | Toplevel parser that ignores error-reporting, regardless of there were+-- error in the parse+parseData :: (ListLike s a, Show a) => P (Str a s LineColPos) b -> s -> b+parseData p inp = fst ( parseDataWithErrors p inp )++-- | Toplevel parser that returns both the result as well as a (possibly empty)+-- list of error-corrections.+parseDataWithErrors :: (ListLike s a, Show a) + => P (Str a s LineColPos) b -> s -> (b, [Error LineColPos])+parseDataWithErrors p inp = (parse ( (,) <$> p <*> pEnd) + (createStr (LineColPos 0 0 0) inp))+ +-- | Parses a specific string+pString :: (ListLike state a, IsLocationUpdatedBy loc a, Show a, Eq a) + => [a] -> P (Str a state loc) [a]+{-# INLINABLE pString #-} +pString s = foldr (\a b -> (:) <$> a <*> b) (pure []) (map pSym s)++-- | Parses UNIX and DOS/WINDOWS line endings including trailing whitespace+pLineEnd :: Parser String+pLineEnd = pString "\n" <|> pString "\r\n" <|> pString " " <|> pString "\t"++-- | Parses an arbitrary times the first parsing combinator until the parsing +-- second parsing combinator is encountered. The result of the second parsing+-- combinator is ignored.+pManyTill :: P st a -> P st b -> P st [a]+pManyTill p end = [] <$ end + <<|> + (:) <$> p <*> pManyTill p end+