PitchClass.hs

{-# 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