HarmTrace-Base 1.4.0.1 → 1.5.3.1

raw patch · 12 files changed

+588/−415 lines, 12 filesdep +randomdep ~HarmTrace-Basedep ~ListLikedep ~QuickCheckPVP ok

version bump matches the API change (PVP)

Dependencies added: random

Dependency ranges changed: HarmTrace-Base, ListLike, QuickCheck, base, uu-parsinglib

API changes (from Hackage documentation)

Files

• HarmTrace-Base.cabal +24/−25
• src/HarmTrace/Base/Chord.hs +5/−6
• src/HarmTrace/Base/Chord/Analysis.hs +59/−54
• src/HarmTrace/Base/Chord/Datatypes.hs +67/−68
• src/HarmTrace/Base/Chord/Internal.hs +6/−7
• src/HarmTrace/Base/Chord/Intervals.hs +14/−16
• src/HarmTrace/Base/Chord/PitchClass.hs +43/−30
• src/HarmTrace/Base/Parse.hs +7/−8
• src/HarmTrace/Base/Parse/ChordParser.hs +47/−36
• src/HarmTrace/Base/Parse/General.hs +17/−19
• src/HarmTrace/Base/Time.hs +213/−101
• src/Tests.hs +86/−45

@@ -1,23 +1,22 @@ name:                HarmTrace-Base
-version:             1.4.0.1
+version:             1.5.3.1
 synopsis:            Parsing and unambiguously representing musical chords.
-description:         HarmTrace: Harmony Analysis and Retrieval of Music 
+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 
+                     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
+copyright:           (c) 2012--2016 Chordify B.V.
 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 
+author:              W. Bas de Haas, Jeroen Bransen and Jose Pedro Magalhaes
+maintainer:          haskelldevelopers@chordify.net
 category:            Music
 build-type:          Simple
-tested-with:         GHC == 7.4.1, GHC == 7.6.1, GHC == 7.8.2
+tested-with:         GHC == 7.4.1, GHC == 7.6.1, GHC == 7.8.2, GHC == 7.10.2, GHC == 8.0.1
 cabal-version:       >=1.10
 extra-Source-Files:  README.md CHANGELOG.md
 source-repository head
@@ -32,21 +31,21 @@                        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.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, 
+  hs-source-dirs:      src
+
+  build-depends:       base >= 4.4 && < 4.10,
+                       uu-parsinglib ==2.9.1.*,
+                       ListLike >= 3.0.1,
+                       binary >= 0.6.4,
                        ghc-prim >= 0.2,
                        containers >= 0.5.0.0
-  
+
   ghc-options:         -Wall
                        -O2
 
@@ -55,14 +54,14 @@   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,
-                       
+  build-depends:       QuickCheck >= 2.7,
+                       random >= 1.1,
+                       HarmTrace-Base == 1.5.3.0,
                        base >= 4.2,
-                       uu-parsinglib ==2.7.4.*, 
-                       ListLike ==4.1.*, 
-                       binary >= 0.6.4, 
+                       uu-parsinglib ==2.9.1.*,
+                       ListLike >= 3.0.1,
+                       binary >= 0.6.4,
                        ghc-prim >= 0.2,
                        containers >= 0.5.0.0
-                       
+
   ghc-options:          -Wall

@@ -2,20 +2,19 @@ --------------------------------------------------------------------------------
 -- |
 -- Module      :  HarmTrace.Base.Chord
--- Copyright   :  (c) 2013--2014 W. Bas de Haas and Jose Pedro Magalhaes,
---                Multiphonyx Holding BV
+-- Copyright   :  (c) 2012--2016, Chordify BV
 -- License     :  LGPL-3
 --
--- Maintainer  :  bas@chordify.net, dreixel@chordify.net 
+-- Maintainer  :  haskelldevelopers@chordify.net
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
--- Summary: An interface to all the sub modules of HarmTrace.Base.Chord 
+-- 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.Datatypes
+  , module HarmTrace.Base.Chord.Analysis
   , module HarmTrace.Base.Chord.PitchClass
   , module HarmTrace.Base.Chord.Intervals
   ) where

@@ -2,11 +2,10 @@ --------------------------------------------------------------------------------
 -- |
 -- Module      :  HarmTrace.Base.MusicRep
--- Copyright   :  (c) 2013--2014 W. Bas de Haas and Jose Pedro Magalhaes,
---                Multiphonyx Holding BV
+-- Copyright   :  (c) 2012--2016, Chordify BV
 -- License     :  LGPL-3
 --
--- Maintainer  :  bas@chordify.net, dreixel@chordify.net 
+-- Maintainer  :  haskelldevelopers@chordify.net
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
@@ -35,26 +34,29 @@   , isSus4
   -- * Scale degree transposition
   , transposeRoot
+  , transposeCL
   , transposeSD
   , toChordDegree
   , toScaleDegree
   , intervalToPitch
-  , icToInterval
+
+  -- exported twice
+  -- , 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 
+-- | 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
@@ -64,7 +66,7 @@ -- | 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 = 
+analyseDegClassType degs =
     case (analyseThird degs, analyseFifth degs, analyseSevth degs) of
        -- Triads
        (MinThird, DimFifth , DimSev) -> DimClass
@@ -90,7 +92,7 @@ shToClassType HDim7   = MinClass
 shToClassType MinMaj7 = MinClass
 shToClassType Aug7    = DomClass
-shToClassType Maj6    = MajClass 
+shToClassType Maj6    = MajClass
 shToClassType Min6    = MinClass
 shToClassType Nin     = DomClass
 shToClassType Maj9    = MajClass
@@ -119,13 +121,13 @@ 
 triadToSh :: Triad -> Shorthand
 triadToSh t = case t of
-                 MajTriad -> Maj 
-                 MinTriad -> Min 
-                 AugTriad -> Aug 
-                 DimTriad -> Dim 
+                 MajTriad -> Maj
+                 MinTriad -> Min
+                 AugTriad -> Aug
+                 DimTriad -> Dim
                  NoTriad  -> None
 
--- | Analyses the structure of an 'IntSet' and returns an appropriate 
+-- | Analyses the structure of an 'IntSet' and returns an appropriate
 -- 'ShortHand', if possible
 analyseTetra :: IntSet -> Shorthand
 analyseTetra is = case (analyseTriad is, analyseSevth is) of
@@ -137,12 +139,12 @@                     (DimTriad, DimSev) -> Dim7
                     (AugTriad, MinSev) -> Aug7
                     (t       , NoSev ) -> triadToSh t
-                    _                  -> None                 
+                    _                  -> 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 
+-- maj
 --
 -- >>> toTriad (Chord (Note Nat C) HDim7 [Add (Note Sh I11)] 0 0)
 -- dim
