music-pitch 1.2 → 1.3

raw patch · 12 files changed

+1252/−71 lines, 12 filesdep +music-pitch-literaldep +vector-spacePVP ok

version bump matches the API change (PVP)

Dependencies added: music-pitch-literal, vector-space

API changes (from Hackage documentation)

Files

• music-pitch.cabal +12/−3
• src/Music/Pitch.hs +8/−8
• src/Music/Pitch/Absolute.hs +67/−58
• src/Music/Pitch/Intonation.hs +11/−0
• src/Music/Pitch/Relative.hs +159/−2
• src/Music/Pitch/Relative/Accidental.hs +72/−0
• src/Music/Pitch/Relative/Interval.hs +380/−0
• src/Music/Pitch/Relative/Name.hs +20/−0
• src/Music/Pitch/Relative/Number.hs +56/−0
• src/Music/Pitch/Relative/Pitch.hs +148/−0
• src/Music/Pitch/Relative/Quality.hs +156/−0
• src/Music/Pitch/Relative/Semitones.hs +163/−0

@@ -1,6 +1,6 @@  name:               music-pitch-version:            1.2+version:            1.3 cabal-version:      >= 1.2 author:             Hans Hoglund maintainer:         Hans Hoglund@@ -14,7 +14,7 @@ description:      Abstract representation of musical pitch.     -    This library is part of the Haskell Music Suite, see <http://musicsuite.github.com>.+    This library is part of the Music Suite        , see <http://musicsuite.github.com>.  library                         build-depends: @@ -23,11 +23,20 @@         time,         random,         semigroups,-        semigroupoids+        semigroupoids,+        music-pitch-literal,+        vector-space      hs-source-dirs: src     exposed-modules:         Music.Pitch         Music.Pitch.Absolute         Music.Pitch.Relative+        Music.Pitch.Relative.Accidental+        Music.Pitch.Relative.Interval+        Music.Pitch.Relative.Name+        Music.Pitch.Relative.Number+        Music.Pitch.Relative.Pitch+        Music.Pitch.Relative.Quality+        Music.Pitch.Relative.Semitones         Music.Pitch.Intonation

@@ -13,13 +13,13 @@ -- ------------------------------------------------------------------------------------- -module Music.Pitch -- (--- )-where+module Music.Pitch (+        module Music.Pitch.Absolute,+        module Music.Pitch.Relative,+        module Music.Pitch.Literal+  ) where -import Data.Maybe-import Data.Either-import Data.Semigroup-import Control.Monad-import Control.Applicative+import Music.Pitch.Absolute+import Music.Pitch.Relative+import Music.Pitch.Literal 

@@ -12,13 +12,23 @@ -- Stability   : experimental -- Portability : portable ----- Provides overloaded pitch literals.+-- Absolute pitch representation.+-- +-- The canonical pitch representation is frequency in Hertz (Hz). For conversion, see+-- 'HasFrequency'. -- ------------------------------------------------------------------------------------- -module Music.Pitch.Absolute -- (--- )-where+module Music.Pitch.Absolute (+        Hertz(..),+        -- Octaves,+        Cents,+        Fifths,+        HasFrequency(..),+        -- octaves,+        fifths,+        cents,+  ) where  import Data.Maybe import Data.Either@@ -26,73 +36,72 @@ import Control.Monad import Control.Applicative --- | Frequency in Hertz    -newtype Frequency = Frequency { getFrequency :: Double }-    deriving ( Show, Eq, Enum, Num, Ord, Fractional, Floating )-+-- | +-- Absolute frequency in Hertz.    +newtype Hertz = Hertz { getHertz :: Double }+    deriving (Read, Show, Eq, Enum, Num, Ord, Fractional, Floating, Real, RealFrac) --- | Logarithmic pitch reprentation.+-- | +-- Number of pure octaves. ----- > convert (f * 2) = convert f + Octaves 1    -newtype Octaves = Octaves { getOctaves :: Frequency }-    deriving ( Show, Eq, Enum, Num, Ord, Fractional, Floating )+-- Octaves are a logarithmic representation of frequency such that+--+-- > f * (2/1) = frequency (octaves f + 1)    +newtype Octaves = Octaves { getOctaves :: Hertz }+    deriving (Read, Show, Eq, Enum, Num, Ord, Fractional, Floating, Real, RealFrac) --- | Logarithmic pitch reprentation.+-- | +-- Number of pure octaves. ----- > convert (f * 2) = convert f + Octave 1    -newtype Fifths = Fifths { getFifths :: Frequency }-    deriving ( Show, Eq, Enum, Num, Ord, Fractional, Floating )+-- Cents are a logarithmic representation of frequency such that+--+-- > f * (2/1) = frequency (cents f + 1200)    +newtype Cents = Cents { getCents :: Hertz }+    deriving (Read, Show, Eq, Enum, Num, Ord, Fractional, Floating, Real, RealFrac) --- | Logarithmic pitch reprentation.    +-- | +-- Number of pure fifths. ----- > convert (f * 2) = convert f + Cent 1200    -newtype Cents = Cents { getCents :: Frequency }-    deriving ( Show, Eq, Enum, Num, Ord, Fractional, Floating )+-- Fifths are a logarithmic representation of frequency.+--+-- > f * (3/2) = frequency (fifths f + 1)    +newtype Fifths = Fifths { getFifths :: Hertz }+    deriving (Read, Show, Eq, Enum, Num, Ord, Fractional, Floating, Real, RealFrac) -class HasFrequence a where-    frequency :: a -> Frequency --- instance Convert Frequency Octave where---     convert f             =  Octave (logBase 2 f)---     reconvert (Octave f)  =  2 ** f--- --- instance Convert Cent Octave where---     convert (Cent f)      =  Octave (f / 1200)---     reconvert (Octave f)  =  Cent   (f * 1200)--- --- instance Convert Frequency Cent where---     convert f             =  Cent   (logBase 2 f * 1200)---     reconvert (Cent f)    =  2 ** (f / 1200)--- --- instance Convert Octave Frequency where---     convert = reconvert---     reconvert = convert--- --- instance Convert Octave Cent where---     convert = reconvert---     reconvert = convert--- --- instance Convert Cent Frequency where---     convert = reconvert---     reconvert = convert-    +instance Semigroup Hertz    where (<>) = (*)+instance Semigroup Octaves  where (<>) = (+)+instance Semigroup Fifths   where (<>) = (+)+instance Semigroup Cents    where (<>) = (+) -cents :: HasFrequence a => a -> Cents-cents = undefined +instance Monoid Hertz       where { mempty  = 1 ; mappend = (*) }+instance Monoid Octaves     where { mempty  = 0 ; mappend = (+) }+instance Monoid Fifths      where { mempty  = 0 ; mappend = (+) }+instance Monoid Cents       where { mempty  = 0 ; mappend = (+) } -fifths :: HasFrequence a => a -> Fifths-fifths = undefined +class HasFrequency a where+    frequency :: a -> Hertz -octaves :: HasFrequence a => a -> Octaves-octaves = undefined +instance HasFrequency Hertz where+    frequency = id --- unitFrequency :: Frequency--- unitFrequency = 1+instance HasFrequency Octaves where+    frequency (Octaves f)  = (2/1) ** f --- unitOctave :: Octave--- unitOctave = Octave 0+instance HasFrequency Fifths where+    frequency (Fifths f)   =  (3/2) ** f --- unitCent :: Cent--- unitCent = Cent 0+instance HasFrequency Cents where+    frequency (Cents f)    =  (2/1) ** (f / 1200)++octaves :: HasFrequency a => a -> Octaves+octaves a = Octaves $ logBase (2/1) (frequency a)++fifths :: HasFrequency a => a -> Fifths+fifths a = Fifths $ logBase (3/2) (frequency a)++cents :: HasFrequency a => a -> Cents+cents a = Cents $ logBase (2/1) (frequency a) * 1200+                               

