HarmTrace-Base 1.1.0.2 → 1.4.0.1

raw patch · 20 files changed

+2018/−1448 lines, 20 filesdep +HarmTrace-Basedep +QuickCheckdep +containersdep ~ListLikedep ~basedep ~uu-parsinglibsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: HarmTrace-Base, QuickCheck, containers

Dependency ranges changed: ListLike, base, uu-parsinglib

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• HarmTrace-Base.cabal +68/−33
• LICENSE +165/−165
• README.md +15/−0
• Setup.hs +2/−2
• src/HarmTrace/Base/Chord.hs +26/−0
• src/HarmTrace/Base/Chord/Analysis.hs +329/−0
• src/HarmTrace/Base/Chord/Datatypes.hs +338/−0
• src/HarmTrace/Base/Chord/Internal.hs +91/−0
• src/HarmTrace/Base/Chord/Intervals.hs +123/−0
• src/HarmTrace/Base/Chord/PitchClass.hs +144/−0
• src/HarmTrace/Base/ChordTokenizer.hs +0/−194
• src/HarmTrace/Base/MusicRep.hs +0/−656
• src/HarmTrace/Base/MusicTime.hs +0/−308
• src/HarmTrace/Base/Parse.hs +22/−0
• src/HarmTrace/Base/Parse/ChordParser.hs +160/−0
• src/HarmTrace/Base/Parse/General.hs +91/−0
• src/HarmTrace/Base/Parsing.hs +0/−90
• src/HarmTrace/Base/Time.hs +302/−0
• src/Tests.hs +138/−0

@@ -0,0 +1,4 @@+### Changelog ###
+
+1.4.0.1 HarmTrace-Base has been completely rewritten and is not compatible 
+        with software that depends on HarmTrace-Base < 1.4. 

@@ -1,33 +1,68 @@-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+name:                HarmTrace-Base
+version:             1.4.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--2014 W. Bas de Haas and Jose Pedro Magalhaes,
+                     Multiphonyx Holding BV
+homepage:            https://bitbucket.org/bash/harmtrace-base
+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, GHC == 7.8.2
+cabal-version:       >=1.10
+extra-Source-Files:  README.md CHANGELOG.md
+source-repository head
+  type:              git
+  location:          git@bitbucket.org:bash/harmtrace-base.git
+
+
+library
+  default-language:    Haskell2010
+  exposed-modules:     HarmTrace.Base.Chord,
+                       HarmTrace.Base.Chord.Datatypes,
+                       HarmTrace.Base.Chord.Analysis,
+                       HarmTrace.Base.Chord.PitchClass,
+                       HarmTrace.Base.Chord.Intervals,
+                       HarmTrace.Base.Parse, 
+                       HarmTrace.Base.Parse.General, 
+                       HarmTrace.Base.Parse.ChordParser, 
+                       HarmTrace.Base.Time
+
+  other-modules:       HarmTrace.Base.Chord.Internal
+  hs-source-dirs:      src  
+  
+  build-depends:       base >= 4.4 && < 4.8, 
+                       uu-parsinglib ==2.7.4.*, 
+                       ListLike ==4.1.*, 
+                       binary >= 0.6.4, 
+                       ghc-prim >= 0.2,
+                       containers >= 0.5.0.0
+  
+  ghc-options:         -Wall
+                       -O2
+
+Test-Suite test-harmtrace-base
+  default-language:    Haskell2010
+  type:                exitcode-stdio-1.0
+  main-is:             Tests.hs
+  hs-source-dirs:      src
+  build-depends:       QuickCheck >= 1.0 && < 2.1,
+                       HarmTrace-Base == 1.4.0.1,
+                       
+                       base >= 4.2,
+                       uu-parsinglib ==2.7.4.*, 
+                       ListLike ==4.1.*, 
+                       binary >= 0.6.4, 
+                       ghc-prim >= 0.2,
+                       containers >= 0.5.0.0
+                       
+  ghc-options:          -Wall

@@ -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.