@@ -157,11 +159,11 @@ 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 =  
+analyseTriad is =
     case (analyseThird is, analyseFifth is) of
        (MajThird, PerfFifth) -> MajTriad
        (MajThird, AugFifth ) -> AugTriad
@@ -171,23 +173,23 @@        (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 
+
+-- | analyses the fifth in a degree list
 analyseFifth :: IntSet -> Fifth
-analyseFifth is 
+analyseFifth is
   | member 7 is = PerfFifth
   | member 6 is = DimFifth
   | member 8 is = AugFifth
   | otherwise   = NoFifth
 
--- | analyses the fifth in a degree list 
+-- | analyses the fifth in a degree list
 analyseSevth :: IntSet -> Sevth
 analyseSevth is
   | member 10 is = MinSev
@@ -195,11 +197,11 @@   | member 9  is = DimSev
   | otherwise    = NoSev
 
- 
--- | Converts a 'Shorthand' to a 'Triad' 
+
+-- | 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     
+-- determine the triad
+shToTriad :: Shorthand -> Triad
 shToTriad Maj     = MajTriad
 shToTriad Min     = MinTriad
 shToTriad Dim     = DimTriad
@@ -211,7 +213,7 @@ shToTriad HDim7   = DimTriad
 shToTriad MinMaj7 = MinTriad
 shToTriad Aug7    = AugTriad
-shToTriad Maj6    = MajTriad 
+shToTriad Maj6    = MajTriad
 shToTriad Min6    = MinTriad
 shToTriad Nin     = MajTriad
 shToTriad Maj9    = MajTriad
@@ -230,13 +232,13 @@ 
 
 -- | Converts a 'Shorthand' to a 'Mode'
-toMode :: Triad -> 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' 
+-- | Converts a 'Shorthand' to either a 'MajClass', 'MinClass' or 'NoClass'
 -- 'ClassType'.
 toMajMin :: Triad -> ClassType
 toMajMin MajTriad = MajClass
@@ -245,7 +247,7 @@ toMajMin DimTriad = MinClass
 toMajMin NoTriad  = NoClass
 
--- | applies 'toMajMin' to a 'Chord', in case there is no triad, e.g. 
+-- | 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
@@ -258,16 +260,16 @@                      -- 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, 
+
+-- | 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 
+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, 
+
+-- | 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)
@@ -276,54 +278,57 @@                                &&     (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 
+-- | 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 = 
+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) = 
+-- 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 
-  
+transposeRoot = transpose roots
+
+-- | Transposes a ChordLabel with a 'Int' semitones up
+transposeCL :: ChordLabel -> Int -> ChordLabel
+transposeCL c sem = fmap (flip transposeRoot sem) c
+
 -- | Transposes a scale degree with 'Int' semitones up
 transposeSD :: ScaleDegree -> Int -> ScaleDegree
-transposeSD deg sem = transpose scaleDegrees deg sem 
+transposeSD = transpose scaleDegrees
 
 transpose :: Diatonic a => [Note a] -> Note a -> Int -> Note a
 transpose ns n sem = ns !! ((sem + (toPitchClass n)) `mod` 12)
 
 
 -- | Similar to 'toScaleDegree', an interval is transformed into an absolute
--- 'Root' pitch, given another 'Root' that serves as a basis. 
---  
+-- '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' 
+-- | 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     
 
+ where add = map (Add . icToInterval) $ toAscList (is \\ shToIntSet sh)
+       sh  = analyseTetra is

@@ -6,29 +6,28 @@ --------------------------------------------------------------------------------
 -- |
 -- Module      :  HarmTrace.Base.MusicRep
--- Copyright   :  (c) 2012--2014 W. Bas de Haas and Jose Pedro Magalhaes,
---                Multiphonyx Holding BV
+-- Copyright   :  (c) 2012--2016, Chordify BV
 -- License     :  LGPL-3
 --
--- Maintainer  :  bas@chordify.net, dreixel@chordify.net 
+-- Maintainer  :  haskelldevelopers@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>). 
+-- 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 
+  , Root
   , DiatonicNatural (..)
-  , ScaleDegree 
+  , ScaleDegree
   , DiatonicDegree (..)
   -- ** Keys
   , Key (..)
@@ -42,7 +41,7 @@   , Shorthand (..)
   , Addition (..)
   , IntNat (..)
-  , Interval 
+  , Interval
   , ChordLabel
   , ChordDegree
 
@@ -56,12 +55,12 @@   , 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
 --------------------------------------------------------------------------------
@@ -87,36 +86,36 @@              | UndefChord        -- ^ An undefined chord
                 deriving (Eq, Ord, Generic, Functor)
 
--- | Returns the root of a 'Chord', and throws an error in case of a 'NoChord' 
+-- | 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) 
+chordRoot = catchNoChord "Chord.Datatypes.chordRoot" (\(Chord r _ _ _) -> r)
 
--- | Returns the 'Shorthand' of a 'Chord', and throws an error in case of 
+-- | 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) 
+chordShorthand = catchNoChord "Chord.Datatypes.chordShorthand" (\(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) 
+chordAdditions = catchNoChord "Chord.Datatypes.chordAdditions" (\(Chord _ _ a _) ->a)
 
--- | Returns the bass 'Interval' of a 'Chord', and throws an error in case of 
+-- | 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) 
+chordBass = catchNoChord "Chord.Datatypes.chordBass" (\(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 
+-- 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
+-- | Following Harte et al., we define a number of chord 'Shorthand's
 data Shorthand = -- | Triadic chords
                  Maj | Min | Dim | Aug
                  -- | Seventh chords
@@ -129,69 +128,69 @@                | Sus4 | Sus2 | SevSus4
                  -- | Power chords
                | Five
-                 -- Only a root note
+                 -- | Only a root note
                | None
-                 -- Additional shorthands in billboard collection
+                 -- | Additional shorthands in billboard collection
                | Eleven | Thirteen | Min11 | Maj13 | Min13
-               
-  deriving (Eq, Ord, Enum, Bounded, Generic) 
 
+  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 
+-- | 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  
+-- | Representing absolute 'Root' notes
 type Root = Note DiatonicNatural
 
 -- | The seven diatonic naturals
-data DiatonicNatural =  C | D | E | F | G | A | B 
+data DiatonicNatural =  C | D | E | F | G | A | B
   deriving (Show, Eq, Enum, Ord, Bounded, Generic)
-  
--- | Intervals for additional chord notes    
+
+-- | 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)     
+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) 
-  
+data Note a = Note Accidental a   deriving (Eq, Ord, Generic)
+
 -- | A musical 'Accidental'
 data Accidental = Nat -- ^ natural