@@ -22,4 +22,15 @@ import Data.Semigroup import Control.Monad import Control.Applicative+import Music.Pitch.Absolute +type Intonation a = a -> Hertz++pure :: Integral a => Intonation a+pure = undefined++pythagorean :: Integral a => Intonation a+pythagorean = undefined++twelveToneEqual :: Integral a => Intonation a+twelveToneEqual = undefined

@@ -1,4 +1,13 @@ +{-# LANGUAGE+    GeneralizedNewtypeDeriving,+    FlexibleInstances,+    DeriveFunctor,+    TypeFamilies,+    StandaloneDeriving,+    OverloadedStrings,+    DeriveFoldable #-}+ ------------------------------------------------------------------------------------- -- | -- Copyright   : (c) Hans Hoglund 2012@@ -13,13 +22,161 @@ -- ------------------------------------------------------------------------------------- -module Music.Pitch.Relative -- (--- )+module Music.Pitch.Relative (+    module Music.Pitch.Relative.Accidental,+    module Music.Pitch.Relative.Interval,+    module Music.Pitch.Relative.Name,+    module Music.Pitch.Relative.Number,+    module Music.Pitch.Relative.Pitch,+    module Music.Pitch.Relative.Quality,+    module Music.Pitch.Relative.Semitones,+) where  import Data.Maybe import Data.Either import Data.Semigroup+import Data.VectorSpace+import Data.AffineSpace import Control.Monad import Control.Applicative+import Music.Pitch.Absolute hiding (Octaves(..), octaves)+import Music.Pitch.Literal+import qualified Data.List as List +import Music.Pitch.Relative.Semitones+import Music.Pitch.Relative.Accidental+import Music.Pitch.Relative.Quality+import Music.Pitch.Relative.Name+import Music.Pitch.Relative.Number+import Music.Pitch.Relative.Pitch+import Music.Pitch.Relative.Interval+++{-  +    Some terminology:                                           +        +        newtype Pitch = (PitchClass, Semitones)+            For example (E, Natural)+            We write [c,cs,db..] for [(C, Natural), (C, Sharp), (D, Flat)..]+        +        newtype Interval = (Number, Semitones)+            For example (Augmented, IV)+        +        Interval is the relative representation of pitch +        +        Pitch is an affine space with Interval as the difference type+            c           .+^ major third = e+            major third ^+^ major third = augmentedFifth+        ++        Pitch addition and enhamonic equivalence:++++        +        Semitones is the smallest musical unit (Semitones in Western music)+        +        The `semitones` function retrieves the number of Semitones in a pitch, for example+            semitones :: Interval -> Semitones+            semitones major third = 4++        Note that semitones is surjetive. We can define a non-deterministic function `intervals`+            intervals :: Semitones -> [Interval]+            intervals 4 = [majorThird, diminishedFourth]+        Law+            map semitones (intervals a) = replicate n a    for all n > 0+        Lemma+            map semitones (intervals a)+        ++        isHemitonic   [1,2,2] = True+        isHemitonic   [2,2,2] = False+        isCohemitonic [1,1,2] = True+        isCohemitonic [1,2,1] = False+        isTritonic ...+        +        A Scale is a [Semitones], for example [2,2,1,2,2,2,1]+            From this we can derive       [2,4,5,7,9,11,12]+        A Scale is a function (Number -> Interval)+        A Scale is a function (Number -> Semitones)++    Tonal+        isConsonance :: Interval -> Bool+        isPerfectConsonance :: Interval -> Bool+        isImperfectConsonance :: Interval -> Bool+        isDissonance :: Interval -> Bool+        isDissonance :: Interval -> Bool+        isHemitonic :: Interval -> Bool+        isTritonic :: Interval -> Bool++        isSemitone :: Interval -> Bool+        isSemitone :: Interval -> Bool+        isLeap :: Interval -> Bool+        isSimple :: Interval -> Bool+        isCompound :: Interval -> Bool+        +        -- TODO simplify etc+        isMelodicDissonance :: Interval -> Bool+++    "Post-tonal"+    +        Messiaen+        +        mode1 = [2,2,2,2,2]+        mode2 = [1,2, 1,2, 1,2, 1,2]+        mode3 = [2,1,1, 2,1,1, 2,1,1]+        mode4 = [1,1,3,1,   1,1,3,1]+        mode5 = [1,4,1,     1,4,1]+        mode6 = [2,2,1,1,   2,2,1,1]+        mode7 = [1,1,1,2,1, 1,1,1,2,1]+++-   Old stuff>++++-- Semitone is an enumerated associated type+type family Semitone a :: *+type family Alteration a :: *++-- A scale is a function :: Semitone a -> a+newtype Scale a = Scale { getScale :: [Semitone a] } +-- Eq, Show++semitone :: Scale a -> Semitone a -> a+semitone = undefined+++semitone (Scale xs) p = xs !! (fromIntegral p `mod` length xs)+++fromSemitone :: (Num a, Ord a, Integral b, Num c) => Scale a -> b -> c+fromSemitone (Scale xs) p = fromIntegral $ fromMaybe (length xs - 1) $ List.findIndex (>= fromIntegral p) xs++scaleFromSemitones :: Num a => [a] -> Scale a+scaleFromSemitones = Scale . accum+    where+        accum = snd . List.mapAccumL add 0+        add a x = (a + x, a + x)++-- numberOfSemitones :: Scale a -> Int+numberOfSemitones = length . getScale++major :: Num a => Scale a+major = scaleFromSemitones [0,2,2,1,2,2,2,1]++naturalMinor :: Num a => Scale a+naturalMinor = scaleFromSemitones [0,2,1,2,2,1,2,2]++harmonicMinor :: Num a => Scale a                     +harmonicMinor = scaleFromSemitones [0,2,1,2,2,1,3,1]++-}+++-- or' :: (t -> Bool) -> (t -> Bool) -> t -> Bool+-- or' p q x = p x || q x++-- replicate' n = replicate (fromIntegral n)

@@ -0,0 +1,72 @@++{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving, FlexibleInstances #-}++module Music.Pitch.Relative.Accidental (+        -- * Alterable class+        Alterable(..),++        -- * Accidentals+        Accidental,+        doubleFlat, +        flat, +        natural, +        sharp, +        doubleSharp,+  ) where++import Music.Pitch.Literal++-- |+-- Class of things that can be altered.+--+class Alterable a where+    -- | +    -- Increase the given pitch by one.+    -- +    sharpen :: a -> a++    -- | +    -- Decrease the given pitch by one.+    -- +    flatten :: a -> a++newtype Accidental = Accidental { getAccidental :: Integer }+    deriving (Eq, Ord, Num, Enum, Real, Integral)+    +instance Show Accidental where+    show n | n == 0 = "natural"+           | n > 0  = replicate' n 's'+           | n < 0  = replicate' (negate n) 'b'++instance Alterable Accidental where+    sharpen = succ+    flatten = pred++instance Alterable Double where+    sharpen = (+ 1)+    flatten = (subtract 1)++instance Alterable Integer where+    sharpen = (+ 1)+    flatten = (subtract 1)++instance (IsPitch a, Alterable a) => IsPitch (Accidental -> a) where+    fromPitch l acc+        | acc == sharp  = sharpen (fromPitch l)+        | acc == flat   = flatten (fromPitch l)++sharp, flat, natural, doubleFlat, doubleSharp :: Accidental+-- | The double sharp accidental.+doubleSharp = 2+-- | The sharp accidental.+sharp       = 1+-- | The natural accidental.+natural     = 0+-- | The flat accidental.+flat        = -1+-- | The double flat accidental.+doubleFlat  = -2+++replicate' n = replicate (fromIntegral n)+

@@ -0,0 +1,380 @@++{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving, TypeFamilies #-}++module Music.Pitch.Relative.Interval (+        -- ** Intervals+        Interval,++        -- *** Creating intervals+        interval,+        perfect,+        major,+        minor,+        augmented,+        diminished,+        doublyAugmented,+        doublyDiminished,++        -- *** Inspecting intervals+        number,+        -- isPerfectUnison,+        isPositive,+        isNegative,++        -- *** Simple and compound intervals+        isSimple,+        isCompound,+        separate,+        simple,++        -- *** Inversion+        invert,+++        -- * Utility+        -- ** Spelling+        Spelling,+        spell,+        sharps,+        flats,++        -- * Literals (TODO move)+        d1, _P1, _A1,+        d2, m2, _M2, _A2,+        d3, m3, _M3, _A3,+        d4, _P4, _A4,+        d5, _P5, _A5,+        d6, m6, _M6, _A6,+        d7, m7, _M7, _A7,+        d8, _P8, _A8,++        -- TODO+        intervalDiff,+        interval',+        octave,+  ) where++import Data.Maybe+import Data.Either+import Data.Semigroup+import Data.VectorSpace+import Data.AffineSpace+import Control.Monad+import Control.Applicative+import Music.Pitch.Absolute hiding (Octaves(..), octaves)+import Music.Pitch.Literal+import qualified Data.List as List++import Music.Pitch.Relative.Quality+import Music.Pitch.Relative.Semitones+import Music.Pitch.Relative.Number++-- |+-- An interval is the difference between two pitches, incuding negative+-- intervals.+--+-- Intervals and pitches can be added using '.+^'. To get the interval between+-- two pitches, use '.-.'.+--+-- > c .+^ minor third == eb+-- > f .-. c           == perfect fourth+--+-- Adding intervals preserves spelling. For example:+--+-- > m3 ^+^ _M3 = _P5+-- > d5 ^+^ _M6 = m10+--+-- The scalar type of intervals are 'Integer', using '^*' to stack intervals+-- of a certain type on top of each other. For example @_P5 ^* 2@ is a stack+-- of 2 perfect fifths. The 'Num' instance works as expected for '+', 'negate'+-- and 'abs', and arbitrarily uses octaves for multiplication. If you find+-- yourself '*', or 'signum' on intervals, consider switching to '^*' or+-- 'normalized'.+--+-- Intervals are generally described in terms of 'Quality' and 'Number'. To+-- construct an interval, use the 'interval' constructor, the utility+-- constructors 'major', 'minor', 'augmented' and 'diminished', or the+-- interval literals:+--+-- > m5  == minor   fifth    == interval Minor   5+-- > _P4 == perfect fourth   == interval Perfect 5+-- > d5  == diminished fifth == diminish (perfect fifth)+--+newtype Interval = Interval { getInterval :: (+            Int,        -- octaves, may be negative+            Int,        -- diatonic semitone [0..6]+            Int         -- chromatic semitone [0..11]+    ) }+    deriving (Eq, Ord)++instance Num Interval where+    (+)           = addInterval+    negate        = negateInterval+    abs a         = if isNegative a then negate a else a+    a * b         = fromIntegral (semitones a `div` 12) `stackInterval` b+    signum a      = if isNegative a then (-_P8) else _P8+    fromInteger 0 = _P1+    fromInteger _ = undefined++instance Show Interval where+    show a | isNegative a = "-" ++ show (quality a) ++ show (abs $ number a)+           | otherwise    =        show (quality a) ++ show (abs $ number a)++instance Semigroup Interval where+    (<>)    = addInterval++instance Monoid Interval where+    mempty  = perfect unison+    mappend = addInterval++instance AdditiveGroup Interval where+    zeroV   = perfect unison+    (^+^)   = addInterval+    negateV = negateInterval++instance VectorSpace Interval where+    type Scalar Interval = Integer+    (*^) = stackInterval++instance HasQuality Interval where+    quality (Interval (o, d, c))+        | o >= 0    =                 diffToQuality (isPerfectNumber d) (c - diatonicToChromatic d)+        | otherwise = invertQuality $ diffToQuality (isPerfectNumber d) (c - diatonicToChromatic d)++instance Augmentable Interval where+    augment  (Interval (o, d, c)) = Interval (o, d, c + 1)+    diminish (Interval (o, d, c)) = Interval (o, d, c - 1)++instance HasOctaves Interval where+    octaves = fst . separate++instance HasSemitones Interval where+    semitones (Interval (o, d, c)) = fromIntegral $ o * 12 + c++instance HasSteps Interval where+    steps a = fromIntegral $ semitones a `mod` 12++intervalDiff :: Interval -> Int+intervalDiff (Interval (o, d, c)) = c - diatonicToChromatic d++-- |+-- Creates an interval from a quality and number.+--+-- If given 'Perfect' with an imperfect number (such as 3 or 7) a major interval is+-- returned. If given 'Major' or 'Minor' with a perfect number (such as 5), constructs+-- a perfect or diminished interval respectively.+--+interval :: Quality -> Number -> Interval+interval quality number = interval' (qualityToDiff (isPerfectNumber diatonic) quality) (fromIntegral number)+    where+        (_, diatonic) = (fromIntegral $ number - 1) `divMod` 7++interval' :: Int -> Int -> Interval+interval' diff number = Interval (octave, diatonic, diatonicToChromatic diatonic + diff)+    where+        (octave, diatonic) = (number - 1) `divMod` 7+++-- | Creates a perfect interval.+--   If given an inperfect number, constructs a major interval.+perfect    = interval Perfect+-- | Creates a major interval.+--   If given a perfect number, constructs a perfect interval.+major      = interval Major+-- | Creates a minor interval.+--   If given a perfect number, constructs a diminished interval.+minor      = interval Minor+-- | Creates an augmented interval.+augmented  = interval (Augmented 1)+-- | Creates a diminished interval.+diminished = interval (Diminished 1)+-- | Creates a doubly augmented interval.+doublyAugmented  = interval (Augmented 2)+-- | Creates a doubly diminished interval.+doublyDiminished = interval (Diminished 2)+++invertDiatonic :: Num a => a -> a+invertDiatonic d  = 7  - d++invertChromatic :: Num a => a -> a+invertChromatic c = 12 - c++negateInterval :: Interval -> Interval+negateInterval (Interval (o, 0, 0))   = Interval (negate o, 0, 0)+negateInterval (Interval (oa, da,ca)) = Interval (negate (oa + 1), invertDiatonic da, invertChromatic ca)++addInterval :: Interval -> Interval -> Interval+addInterval (Interval (oa, da,ca)) (Interval (ob, db,cb))+    = Interval (oa + ob + carry, steps, chroma)+    where+        (carry, steps) = (da + db) `divMod` 7+        chroma         = trunc (ca + cb)+        trunc          = if carry > 0 then (`mod` 12) else id++stackInterval :: Integer -> Interval -> Interval+stackInterval n a | n >= 0    = mconcat $ replicate (fromIntegral n) a+                  | otherwise = negate $ stackInterval (negate n) a++-- |+-- Separate a compound interval into octaves and a simple interval.+--+-- > (perfect octave)^*x + y = z  iff  (x, y) = separate z+--+separate :: Interval -> (Octaves, Interval)+separate (Interval (o, d, c)) = (fromIntegral o, Interval (0, d, c))++-- |+-- Returns the simple part of an interval.+--+-- > (perfect octave)^*x + y = z  iff  y = simple z+--+simple :: Interval -> Interval+simple = snd . separate+++-- |+-- Returns the number portion of an interval.+--+-- The interval number is negative if and only if the interval is negative.+--+-- See also 'quality', 'octaves' and 'semitones'.+--+number :: Interval -> Number+number (Interval (o, d, c)) = fromIntegral $ inc $ o * 7 + d+    where+        inc a = if a >= 0 then succ a else pred a++++-- |+-- Returns whether the given interval is simple.+--+-- A simple interval is an positive interval spanning less than one octave.+--+isSimple :: Interval -> Bool+isSimple = (== 0) . octaves++-- |+-- Returns whether the given interval is compound.+--+-- A compound interval is either a negative interval, or a positive interval spanning+-- more than octave.+--+isCompound :: Interval -> Bool+isCompound = (/= 0) . octaves++isPerfectUnison :: Interval -> Bool+isPerfectUnison a = a == perfect unison++-- |+-- Returns whether the given interval is positive.+--+isPositive :: Interval -> Bool+isPositive (Interval (oa, _, _)) = oa > 0++-- |+-- Returns whether the given interval is negative.+--+isNegative :: Interval -> Bool+isNegative (Interval (oa, _, _)) = oa < 0+++-- |+-- Intervallic inversion.+--+-- The inversion of a simple interval is determined by the following rules:+--+-- * The interval number and the number of its inversion always add up to nine+--   (i.e. 4 + 5 = 9).+--+-- * The inversion of a major interval is a minor interval, and vice versa;+--   the inversion of a perfect interval is also perfect; the inversion of an+--   augmented interval is a diminished interval, and vice versa; the+--   inversion of a doubly augmented interval is a doubly diminished interval,+--   and vice versa.+--+-- The inversion of any compound interval is always the same as the inversion+-- of the simple interval from which it is compounded, i.e.:+--+-- > invert = simple . negate+--+invert :: Interval -> Interval+invert = simple . negate++++type Spelling = Semitones -> Number++spell :: HasSemitones a => Spelling -> a -> Interval+spell z = (\s -> Interval (fromIntegral $ s `div` 12, fromIntegral $ z s, fromIntegral s)) .  semitones++isPerfectNumber :: Int -> Bool+isPerfectNumber 0 = True+isPerfectNumber 1 = False+isPerfectNumber 2 = False+isPerfectNumber 3 = True+isPerfectNumber 4 = True+isPerfectNumber 5 = False+isPerfectNumber 6 = False++diatonicToChromatic :: Int -> Int+diatonicToChromatic = go+    where+        go 0 = 0+        go 1 = 2+        go 2 = 4+        go 3 = 5+        go 4 = 7+        go 5 = 9+        go 6 = 11++sharps :: Semitones -> Number+sharps = go+    where+        go 0  = 0+        go 1  = 0+        go 2  = 1+        go 3  = 1+        go 4  = 2+        go 5  = 3+        go 6  = 3+        go 7  = 4+        go 8  = 4+        go 9  = 5+        go 10 = 5+        go 11 = 6++flats :: Semitones -> Number+flats = go+    where+        go 0  = 0+        go 1  = 1+        go 2  = 1+        go 3  = 2+        go 4  = 2+        go 5  = 3+        go 6  = 4+        go 7  = 4+        go 8  = 5+        go 9  = 5+        go 10 = 6+        go 11 = 6+++++_ = 1 ;                  d1 = Interval (0,0,-1) ; _P1 = Interval (0,0,0)  ; _A1 = Interval (0,0,1)+d2 = Interval (0,1,0)  ; m2 = Interval (0,1,1)  ; _M2 = Interval (0,1,2)  ; _A2 = Interval (0,1,3)+d3 = Interval (0,2,2)  ; m3 = Interval (0,2,3)  ; _M3 = Interval (0,2,4)  ; _A3 = Interval (0,2,5)+_ = 1 ;                  d4 = Interval (0,3,4)  ; _P4 = Interval (0,3,5)  ; _A4 = Interval (0,3,6)+_ = 1 ;                  d5 = Interval (0,4,6)  ; _P5 = Interval (0,4,7)  ; _A5 = Interval (0,4,8)+d6 = Interval (0,5,7)  ; m6 = Interval (0,5,8)  ; _M6 = Interval (0,5,9)  ; _A6 = Interval (0,5,10)+d7 = Interval (0,6,9)  ; m7 = Interval (0,6,10) ; _M7 = Interval (0,6,11) ; _A7 = Interval (0,6,12)+_ = 1 ;                  d8 = Interval (1,0,-1) ; _P8 = Interval (1,0,0)  ; _A8 = Interval (1,0,1)++d9  = d2  + _P8 ; m9  = m2  + _P8 ; _M9  = _M2 + _P8 ; _A9  = _A2 + _P8+d10 = d3  + _P8 ; m10 = m3  + _P8 ; _M10 = _M3 + _P8 ; _A10 = _A3 + _P8+++

@@ -0,0 +1,20 @@+ +{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-}++module Music.Pitch.Relative.Name (+        -- ** Name+        Name(..),+  ) where++instance Show Name where+    show C = "c"+    show D = "d"+    show E = "e"+    show F = "f"+    show G = "g"+    show A = "a"+    show B = "b"++data Name = C | D | E | F | G | A | B+    deriving (Eq, Ord, Enum)+

@@ -0,0 +1,56 @@++{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-}++module Music.Pitch.Relative.Number (+        -- ** Number+        Number,   +        unison,+        prime,+        second,+        third,+        fourth,+        fifth,+        sixth,+        seventh,+        octave,+        -- ninth,+        -- tenth,+        -- twelfth,+        -- thirteenth,+        -- fourteenth,+        -- duodecim,+  ) where++-- |+-- The number portion of an interval (i.e. second, third, etc).+--+-- Note that the interval number is always one step larger than number of steps spanned by+-- the interval (i.e. a third spans two diatonic steps). Thus 'number' does not distribute+-- over addition:+--+-- > number (a + b) = number a + number b - 1+--+newtype Number = Number { getNumber :: Integer }+    deriving (Eq, Ord, Num, Enum, Real, Integral)+    +instance Show Number where { show = show . getNumber }++unison  :: Number+prime   :: Number+second  :: Number+third   :: Number+fourth  :: Number+fifth   :: Number+sixth   :: Number+seventh :: Number+octave  :: Number+unison  = 1+prime   = 1+second  = 2+third   = 3+fourth  = 4+fifth   = 5+sixth   = 6+seventh = 7+octave  = 8+

@@ -0,0 +1,148 @@++{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving, TypeFamilies #-}++module Music.Pitch.Relative.Pitch (+        -- * Pitch+        Pitch,    +        pitch,+        name,+        accidental,+        asPitch,+  ) where++import Data.Maybe+import Data.Either+import Data.Semigroup+import Data.VectorSpace+import Data.AffineSpace+import Control.Monad+import Control.Applicative+import Music.Pitch.Absolute hiding (Octaves(..), octaves)+import Music.Pitch.Literal+import qualified Data.List as List++import Music.Pitch.Relative.Interval+import Music.Pitch.Relative.Quality+import Music.Pitch.Relative.Accidental+import Music.Pitch.Relative.Semitones+import Music.Pitch.Relative.Name++-- |+-- Standard pitch representation.+--+-- Intervals and pitches can be added using '.+^'. To get the interval between+-- two pitches, use '.-.'.+--+-- Notes with accidentals can be written by adding the @s@ or @b@ suffices+-- (or two for double sharps and flats).+--+-- > cs, ds, es ...    -- sharp+-- > cb, db, eb ...    -- flat+-- > css, dss, ess ... -- double sharp+-- > cbb, dbb, ebb ... -- double flat+--+-- There is also a convenience syntax for entering pitches one octave up or+-- down, using @'@ and @_@ respectively.+--+-- > g a b c'+-- > d c b_ c+--+-- Because of some overloading magic, we can actually write @sharp@ and+-- @flat@ as /postfix/ functions. This gives a better read:+--+-- > cs == c sharp+-- > db == c flat+--+-- You can of course use typical functional transformation of pitch as well.+-- For example 'sharpen' and 'flatten' are the ordinary (prefix) versions of+-- 'sharp' and 'flat'+--+-- > sharpen c             == c sharp       == cs+-- > flatten d             == d flat        == ds+-- > (sharpen . sharpen) c == c doubleSharp == css+-- > (flatten . flatten) d == d doubleFlat  == dss+--+-- Note that there is no guarantee that your pitch representation use+-- enharmonic equivalence, so @cs == db@ may or may not hold.+--+-- > c .+^ minor third == eb+-- > f .-. c           == perfect fourth+--+-- Pitches are described by name, accidental and octave number.+--+-- > c   == fromIntegral 0+-- > _P4 == perfect fourth   == interval Perfect 5+-- > d5  == diminished fifth == diminish (perfect fifth)+--+newtype Pitch = Pitch { getPitch :: Interval }+    deriving (Eq, Num, Ord)+    +instance AffineSpace Pitch where+    type Diff Pitch     = Interval+    Pitch a .-. Pitch b = a ^-^ b+    Pitch a .+^ b       = Pitch (a ^+^ b)++instance Show Pitch where+    show p = show (name p) ++ showAccidental (accidental p) ++ showOctave (octaves p)+        where+            showOctave n+                | n > 0     = replicate' n '\''+                | otherwise = replicate' (negate n) '_'+            showAccidental n+                | n > 0     = replicate' n 's'+                | otherwise = replicate' (negate n) 'b'++instance Alterable Pitch where+    sharpen (Pitch a) = Pitch (augment a)+    flatten (Pitch a) = Pitch (diminish a)++-- |+-- This is just the identity function, but is useful to fix the type of 'Pitch'.+--+asPitch :: Pitch -> Pitch+asPitch = id++-- |+-- Creates a pitch from name accidental.+--+pitch :: Name -> Accidental -> Pitch+pitch = undefined++-- |+-- Returns the name of a pitch.+--+-- See also 'octaves', and 'steps' and 'semitones'.+--+name :: Pitch -> Name+name = toEnum . fromIntegral . pred . number . simple . getPitch++-- |+-- Returns the accidental of a pitch.+--+-- See also 'octaves', and 'steps' and 'semitones'.+--+accidental :: Pitch -> Accidental+accidental = fromIntegral . intervalDiff . simple . getPitch++instance HasOctaves Pitch where+    octaves = octaves . getPitch++instance HasSemitones Pitch where+    semitones = semitones . getPitch++instance HasSteps Pitch where+    steps = steps . getPitch+++instance IsPitch Pitch where+    fromPitch (PitchL (c, a, o)) =+        Pitch $ interval' (qual a) (c + 1)+            ^+^+            (perfect octave^* fromIntegral (o - 4))+        where+            qual Nothing  = 0+            qual (Just n) = round n++midiNumber :: Pitch -> Integer+midiNumber = fromIntegral . semitones . getPitch+

@@ -0,0 +1,156 @@++{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-}++module Music.Pitch.Relative.Quality (++        -- * Augmentable class+        Augmentable(..),++        -- * Quality+        Quality(..),    +        HasQuality(..),+        -- invertQuality,+        isPerfect,+        isMajor,+        isMinor,+        isAugmented,+        isDiminished,+        +        -- TODO+        diffToQuality,+        qualityToDiff,+        invertQuality,+        replicate',+  ) where++-- |+-- Class of types that can be augmented.+--+class Augmentable a where++    -- | +    -- Increase the size of this interval by one.+    --+    augment :: a -> a++    -- | +    -- Decrease the size of this interval by one.+    --+    diminish :: a -> a++-- |+-- Interval quality is either perfect, major, minor, augmented, and+-- diminished. This representation allows for an arbitrary number of+-- augmentation or diminishions, so /augmented/ is represented by @Augmented+-- 1@, /doubly augmented/ by @Augmented 2@ and so on.+--+-- The quality of a compound interval is the quality of the simple interval on+-- which it is based.+--+data Quality+    = Major+    | Minor+    | Perfect+    | Augmented Integer+    | Diminished Integer+    deriving (Eq, Ord)++instance Show Quality where+    show Major            = "_M"+    show Minor            = "m"+    show Perfect          = "_P"+    show (Augmented n)    = "_" ++ replicate' n 'A'+    show (Diminished n)   = replicate' n 'd'++instance HasQuality Quality where+    quality = id++-- TODO this instance should not be used+-- instance Augmentable Quality where+--     augment = go+--         where+--             go (Diminished 0)   = Augmented n    -- not unique!+--             go (Diminished n)   = Augmented n+--             go Minor            = Major+--             go Major            = Augmented 1+--             go Perfect          = Augmented 1+--             go (Augmented n)    = Diminished (n)++class HasQuality a where+    quality :: a -> Quality++invertQuality :: Quality -> Quality+invertQuality = go+    where+        go Major            = Minor+        go Minor            = Major+        go Perfect          = Perfect+        go (Augmented n)    = Diminished n+        go (Diminished n)   = Augmented n+++-- | +-- Returns whether the given quality is perfect.+-- +isPerfect :: HasQuality a => a -> Bool+isPerfect a = case quality a of { Perfect -> True ; _ -> False }++-- | +-- Returns whether the given quality is major.+-- +isMajor :: HasQuality a => a -> Bool+isMajor a = case quality a of { Major -> True ; _ -> False }++-- | +-- Returns whether the given quality is minor.+-- +isMinor :: HasQuality a => a -> Bool+isMinor a = case quality a of { Minor -> True ; _ -> False }++-- | +-- Returns whether the given quality is /augmented/ (including double augmented etc).+-- +isAugmented :: HasQuality a => a -> Bool+isAugmented a = case quality a of { Augmented _ -> True ; _ -> False }++-- | +-- Returns whether the given quality is /diminished/ (including double diminished etc).+-- +isDiminished :: HasQuality a => a -> Bool+isDiminished a = case quality a of { Diminished _ -> True ; _ -> False }++-- | +-- Convert an offset to a quality.+--+-- This is different for perfect and imperfect interals:+--+--      Imperfect   Perfect+--      ===         ===+-- -3   dd          ddd+-- -2   d           dd+-- -1   m           d+--  0   M           P+--  1   a           a+--  2   aa          aa+--+diffToQuality :: Bool -> Int -> Quality+diffToQuality = go+    where+        go True  0   = Perfect+        go True  n   = if n > 0 then Augmented (fromIntegral n) else Diminished (fromIntegral $ negate n)+        go False 0    = Major+        go False (-1) = Minor+        go False n    = if n > 0 then Augmented (fromIntegral n) else Diminished (fromIntegral $ negate $ n + 1)++qualityToDiff :: Bool -> Quality -> Int+qualityToDiff perfect = go+    where+        go (Diminished n)   = fromIntegral $ negate $ if perfect then n else n + 1+        go Minor            = fromIntegral $ -1+        go Perfect          = fromIntegral $ 0+        go Major            = fromIntegral $ 0+        go (Augmented n)    = fromIntegral $ n++++replicate' n = replicate (fromIntegral n)

@@ -0,0 +1,163 @@++{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-}++module Music.Pitch.Relative.Semitones (+        -- * Octaves+        Octaves,+        HasOctaves(..),++        -- * Steps+        Steps,+        HasSteps(..),++        -- * Semitones+        Semitones,+        HasSemitones(..),+        semitone,+        tone,+        ditone,+        tritone,+        isSemitone,+        isTone,+        isTritone,+        +        -- ** Enharmonic equivalence+        (=:=),+        (/:=),+  ) where++-- |+-- An interval represented as a number of octaves, including negative+-- intervals.+--+-- > octaves a = semitones a `div` 12+-- > steps   a = semitones a `mod` 12+--+newtype Octaves = Octaves { getOctaves :: Integer }     +    deriving (Eq, Ord, Num, Enum, Real, Integral)++instance Show       Octaves where { show = show . getOctaves }+instance HasOctaves Octaves where { octaves = id }++-- |+-- Class of intervals that has a number of 'Octaves'.+--+class HasOctaves a where+    -- |+    -- Returns the number of octaves spanned by an interval.+    --+    -- The number of octaves is negative if and only if the interval is+    -- negative.+    --+    -- Examples:+    --+    -- > octaves (perfect unison)  =  0+    -- > octaves (d5 ^* 4)         =  2+    -- > octaves (-_P8)            =  -1+    --+    octaves :: a -> Octaves+++-- |+-- An interval represented as a number of steps in the range /0 ≤ x < 12/.+--+-- > octaves a = semitones a `div` 12+-- > steps   a = semitones a `mod` 12+--+newtype Steps = Steps { getSteps :: Integer }+    deriving (Eq, Ord, Num, Enum, Real, Integral)++instance Show     Steps where { show = show . getSteps }+instance HasSteps Steps where { steps = id }++-- |+-- Class of intervals that has a number of 'Steps'.+--+class HasSteps a where+    -- |+    -- The number of steps is always in the range /0 ≤ x < 12/.+    --+    -- Examples:+    --+    -- > octaves (perfect unison)  =  0+    -- > octaves (d5 ^* 4)         =  2+    -- > octaves (-m7)             =  -1+    --+    steps :: a -> Steps++-- |+-- An interval represented as a number of semitones, including negative+-- intervals, as well as intervals larger than one octave. This representation+-- does not take spelling into account, so for example a major third and a+-- diminished fourth can not be distinguished.+--+-- Intervals that name a number of semitones (i.e. 'semitone', 'tritone') does+-- not have an unequivocal spelling. To convert these to an interval, a+-- 'Spelling' must be provided as in:+--+-- > spell sharps tritone == augmented fourth+-- > spell flats  tritone == diminished fifth+--+newtype Semitones = Semitones { getSemitones :: Integer }+    deriving (Eq, Ord, Num, Enum, Real, Integral)++instance Show         Semitones where { show = show . getSemitones }+instance HasSemitones Semitones where { semitones = id }++-- |+-- Class of intervals that can be converted to a number of 'Semitones'.+--+class HasSemitones a where++    -- |+    -- Returns the number of semitones spanned by an interval.+    --+    -- The number of semitones is negative if and only if the interval is+    -- negative.+    --+    -- Examples:+    --+    -- > semitones (perfect unison)  =  0+    -- > semitones tritone           =  6+    -- > semitones d5                =  6+    -- > semitones (-_P8)            =  -12+    --+    semitones :: a -> Semitones+++semitone, tone, ditone, tritone :: Semitones++-- | Precisely one semitone.+semitone = 1+-- | Precisely one whole tone, or two semitones.+tone     = 2+-- | Precisely two whole tones, or four semitones.+ditone   = 4+-- | Precisely three whole tones, or six semitones.+tritone  = 6++isTone, isSemitone, isTritone :: HasSemitones a => a -> Bool+-- | Returns true iff the given interval spans one semitone.+isSemitone  = (== semitone) . abs . semitones+-- | Returns true iff the given interval spans one whole tone (two semitones).+isTone      = (== tone)     . abs . semitones+-- | Returns true iff the given interval spans three whole tones (six semitones).+isTritone   = (== tritone)  . abs . semitones+++infix 4 =:=+infix 4 /:=++-- |+-- Enharmonic equivalence.+--+(=:=) :: HasSemitones a => a -> a -> Bool+a =:= b = semitones a == semitones b++-- |+-- Enharmonic non-equivalence.+--+(/:=) :: HasSemitones a => a -> a -> Bool+a /:= b = semitones a /= semitones b++