@@ -0,0 +1,15 @@+# README #
+
+## HarmTrace Base: Parsing and unambiguously representing musical chords ##
+
+HarmTrace base is a library for representing musical chords. It is used a 
+small number of programs, 
+like [HarmTrace](https://hackage.haskell.org/package/HarmTrace), which is also
+part of the back-end of [Chordify](http://chordify.net).
+
+HarmTrace: Harmony Analysis and Retrieval of Music with Type-level 
+Representations of Abstract Chords Entities
+
+## Installing ##
+
+`cabal install` 

@@ -1,2 +1,2 @@-import Distribution.Simple-main = defaultMain+import Distribution.Simple
+main = defaultMain

@@ -0,0 +1,26 @@+{-# OPTIONS_GHC -Wall             #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  HarmTrace.Base.Chord
+-- Copyright   :  (c) 2013--2014 W. Bas de Haas and Jose Pedro Magalhaes,
+--                Multiphonyx Holding BV
+-- License     :  LGPL-3
+--
+-- Maintainer  :  bas@chordify.net, dreixel@chordify.net 
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Summary: An interface to all the sub modules of HarmTrace.Base.Chord 
+--------------------------------------------------------------------------------
+
+module HarmTrace.Base.Chord (
+    module HarmTrace.Base.Chord.Datatypes  
+  , module HarmTrace.Base.Chord.Analysis  
+  , module HarmTrace.Base.Chord.PitchClass
+  , module HarmTrace.Base.Chord.Intervals
+  ) where
+
+import HarmTrace.Base.Chord.Datatypes
+import HarmTrace.Base.Chord.Analysis
+import HarmTrace.Base.Chord.PitchClass
+import HarmTrace.Base.Chord.Intervals

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

@@ -0,0 +1,338 @@+{-# OPTIONS_GHC -Wall             #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE DeriveFunctor        #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  HarmTrace.Base.MusicRep
+-- Copyright   :  (c) 2012--2014 W. Bas de Haas and Jose Pedro Magalhaes,
+--                Multiphonyx Holding BV
+-- 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.Chord.Datatypes (
+  -- * Representing musical chords and keys
+    Note (..)
+  , Accidental (..)
+  , Root 
+  , DiatonicNatural (..)
+  , ScaleDegree 
+  , DiatonicDegree (..)
+  -- ** Keys
+  , Key (..)
+  , Mode (..)
+  -- ** Chords
+  , Chord (..)
+  , chordRoot
+  , chordShorthand
+  , chordAdditions
+  , chordBass
+  , Shorthand (..)
+  , Addition (..)
+  , IntNat (..)
+  , Interval 
+  , ChordLabel
+  , ChordDegree
+
+  -- ** Derived types for classification of chords
+  , ClassType (..)
+  , Triad (..)
+  -- * Tests & Utilities
+  , shortChord
+  , discardBass
+  , isNoneChord
+  , isAddition
+  , catchNoChord
+  ) where
+  
+import Data.Maybe                 ( fromJust )
+import Data.List                  ( elemIndex, intercalate )
+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 chord based on absolute 'Root' notes
+type ChordLabel   = Chord Root
+
+-- | A chord based on relative 'ScaleDegree's
+type ChordDegree  = Chord ScaleDegree
+
+-- | The representation for a single chord consisting of a root, a 'Shorthand'
+-- representing the interval structure of the chord, a list of 'Additions',
+-- for representing other (additional) structure, and the base 'Inversion'
+data Chord a = Chord a  Shorthand [Addition] Interval  -- ^ a regular chord
+             | NoChord           -- ^ No sounding chord (silence, noise, etc.)
+             | UndefChord        -- ^ An undefined chord
+                deriving (Eq, Ord, Generic, Functor)
+
+-- | Returns the root of a 'Chord', and throws an error in case of a 'NoChord' 
+-- or an 'UndefChord'.
+chordRoot :: Show a => Chord a -> a
+chordRoot = catchNoChord "Chord.Datatypes.chordRoot" (\(Chord r _ _ _) -> r) 
+
+-- | Returns the 'Shorthand' of a 'Chord', and throws an error in case of 
+-- a 'NoChord' or an 'UndefChord'.
+chordShorthand :: Show a => Chord a -> Shorthand
+chordShorthand = catchNoChord "Chord.Datatypes.chordRoot" (\(Chord _ s _ _) ->s) 
+
+-- | Returns the list of 'Additions' of a 'Chord', and throws an error in case
+-- of a 'NoChord' or an 'UndefChord'.
+chordAdditions :: Show a => Chord a -> [Addition]
+chordAdditions = catchNoChord "Chord.Datatypes.chordRoot" (\(Chord _ _ a _) ->a) 
+
+-- | Returns the bass 'Interval' of a 'Chord', and throws an error in case of 
+-- a 'NoChord' or an 'UndefChord'.
+chordBass :: Show a => Chord a -> Interval
+chordBass = catchNoChord "Chord.Datatypes.chordRoot" (\(Chord _ _ _ b) -> b) 
+
+-- | Updates the root field of a 'Chord'
+-- updateRoot :: Chord a -> a -> Chord a
+-- updateRoot (Chord r sh a b) r' = Chord r' sh a b 
+
+-- | We introduce four chord categories: major chords, minor chords, dominant
+-- seventh chords, and diminished 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 | Aug7
+                 -- | Sixth chords
+               | Maj6 | Min6
+                 -- | Extended chords
+               | Nin | Maj9 | Min9
+                 -- | Suspended chords
+               | Sus4 | Sus2 | SevSus4
+                 -- | Power chords
+               | Five
+                 -- Only a root note
+               | 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 
+  deriving (Show, Eq, Enum, Ord, Bounded, Generic)
+  
+-- | Intervals for additional chord notes    
+data Addition = Add   Interval
+              | NoAdd Interval deriving (Eq, Ord, Generic)
+
+-- | Diatonic major intervals used to denote 'Chord' 'Addition's and bass
+-- 'Interval's
+data IntNat = I1  | I2  | I3  | I4 | I5 | I6 | I7 | I8 | I9 | I10 
+            | I11 | I12 | I13 
+  deriving (Eq, Enum, Ord, Bounded, Generic)     
+
+-- \ Represents a musical interval
+type Interval = Note IntNat
+  
+-- | A musical note is a pitch (either absolute or relative) possibly modified
+-- by an 'Accidental'
+data Note a = Note Accidental a   deriving (Eq, Ord, Generic) 
+  
+-- | A musical 'Accidental'
+data Accidental = Nat -- ^ natural
+                | Sh  -- ^ sharp 
+                | Fl  -- ^ flat
+                | SS  -- ^ double sharp
+                | FF  -- ^ double flat
+  deriving (Eq, Ord, Generic)
+
+-- | A 'Triad' comes in four flavours: major, minor, augmented, diminished, 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"  
+
+-- In showing chords, we obey Harte et al.'s syntax as much as possible
+instance Show ChordLabel where
+  show NoChord    = "N"
+  show UndefChord = "X"
+  show (Chord r None []  b) = show r ++ ":1" ++ showIv b
+  show (Chord r sh   add b) = show r ++ ':' : show sh ++ showAdd add ++ showIv b
+  -- 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
+  -- show c = case chordRoot c of
+     -- n@(Note Nat N) -> show n
+     -- n@(Note Nat X) -> show n
+     -- r                  -> show r ++ ':' : show (chordShorthand c) ++ ' ' : show ( toPitchClasses  c)   
+    
+showIv :: Interval -> String
+showIv (Note Nat I1) = ""
+showIv i             = '/' : show i 
+
+    
+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 Aug7     = "aug7"
+  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 SevSus4  = "7sus4"
+  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 IntNat) where
+  show (Note m i) = show m ++ show i
+
+instance Show (Note DiatonicNatural) where
+  show (Note m r) = show r ++ show m  
+  
+instance Show (Note DiatonicDegree) where
+  show (Note m r) = show m ++ show r
+  
+instance Show IntNat where
+  show a = show . ((!!) ([1..13]::[Integer])) 
+                . fromJust $ elemIndex a [minBound..]
+   
+  
+instance Show Accidental where 
+  show Nat = ""
+  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"
+  
+--------------------------------------------------------------------------------
+-- Utilities     
+--------------------------------------------------------------------------------
+
+-- | A Constructor for a simple chord based on a 'Root' and 'Shorthand' only
+shortChord :: Root -> Shorthand -> ChordLabel
+shortChord r sh = Chord r sh [] (Note Nat I1)
+
+-- | Returns True if the 'ChordLabel' is not a chord, and False otherwise 
+isNoneChord :: ChordLabel -> Bool
+isNoneChord NoChord = True
+isNoneChord _       = 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
+
+-- | Discards a base note by replacing the bass 'Interval' by a 
+-- 'Note' 'Nat' 'I1'
+discardBass :: Chord a -> Chord a
+discardBass NoChord           = NoChord
+discardBass UndefChord        = UndefChord
+discardBass (Chord r sh a _b) = Chord r sh a (Note Nat I1)
+
+-- | Checks if the 'ChordLabel' is a 'NoChord' or 'UndefChord' and throws
+-- an error using the first argument as an function identifier for debugging.
+-- In case of a 'ChordLabel' the second argument is applied to the third
+-- argument.
+catchNoChord :: Show a => String -> (Chord a -> b) ->  Chord a -> b
+catchNoChord s f c = case c of
+       NoChord    -> error ("HarmTrace.Base."++s++" applied to a NoChord")
+       UndefChord -> error ("HarmTrace.Base."++s++" applied to a UndefChord")
+       _          -> f c
+
+--------------------------------------------------------------------------------
+-- Binary instances
+--------------------------------------------------------------------------------
+
+instance Binary Key
+instance Binary Mode 
+instance Binary a => Binary (Chord a)
+instance Binary ClassType
+instance Binary Shorthand
+instance Binary DiatonicDegree
+instance Binary DiatonicNatural
+instance Binary Addition
+instance Binary IntNat
+instance Binary a => Binary (Note a)
+instance Binary Accidental
+instance Binary Triad

@@ -0,0 +1,91 @@+{-# OPTIONS_GHC -Wall             #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  HarmTrace.Base.Chord.Internal
+-- Copyright   :  (c) 2013 W. Bas de Haas and Jose Pedro Magalhaes,
+--                Multiphonyx Holding BV
+-- License     :  LGPL-3
+--
+-- Maintainer  :  bas@chordify.net, dreixel@chordify.net 
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Summary: Some common function that are not exported
+--------------------------------------------------------------------------------
+
+module HarmTrace.Base.Chord.Internal (
+    modToInt
+  , scaleDegrees
+  , roots
+  , intervals
+  ) where
+
+import HarmTrace.Base.Chord.Datatypes
+
+-- | Transforms type-level Accidentals to semitones (Int values)
+modToInt :: Accidental -> Int
+modToInt Nat =  0
+modToInt Sh  =  1
+modToInt Fl  = -1
+modToInt SS  =  2
+modToInt FF  = -2
+
+-- | A list of 12 'ScaleDegree's, ignoring pitch spelling.
+scaleDegrees ::[ ScaleDegree ]  
+scaleDegrees = [ Note  Nat I
+               , Note  Sh  I
+               , Note  Nat II
+               , Note  Fl  III
+               , Note  Nat III
+               , Note  Nat IV
+               , Note  Sh  IV
+               , Note  Nat V
+               , Note  Fl  VI
+               , Note  Nat VI
+               , Note  Fl  VII
+               , Note  Nat VII
+               ]
+               
+
+-- | A list of 12 'Note DiatonicNatural's, ignoring pitch spelling.
+roots ::       [ Root ]  
+roots =        [ Note Nat C
+               , Note Sh  C
+               , Note Nat D
+               , Note Fl  E
+               , Note Nat E
+               , Note Nat F
+               , Note Sh  F
+               , Note Nat G
+               , Note Fl  A
+               , Note Nat A
+               , Note Fl  B
+               , Note Nat B
+               ]
+
+
+intervals ::   [ Interval ]
+intervals =    [ Note Nat I1  --  0: Prime
+               , Note Fl  I2  --  1: Minor second
+               , Note Nat I2  --  2: Major second
+               , Note Fl  I3  --  3: Minor third
+               , Note Nat I3  --  4: Major third
+               , Note Nat I4  --  5: Perfect fourth
+               , Note Fl  I5  --  6: Diminished fifth (augmented fourth)
+               , Note Nat I5  --  7: Perfect fifth
+               , Note Fl  I6  --  8: Minor sixth
+               , Note Nat I6  --  9: Major sixth
+               , Note Fl  I7  -- 10: Minor seventh
+               , Note Nat I7  -- 11: Major seventh
+               , Note Nat I8  -- 12: Perfect Octave
+               , Note Fl  I9  -- 13: Flat nine   -- in jazz jargon
+               , Note Nat I9  -- 14: Nine
+               , Note Sh  I9  -- 15: Sharp nine
+               , Note Nat I10 -- 16: tenth: is viewed as third
+               , Note Nat I11 -- 17: eleventh
+               , Note Sh  I11 -- 18: sharp eleventh
+               , Note Nat I12 -- 19: twelveth: viewed as fifth
+               , Note Fl  I13 -- 20: Flat thirteen
+               , Note Nat I13 -- 21: Thirteen
+               ]

@@ -0,0 +1,123 @@+{-# OPTIONS_GHC -Wall             #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  HarmTrace.Base.Chord.Intervals
+-- Copyright   :  (c) 2013--2014 W. Bas de Haas and Jose Pedro Magalhaes,
+--                Multiphonyx Holding BV
+-- License     :  LGPL-3
+--
+-- Maintainer  :  bas@chordify.net, dreixel@chordify.net 
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Summary: We can represent a chord as a set of intervals relative to the 
+-- root of the chord.
+--------------------------------------------------------------------------------
+
+module HarmTrace.Base.Chord.Intervals (
+  -- * Interval Conversion
+    icToInterval
+  , toIntervalClss
+  -- * Creating Interval Sets
+  -- , IntSet
+  , toIntSet
+  -- * Utilities
+  , addToIntSet
+  , shToIntSet
+  ) where
+
+import HarmTrace.Base.Chord.Datatypes
+import HarmTrace.Base.Chord.Internal
+
+import Data.List                  ( partition )
+import Data.IntSet                ( IntSet, fromList, union, insert, singleton
+                                  , empty, (\\) )
+
+-- | Converts an 'Int'erval class to an 'Interval'
+icToInterval :: Int -> Interval
+icToInterval i
+  | 0 <= i && i <= 21 = intervals !! i
+  | otherwise         = error ("HarmTrace.Base.MusicRep.toInterval " ++
+                               "invalid pitch class: " ++ show i)
+
+-- | Similar to 'toPitchClss', this function calculates an enharmonic 
+-- interval class for each 'Note Interval' in the range of [0 .. 23]
+-- ( == ['Note Nat I1' .. 'Note SS I13']
+toIntervalClss :: Interval -> Int
+toIntervalClss n@(Note m i) =
+  --         1 2 3 4 5 6 7  8  9  10 11 12 13
+  let ic = ([0,2,4,5,7,9,11,12,14,16,17,19,21] !! (fromEnum i)) + modToInt m 
+  in  if ic >= 0 then ic
+                 else error ("HarmTrace.Base.MusicRep.toIntervalClss: no "
+                          ++ "interval class for " ++ show n)
+
+
+-- | Transforms a Chord into a list of relative intervals stored as an 'IntSet'
+-- without the root an bass note represented as the number of semitones above
+-- the root.
+-- 
+-- >>> toIntSet (Chord (Note Nat C) HDim7 [Add (Note Sh I11)] (Note Fl I3))
+-- fromList [3,6,10,18]
+--
+-- >>> toIntSet (Chord (Note Nat C) Min13 [NoAdd (Note Nat I11)] (Note Nat I1))
+-- fromList [3,7,10,14,21]
+--
+-- >>> toIntSet (parseData pChord "D:7(b9)")
+-- fromList [4,7,10,13]
+--
+toIntSet :: Chord a -> IntSet
+toIntSet (Chord  _r sh [] _b) = shToIntSet sh
+toIntSet (Chord  _r sh a  _b) = let (add, rm) = partition isAddition a
+                                in (shToIntSet sh `union` toSet add) \\ toSet rm
+toIntSet _ = error ("HarmTrace.Base.MusicRep.toIntValList: cannot create" ++
+                        "interval list for N or X")
+
+-- | Converts a list of addition to an 'IntSet' containing the relative 
+-- structure of the ('Addition' list of the) 'Chord'
+addToIntSet :: [Addition] -> IntSet 
+addToIntSet add = toSet adds \\ toSet remv
+  where (adds, remv) = partition isAddition add
+
+-- not exported: strips the interval from a list of Additions regardless of
+-- it is a Add or NoAdd
+toSet :: [Addition] -> IntSet
+toSet = fromList . map (toIntervalClss . getInt) where
+
+  getInt :: Addition -> Interval
+  getInt (NoAdd i) = i
+  getInt (Add   i) = i
+        
+  
+-- | Expands a 'Shorthand' to its list of degrees
+shToIntSet :: Shorthand -> IntSet 
+shToIntSet Maj     = fromList [4,7]              --    [Note Nat I3,Note Nat I5]
+shToIntSet Min     = fromList [3,7]              --    [Note Fl  I3,Note Nat I5]
+shToIntSet Dim     = fromList [3,6]              --    [Note Fl  I3,Note Fl  I5]
+shToIntSet Aug     = fromList [4,8]              --    [Note Nat I3,Note Sh  I5]
+shToIntSet Maj7    = insert 11 (shToIntSet Maj)  -- ++ [Note Nat I7]
+shToIntSet Min7    = insert 10 (shToIntSet Min)  -- ++ [Note Fl  I7]
+shToIntSet Sev     = insert 10 (shToIntSet Maj)  -- ++ [Note Fl  I7]
+shToIntSet Dim7    = insert  9 (shToIntSet Dim)  -- ++ [Note FF  I7]
+shToIntSet HDim7   = insert 10 (shToIntSet Dim)  -- ++ [Note Fl  I7]
+shToIntSet MinMaj7 = insert 11 (shToIntSet Min)  -- ++ [Note Nat I7]
+shToIntSet Aug7    = insert 10 (shToIntSet Aug)  -- ++ [Note Fl  I7]
+shToIntSet Maj6    = insert  9 (shToIntSet Maj)  -- ++ [Note Nat I6]
+-- Harte uses a 6 instead of b6
+shToIntSet Min6    = insert  8 (shToIntSet Min ) -- ++ [Note Fl  I6] 
+shToIntSet Nin     = insert 14 (shToIntSet Sev ) -- ++ [Note Nat I9]
+shToIntSet Maj9    = insert 14 (shToIntSet Maj7) -- ++ [Note Nat I9]
+shToIntSet Min9    = insert 14 (shToIntSet Min7) -- ++ [Note Nat I9]
+shToIntSet Five    = singleton 7                 --    [Note Nat I5]
+shToIntSet Sus2    = fromList [2,7]              --    [Note Nat I2,Note Nat I5]
+shToIntSet Sus4    = fromList [5,7]              --    [Note Nat I4,Note Nat I5]
+shToIntSet SevSus4 = insert 10 (shToIntSet Sus4) -- ++ [Note Fl  I7]
+shToIntSet None    = empty
+-- additional Billboard shorthands
+shToIntSet Min11   = insert 17 (shToIntSet Min9  ) -- ++ [Note Nat I11]
+shToIntSet Eleven  = insert 17 (shToIntSet Nin   ) -- ++ [Note Nat I11]
+shToIntSet Min13   = insert 21 (shToIntSet Min11 ) -- ++ [Note Nat I13]
+shToIntSet Maj13   = insert 21 (shToIntSet Maj9  ) -- ++ [Note Nat I13]
+shToIntSet Thirteen= insert 21 (shToIntSet Eleven) -- ++ [Note Nat I13]
+     
+     
+     

@@ -0,0 +1,144 @@+{-# OPTIONS_GHC -Wall             #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE DeriveGeneric        #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  HarmTrace.Base.Chord.PitchClass
+-- Copyright   :  (c) 2013--2014 W. Bas de Haas and Jose Pedro Magalhaes,
+--                Multiphonyx Holding BV
+-- License     :  LGPL-3
+--
+-- Maintainer  :  bas@chordify.net, dreixel@chordify.net 
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Summary: this module provides some functions that transform notes and chords
+-- into pitch classes and pitch class sets. See for more info:
+-- <http://en.wikipedia.org/wiki/Pitch_class>
+--------------------------------------------------------------------------------
+module HarmTrace.Base.Chord.PitchClass (
+    PCSet  -- Pitch Class Set
+  , pc     -- Unwraps a 'PCSet'
+    -- * Pitch classes
+  , toPitchClass
+  , pcToRoot
+    -- * Pitch classes applied to chords
+  , toPitchClasses
+  , rootPC
+  , bassPC
+  , ignorePitchSpelling
+    -- * Pitch classes applied to interval sets
+  , intValToPitchClss
+  , intSetToPC  
+  -- * Enharmonic Equivalence
+  , EnHarEq (..)
+  -- * Diatonic Class
+  , Diatonic
+  ) where
+
+import HarmTrace.Base.Chord.Datatypes
+import HarmTrace.Base.Chord.Intervals
+import HarmTrace.Base.Chord.Internal
+
+import Data.Binary                ( Binary )
+import Data.IntSet                ( IntSet, fromList, union )
+import qualified Data.IntSet as S ( map )
+import GHC.Generics               ( Generic )
+
+-- | We hide the constructors, such that a PCSet can only be constructed with
+-- 'toPitchClasses', this to overcome confusion between interval sets and
+-- pitch class sets, which are both 'Data.IntSet.IntSet's
+newtype PCSet = PCSet {pc :: IntSet} deriving (Show, Eq, Generic)
+
+instance Binary PCSet
+
+-- | 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.
+toPitchClass :: (Diatonic a) => Note a -> Int
+toPitchClass (Note m p) 
+  | ix <= 6   = noNegatives (([0,2,4,5,7,9,11] !! ix) + modToInt m) `mod` 12
+  | otherwise = error ("HarmTrace.Base.MusicRep.toPitchClass: no semitone for "
+                        ++ show p ++ show m )
+      where ix = fromEnum p
+            noNegatives s | s < 0     = 12 + s
+                          | otherwise = s
+
+
+-- | Transforms an interval set to and a root into a 'PCSet'
+intSetToPC :: IntSet -> Root -> PCSet
+intSetToPC is r = PCSet . S.map (transp (toPitchClass r)) $ is where
+
+  transp :: Int -> Int -> Int
+  transp t i = (i + t) `mod` 12
+  
+ 
+-- | As 'toIntervalClss', but returns the 'Int' pitch class. 
+intValToPitchClss :: Root -> Interval -> Int
+intValToPitchClss r i = (toPitchClass r + toIntervalClss i) `mod` 12
+                          
+  
+-- | The reverse of 'toPitchClass' returning the 'Note DiatonicNatural' given a 
+-- Integer [0..11] semitone, where 0 represents C. All pitch spelling is ignored
+-- and the the following twelve pitch names will be output: C, C#, D, Eb, E, F
+-- F#, G, Ab, A, Bb, B.  When the integer is out of the range [0..11] an 
+-- error is thrown.
+pcToRoot :: Int -> Root
+pcToRoot i 
+  | 0 <= i && i <= 11 = roots !! i
+  | otherwise         = error ("HarmTrace.Base.MusicRep.toRoot " ++
+                               "invalid pitch class: " ++ show i)
+                          
+-- | Similar to 'toIntSet' but returns 'Int' pitch classes and includes the
+-- 'Root' and the bass 'Note' of the the 'Chord'. 'toPitchClasses' throws an
+-- error when applied to a 'NoChord' or 'UndefChord'.
+toPitchClasses :: ChordLabel -> PCSet
+toPitchClasses c = catchNoChord "Chord.PitchClass.toPitchClasses" 
+                                (intSetToPC ivs . chordRoot) c
+  
+  where ivs = toIntSet c `union` fromList [0, toIntervalClss (chordBass c)] 
+  
+-- | A short-cut applying 'intValToPitchClss' to a 'Chord'. 'bassPC' throws an
+-- error when applied to a 'NoChord' or 'UndefChord'.
+bassPC :: ChordLabel -> Int
+bassPC = catchNoChord "Chord.PitchClass.rootPC" bassPC' where
+  
+  bassPC' :: ChordLabel -> Int
+  bassPC' c = intValToPitchClss (chordRoot c) (chordBass c)
+
+-- | A short-cut applying 'toPitchClass' to a 'Chord'. 'rootPC'  throws an
+-- error when applied to a 'NoChord' or 'UndefChord'.
+rootPC :: ChordLabel -> Int  
+rootPC = catchNoChord "Chord.PitchClass.rootPC" (toPitchClass . chordRoot)
+
+-- | Ignores the pitch spelling of a chord by applying 'pcToRoot' and 
+-- 'toPitchClass' to the root of a 'ChordLabel'.
+ignorePitchSpelling :: ChordLabel -> ChordLabel
+ignorePitchSpelling NoChord    = NoChord
+ignorePitchSpelling UndefChord = UndefChord
+ignorePitchSpelling c          = fmap (pcToRoot . toPitchClass) c
+--------------------------------------------------------------------------------
+-- Classes
+--------------------------------------------------------------------------------
+
+-- | A class to compare datatypes that sound the same (they contain the 
+-- same pitch class content):
+-- <http://en.wikipedia.org/wiki/Enharmonic>
+class EnHarEq a where
+  (&==) :: a -> a -> Bool
+  (&/=) :: a -> a -> Bool
+
+  a &== b = not (a &/= b)
+  a &/= b = not (a &== b)
+
+instance Diatonic a => EnHarEq (Note a) where
+  a &== b = toPitchClass a == toPitchClass b
+  
+instance EnHarEq ChordLabel where
+  a &== b = toPitchClasses a == toPitchClasses b  
+  
+-- | A class to mark certain datatypes to have a diatonic structure:
+--   http://en.wikipedia.org/wiki/Diatonic_and_chromatic
+class (Generic a, Show a, Enum a, Bounded a) => Diatonic a
+
+instance Diatonic DiatonicNatural
+instance Diatonic DiatonicDegree

@@ -1,194 +0,0 @@-{-# 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"

@@ -1,656 +0,0 @@-{-# 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

@@ -1,308 +0,0 @@-{-# 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

@@ -0,0 +1,22 @@+{-# OPTIONS_GHC -Wall             #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  HarmTrace.Base.Parse
+-- Copyright   :  (c) 2013--2014 W. Bas de Haas and Jose Pedro Magalhaes,
+--                Multiphonyx Holding BV
+-- License     :  LGPL-3
+--
+-- Maintainer  :  bas@chordify.net, dreixel@chordify.net 
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Summary: An interface to all the sub modules of HarmTrace.Base.Parse 
+--------------------------------------------------------------------------------
+
+module HarmTrace.Base.Parse (
+    module HarmTrace.Base.Parse.General  
+  , module HarmTrace.Base.Parse.ChordParser  
+  ) where
+
+import HarmTrace.Base.Parse.General  
+import HarmTrace.Base.Parse.ChordParser  

@@ -0,0 +1,160 @@+{-# OPTIONS_GHC -Wall           #-}
+{-# LANGUAGE FlexibleContexts   #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  HarmTrace.Base.Parse.ChordParser
+-- Copyright   :  (c) 2012--2014 W. Bas de Haas and Jose Pedro Magalhaes,
+--                Multiphonyx Holding BV
+-- 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.Parse.ChordParser ( 
+  -- * Parsing (elements of) chords
+    pChord
+  , pShorthand
+  , pRoot
+  , pAdditions
+  , pAddition
+  , pKey
+  ) where
+
+import HarmTrace.Base.Parse.General
+import HarmTrace.Base.Chord
+
+--------------------------------------------------------------------------------
+-- Parsing String of Musical Chords
+--------------------------------------------------------------------------------
+
+-- | 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 
+-- depended, often these are beats, but they can also be eighth notes)
+pChord :: Parser ChordLabel 
+{-# INLINE pChord #-}
+pChord =     pChordLabel 
+         <|> (NoChord    <$ (pString "N"  <|> pString "&pause"))
+         <|> (UndefChord <$ (pSym '*'     <|> pSym 'X'))
+         <?> "Chord"
+                    
+-- Parses a chord label
+-- TODO add support for inversion
+pChordLabel :: Parser ChordLabel
+{-# INLINE pChordLabel #-}
+pChordLabel = mkChord <$> pRoot <* (pSym ':' `opt` ':') 
+                      <*> pMaybe pShorthand
+                      <*> (pAdditions `opt` []) 
+                      <*> pInversion where
+  
+  mkChord :: Root -> Maybe Shorthand -> [Addition] -> Maybe Interval
+          -> ChordLabel
+  -- if there are no degrees and no shorthand, following Harte it 
+  -- should be labelled a Maj chord
+  mkChord r Nothing [] b = Chord   r Maj             [] (inversion b)
+  mkChord r Nothing  a b = toChord r (addToIntSet a)    b
+  mkChord r (Just s) a b = Chord   r s               a  (inversion b) 
+  
+  -- prepares an inversion, if any
+  inversion :: Maybe Interval -> Interval
+  inversion = maybe (Note Nat I1) id
+
+-- Parses an inversion, but inversions are ignored for now.
+pInversion :: Parser (Maybe Interval)
+pInversion = pMaybe (pSym '/' *> pIntNote) <?> "/Inversion"
+             
+-- | 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 'Shorthand's
+-- 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"
+             <|> Aug7     <$ pString "aug7"
+             <|> 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" 
+             <|> SevSus4  <$ pString "7sus4" 
+             -- 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   <$>             pIntNote)
+        <|> (NoAdd <$> (pSym '*'*> pIntNote))
+        <?> "Addition"
+
+-- | Parses an 'Interval'
+pIntNote :: Parser Interval
+pIntNote = Note <$> pAccidental <*> pInterval
+        
+-- | Parses in 'Accidental'       
+pAccidental :: Parser Accidental
+pAccidental =    Sh <$ pSym    's'
+             <|> Sh <$ pSym    '#'
+             <|> Fl <$ pSym    'b'
+             <|> SS <$ pString "ss"
+             <|> SS <$ pString "##"
+             <|> FF <$ pString "bb"
+             <|> pure Nat <?> "Accidental"
+
+-- | Parses an 'Interval'
+pInterval :: Parser IntNat
+pInterval =  ((!!) [minBound..] ) . pred <$> pNaturalRaw <?> "Interval"
+
+-- | Parses a 'Root' 'Note', e.g. @A@, @Bb@, or @F#@.
+pRoot :: Parser Root
+{-# INLINE pRoot #-}
+pRoot = (flip Note) <$> pDiaNat <*> pAccidental
+
+pDiaNat :: Parser DiatonicNatural
+{-# INLINE pDiaNat #-}
+pDiaNat =    A  <$ pSym 'A'
+         <|> B  <$ pSym 'B'
+         <|> C  <$ pSym 'C'
+         <|> D  <$ pSym 'D'
+         <|> E  <$ pSym 'E'
+         <|> F  <$ pSym 'F'
+         <|> G  <$ pSym 'G'

@@ -0,0 +1,91 @@+{-# OPTIONS_GHC -Wall         #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  HarmTrace.Base.Parse.General
+-- Copyright   :  (c) 2012--2014 W. Bas de Haas and Jose Pedro Magalhaes,
+--                Multiphonyx Holding BV
+-- 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.Parse.General ( -- * Top level parsers 
+    parseData
+  , parseDataWithErrors
+  , parseDataSafe
+    -- * Some general parsers
+  , pString
+  , pLineEnd
+  , pManyTill
+    -- Re-exporting the uu-parsinglib
+  , module Text.ParserCombinators.UU 
+  , module Text.ParserCombinators.UU.Utils
+  , module Text.ParserCombinators.UU.BasicInstances
+  -- , module Data.ListLike.Base 
+  ) 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))
+
+-- | Top-level 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 )
+
+-- | Top-level 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
+

@@ -1,90 +0,0 @@-{-# 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-

@@ -0,0 +1,302 @@+{-# LANGUAGE TypeSynonymInstances             #-}
+{-# LANGUAGE FlexibleInstances                #-}
+{-# LANGUAGE ScopedTypeVariables              #-}
+{-# 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.Time (
+   
+   NumData
+  -- ** Representing musical time
+  , Timed (..)
+  , Beat (..)
+  , BeatTime (..) 
+
+  -- * Functions
+  -- ** Data access
+  , timed
+  , timedBT
+  , getBeatTime 
+  , getBeat 
+  , onset
+  , offset
+  , duration
+  , setData
+  , getEndTime
+  
+  -- ** Type conversion and other utilities
+  -- , fromDurations
+  , mergeTimed
+  , mergeTimedWith
+  , expandTimed
+  , concatTimed
+  , splitTimed
+  , nextBeat
+  , prevBeat 
+  , dropTimed
+  , timeStamp
+  , timeComp
+  , roundingError
+  , beat 
+  , pprint
+  , prettyPrint
+
+) where
+             
+import Data.List                      ( intercalate )
+
+-- | When reducing and expanding 'Timed' 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 millisecond  
+
+
+-- | 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 datatype that wraps around an (musical) datatype, adding information 
+-- about the musical time to this datatype. Musical time is stored as 
+-- a list of 'BeatTime' time stamps that can optionally be augmented
+-- with information about the 'Beat' position of the particular time stamp 
+-- inside the bar.
+data Timed a = Timed { -- | Returns the contained datatype 
+                               getData :: a 
+                               -- | Returns the list of TimeStamps
+                             , getTimeStamps :: [BeatTime]
+                             } deriving (Functor, Show, Eq)
+
+-- | 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, Ord, Enum)
+
+--------------------------------------------------------------------------------
+-- Instances of high-level data structure
+--------------------------------------------------------------------------------
+
+  
+instance Show Beat where
+  show One   = "1"
+  show Two   = "2"
+  show Three = "3"
+  show Four  = "4"
+  show NoBeat = "x"
+
+instance Show BeatTime where
+  show (BeatTime t bt) = '(' : show t ++ ", " ++ show bt ++ ")"
+  show (Time t)       = '(' : show t ++ ")"
+
+    
+--------------------------------------------------------------------------------
+-- numerical data representation
+--------------------------------------------------------------------------------
+
+
+-- 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 BeatTime = BeatTime NumData Beat
+              | Time     NumData      deriving Eq
+
+-- we compare based on the timestamp only
+instance Ord BeatTime where
+  compare a b = compare (timeStamp a) (timeStamp b)
+
+--------------------------------------------------------------------------------
+-- Some type conversion utilities
+--------------------------------------------------------------------------------
+{-
+fromDurations :: NumData -> [(a,NumData)] -> [Timed a]
+fromDurations z td = foldl' step [] td where
+
+  step :: [Timed a] -> (a, NumData) ->  [Timed a]
+  step []                         (a, x) = [TimedData x [Time z, Time x]]
+  step [Timed _ [Time _, Time o]] (a, x) = [TimedData x [Time o, Time x]]
+-}
+
+-- | alternative 'Timed' constructor
+timed :: a -> NumData -> NumData -> Timed a
+timed d x y = Timed d [Time x, Time y]
+
+-- | alternative 'Timed' constructor
+timedBT :: a -> BeatTime -> BeatTime -> Timed a
+timedBT d x y = Timed d [x, y]
+
+-- | concatenates the 'BeatTime' timestamps of two 'Timed's and 
+-- creates a new 'Timed' that stores the first argument. 
+-- N.B. this function uses 'timeComp' to allow for very small timing deviations
+concatTimed :: a -> Timed a -> Timed a -> Timed a
+concatTimed dat (Timed _ ta) (Timed _ tb) = 
+  Timed dat (mergeBeatTime ta tb) where
+
+  mergeBeatTime :: [BeatTime] -> [BeatTime] -> [BeatTime]
+  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  
+
+
+-- | the inverse of 'mergeTimed', expanding the list 'Timed' elements to all
+-- timestamps stored in the 'getTimeStamps' list. N.B. 
+--
+-- >>> expandTimed (mergeTimed x) = x :: [Timed a]
+-- 
+-- also,
+--
+-- >>> (expandTimed cs) = cs
+--
+-- and,
+--
+-- >>> mergeTimed (mergeTimed (mergeTimed cs)) = (mergeTimed cs)
+--
+-- hold. This has been tested on the first tranche of 649 Billboard songs.
+expandTimed :: [Timed a] -> [Timed a]
+expandTimed = concatMap replic where
+
+  replic :: Timed a -> [Timed a]
+  replic (Timed c ts) = let reps = repeat c 
+                        in  zipWith3 timedBT (c : reps) ts (tail ts)
+
+-- | merges consecutive 'Timed' values that store the same element (using
+-- ('(==)'). For example:
+--
+-- >>> mergeTimed [timed "c" 0 1, timed "c" 1 2, timed "d" 3 4, timed "d" 4 5, timed "e" 5 6]
+-- >>> [Timed {getData = "c", getTimeStamps = [(0.0),(1.0),(2.0)]}
+-- >>> ,Timed {getData = "d", getTimeStamps = [(3.0),(4.0),(5.0)]}
+-- >>> ,Timed {getData = "e", getTimeStamps = [(5.0),(6.0)]}]
+-- 
+mergeTimed :: Eq a => [Timed a] -> [Timed a]
+mergeTimed = mergeTimedWith (==)
+
+-- | Does exactly what 'mergeTimed' does, but allows for a custom equality 
+-- function
+mergeTimedWith :: forall a. Eq a => (a -> a -> Bool) -> [Timed a] -> [Timed a]
+mergeTimedWith eq = foldr groupT [] where
+
+   groupT :: Eq a => Timed a -> [Timed a] -> [Timed a]
+   groupT c [] = [c]
+   groupT tc@(Timed c _ ) (th@(Timed h _ ) : t)
+     | c `eq` h  = concatTimed c tc th : t
+     | otherwise = tc : th : t
+
+-- | Splits a 'Timed' in two 'Timed's at the specified position. If
+-- the position is out of range, an error is thrown.
+--
+-- >>> splitTimed (Timed "x" [Time 2, Time 5]) 4
+-- >>> ( Timed {getData = "x", getTimeStamps = [(2.0),(4.0)]}
+-- >>> , Timed {getData = "x", getTimeStamps = [(4.0),(5.0)]} )
+splitTimed :: Show a => Timed a -> NumData -> (Timed a, Timed a)
+splitTimed td@(Timed d t) s 
+  | s > onset td = case span ((< s) . timeStamp) t of
+                    (_, []) -> e
+                    (x, y ) -> ( Timed d (x ++ [Time s])
+                               , Timed d (Time s : y   ))
+  | otherwise    = e
+      where e = error ( "HarmTrace.Base.MusicTime.splitTimed: Timestamp " 
+                      ++ show s ++ " not in range of Timed: " ++ show td) 
+  
+    
+-- | 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
+
+-- | wraps a datatype in 'Timed'
+setData :: Timed a -> b -> Timed b
+setData td d = td {getData = d}
+
+-- | Returns the start time stamp
+getBeatTime :: Timed a -> BeatTime
+getBeatTime td = case getTimeStamps td of
+  []    -> error "HarmTrace.Base.MusicTime.getBeatTime: no timestamps are stored"
+  (h:_) -> h
+
+-- | Returns the start 'Beat'
+getBeat :: Timed a -> Beat
+getBeat = beat . getBeatTime 
+
+-- | Given a list of 'Timed' values, returns the end time of the latest element
+-- in the list.
+getEndTime :: [Timed a] -> NumData
+getEndTime [] = error "getEndTime: empty list"
+getEndTime l  = offset . last $ l
+
+-- | Returns the 'NumData' timestamp, given a 'BeatTime'
+timeStamp :: BeatTime -> NumData
+timeStamp (BeatTime t _bt) = t
+timeStamp (Time    t    ) = t  
+
+-- | Returns the 'NumData' timestamp, given a 'BeatTime'
+beat :: BeatTime -> Beat
+beat (BeatTime _t bt) = bt
+beat (Time    _t   ) = NoBeat
+
+-- | Returns the onset time stamp
+onset :: Timed a -> NumData
+onset = timeStamp . getBeatTime 
+
+-- | Returns the offset time stamp
+offset :: Timed a -> NumData
+offset td = case getTimeStamps td of
+  []  -> error "HarmTrace.Base.MusicTime.offset: no timestamps are stored"
+  l   -> timeStamp . last $ l
+
+-- | Returns the duration of 'Timed'
+duration :: Timed a -> NumData
+duration td = offset td - onset td
+
+-- 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
+
+-- | drops the time (with or without 'Beat') information of a list 
+-- 'Timed' data structure 
+dropTimed :: [Timed a] -> [a]
+dropTimed = map getData
+
+-- | Pretty prints a list of 'Timed's, one per line
+prettyPrint :: Show a => [Timed a] -> String
+prettyPrint = intercalate "\n" . map pprint where
+
+-- | Pretty prints a single 'Timed'
+pprint :: Show a => Timed a -> String
+pprint (Timed d [ ]) = "not set - not set: " ++ show d
+pprint (Timed d [x]) = show x ++" - not set: " ++ show d
+pprint (Timed d ts ) = show (head ts) ++ " - " ++ show (last ts) 
+                                          ++ ": "  ++ show d

@@ -0,0 +1,138 @@+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# OPTIONS_GHC -fno-warn-orphans       #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  HarmTrace.Base.Chord.Tests
+-- Copyright   :  (c) 2013--2014 W. Bas de Haas and Jose Pedro Magalhaes,
+--                Multiphonyx Holding BV
+-- License     :  LGPL-3
+--
+-- Maintainer  :  bas@chordify.net, dreixel@chordify.net 
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Summary: Defines some property tests for testing the HarmTrace.Base package
+--------------------------------------------------------------------------------
+module Main where
+
+import HarmTrace.Base.Chord
+import HarmTrace.Base.Parse   ( parseDataSafe, pChord )
+import HarmTrace.Base.Time
+
+import Test.QuickCheck
+import Test.QuickCheck.Batch
+
+import Data.List              ( sort, foldl' )
+
+import System.Exit            ( exitFailure, exitSuccess )
+
+instance Arbitrary DiatonicNatural where
+  arbitrary = elements . enumFrom $ C
+
+instance Arbitrary IntNat where
+  arbitrary = elements . enumFrom $ I1
+  
+instance Arbitrary Accidental where
+  arbitrary = elements [Nat,Sh,Fl,SS,FF]
+
+
+instance Arbitrary Root where
+  arbitrary = elements . map pcToRoot $ [0..11]
+  
+instance Arbitrary Interval where
+  arbitrary = choose (0,21) >>= return . icToInterval  
+  
+-- instance Arbitrary a => Arbitrary (Note a) where
+  -- arbitrary = do nat <- arbitrary
+                 -- acc <- arbitrary
+                 -- return (Note acc nat)
+
+               
+instance Arbitrary Shorthand where
+  arbitrary = elements . enumFrom $ Maj
+  
+instance Arbitrary Addition where
+  arbitrary = oneof [ arbitrary >>= return . Add
+                    , arbitrary >>= return . NoAdd ]
+
+instance Arbitrary a => Arbitrary (Chord a) where
+  arbitrary = do r   <- arbitrary
+                 sh  <- elements [Maj, Min, Aug, Dim, Maj7, Min7, Sev, Dim7, HDim7, Aug7, MinMaj7]
+                 -- sh  <- arbitrary
+                 -- add <- arbitrary >>= listOf . return . Add 
+                 
+                 b   <- arbitrary
+                 return (Chord r sh [] b ) -- (Note Nat I1))
+                 
+instance Arbitrary a => Arbitrary (Timed a) where
+  arbitrary = do x  <- arbitrary
+                 s  <- elements [2 .. 5]
+                 ts <- vector s -- guarantee that this list has a minimum of 2 items
+                 return . Timed x . sort $ ts
+               
+newtype ChkTimed = ChkTimed [Timed ChordLabel] deriving (Show, Eq)
+instance Arbitrary ChkTimed where
+  arbitrary = do let f :: [Timed a] -> (a, NumData) -> [Timed a]
+                     f [   ] (a, x) = [timed a 0 x]
+                     f (h:t) (a, x) = let o = offset h in timed a o (o+x) : h : t
+                     
+                     dups :: [Bool] -> [a] -> [a]
+                     dups [ ]     l     = l
+                     dups _      [ ]    = []
+                     dups (b:bs) (e:es) | b         = e : dups bs (e : es)
+                                        | otherwise = e : dups bs es
+                 
+                 ds <- arbitrary 
+                 as <- arbitrary >>= return . dups ds
+                 ns <- arbitrary >>= return . filter (> 0) 
+                 return . ChkTimed . reverse . foldl' f [] $ zip as ns
+                 
+instance Arbitrary BeatTime where
+  arbitrary = do choose (0.0, 100.0) >>= return . Time
+
+                 
+pcProp :: Root -> Bool
+pcProp r = (toPitchClass r) == toPitchClass (pcToRoot (toPitchClass r))
+
+pcSetProp :: Chord Root -> Bool
+pcSetProp c = c == toChord (chordRoot c) (toIntSet c) (Just $ chordBass c)
+
+intervalProp :: Interval -> Bool
+intervalProp i = i == icToInterval (toIntervalClss i)
+
+intervalProp2 :: Int -> Bool
+intervalProp2 i = i == toIntervalClss (icToInterval i)
+
+enHarEqProp :: Root -> Bool
+enHarEqProp a = a &== a
+
+parseProp :: Chord Root -> Bool
+parseProp c = parseDataSafe pChord (show c) == c
+
+mergeTimedTest :: ChkTimed -> Bool
+mergeTimedTest (ChkTimed cs) = expandTimed (mergeTimed cs) == cs
+
+mergeTimedTest2 :: ChkTimed -> Bool
+mergeTimedTest2 (ChkTimed cs) = expandTimed cs == cs
+
+mergeTimedTest3 :: ChkTimed -> Bool
+mergeTimedTest3 (ChkTimed cs) = mergeTimed (mergeTimed cs) == mergeTimed cs
+
+--------------------------------------------------------------------------------
+-- Execute the tests
+--------------------------------------------------------------------------------
+
+main :: IO ()
+main = do let opts = TestOptions 100    -- nr of tests to run
+                                 0      -- no time limit
+                                 True   -- debug?
+              myTest s p = runTests ("Testing HarmTrace-Base: "++ s ++" ... ") 
+                                    opts . map run $ p
+          myTest "roots"        [ pcProp, enHarEqProp ]
+          myTest "chords"       [ pcSetProp, parseProp ]
+          myTest "intervals I"  [ intervalProp ]
+          myTest "intervals II" [ intervalProp2 ]
+          myTest "mergeTimed"   [ mergeTimedTest, mergeTimedTest2, mergeTimedTest3 ] 
+          
+