-                | Sh  -- ^ sharp 
+                | 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 
+-- | 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 
+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"  
+  show MinMode = "m"
 
 -- In showing chords, we obey Harte et al.'s syntax as much as possible
 instance Show ChordLabel where
@@ -205,13 +204,13 @@   -- 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)   
-    
+     -- r                  -> show r ++ ':' : show (chordShorthand c) ++ ' ' : show ( toPitchClasses  c)
+
 showIv :: Interval -> String
 showIv (Note Nat I1) = ""
-showIv i             = '/' : show i 
+showIv i             = '/' : show i
 
-    
+
 showAdd :: [Addition] -> String
 showAdd [] = ""
 showAdd x  = '(' : intercalate "," (map show x) ++ ")"
@@ -234,16 +233,16 @@   show Min9     = "min9"
   show Min11    = "min11"
   show Min13    = "min13"
-  show Maj13    = "maj13" 
+  show Maj13    = "maj13"
   show Sus4     = "sus4"
   show Sus2     = "sus2"
   show SevSus4  = "7sus4"
-  show Five     = "5" 
-  show Nin      = "9" 
+  show Five     = "5"
+  show Nin      = "9"
   show Eleven   = "11"
   show Thirteen = "13"
   show None     = ""
-  
+
 instance Show ClassType where
   show MajClass = ""
   show MinClass = "m"
@@ -256,26 +255,26 @@   show (Note m i) = show m ++ show i
 
 instance Show (Note DiatonicNatural) where
-  show (Note m r) = show r ++ show m  
-  
+  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])) 
+  show a = show . ((!!) ([1..13]::[Integer]))
                 . fromJust $ elemIndex a [minBound..]
-   
-  
-instance Show Accidental where 
+
+
+instance Show Accidental where
   show Nat = ""
   show Sh  = "#"
   show Fl  = "b"
   show SS  = "##"
-  show FF  = "bb"     
+  show FF  = "bb"
 
 instance Show Addition where
   show (Add   n) = show n
-  show (NoAdd n) = '*' : show n    
+  show (NoAdd n) = '*' : show n
 
 instance Show Triad where
   show MajTriad = "maj"
@@ -283,27 +282,27 @@   show AugTriad = "aug"
   show DimTriad = "dim"
   show NoTriad  = "NoTriad"
-  
+
 --------------------------------------------------------------------------------
--- Utilities     
+-- 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 
+-- | 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 
+-- | 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 
+-- | Discards a base note by replacing the bass 'Interval' by a
 -- 'Note' 'Nat' 'I1'
 discardBass :: Chord a -> Chord a
 discardBass NoChord           = NoChord
@@ -325,7 +324,7 @@ --------------------------------------------------------------------------------
 
 instance Binary Key
-instance Binary Mode 
+instance Binary Mode
 instance Binary a => Binary (Chord a)
 instance Binary ClassType
 instance Binary Shorthand

@@ -3,11 +3,10 @@ --------------------------------------------------------------------------------
 -- |
 -- Module      :  HarmTrace.Base.Chord.Internal
--- Copyright   :  (c) 2013 W. Bas de Haas and Jose Pedro Magalhaes,
---                Multiphonyx Holding BV
+--- Copyright   :  (c) 2012--2016, Chordify BV
 -- License     :  LGPL-3
 --
--- Maintainer  :  bas@chordify.net, dreixel@chordify.net 
+-- Maintainer  :  haskelldevelopers@chordify.net
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
@@ -32,7 +31,7 @@ modToInt FF  = -2
 
 -- | A list of 12 'ScaleDegree's, ignoring pitch spelling.
-scaleDegrees ::[ ScaleDegree ]  
+scaleDegrees ::[ ScaleDegree ]
 scaleDegrees = [ Note  Nat I
                , Note  Sh  I
                , Note  Nat II
@@ -46,10 +45,10 @@                , Note  Fl  VII
                , Note  Nat VII
                ]
-               
 
+
 -- | A list of 12 'Note DiatonicNatural's, ignoring pitch spelling.
-roots ::       [ Root ]  
+roots ::       [ Root ]
 roots =        [ Note Nat C
                , Note Sh  C
                , Note Nat D
@@ -88,4 +87,4 @@                , Note Nat I12 -- 19: twelveth: viewed as fifth
                , Note Fl  I13 -- 20: Flat thirteen
                , Note Nat I13 -- 21: Thirteen
-               ]+               ]

@@ -2,15 +2,14 @@ --------------------------------------------------------------------------------
 -- |
 -- Module      :  HarmTrace.Base.Chord.Intervals
--- Copyright   :  (c) 2013--2014 W. Bas de Haas and Jose Pedro Magalhaes,
---                Multiphonyx Holding BV
+-- Copyright   :  (c) 2012--2016, Chordify BV
 -- License     :  LGPL-3
 --
--- Maintainer  :  bas@chordify.net, dreixel@chordify.net 
+-- Maintainer  :  haskelldevelopers@chordify.net
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
--- Summary: We can represent a chord as a set of intervals relative to the 
+-- Summary: We can represent a chord as a set of intervals relative to the
 -- root of the chord.
 --------------------------------------------------------------------------------
 
@@ -33,6 +32,8 @@ import Data.IntSet                ( IntSet, fromList, union, insert, singleton
                                   , empty, (\\) )
 
+-- TODO wrap this Int in an IC newtype
+
 -- | Converts an 'Int'erval class to an 'Interval'
 icToInterval :: Int -> Interval
 icToInterval i
@@ -40,13 +41,13 @@   | otherwise         = error ("HarmTrace.Base.MusicRep.toInterval " ++
                                "invalid pitch class: " ++ show i)
 
--- | Similar to 'toPitchClss', this function calculates an enharmonic 
+-- | 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 
+  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)
@@ -55,7 +56,7 @@ -- | 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]
 --
@@ -72,9 +73,9 @@ 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 
+-- | Converts a list of addition to an 'IntSet' containing the relative
 -- structure of the ('Addition' list of the) 'Chord'
-addToIntSet :: [Addition] -> IntSet 
+addToIntSet :: [Addition] -> IntSet
 addToIntSet add = toSet adds \\ toSet remv
   where (adds, remv) = partition isAddition add
 
@@ -86,10 +87,10 @@   getInt :: Addition -> Interval
   getInt (NoAdd i) = i
   getInt (Add   i) = i
-        
-  
+
+
 -- | Expands a 'Shorthand' to its list of degrees
-shToIntSet :: Shorthand -> IntSet 
+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]
@@ -103,7 +104,7 @@ 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 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]
@@ -118,6 +119,3 @@ 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]
-     
-     
-     

@@ -4,11 +4,10 @@ --------------------------------------------------------------------------------
 -- |
 -- Module      :  HarmTrace.Base.Chord.PitchClass
--- Copyright   :  (c) 2013--2014 W. Bas de Haas and Jose Pedro Magalhaes,
---                Multiphonyx Holding BV
+-- Copyright   :  (c) 2012--2016, Chordify BV
 -- License     :  LGPL-3
 --
--- Maintainer  :  bas@chordify.net, dreixel@chordify.net 
+-- Maintainer  :  haskelldevelopers@chordify.net
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
@@ -27,9 +26,11 @@   , rootPC
   , bassPC
   , ignorePitchSpelling
+    -- * Pitch classes applied to keys
+  , keyPitchClasses
     -- * Pitch classes applied to interval sets
   , intValToPitchClss
-  , intSetToPC  
+  , intSetToPC
   -- * Enharmonic Equivalence
   , EnHarEq (..)
   -- * Diatonic Class
@@ -52,65 +53,77 @@ 
 instance Binary PCSet
 
+-- | The (relative) notes in a major scale
+majorScale :: Num a => [a]
+majorScale = [0,2,4,5,7,9,11]
+
+-- | The (relative) notes in a minor scale
+minorScale :: Num a => [a]
+minorScale = [0,2,3,5,7,8,10]
+
 -- | 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
+toPitchClass (Note m p)
+  | ix <= 6   = ((majorScale !! 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. 
+
+
+-- | 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 
+
+
+-- | 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 
+-- 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 
+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" 
+toPitchClasses c = catchNoChord "Chord.PitchClass.toPitchClasses"
                                 (intSetToPC ivs . chordRoot) c
-  
-  where ivs = toIntSet c `union` fromList [0, toIntervalClss (chordBass c)] 
-  
+
+  where ivs = toIntSet c `union` fromList [0, toIntervalClss (chordBass c)]
+
+-- | Return the set of pitches for the given key.
+keyPitchClasses :: Key -> PCSet
+keyPitchClasses k = intSetToPC (fromList scale) (keyRoot k) where
+  scale = case keyMode k of
+    MajMode -> majorScale
+    MinMode -> minorScale
+
 -- | 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 :: ChordLabel -> Int
 rootPC = catchNoChord "Chord.PitchClass.rootPC" (toPitchClass . chordRoot)
 
--- | Ignores the pitch spelling of a chord by applying 'pcToRoot' and 
+-- | Ignores the pitch spelling of a chord by applying 'pcToRoot' and
 -- 'toPitchClass' to the root of a 'ChordLabel'.
 ignorePitchSpelling :: ChordLabel -> ChordLabel
 ignorePitchSpelling NoChord    = NoChord
@@ -120,7 +133,7 @@ -- Classes
 --------------------------------------------------------------------------------
 
--- | A class to compare datatypes that sound the same (they contain the 
+-- | 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
@@ -132,13 +145,13 @@ 
 instance Diatonic a => EnHarEq (Note a) where
   a &== b = toPitchClass a == toPitchClass b
-  
+
 instance EnHarEq ChordLabel where
-  a &== b = toPitchClasses a == toPitchClasses b  
-  
+  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+instance Diatonic DiatonicDegree

@@ -2,21 +2,20 @@ --------------------------------------------------------------------------------
 -- |
 -- Module      :  HarmTrace.Base.Parse
--- Copyright   :  (c) 2013--2014 W. Bas de Haas and Jose Pedro Magalhaes,
---                Multiphonyx Holding BV
+-- Copyright   :  (c) 2012--2016, Chordify BV
 -- License     :  LGPL-3
 --
--- Maintainer  :  bas@chordify.net, dreixel@chordify.net 
+-- Maintainer  :  haskelldevelopers@chordify.net
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
--- Summary: An interface to all the sub modules of HarmTrace.Base.Parse 
+-- 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  
+    module HarmTrace.Base.Parse.General
+  , module HarmTrace.Base.Parse.ChordParser
   ) where
 
-import HarmTrace.Base.Parse.General  
-import HarmTrace.Base.Parse.ChordParser  
+import HarmTrace.Base.Parse.General
+import HarmTrace.Base.Parse.ChordParser

@@ -4,11 +4,10 @@ --------------------------------------------------------------------------------
 -- |
 -- Module      :  HarmTrace.Base.Parse.ChordParser
--- Copyright   :  (c) 2012--2014 W. Bas de Haas and Jose Pedro Magalhaes,
---                Multiphonyx Holding BV
+-- Copyright   :  (c) 2012--2016, Chordify BV
 -- License     :  LGPL-3
 --
--- Maintainer  :  bas@chordify.net, dreixel@chordify.net 
+-- Maintainer  :  haskelldevelopers@chordify.net
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
@@ -16,7 +15,7 @@ -- representations.
 --------------------------------------------------------------------------------
 
-module HarmTrace.Base.Parse.ChordParser ( 
+module HarmTrace.Base.Parse.ChordParser (
   -- * Parsing (elements of) chords
     pChord
   , pShorthand
@@ -24,45 +23,47 @@   , pAdditions
   , pAddition
   , pKey
+  , pBeat
   ) where
 
 import HarmTrace.Base.Parse.General
 import HarmTrace.Base.Chord
+import HarmTrace.Base.Time
 
 --------------------------------------------------------------------------------
 -- 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 
+-- | 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 
+pChord :: Parser ChordLabel
 {-# INLINE pChord #-}
-pChord =     pChordLabel 
+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` ':') 
+pChordLabel = mkChord <$> pRoot <* (pSym ':' `opt` ':')
                       <*> pMaybe pShorthand
-                      <*> (pAdditions `opt` []) 
+                      <*> (pAdditions `opt` [])
                       <*> pInversion where
-  
+
   mkChord :: Root -> Maybe Shorthand -> [Addition] -> Maybe Interval
           -> ChordLabel
-  -- if there are no degrees and no shorthand, following Harte it 
+  -- 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) 
-  
+  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
@@ -70,9 +71,9 @@ -- 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 :: Parser Key
 pKey = f <$> pRoot <* pSym ':' <*> pShorthand <?> "Key"
   where f r m | m == Maj = Key r MajMode
               | m == Min = Key r MinMode
@@ -100,26 +101,26 @@              <|> Nin      <$ pString "9"
              <|> Maj9     <$ pString "maj9"
              <|> Min9     <$ pString "min9"
-             <|> Five     <$ pString "5" 
-             <|> Sus2     <$ pString "sus2" 
-             <|> Sus4     <$ pString "sus4" 
-             <|> SevSus4  <$ pString "7sus4" 
+             <|> 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 
+             <|> 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 
+-- | Parses a list of 'Chord' 'Addition's within parenthesis
 pAdditions :: Parser [Addition]
-pAdditions = pPacked (pSym '(') (pSym ')') ( pListSep (pSym ',') pAddition ) 
+pAdditions = pPacked (pSym '(') (pSym ')') ( pListSep (pSym ',') pAddition )
              <?> "Addition List"
 
--- | Parses the a 'Chord' 'Addition' (or the removal of a chord addition, 
+-- | Parses the a 'Chord' 'Addition' (or the removal of a chord addition,
 -- prefixed by  a @*@)
 pAddition :: Parser Addition
 pAddition = (Add   <$>             pIntNote)
@@ -129,8 +130,8 @@ -- | Parses an 'Interval'
 pIntNote :: Parser Interval
 pIntNote = Note <$> pAccidental <*> pInterval
-        
--- | Parses in 'Accidental'       
+
+-- | Parses in 'Accidental'
 pAccidental :: Parser Accidental
 pAccidental =    Sh <$ pSym    's'
              <|> Sh <$ pSym    '#'
@@ -142,7 +143,8 @@ 
 -- | Parses an 'Interval'
 pInterval :: Parser IntNat
-pInterval =  ((!!) [minBound..] ) . pred <$> pNaturalRaw <?> "Interval"
+pInterval =  foldr (<|>) pFail opts <?> "Interval" where
+  opts = [i <$ pString (show i) | i <- [minBound..] ]
 
 -- | Parses a 'Root' 'Note', e.g. @A@, @Bb@, or @F#@.
 pRoot :: Parser Root
@@ -158,3 +160,12 @@          <|> E  <$ pSym 'E'
          <|> F  <$ pSym 'F'
          <|> G  <$ pSym 'G'
+
+-- | Parses a 'Beat'.
+pBeat :: Parser Beat
+pBeat =   One    <$ pSym '1'
+      <|> Two    <$ pSym '2'
+      <|> Three  <$ pSym '3'
+      <|> Four   <$ pSym '4'
+      <|> NoBeat <$ pSym 'x'
+      <?> "Beat"

@@ -4,11 +4,10 @@ --------------------------------------------------------------------------------
 -- |
 -- Module      :  HarmTrace.Base.Parse.General
--- Copyright   :  (c) 2012--2014 W. Bas de Haas and Jose Pedro Magalhaes,
---                Multiphonyx Holding BV
+-- Copyright   :  (c) 2012--2016, Chordify BV
 -- License     :  LGPL-3
 --
--- Maintainer  :  bas@chordify.net, dreixel@chordify.net 
+-- Maintainer  :  haskelldevelopers@chordify.net
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
@@ -17,7 +16,7 @@ --------------------------------------------------------------------------------
 
 
-module HarmTrace.Base.Parse.General ( -- * Top level parsers 
+module HarmTrace.Base.Parse.General ( -- * Top level parsers
     parseData
   , parseDataWithErrors
   , parseDataSafe
@@ -26,10 +25,10 @@   , pLineEnd
   , pManyTill
     -- Re-exporting the uu-parsinglib
-  , module Text.ParserCombinators.UU 
+  , module Text.ParserCombinators.UU
   , module Text.ParserCombinators.UU.Utils
   , module Text.ParserCombinators.UU.BasicInstances
-  -- , module Data.ListLike.Base 
+  -- , module Data.ListLike.Base
   ) where
 
 import Text.ParserCombinators.UU
@@ -40,23 +39,23 @@ 
 --------------------------------------------------------------------------------
 -- 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) => 
+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" 
+                            ++ " 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 
+                            ++ (concat . intersperse "\n" . take 50
                                        . map show $ err))
 
 -- | Top-level parser that ignores error-reporting, regardless of there were
@@ -66,26 +65,25 @@ 
 -- | Top-level parser that returns both the result as well as a (possibly empty)
 -- list of error-corrections.
-parseDataWithErrors :: (ListLike s a, Show a) 
+parseDataWithErrors :: (ListLike s a, Show a)
                     =>  P (Str a s LineColPos) b -> s -> (b, [Error LineColPos])
-parseDataWithErrors p inp = (parse ( (,) <$> p <*> pEnd) 
+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) 
+pString :: (ListLike state a, IsLocationUpdatedBy loc a, Show a, Eq a)
         => [a] -> P (Str a state loc) [a]
-{-# INLINABLE  pString #-}        
+{-# 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 
+-- | 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 
-                  <<|> 
+pManyTill p end = [] <$ end
+                  <<|>
                   (:) <$> p <*> pManyTill p end
-

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric                    #-}
 {-# LANGUAGE TypeSynonymInstances             #-}
 {-# LANGUAGE FlexibleInstances                #-}
 {-# LANGUAGE ScopedTypeVariables              #-}
@@ -6,38 +7,42 @@ --------------------------------------------------------------------------------
 -- |
 -- Module      :  HarmTrace.Base.MusicTime
--- Copyright   :  (c) 2012--2013 W. Bas de Haas and Jose Pedro Magalhaes
+-- Copyright   :  (c) 2012--2016, Chordify BV
 -- License     :  LGPL-3
 --
--- Maintainer  :  bas@chordify.net, dreixel@chordify.net 
+-- Maintainer  :  haskelldevelopers@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 
+-- (but not necessarily) in the context of recognising chords
 -- from an arbitrary audio source.
 --------------------------------------------------------------------------------
 
 module HarmTrace.Base.Time (
-   
-   NumData
+
   -- ** Representing musical time
-  , Timed (..)
+    Timed
+  , DTimed
+  , Timed' (..)
   , Beat (..)
-  , BeatTime (..) 
+  , BeatTime (..)
+  , MeterKind (..)
 
   -- * Functions
   -- ** Data access
   , timed
   , timedBT
-  , getBeatTime 
-  , getBeat 
+  , onBeatTime
+  , offBeatTime
+  , onBeat
+  , offBeat
   , onset
   , offset
   , duration
   , setData
   , getEndTime
-  
+
   -- ** Type conversion and other utilities
   -- , fromDurations
   , mergeTimed
@@ -45,57 +50,72 @@   , expandTimed
   , concatTimed
   , splitTimed
+  , setMeterKind
+  , updateBeats
+  , updateBeat
+  , splitPickup -- remove
   , nextBeat
-  , prevBeat 
+  , prevBeat
+  , lastBeat
+  , updBeat
+  , updTime
+  , updateTimeStamp
   , dropTimed
   , timeStamp
   , timeComp
   , roundingError
-  , beat 
+  , beat
   , pprint
   , prettyPrint
 
 ) where
-             
-import Data.List                      ( intercalate )
 
+import Data.List                      ( intercalate, mapAccumL )
+import Data.Ratio                     ( (%) )
+import GHC.Generics                   ( Generic )
+
 -- | 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 
+-- 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
+roundingError :: Fractional t => t
+roundingError = fromRational (1 % 1000)  -- = one millisecond
 
 --------------------------------------------------------------------------------
 -- High-level structure
 --------------------------------------------------------------------------------
 
+-- | a shorthand for a 'Timed'' datatype that uses 'Float' precision
+--  (also for backwards competibility)
+type Timed  a = Timed' Float  a
 
--- | A datatype that wraps around an (musical) datatype, adding information 
--- about the musical time to this datatype. Musical time is stored as 
+-- | a shorthand for 'Double' precision
+type DTimed a = Timed' Double a
+
+-- | 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 
+-- 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)
+data Timed' t a = Timed { getData :: a
+                        -- ^ Returns the contained datatype
+                        , getTimeStamps :: [BeatTime t]
+                        -- ^ Returns the list of TimeStamps
+                        } deriving (Functor, Show, Eq, Generic)
 
 -- | 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)
+data Beat = One | Two | Three | Four | NoBeat deriving (Eq, Ord, Enum, Generic)
 
+-- | Having a high-level representation of a musical meter: 'Duple' is
+-- counted in two and 'Triple' in three.
+data MeterKind = Duple | Triple deriving (Eq, Show, Ord, Generic)
+
 --------------------------------------------------------------------------------
 -- Instances of high-level data structure
 --------------------------------------------------------------------------------
 
-  
+
 instance Show Beat where
   show One   = "1"
   show Two   = "2"
@@ -103,24 +123,24 @@   show Four  = "4"
   show NoBeat = "x"
 
-instance Show BeatTime where
-  show (BeatTime t bt) = '(' : show t ++ ", " ++ show bt ++ ")"
-  show (Time t)       = '(' : show t ++ ")"
+instance (Show t, Fractional t) => Show (BeatTime t) where
+  show (BeatTime t bt) = '(' : showFracShort t ++ ',' : show bt ++ ")"
+  show (Time t)        = '(' : showFracShort t ++                  ")"
 
-    
+showFracShort :: (Show t, Fractional t) => t -> String
+showFracShort = take 5 . show
+
 --------------------------------------------------------------------------------
 -- 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
+data BeatTime a = BeatTime a Beat
+                | Time     a       deriving (Functor, Eq, Generic)
 
 -- we compare based on the timestamp only
-instance Ord BeatTime where
+instance (Ord t, Fractional t) => Ord (BeatTime t) where
   compare a b = compare (timeStamp a) (timeStamp b)
 
 --------------------------------------------------------------------------------
@@ -136,36 +156,37 @@ -}
 
 -- | alternative 'Timed' constructor
-timed :: a -> NumData -> NumData -> Timed a
+timed :: Fractional t => a -> t -> t -> Timed' t a
 timed d x y = Timed d [Time x, Time y]
 
 -- | alternative 'Timed' constructor
-timedBT :: a -> BeatTime -> BeatTime -> Timed a
+timedBT :: Fractional t => a -> BeatTime t -> BeatTime t -> Timed' t 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. 
+-- | 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) = 
+concatTimed dat (Timed _ ta) (Timed _ tb) =
   Timed dat (mergeBeatTime ta tb) where
 
-  mergeBeatTime :: [BeatTime] -> [BeatTime] -> [BeatTime]
+  mergeBeatTime :: (Ord t, Show t, Fractional t)
+                => [BeatTime t] -> [BeatTime t] -> [BeatTime t]
   mergeBeatTime [] b = b
   mergeBeatTime a [] = a
-  mergeBeatTime a b = case timeComp (timeStamp . last $ 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  
+    LT -> a ++ b
 
 
 -- | the inverse of 'mergeTimed', expanding the list 'Timed' elements to all
--- timestamps stored in the 'getTimeStamps' list. N.B. 
+-- timestamps stored in the 'getTimeStamps' list. N.B.
 --
 -- >>> expandTimed (mergeTimed x) = x :: [Timed a]
--- 
+--
 -- also,
 --
 -- >>> (expandTimed cs) = cs
@@ -179,7 +200,7 @@ expandTimed = concatMap replic where
 
   replic :: Timed a -> [Timed a]
-  replic (Timed c ts) = let reps = repeat c 
+  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
@@ -189,11 +210,11 @@ -- >>> [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 
+-- | 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
@@ -210,21 +231,75 @@ -- >>> 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 
+splitTimed :: (Show a, Ord t, Show t, Fractional t)
+           => Timed' t a -> t -> (Timed' t a, Timed' t 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) 
-  
-    
+      where e = error ( "HarmTrace.Base.MusicTime.splitTimed: Timestamp "
+                      ++ show s ++ " not in range of Timed: " ++ show td)
+
+-- | Changes the internal 'MeterKind' of a 'Timed' sequence. We assume
+-- that meter changes do nog occur.
+setMeterKind :: MeterKind -> [Timed a] -> [Timed a]
+setMeterKind _ [] = []
+setMeterKind mk x =
+  let (pu, cs) = splitPickup x -- will expand the chords
+
+      srtpu    = (iterate (prevBeat mk) (lastBeat mk)) !! (pred . length $ pu)
+      srt      = onBeat (head cs)
+
+  in  (updateBeats mk srtpu pu) ++
+      (updateBeats mk srt   cs)
+
+-- TODO: maybe setBeats is a better name..?
+-- | applies updateBeat to a list. 'updateBeats' requires a 'MeterKind'
+-- and a starting 'Beat'.
+--
+-- >>> updateBeats Triple Three [ timedBT "a" (BeatTime 0 Three) (BeatTime 1 Four)
+-- >>>                          , timedBT "a" (BeatTime 1 Four) (BeatTime 2 One)
+-- >>>                          , Timed "a" [ BeatTime 2 One, BeatTime 3 Two
+-- >>>                                      , BeatTime 4 Three, BeatTime 5 Four]]
+-- >>> [Timed {getData = "a", getTimeStamps = [(0.0, 3),(1.0, 1)]}
+-- >>> ,Timed {getData = "a", getTimeStamps = [(1.0, 1),(2.0, 2)]}
+-- >>> ,Timed {getData = "a", getTimeStamps = [(2.0, 2),(3.0, 3),(4.0, 1),(5.0, 2)]}]
+updateBeats :: MeterKind -> Beat -> [Timed a] -> [Timed a]
+updateBeats _      _      [] = []
+updateBeats Triple Four   cs = updateBeats Triple One cs
+updateBeats _      NoBeat cs = cs
+updateBeats mk     s      cs = snd . mapAccumL f s $ cs
+
+  where f :: Beat -> Timed a -> (Beat, Timed a)
+        f a b = let x = updateBeat mk a b in (offBeat x, x)
+
+-- | Update the 'Beat's in 'Timed' data given a 'MeterKind' and a
+-- starting beat:
+--
+-- >>> updateBeat Triple Two (Timed "c" [ BeatTime 0 Three
+-- >>>                                  , BeatTime 1 Four
+-- >>>                                  , BeatTime 2 One])
+-- >>> Timed {getData = "c", getTimeStamps = [(0.0, 2),(1.0, 3),(2.0, 1)]}
+updateBeat :: MeterKind -> Beat -> Timed a -> Timed a
+updateBeat mk strt (Timed d ts) =
+  Timed d . zipWith BeatTime (map timeStamp ts)
+          . iterate (nextBeat mk) $ strt
+
+-- |
+-- N.B. calls 'expandTimed' before splitting
+splitPickup :: [Timed a] -> ([Timed a], [Timed a])
+splitPickup cs = case span (\t -> (onBeat t) /= One) . expandTimed $ cs of
+                  (x, []) -> ([], x) -- in case we have a very short sequence
+                                     -- don't treat it as a pickup
+                  y       -> y
+
+
 -- | compares to 'NumData' timestamps taking a rounding error 'roundingError'
 -- into account.
-timeComp :: NumData -> NumData -> Ordering
-timeComp a b 
+timeComp :: (Ord t, Fractional t) => t -> t -> Ordering
+timeComp a b
  | a > (b + roundingError) = GT
  | a < (b - roundingError) = LT
  | otherwise               = EQ
@@ -233,70 +308,107 @@ 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 :: Fractional t => BeatTime t -> t
 timeStamp (BeatTime t _bt) = t
-timeStamp (Time    t    ) = t  
+timeStamp (Time     t    ) = t
 
 -- | Returns the 'NumData' timestamp, given a 'BeatTime'
-beat :: BeatTime -> Beat
+beat :: BeatTime t -> Beat
 beat (BeatTime _t bt) = bt
-beat (Time    _t   ) = NoBeat
+beat (Time     _t   ) = NoBeat
 
+-- | Returns the start 'BeatTime'
+onBeatTime :: Fractional t => Timed' t a -> BeatTime t
+onBeatTime td = case getTimeStamps td of
+  []    -> error "HarmTrace.Base.Time.onBeatTime: no timestamps are stored"
+  (h:_) -> h
+
+-- | Returns the offset time stamp
+offBeatTime :: Fractional t => Timed' t a -> BeatTime t
+offBeatTime td = case getTimeStamps td of
+  []  -> error "HarmTrace.Base.Time.offBeatTime: no timestamps are stored"
+  l   -> last l
+
+-- | Returns the start 'Beat'
+onBeat :: Timed a -> Beat
+onBeat = beat . onBeatTime
+
+-- | Returns the offset time stamp
+offBeat :: Timed a -> Beat
+offBeat = beat . offBeatTime
+
 -- | Returns the onset time stamp
-onset :: Timed a -> NumData
-onset = timeStamp . getBeatTime 
+onset :: Fractional t => Timed' t a -> t
+onset = timeStamp . onBeatTime
 
 -- | 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
+offset :: Fractional t => Timed' t a -> t
+offset = timeStamp . offBeatTime
 
+-- | Given a list of 'Timed' values, returns the end time of the latest element
+-- in the list.
+getEndTime :: Fractional t => [Timed' t a] -> t
+getEndTime [] = error "getEndTime: empty list"
+getEndTime l  = offset . last $ l
+
 -- | Returns the duration of 'Timed'
-duration :: Timed a -> NumData
+duration :: Fractional t => Timed' t a -> t
 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 
+-- | 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
+-- N.B. @ nextBeat Four = One @
+nextBeat :: MeterKind -> Beat -> Beat
+nextBeat Duple  Four   = One
+nextBeat Triple Three  = One
+nextBeat _      NoBeat = error "HarmTrace.Base.Time.nextBeat: nextBeat applied toNoBeat"
+nextBeat _      b      = succ b
 
 -- | returns the previous 'Beat', similar to 'prevBeat'.
-prevBeat One  = Four
-prevBeat b    = pred b
+prevBeat :: MeterKind -> Beat -> Beat
+prevBeat Duple  One  = Four
+prevBeat Triple One  = Three
+prevBeat _      NoBeat = error "HarmTrace.Base.Time.prevBeat: nextBeat applied toNoBeat"
+prevBeat _      b    = pred b
 
--- | drops the time (with or without 'Beat') information of a list 
--- 'Timed' data structure 
+-- | returns the last 'Beat' of the 'MeterKind'
+--
+-- >>> lastBeat Duple
+-- >>> Four
+lastBeat :: MeterKind -> Beat
+lastBeat Triple = Three
+lastBeat Duple  = Four
+
+-- | updates a 'Beat' in a 'BeatTime'
+updBeat :: Fractional t => (Beat -> Beat) -> BeatTime t -> BeatTime t
+updBeat _ (Time _) = error "updTimeBeatTime: cannot update non-existing beat"
+updBeat f (BeatTime n b) = BeatTime n (f b)
+
+-- | updates a timestamp in a 'BeatTime'
+updTime :: Fractional t => (t -> t) -> BeatTime t -> BeatTime t
+updTime f (Time     n  ) = Time     (f n)
+updTime f (BeatTime n b) = BeatTime (f n) b
+
+-- | updates the timestamps in a 'Timed' datatype
+updateTimeStamp :: Fractional t
+                => ([BeatTime t] -> [BeatTime t]) -> Timed' t a -> Timed' t a
+updateTimeStamp f (Timed a ts) = Timed a (f ts)
+
+-- | 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
+prettyPrint = intercalate "\n" . map pprint
 
 -- | 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
+pprint (Timed d ts ) = show (head ts) ++ " - " ++ show (last ts)
+                                      ++ ": "  ++ show d

@@ -1,14 +1,12 @@ {-# 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
+-- Copyright   :  (c) 2012--2016, Chordify BV
 -- License     :  LGPL-3
 --
--- Maintainer  :  bas@chordify.net, dreixel@chordify.net 
+-- Maintainer  :  haskelldevelopers@chordify.net
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
@@ -21,37 +19,39 @@ import HarmTrace.Base.Time
 
 import Test.QuickCheck
-import Test.QuickCheck.Batch
+import Test.QuickCheck.Test   ( isSuccess )
 
 import Data.List              ( sort, foldl' )
 
+import System.Random          ( Random )
 import System.Exit            ( exitFailure, exitSuccess )
+import Control.Monad          ( when )
 
 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  
-  
+  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 ]
@@ -60,38 +60,58 @@   arbitrary = do r   <- arbitrary
                  sh  <- elements [Maj, Min, Aug, Dim, Maj7, Min7, Sev, Dim7, HDim7, Aug7, MinMaj7]
                  -- sh  <- arbitrary
-                 -- add <- arbitrary >>= listOf . return . Add 
-                 
+                 -- 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)
+
+data ChkTimed = ChkTimed MeterKind [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
-                     
+  arbitrary = do let -- Step function for creating a Timed ChordLabel
+                     f ::Fractional t => [Timed' t a] -> (a, [t]) -> [Timed' t a]
+                     f _     (_,[]) = error "should not happen"
+                     f [   ] (a, x) = [Timed a (map Time (0:x))]
+                     f (h:t) (a, x) = let o   = offset h
+                                          g y = Time (y + o)
+                                      in Timed a (map g (0:x)) : h : t
+
+                     -- creates additional duplicates at random places
+                     -- dups ds ["a","b"] might return ["a", "a", "b"]
                      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
+
+                 ds <- arbitrary  -- [Bool]
+                 as <- arbitrary >>= return . dups ds -- chords including duplicates
+
+                 -- e.g. Gen [[1.2,3.4], [2.2]] etc.
+                 ns <- arbitrary >>= return . map (sort . map abs)
+                                 >>= return . filter (\x -> let l = length x in l > 0 && l <= 4)
+
+                 mk <- arbitrary -- MeterKind
+                 bt <- elements [One, Two, Three, Four]
+
+                 return . ChkTimed mk . updateBeats mk bt
+                        . reverse . foldl' f [] $ zip as ns
+
+instance (Random t, Fractional t) => Arbitrary (BeatTime t) where
   arbitrary = do choose (0.0, 100.0) >>= return . Time
 
-                 
+instance Arbitrary MeterKind where
+  arbitrary = elements [Duple, Triple]
+
+instance Arbitrary Beat where
+  arbitrary = elements [One, Two, Three, Four, NoBeat]
+
 pcProp :: Root -> Bool
 pcProp r = (toPitchClass r) == toPitchClass (pcToRoot (toPitchClass r))
 
@@ -101,8 +121,8 @@ intervalProp :: Interval -> Bool
 intervalProp i = i == icToInterval (toIntervalClss i)
 
-intervalProp2 :: Int -> Bool
-intervalProp2 i = i == toIntervalClss (icToInterval i)
+-- intervalProp2 :: Int -> Bool
+-- intervalProp2 i = i == toIntervalClss (icToInterval i)
 
 enHarEqProp :: Root -> Bool
 enHarEqProp a = a &== a
@@ -110,29 +130,50 @@ parseProp :: Chord Root -> Bool
 parseProp c = parseDataSafe pChord (show c) == c
 
-mergeTimedTest :: ChkTimed -> Bool
-mergeTimedTest (ChkTimed cs) = expandTimed (mergeTimed cs) == cs
+mergeTimedTest, mergeTimedTest2, mergeTimedTest3, mergeTimedTest4 :: ChkTimed -> Bool
+mergeTimedTest (ChkTimed _ cs) = expandTimed (mergeTimed cs) == expandTimed cs
+mergeTimedTest2 (ChkTimed _ cs) = expandTimed (expandTimed cs) == expandTimed cs
+mergeTimedTest3 (ChkTimed _ cs) = mergeTimed (mergeTimed cs) == mergeTimed cs
+mergeTimedTest4 (ChkTimed _ cs) = mergeTimed (expandTimed cs) == mergeTimed cs
 
-mergeTimedTest2 :: ChkTimed -> Bool
-mergeTimedTest2 (ChkTimed cs) = expandTimed cs == cs
+meterKind1, meterKind2 :: ChkTimed -> Bool
+meterKind1 (ChkTimed Duple  cs) = mergeTimed (setMeterKind Duple  cs) == mergeTimed cs
+meterKind1 (ChkTimed Triple cs) = mergeTimed (setMeterKind Triple cs) == mergeTimed cs
 
-mergeTimedTest3 :: ChkTimed -> Bool
-mergeTimedTest3 (ChkTimed cs) = mergeTimed (mergeTimed cs) == mergeTimed cs
+meterKind2 (ChkTimed Duple  cs) = setMeterKind Duple  cs == expandTimed cs
+meterKind2 (ChkTimed Triple cs) = setMeterKind Triple cs == expandTimed cs
 
+-- meterKind1 (ChkTimed Duple  cs) = setMeterKind Duple  (setMeterKind Triple cs) == cs
+-- meterKind1 (ChkTimed Triple cs) = setMeterKind Triple (setMeterKind Duple  cs) == cs
+
+correctNextBeat :: ChkTimed -> Bool
+correctNextBeat (ChkTimed mk cs) = and . map (correctBeatTimes mk . getTimeStamps) $ cs
+
+correctBeatTimes :: Fractional t => MeterKind -> [BeatTime t] -> Bool
+correctBeatTimes _  [ ] = True
+correctBeatTimes _  [_] = True
+correctBeatTimes mk (a:b:tl) = beat b == nextBeat mk (beat a) && correctBeatTimes mk tl
+
+correctNextBeatMK :: (MeterKind, ChkTimed) -> Bool
+correctNextBeatMK (mk, ChkTimed _ cs) = correctNextBeat
+                                      . ChkTimed mk . mergeTimed . setMeterKind mk $ 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
+main = do let myTest :: Testable p => String -> [p] -> IO ()
+              myTest s p = do putStrLn (" *** Testing HarmTrace-Base: "++ s ++": ... ")
+                              rs <- mapM verboseCheckResult p
+                              when (not . all isSuccess $ rs) exitFailure
+
           myTest "roots"        [ pcProp, enHarEqProp ]
           myTest "chords"       [ pcSetProp, parseProp ]
           myTest "intervals I"  [ intervalProp ]
-          myTest "intervals II" [ intervalProp2 ]
-          myTest "mergeTimed"   [ mergeTimedTest, mergeTimedTest2, mergeTimedTest3 ] 
-          
-          +          -- myTest "intervals II" [ intervalProp2 ]
+          myTest "mergeTimed"   [ mergeTimedTest, mergeTimedTest2, mergeTimedTest3, mergeTimedTest4 ]
+          myTest "nextBeat"     [ correctNextBeat ]
+          myTest "meterKind"    [ meterKind1, meterKind2 ]
+          myTest "meterKind II" [ correctNextBeatMK ]
+          exitSuccess