music-pitch 1.7.2 → 1.8

raw patch · 19 files changed

+1582/−987 lines, 19 filesdep +data-intervaldep +lensdep +positivedep −randomdep −semigroupoidsdep −timedep ~music-pitch-literalPVP ok

version bump matches the API change (PVP)

Dependencies added: data-interval, lens, positive

Dependencies removed: random, semigroupoids, time

Dependency ranges changed: music-pitch-literal

API changes (from Hackage documentation)

Files

• music-pitch.cabal +12/−6
• src/Music/Pitch.hs +10/−19
• src/Music/Pitch/Absolute.hs +55/−50
• src/Music/Pitch/Ambitus.hs +49/−0
• src/Music/Pitch/Clef.hs +59/−8
• src/Music/Pitch/Common.hs +9/−217
• src/Music/Pitch/Common/Chromatic.hs +13/−0
• src/Music/Pitch/Common/Diatonic.hs +11/−0
• src/Music/Pitch/Common/Harmony.hs +28/−10
• src/Music/Pitch/Common/Interval.hs +204/−373
• src/Music/Pitch/Common/Names.hs +414/−0
• src/Music/Pitch/Common/Number.hs +142/−0
• src/Music/Pitch/Common/Pitch.hs +124/−98
• src/Music/Pitch/Common/Quality.hs +153/−0
• src/Music/Pitch/Common/Semitones.hs +47/−46
• src/Music/Pitch/Common/Spell.hs +77/−73
• src/Music/Pitch/Equal.hs +153/−82
• src/Music/Pitch/Intonation.hs +8/−5
• src/Music/Pitch/StaffLines.hs +14/−0

@@ -1,6 +1,6 @@  name:                   music-pitch-version:                1.7.2+version:                1.8 cabal-version:          >= 1.10 author:                 Hans Hoglund maintainer:             Hans Hoglund@@ -23,29 +23,35 @@    library                         build-depends:      base                    >= 4 && < 5,-                        time,-                        random,                         containers,+                        lens                    >= 4.6      && < 4.7,                         semigroups              >= 0.13.0.1 && < 1,-                        semigroupoids,-                        music-pitch-literal     == 1.7.2,+                        music-pitch-literal     == 1.8,+                        data-interval           >= 1.0.0 && < 2,                         vector-space            >= 0.8.7 && < 0.9,                         vector-space-points     >= 0.2 && < 0.3,                         nats,+                        positive                >= 0.3 && < 1,                         type-unary              >= 0.2.16 && < 1.0-                        -- type-level              >= 0.2.4 && < 3.0     exposed-modules:    Music.Pitch                         Music.Pitch.Absolute                         Music.Pitch.Equal                         Music.Pitch.Common+                        Music.Pitch.Common.Quality+                        Music.Pitch.Common.Number+                        Music.Pitch.Common.Diatonic+                        Music.Pitch.Common.Chromatic                         Music.Pitch.Common.Interval                         Music.Pitch.Common.Pitch                         Music.Pitch.Common.Semitones                         Music.Pitch.Common.Spell                         Music.Pitch.Common.Harmony+                        Music.Pitch.Common.Names+                        Music.Pitch.Ambitus                         Music.Pitch.StaffLines                         Music.Pitch.Clef                         Music.Pitch.Tokawa                         Music.Pitch.Intonation     hs-source-dirs:     src     default-language:   Haskell2010+    ghc-options:        -fno-warn-typed-holes

@@ -14,33 +14,20 @@ -------------------------------------------------------------------------------------  module Music.Pitch (-        -- * Prerequisites         module Data.Semigroup,         module Data.VectorSpace,         module Data.AffineSpace,         module Data.AffineSpace.Point,--        -- * Pitch representation-        -        -- -- | Augmentation and diminishing, generalized to work on all interval types.         module Music.Pitch.Augmentable,--        -- -- | Alteration, sharps and flats, generalized to work on all pitch types.         module Music.Pitch.Alterable,--        -- -- | Frequency, cents and other absolute measurements of pitch.         module Music.Pitch.Absolute,--        -- -- | Pitch and intervals, as defined in Common Music Theory (CMT).-        -- ---        -- --   Includes representation of common practice pitches and intervals such as /c sharp/, -        -- --   /diminished second/ and so on.+        module Music.Pitch.Ambitus,+        module Music.Pitch.Equal,         module Music.Pitch.Common,--        -- * Intonation+        module Music.Pitch.Common.Names,+        module Music.Pitch.StaffLines,+        module Music.Pitch.Clef,         module Music.Pitch.Intonation,-        -        -- * Pitch literals         module Music.Pitch.Literal,   ) where @@ -48,11 +35,15 @@ import Data.VectorSpace hiding (Sum, getSum) import Data.AffineSpace import Data.AffineSpace.Point- import Music.Pitch.Absolute import Music.Pitch.Augmentable import Music.Pitch.Alterable+import Music.Pitch.Ambitus+import Music.Pitch.Equal import Music.Pitch.Common+import Music.Pitch.Common.Names import Music.Pitch.Literal+import Music.Pitch.StaffLines+import Music.Pitch.Clef import Music.Pitch.Intonation 

@@ -1,5 +1,6 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeFamilies               #-}  ------------------------------------------------------------------------------------- -- |@@ -12,78 +13,82 @@ -- Portability : portable -- -- Absolute pitch representation.--- --- The canonical pitch representation is frequency in Hertz (Hz). For conversion, see--- 'HasFrequency'. --+-- The canonical pitch representation is frequency in Hertz (Hz).+--+-- For conversion, see 'HasFrequency'.+-- -------------------------------------------------------------------------------------  module Music.Pitch.Absolute (+        -- * Absolute pitch representation         Hertz(..),         -- FreqRatio(..),         -- Octaves,         Cents,         Fifths,+        +        -- * HasFrequency class         HasFrequency(..),         -- octaves,         fifths,         cents,   ) where -import Data.Maybe-import Data.Either-import Data.Semigroup-import Data.VectorSpace-import Data.AdditiveGroup-import Data.AffineSpace-import Control.Monad-import Control.Applicative+import           Control.Applicative+import           Control.Monad+import           Data.AdditiveGroup+import           Data.AffineSpace+import           Data.Either+import           Data.Maybe+import           Data.Semigroup+import           Data.VectorSpace -import Music.Pitch.Literal+import           Music.Pitch.Literal --- | --- Absolute frequency in Hertz.    --- +-- |+-- Absolute frequency in Hertz.+-- newtype Hertz = Hertz { getHertz :: Double }-    deriving (Read, Show, Eq, Enum, Num, Ord, Fractional, Floating, Real, RealFrac)+  deriving (Read, Show, Eq, Enum, Num, Ord, Fractional, Floating, Real, RealFrac)  {---- | +-- | -- A ratio between two different (Hertz) frequencies.--- +-- newtype FreqRatio = FreqRatio { getFreqRatio :: Double }-    deriving (Read, Show, Eq, Enum, Num, Ord, Fractional, Floating, Real, RealFrac)+  deriving (Read, Show, Eq, Enum, Num, Ord, Fractional, Floating, Real, RealFrac) -} --- | +-- | -- Number of pure octaves. -- -- Octaves are a logarithmic representation of frequency such that ----- > f * (2/1) = frequency (octaves f + 1)    --- +-- > f * (2/1) = frequency (octaves f + 1)+-- newtype Octaves = Octaves { getOctaves :: Hertz }-    deriving (Read, Show, Eq, Enum, Num, Ord, Fractional, Floating, Real, RealFrac)+  deriving (Read, Show, Eq, Enum, Num, Ord, Fractional, Floating, Real, RealFrac) --- | +-- | -- Number of pure octaves. -- -- Cents are a logarithmic representation of frequency such that ----- > f * (2/1) = frequency (cents f + 1200)    --- +-- > f * (2/1) = frequency (cents f + 1200)+-- newtype Cents = Cents { getCents :: Hertz }-    deriving (Read, Show, Eq, Enum, Num, Ord, Fractional, Floating, Real, RealFrac)+  deriving (Read, Show, Eq, Enum, Num, Ord, Fractional, Floating, Real, RealFrac) --- | +-- | -- Number of pure fifths. -- -- Fifths are a logarithmic representation of frequency. ----- > f * (3/2) = frequency (fifths f + 1)    --- +-- > f * (3/2) = frequency (fifths f + 1)+-- newtype Fifths = Fifths { getFifths :: Hertz }-    deriving (Read, Show, Eq, Enum, Num, Ord, Fractional, Floating, Real, RealFrac)+  deriving (Read, Show, Eq, Enum, Num, Ord, Fractional, Floating, Real, RealFrac)   instance Semigroup Hertz    where (<>) = (*)@@ -98,13 +103,13 @@  {- instance AdditiveGroup FreqRatio where-    zeroV   = 1-    (^+^)   = (*)-    negateV f = 1 / f+  zeroV   = 1+  (^+^)   = (*)+  negateV f = 1 / f  instance VectorSpace FreqRatio where-    type Scalar FreqRatio = Double-    (*^) x f = FreqRatio ((getFreqRatio f) ** x)+  type Scalar FreqRatio = Double+  (*^) x f = FreqRatio ((getFreqRatio f) ** x)  instance AffineSpace Hertz where   type Diff Hertz = FreqRatio@@ -112,13 +117,13 @@   (.+^) p f = Hertz $ (getHertz p) * (getFreqRatio f) -} instance AdditiveGroup Hertz where-    zeroV   = 1-    (^+^)   = (*)-    negateV f = 1 / f+  zeroV   = 1+  (^+^)   = (*)+  negateV f = 1 / f  instance VectorSpace Hertz where-    type Scalar Hertz = Hertz-    (*^) x f = Hertz ((getHertz f) ** getHertz x)+  type Scalar Hertz = Hertz+  (*^) x f = Hertz ((getHertz f) ** getHertz x)  instance AffineSpace Hertz where   type Diff Hertz = Hertz@@ -126,19 +131,19 @@   (.+^) = (+)  class HasFrequency a where-    frequency :: a -> Hertz+  frequency :: a -> Hertz  instance HasFrequency Hertz where-    frequency = id+  frequency = id  instance HasFrequency Octaves where-    frequency (Octaves f)  = (2/1) ** f+  frequency (Octaves f) = (2/1) ** f  instance HasFrequency Fifths where-    frequency (Fifths f)   =  (3/2) ** f+  frequency (Fifths f)  =  (3/2) ** f  instance HasFrequency Cents where-    frequency (Cents f)    =  (2/1) ** (f / 1200)+  frequency (Cents f)   =  (2/1) ** (f / 1200)  octaves :: HasFrequency a => a -> Octaves octaves a = Octaves $ logBase (2/1) (frequency a)@@ -149,14 +154,14 @@ cents :: HasFrequency a => a -> Cents cents a = Cents $ logBase (2/1) (frequency a) * 1200 --- +-- -- For convenience. TODO problematic for these reasons:--- +-- --  * Confusing as _P8+m2 is not the same as _P8<>m2 --  * Does not work with HasPitch (up, down...) etc as we do not have an affine/vector space pair -- -- Can we fix this with newtype wrappers?--- +-- instance IsInterval Hertz where   fromInterval (IntervalL (o,d,c)) = (2**fromIntegral o) * (r !! fromIntegral c)     where

@@ -0,0 +1,49 @@++{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}++------------------------------------------------------------------------------------+-- |+-- Copyright   : (c) Hans Hoglund, Edward Lilley 2012–2014+--+-- License     : BSD-style+--+-- Maintainer  : hans@hanshoglund.se+-- Stability   : experimental+-- Portability : non-portable (TF,GNTD)+--+-- Musical ambitus, or pitch ranges.+--+-------------------------------------------------------------------------------------++module Music.Pitch.Ambitus where++import Data.Interval hiding (Interval, interval)+import qualified Data.Interval as I+import Control.Lens++-- | An ambitus is a closed interval (in the mathematical sense).+-- +-- Also known as /range/ or /tessitura/, this type can be used to restrict the+-- range of a melody, chord or other pitch container.+-- +-- It is also used in @music-parts@ to represent the range of instruments.+-- +newtype Ambitus a = Ambitus { getAmbitus :: (I.Interval a) }++instance Wrapped (Ambitus a) where+  type Unwrapped (Ambitus a) = I.Interval a+  _Wrapped' = iso getAmbitus Ambitus+instance Rewrapped (Ambitus a) (Ambitus b)++instance (Show a, Num a, Ord a) => Show (Ambitus a) where+  show a = show (a^.from ambitus) ++ "^.ambitus"++ambitus :: (Num a, Ord a) => Iso' (a, a) (Ambitus a)+ambitus = iso toA unA . _Unwrapped+  where+    toA = (\(m, n) -> (I.<=..<=) (Finite m) (Finite n))+    unA a = case (I.lowerBound a, I.upperBound a) of+      (Finite m, Finite n) -> (m, n)++

@@ -12,14 +12,42 @@ {-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE TypeFamilies               #-} +------------------------------------------------------------------------------------+-- |+-- Copyright   : (c) Hans Hoglund, Edward Lilley 2012–2014+--+-- License     : BSD-style+--+-- Maintainer  : hans@hanshoglund.se+-- Stability   : experimental+-- Portability : non-portable (TF,GNTD)+--+-- Clefs and staff positions.+--+-------------------------------------------------------------------------------------+ module Music.Pitch.Clef (+      -- * Clef representation       ClefSymbol,-      OctaveAdjustment,+      ClefOctave,       Clef,       symbolName,       symbolPitch,       positionPitch,       pitchPosition,+      -- ** Properties+      isModernClef,+      isHistoricalClef,+      isVoiceClef,++      -- * Standard clefs+      trebleClef,+      bassClef,+      sopranoClef,+      mezzoSopranoClef,+      altoClef,+      tenorClef,+      baritoneClef,   ) where  import Data.Typeable@@ -31,9 +59,10 @@ data ClefSymbol = GClef | CClef | FClef | PercClef | NeutralClef     deriving (Eq, Ord, Show, Typeable) -type OctaveAdjustment = Integer+type ClefOctave = Integer+type ClefLine   = StaffLines -type Clef = (ClefSymbol, OctaveAdjustment, StaffLines)+type Clef = (ClefSymbol, ClefOctave, ClefLine)  symbolName :: ClefSymbol -> String symbolName GClef = "G clef"@@ -79,11 +108,33 @@   If 1), do we need to separate G/C/F in ClefSymbol, maybe just put a single constructor for common pitch.   In that case, maybe a function isStandardClefPitch (i.e. c/f/g) would be appropriate. -}-+trebleClef :: Clef+bassClef :: Clef+sopranoClef :: Clef+mezzoSopranoClef :: Clef+altoClef :: Clef+tenorClef :: Clef+baritoneClef :: Clef+trebleClef        = (GClef, -1 :: ClefOctave, -1 :: ClefLine)+bassClef          = (FClef, 1  :: ClefOctave, -1 :: ClefLine)+sopranoClef       = (CClef, 0  :: ClefOctave, -2 :: ClefLine)+mezzoSopranoClef  = (CClef, 0  :: ClefOctave, -1 :: ClefLine)+altoClef          = (CClef, 0  :: ClefOctave, 0  :: ClefLine)+tenorClef         = (CClef, 0  :: ClefOctave, 1  :: ClefLine)+baritoneClef      = (CClef, 0  :: ClefOctave, 2  :: ClefLine) --- isModernClef :: Clef -> Bool--- isHistoricalClef :: Clef -> Bool+isModernClef :: Clef -> Bool+isModernClef x | x == trebleClef  = True+isModernClef x | x == bassClef    = True+isModernClef x | x == altoClef    = True+isModernClef x | x == tenorClef   = True+isModernClef x | otherwise        = False --- i.e. a c clef on some staff--- isVoiceClef :: Clef -> Bool+isHistoricalClef :: Clef -> Bool+isHistoricalClef _ = False +-- | Is this a voice clef, i.e. a c clef on some staff.+isVoiceClef :: Clef -> Bool+isVoiceClef x | x == altoClef    = True+isVoiceClef x | x == tenorClef   = True+isVoiceClef x | otherwise        = False

@@ -14,134 +14,16 @@ -------------------------------------------------------------------------------------  module Music.Pitch.Common (-    -- -- * Enharmonic representation-    -- -- ** Octaves-    -- Octaves,-    -- -- HasOctaves(..),-    -- -    -- -- ** Steps-    -- -- Steps,-    -- -- HasSteps(..),-    -- -    -- -- ** Semitones-    -- Semitones,-    -- HasSemitones(..),-    -- semitone,-    -- tone,-    -- ditone,-    -- tritone,-    -- isSemitone,-    -- isTone,-    -- isTritone,-    -- -    -- -- ** Enharmonic equivalence-    -- (=:=),-    -- (/:=),-    -- -    -- -- * Pitches-    -- -- ** Name type-    -- Name(..),-    -- -    -- -- ** Accidental  type-    -- Accidental,-    -- doubleFlat, -    -- flat, -    -- natural, -    -- sharp, -    -- doubleSharp,-    -- -    -- -- *** Inspecting accidentals-    -- isNatural,-    -- isSharpened,-    -- isFlattened,-    -- isStandard,-    -- -    -- -- ** Pitch type-    -- Pitch,    -    -- pitch,-    -- name,-    -- accidental,-    -- asPitch,-    -- -    -- -- module Music.Pitch.Common.Name,-    -- -- module Music.Pitch.Common.Accidental,-    -- -- module Music.Pitch.Common.Pitch,-    -- -    -- -- * Intervals-    -- -- ** Number type-    -- Number,-    -- HasNumber(..),   -    -- unison,-    -- prime,-    -- second,-    -- third,-    -- fourth,-    -- fifth,-    -- sixth,-    -- seventh,-    -- octave,-    -- ninth,-    -- tenth,-    -- twelfth, -    -- duodecim,-    -- thirteenth,-    -- fourteenth,-    -- fifteenth,-    -- -    -- -- ** Quality type-    -- Quality(..),    -    -- HasQuality(..),-    -- invertQuality,-    -- isPerfect,-    -- isMajor,-    -- isMinor,-    -- isAugmented,-    -- isDiminished,-    -- -    -- -- ** Interval type-    -- Interval,-    -- -    -- -- *** Creating intervals-    -- interval,-    -- perfect,-    -- major,-    -- minor,-    -- augmented,-    -- diminished,-    -- doublyAugmented,-    -- doublyDiminished,-    -- asInterval,-    -- -    -- -- *** Inspecting intervals-    -- isNegative,-    -- isPositive,-    -- isNonNegative,-    -- isPerfectUnison,-    -- isStep,-    -- isLeap,-    -- -    -- -- *** Simple and compound intervals-    -- isSimple,-    -- isCompound,-    -- separate,-    -- octaves,-    -- simple,-    -- -    -- -- *** Inversion-    -- invert,  --    -- * Enharmonic representation     module Music.Pitch.Common.Semitones,--    -- * Non-enharmonic representation+    module Music.Pitch.Common.Quality,+    module Music.Pitch.Common.Number,+    module Music.Pitch.Common.Diatonic,+    module Music.Pitch.Common.Chromatic,     module Music.Pitch.Common.Interval,     module Music.Pitch.Common.Pitch,--    -- * Utility     module Music.Pitch.Common.Spell,     module Music.Pitch.Common.Harmony,-)-where+  ) where  import Data.Maybe import Data.Either@@ -150,105 +32,15 @@ import Data.AffineSpace import Control.Monad import Control.Applicative-import qualified Data.List as List  import Music.Pitch.Absolute import Music.Pitch.Literal import Music.Pitch.Common.Pitch+import Music.Pitch.Common.Quality+import Music.Pitch.Common.Number+import Music.Pitch.Common.Diatonic+import Music.Pitch.Common.Chromatic import Music.Pitch.Common.Interval import Music.Pitch.Common.Semitones import Music.Pitch.Common.Spell import Music.Pitch.Common.Harmony---{-  -        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 `spellings`-            spellings :: Semitones -> [Interval]-            spellings 4 = [majorThird, diminishedFourth]-        Law-            map semitones (spellings a) = replicate n a    for all n > 0-        Lemma-            map semitones (spellings 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)--        -- 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,13 @@++{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoMonomorphismRestriction  #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TypeFamilies               #-}++module Music.Pitch.Common.Chromatic where+++newtype ChromaticSteps = ChromaticSteps { getChromaticSteps :: Integer }+  deriving (Eq, Ord, Show, Enum, Num, Real, Integral)+

@@ -0,0 +1,11 @@++{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoMonomorphismRestriction  #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TypeFamilies               #-}++module Music.Pitch.Common.Diatonic where++newtype DiatonicSteps = DiatonicSteps { getDiatonicSteps :: Integer }+  deriving (Eq, Ord, Show, Enum, Num, Real, Integral)

@@ -1,4 +1,18 @@ +------------------------------------------------------------------------------------+-- |+-- Copyright   : (c) Hans Hoglund, Edward Lilley 2012–2014+--+-- License     : BSD-style+--+-- Maintainer  : hans@hanshoglund.se+-- Stability   : experimental+-- Portability : non-portable (TF,GNTD)+--+-- Provides standard intervals.+--+-------------------------------------------------------------------------------------+ module Music.Pitch.Common.Harmony (         isDissonance,         isConsonance,@@ -9,6 +23,8 @@   ) where  import Music.Pitch.Common.Interval+import Music.Pitch.Common.Number+import Music.Pitch.Common.Quality import Music.Pitch.Literal        import Data.Semigroup@@ -25,9 +41,9 @@ -- | Whether the given interval is a (harmonic) dissonance. isDissonance :: Interval -> Bool isDissonance x = case number (simple x) of-    2 -> True-    7 -> True-    _ -> False+  2 -> True+  7 -> True+  _ -> False  -- | Whether the given interval is a (harmonic) consonance. isConsonance :: Interval -> Bool@@ -36,17 +52,17 @@ -- | Whether the given interval is a perfect (harmonic) consonance. isPerfectConsonance :: Interval -> Bool isPerfectConsonance x = case number (simple x) of-    1 -> True-    4 -> True-    5 -> True-    _ -> False+  1 -> True+  4 -> True+  5 -> True+  _ -> False  -- | Whether the given interval is an imperfect (harmonic) consonance. isImperfectConsonance :: Interval -> Bool isImperfectConsonance x = case number (simple x) of-    3 -> True-    6 -> True-    _ -> False+  3 -> True+  6 -> True+  _ -> False  -- | Whether the given interval is a melodic dissonance. isMelodicDissonance :: Interval -> Bool@@ -56,6 +72,7 @@ isMelodicConsonance :: Interval -> Bool isMelodicConsonance x = quality x `elem` [Perfect, Major, Minor] +{- type Chord = Set Interval  majorTriad, minorTriad :: Chord@@ -67,3 +84,4 @@ maj7 = (<> Set.fromList [_M7])  +-}

@@ -1,6 +1,9 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving, TypeFamilies,-             NoMonomorphismRestriction, DeriveDataTypeable #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoMonomorphismRestriction  #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TypeFamilies               #-}  ------------------------------------------------------------------------------------ -- |@@ -17,41 +20,19 @@ -------------------------------------------------------------------------------------  module Music.Pitch.Common.Interval (-        -- * Quality-        Quality(..),    -        HasQuality(..),-        invertQuality,-        isPerfect,-        isMajor,-        isMinor,-        isAugmented,-        isDiminished, -        -- ** Number-        Number,-        HasNumber(..),   -        unison,-        prime,-        second,-        third,-        fourth,-        fifth,-        sixth,-        seventh,-        octave,-        ninth,-        tenth,-        twelfth, -        duodecim,-        thirteenth,-        fourteenth,-        fifteenth,   -        -- ** Intervals-        Interval(..),--        -- *** Creating intervals-        mkInterval,+        -- * Intervals+        Interval,+        -- ** Creating intervals+        interval,+        interval',+        _number,+        _quality,+        _steps,+        _alteration,+        +        -- ** Synonyms         perfect,         major,         minor,@@ -60,7 +41,7 @@         doublyAugmented,         doublyDiminished, -        -- *** Inspecting intervals+        -- ** Inspecting intervals         isNegative,         isPositive,         isNonNegative,@@ -68,7 +49,7 @@         isStep,         isLeap, -        -- *** Simple and compound intervals+        -- ** Simple and compound intervals         isSimple,         isCompound,         separate,@@ -83,235 +64,59 @@          -- * Basis values         IntervalBasis(..),-       +         -- ** Converting basis         convertBasis,         convertBasisFloat,         intervalDiv,-        -        -- ** Basis values (TODO cleanup)-        basis_P1,-        basis_A1,-        basis_d2,-        basis_P8,-        basis_P5,-        -        -- ** Utility-        intervalDiff,-        mkInterval',   ) where -import Data.Maybe-import Data.Either-import Data.Semigroup-import Data.VectorSpace--- import Data.AffineSpace-import Data.Basis-import Data.Typeable-import Control.Monad-import Control.Applicative-import qualified Data.List as List+import           Data.Either+import           Data.Maybe+import           Data.Semigroup+import           Data.VectorSpace+import           Data.AffineSpace.Point (relative)+import           Control.Applicative+import           Control.Monad+import           Control.Lens hiding (simple)+import           Data.Basis+import qualified Data.List                    as List+import           Data.Typeable+import           Numeric.Positive -import Music.Pitch.Absolute-import Music.Pitch.Augmentable-import Music.Pitch.Literal-import Music.Pitch.Common.Semitones+import           Music.Pitch.Absolute+import           Music.Pitch.Augmentable+import           Music.Pitch.Common.Semitones+import           Music.Pitch.Common.Quality+import           Music.Pitch.Common.Number+import           Music.Pitch.Common.Chromatic+import           Music.Pitch.Common.Diatonic+import           Music.Pitch.Literal --- |--- 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.------ Note that (Augmented 0) and (Diminished 0) are superfluous identity--- values, use Perfect instead. Augmented and Diminished must also--- take only positive arguments. -data Quality-    = Major-    | Minor-    | Perfect-    | Augmented Int-    | Diminished Int-    deriving (Eq, Ord, Show) -instance HasQuality Quality where-    quality = id  --- | Augmentable Quality instance--- --- This Augmentable instance exists solely for use of the getQuality--- function, which ensures that there is never any ambiguity around--- diminished/augmented intervals turning into major/minor/perfect--- intervals. -instance Augmentable Quality where-  augment Major = Augmented 1-  augment Minor = Major-  augment Perfect = Augmented 1-  augment (Augmented n) = Augmented (n + 1)-  augment (Diminished n) = Diminished (n - 1)-  diminish Major = Minor-  diminish Minor = Diminished 1-  diminish Perfect = Diminished 1-  diminish (Augmented n) = Augmented (n - 1)-  diminish (Diminished n) = Diminished (n + 1) -class HasQuality a where-    quality :: a -> Quality --- |--- Invert a quality.--- --- Perfect is unaffected, major becomes minor and vice versa, augmented--- becomes diminished and vice versa. ----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 }- -- |--- 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+-- A musical interval such as minor third, augmented fifth, duodecim etc. ---newtype Number = Number { getNumber :: Int }-    deriving (Eq, Ord, Num, Enum, Real, Integral)-    -instance Show Number where { show = show . getNumber }-instance HasNumber Number where number = id----- | A synonym for @1@.-unison      :: Number-unison      = 1---- | A synonym for @1@.-prime       :: Number-prime       = 1---- | A synonym for @2@.-second      :: Number-second      = 2---- | A synonym for @3@.-third       :: Number-third       = 3---- | A synonym for @4@.-fourth      :: Number-fourth      = 4     ---- | A synonym for @5@.-fifth       :: Number-fifth       = 5---- | A synonym for @6@.-sixth       :: Number-sixth       = 6---- | A synonym for @7@.-seventh     :: Number-seventh     = 7---- | A synonym for @8@.-octave      :: Number-octave      = 8---- | A synonym for @9@.-ninth       :: Number-ninth       = 9---- | A synonym for @10@.-tenth       :: Number-tenth       = 10---- | A synonym for @11@.-eleventh    :: Number-eleventh    = 11---- | A synonym for @12@.-twelfth     :: Number-twelfth     = 12---- | A synonym for @12@.-duodecim    :: Number-duodecim    = 12---- | A synonym for @13@.-thirteenth  :: Number-thirteenth  = 13---- | A synonym for @14@.-fourteenth  :: Number-fourteenth  = 14---- | A synonym for @15@.-fifteenth   :: Number-fifteenth   = 15--class HasNumber a where-    -- |-    -- 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 :: a -> Number--                                                   -                                                   --- |--- An interval is the difference between two pitches, incuding negative--- intervals.+-- We include direction in in this definition, so a downward minor third (written @-m3@)+-- is distinct from an upward minor third (written @m3@). Note that @_P1@ and @-P1@ are+-- synynoms. ----- Intervals and pitches can be added using '.+^'. To get the interval between--- two pitches, use '.-.'.+-- Not to be confused with a mathematical inverval in pitch space, which is called+-- 'Ambitus'. Intervals and pitches form an affine-vector space pair with intervals and+-- /vectors/ and pitches as /points/. To add an interval to a, use '.+^'. To get the+-- interval between two pitches, use '.-.'. -- -- > c .+^ minor third == eb -- > f .-. c           == perfect fourth@@ -321,36 +126,41 @@ -- > m3 ^+^ _M3 = _P5 -- > d5 ^+^ _M6 = m10 ----- The scalar type of 'Interval' is 'Int', using '^*' to stack intervals of a certain--- type on top of each other. For example @_P5 ^* 2@ is a stack of 2 perfect fifths, or a--- major ninth. The 'Num' instance works as expected for '+', 'negate' and 'abs', and+-- The scalar type of 'Interval' is 'Int', using '^*' to stack intervals of a certain type+-- on top of each other. For example @_P5 ^* 2@ is a stack of 2 perfect fifths, or a major+-- ninth. The 'Num' instance works as expected for '+', 'negate' and 'abs', and -- (arbitrarily) uses minor seconds 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:+-- 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)+-- > m5  == minor   fifth    == interval Minor   5 > _P4 == perfect fourth   == interval+-- Perfect 5 > d5  == diminished fifth == diminish (perfect fifth) -- newtype Interval = Interval { getInterval :: (-            Int,        -- number of A1, i.e. chromatic steps-            Int        -- number of d2, i.e. diatonic steps+            Int,  -- Number of A1, i.e. chromatic steps+            Int   -- Number of d2, i.e. diatonic steps     ) }-    deriving (Eq, Ord, Typeable)+    deriving (Eq, Typeable) +-- | Lexicographical ordering, comparing the 'd2' component of the+-- Interval first, as it's tied to the Number which is expected to be+-- 'bigger' than the Quality, assuming ordinary tuning systems+instance Ord Interval where+  Interval a `compare` Interval b = swap a `compare` swap b+    where swap (x,y) = (y,x)+ -- | Avoid using '(*)', or 'signum' on intervals. instance Num Interval where-    (+)           = addInterval-    negate        = negateInterval-    abs a         = if isNegative a then negate a else a-    (*)           = error "Music.Pitch.Common.Interval: no overloading for (*)"-    signum        = error "Music.Pitch.Common.Interval: no overloading for signum"-    fromInteger   = error "Music.Pitch.Common.Interval: no overloading for fromInteger"-        +  (+)           = addInterval+  negate        = negateInterval+  abs a         = if isNegative a then negate a else a+  (*)           = error "Music.Pitch.Common.Interval: no overloading for (*)"+  signum        = error "Music.Pitch.Common.Interval: no overloading for signum"+  fromInteger   = error "Music.Pitch.Common.Interval: no overloading for fromInteger"+ instance Show Interval where   show a     | isNegative a = "-" ++ showQuality (extractQuality a) ++ show (abs $ extractNumber a)@@ -359,24 +169,24 @@       showQuality Major            = "_M"       showQuality Minor            = "m"       showQuality Perfect          = "_P"-      showQuality (Augmented n)    = "_" ++ replicate' n 'A'-      showQuality (Diminished n)   = replicate' n 'd'+      showQuality (Augmented n)    = "_" ++ replicate (fromIntegral n) 'A'+      showQuality (Diminished n)   = replicate (fromIntegral n) 'd'  instance Semigroup Interval where-    (<>)    = addInterval+  (<>)    = addInterval  instance Monoid Interval where-    mempty  = perfect unison-    mappend = addInterval+  mempty  = basis_P1+  mappend = addInterval  instance AdditiveGroup Interval where-    zeroV   = perfect unison-    (^+^)   = addInterval-    negateV = negateInterval+  zeroV   = basis_P1+  (^+^)   = addInterval+  negateV = negateInterval  instance VectorSpace Interval where-    type Scalar Interval = Integer-    (*^) = stackInterval+  type Scalar Interval = Integer+  (*^) = stackInterval  -- TODO move data IntervalBasis = Chromatic | Diatonic@@ -413,8 +223,9 @@ addInterval (Interval (a1, d1)) (Interval (a2, d2)) = Interval (a1 + a2, d1 + d2)  stackInterval :: Integer -> Interval -> Interval-stackInterval n a | n >= 0    = mconcat $ replicate (fromIntegral n) a-                  | otherwise = negate $ stackInterval (negate n) a+stackInterval n a+  | n >= 0    = mconcat $ replicate (fromIntegral n) a+  | otherwise = negate $ stackInterval (negate n) a  intervalDiff :: Interval -> Int intervalDiff (Interval (c, d)) = c - diatonicToChromatic d@@ -426,7 +237,7 @@ -- major interval instead. Given 'Major' or 'Minor' with a number indicating a perfect -- consonance, 'interval' returns a perfect or diminished interval respectively. ---mkInterval' +mkInterval'   :: Int        -- ^ Difference in chromatic steps (?).   -> Int        -- ^ Number of diatonic steps (NOT interval number).   -> Interval@@ -439,63 +250,7 @@ basis_P8 = Interval (12, 7)  -mkInterval :: Quality -> Number -> Interval - -- our identity:-mkInterval Perfect 1 = basis_P1- -- and our two basis vectors:-mkInterval (Augmented 1) 1 = basis_A1-mkInterval (Diminished 1) 2 = basis_d2--mkInterval Minor 2 = basis_d2 ^+^ basis_A1-mkInterval Major 2 = (mkInterval Minor 2) ^+^ basis_A1-mkInterval (Augmented 1) 2 = (mkInterval Major 2) ^+^ basis_A1--mkInterval (Diminished 1) 3 = (mkInterval Minor 3) ^-^ basis_A1-mkInterval Minor 3 = (mkInterval Major 2) ^+^ (mkInterval Minor 2)-mkInterval Major 3 = (mkInterval Major 2) ^+^ (mkInterval Major 2)-mkInterval (Augmented 1) 3 =  (mkInterval Major 3) ^+^ basis_A1--mkInterval (Diminished 1) 4 = (mkInterval Perfect 4) ^-^ basis_A1-mkInterval Perfect 4 = (mkInterval Major 3) ^+^ (mkInterval Minor 2)-mkInterval (Augmented 1) 4 =  (mkInterval Perfect 4) ^+^ basis_A1--mkInterval (Diminished 1) 5 = (mkInterval Perfect 5) ^-^ basis_A1-mkInterval Perfect 5 = (mkInterval Perfect 4) ^+^ (mkInterval Major 2)-mkInterval (Augmented 1) 5 =  (mkInterval Perfect 5) ^+^ basis_A1--mkInterval (Diminished 1) 6 = (mkInterval Minor 6) ^-^ basis_A1-mkInterval Minor 6 = (mkInterval Perfect 5) ^+^ (mkInterval Minor 2)-mkInterval Major 6 = (mkInterval Perfect 5) ^+^ (mkInterval Major 2)-mkInterval (Augmented 1) 6 =  (mkInterval Major 6) ^+^ basis_A1--mkInterval (Diminished 1) 7 = (mkInterval Minor 7) ^-^ basis_A1-mkInterval Minor 7 = (mkInterval Major 6) ^+^ (mkInterval Minor 2)-mkInterval Major 7 = (mkInterval Major 6) ^+^ (mkInterval Major 2)-mkInterval (Augmented 1) 7 =  (mkInterval Major 7) ^+^ basis_A1--mkInterval Minor 1 = error "invalid interval"-mkInterval Major 1 = error "invalid interval"-mkInterval Perfect 2 = error "invalid interval"-mkInterval Perfect 3 = error "invalid interval"-mkInterval Minor 4 = error "invalid interval"-mkInterval Major 4 = error "invalid interval"-mkInterval Minor 5 = error "invalid interval"-mkInterval Major 5 = error "invalid interval"-mkInterval Perfect 6 = error "invalid interval"-mkInterval Perfect 7 = error "invalid interval"--mkInterval (Diminished 0) n = error "(Diminished 0) is not a valid Quality"-mkInterval (Augmented 0) n = error  "(Augmented 0) is not a valid Quality"--mkInterval (Diminished q) n = (mkInterval (Diminished (q - 1)) n) ^-^ basis_A1-mkInterval (Augmented q) n = (mkInterval (Diminished (q - 1)) n) ^+^ basis_A1--mkInterval q (Number n) = if n > 0-                          then (mkInterval q (Number (n - 7))) ^+^ basis_P8-                          else (mkInterval q (Number (n + 7))) ^-^ basis_P8-- -- | -- Extracting the 'number' from an interval vector. --@@ -503,7 +258,7 @@ -- * d2), so the 'number' part of the interval must be stored entirely -- in the d * d2 part (adding a unison, perfect or otherwise, can -- never increase the number of the interval)--- +-- extractNumber :: Interval -> Number extractNumber (Interval (a, d))   | d >= 0    = Number (d + 1)@@ -588,10 +343,10 @@  Prelude Music.Prelude> separate (2*^_P8+m3) (2,m3)-Prelude Music.Prelude> +Prelude Music.Prelude> Prelude Music.Prelude> separate (3*^_P8+m3) (3,m3)-Prelude Music.Prelude> +Prelude Music.Prelude> Prelude Music.Prelude> separate (0*^_P8+m3) (0,m3) Prelude Music.Prelude> separate ((-1)*^_P8+m3)@@ -613,14 +368,7 @@ -- > _P8^*octaves x ^+^ simple x = x -- octaves :: Interval -> Octaves-octaves i -  | isNegative i && not (isOctaveMultiple i) = negate (octaves' i) - 1-  | isNegative i && isOctaveMultiple i       = negate (octaves' i)-  | otherwise                                = octaves' i--isOctaveMultiple (Interval (_,d)) = d `mod` 7 == 0--octaves' i = fromIntegral $ intervalDiv i basis_P8+octaves (Interval (_,d)) = fromIntegral $ d `div` 7  -- | -- Returns the simple part of an interval.@@ -669,7 +417,7 @@ -- Returns whether the given interval a perfect unison. -- isPerfectUnison :: Interval -> Bool-isPerfectUnison = (== perfect unison)+isPerfectUnison (Interval (a, d)) = (a,d) == (0,0)  -- | -- Returns whether the given interval is a step (a second or smaller).@@ -712,17 +460,107 @@ asInterval :: Interval -> Interval asInterval = id +++++++mkInterval :: Quality -> Number -> Interval+mkInterval q n = mkInterval' (fromIntegral diff) (fromIntegral steps)+  where+    diff  = qualityToDiff (n > 0) (expectedQualityType n) (q)+    steps = case n `compare` 0 of+      GT -> n - 1+      EQ -> error "diatonicSteps: Invalid number 0"+      LT -> n + 1+    -- steps = n^.diatonicSteps+++++++-- | View or set the alteration (i.e. the number of chromatic steps differing from the excepted number) in an interval.+_alteration :: Lens' Interval ChromaticSteps+_alteration = from interval' . _1++-- | View or set the number of chromatic steps in an interval.+_steps :: Lens' Interval DiatonicSteps+_steps = from interval' . _2++-- | View or set the quality of an interval.+_quality :: Lens' Interval Quality+_quality = from interval . _1++-- | View or set the number component of an interval.+_number :: Lens' Interval Number +_number = from interval . _2++-- | View an interval as a pair of quality and number or vice versa.+interval :: Iso' (Quality, Number) Interval+interval = iso (uncurry mkInterval) (\x -> (quality x, number x))++-- | View an interval as a pair of alteration and diatonic steps or vice versa.+interval' :: Iso' (ChromaticSteps, DiatonicSteps) Interval+interval' = iso (\(d,s) -> mkInterval' (fromIntegral d) (fromIntegral s)) +  (\x -> (qualityToDiff (number x >= 0) (expectedQualityType (number x)) (quality x), (number x)^.diatonicSteps))+ {--isPerfectNumber :: Int -> Bool-isPerfectNumber 0 = True-isPerfectNumber 1 = False-isPerfectNumber 2 = False-isPerfectNumber 3 = True-isPerfectNumber 4 = True-isPerfectNumber 5 = False-isPerfectNumber 6 = False++-- -- TODO be "nice"+-- mkIntervalNice :: Quality -> Number -> Interval+-- mkIntervalNice q n+--   | expectedQualityType n `elem` qualityTypes q = mkInterval q n +--   | expectedQualityType n == MajorMinorType     = mkInterval (toMajorMinorType q) n+--   | expectedQualityType n == PerfectType        = mkInterval (toPerfectType q) n++toMajorMinorType Perfect = Major+toPerfectType    Major   = Perfect+toPerfectType    Minor   = (Diminished 1)+-- toPerfectType    x = x+ -} ++          +{-|+>>> m3 & _number %~ pred+m2+>>> m3 & _number %~ succ+d4+>>> _M3 & _number %~ succ+_P4+++>>> m3 & _number +~ 1+d4+>>> m3 & _number +~ 2+d5+>>> m3 & _number +~ 3+m6+>>> m3 & _number +~ 4+++>>> m3 & _quality .~ Minor+m3+>>> _P5 & _quality .~ Minor+d5+>>> (-d5) & _quality %~ diminish+++TODO only obeys lens laws up to quality normalization++>>> _P5 & _quality .~ Minor+d5+>>> _P5 & _quality .~ (Diminished 1)+d5++-}             +++-- Internal stuff+ -- TODO more generic pattern here diatonicToChromatic :: Int -> Int diatonicToChromatic d = (octaves*12) + go restDia@@ -731,14 +569,6 @@         (octaves, restDia) = d `divMod` 7         go = ([0,2,4,5,7,9,11] !!) --- {-# DEPRECATED intervalDiff "This should be hidden" #-}--- {-# DEPRECATED mkInterval'  "This should be hidden "#-}--replicate' n = replicate (fromIntegral n)---- -- | Integer div of intervals: i / di = x, where x is an integer intervalDiv :: Interval -> Interval -> Int intervalDiv (Interval (a, d)) (Interval (1, 0)) = a@@ -747,7 +577,7 @@   | (i > basis_P1) = intervalDivPos i di   | (i < basis_P1) = intervalDivNeg i di   | otherwise = 0 :: Int-  where +  where     intervalDivPos i di       | (i < basis_P1) = undefined       | (i ^-^ di) < basis_P1 = 0@@ -758,36 +588,37 @@       | otherwise = 1 + (intervalDiv (i ^+^ di) di)  -- | Represent an interval i in a new basis (j, k).--- +-- -- We want x,y where i = x*j + y*k -- -- e.g., convertBasis basis_d2 _P5 basis_P8 == Just (-12,7), as expected.  convertBasis-  :: Interval -  -> Interval -  -> Interval +  :: Interval+  -> Interval+  -> Interval   -> Maybe (Int, Int) convertBasis i j k   | (p == 0) = Nothing   | not $ p `divides` r = Nothing   | not $ p `divides` q = Nothing   | otherwise = Just (r `div` p, q `div` p)-  where Interval (m, n) = i-        Interval (a, b) = j-        Interval (c, d) = k-        p = (a*d - b*c)-        q = (a*n - b*m)-        r = (d*m - c*n)+  where+    Interval (m, n) = i+    Interval (a, b) = j+    Interval (c, d) = k+    p = (a*d - b*c)+    q = (a*n - b*m)+    r = (d*m - c*n)   -- | Same as above, but don't worry if new interval has non-integer -- coefficients -- useful when getting a value to use as a frequency -- ratio in a tuning system. convertBasisFloat :: (Fractional t, Eq t)-  => Interval -  -> Interval -  -> Interval +  => Interval+  -> Interval+  -> Interval   -> Maybe (t, t) convertBasisFloat i j k   | (p == 0) = Nothing

@@ -0,0 +1,414 @@++------------------------------------------------------------------------------------+-- |+-- Copyright   : (c) Hans Hoglund, Edward Lilley 2012–2014+--+-- License     : BSD-style+--+-- Maintainer  : hans@hanshoglund.se+-- Stability   : experimental+-- Portability : non-portable (TF,GNTD)+--+-- Provides standard intervals.+--+-------------------------------------------------------------------------------------++module Music.Pitch.Common.Names (+      Language(..),+      Mode(..),+      showKey,+      showPitch,+      showMode,+      showSep,+  ) where++import Music.Pitch.Literal+import Music.Pitch.Common.Pitch+import Music.Pitch.Common.Interval+import Data.Maybe+import qualified Data.List++{-+Original at http://tinyurl.com/ongo4al+Use convertcsv.com to convert to JSON array+-}++data Language+  = English+  | German+  | Dutch+  | Japanese+  | Italian+  | French+  | Spanish+  | Portuguese+  | Russian+  | Romanian+  | Swedish+  | NewSwedish+  deriving (Show, Eq, Ord)+  +showPitch :: Language -> Pitch -> String+showPitch lang pitch = (!! (pitchToIndex + pitchNameOffset)) $ fromMaybe (error "showPitch: Bad lang") $ listToMaybe $ filter (\xs -> head xs == show lang) $ pitchNames+  where+    -- TODO normalize dbb etc.+    pitchToIndex = fromMaybe (error "showPitch: Bad pitch") $ Data.List.findIndex (== pitch) +      [cb,c,cs,+       db,d,ds,+       eb,e,{-es,-}+       {-fb,-}f,fs,+       gb,g,gs,+       ab,a,as,+       bb,b,bs]     +    pitchNameOffset = 3++data Mode = MajorMode | MinorMode+  deriving (Eq, Ord, Show)++showMode :: Language -> Mode -> String+showMode lang mode = (!! (modeToIndex + modeNameOffset)) $ fromMaybe (error "showMode: Bad lang") $ listToMaybe $ filter (\xs -> head xs == show lang) $ modeNames+  where+    modeToIndex = fromMaybe (error "showPitch: Bad mode") $ Data.List.findIndex (== mode) +      [MajorMode,MinorMode]     +    modeNameOffset = 1++showKey :: Language -> Pitch -> Mode -> String+showKey lang pitch mode = showPitch lang pitch ++ showSep lang ++ showMode lang mode++showSep :: Language -> String+showSep lang = fromMaybe (error "showSep: Bad lang") $ Data.List.lookup (show lang) nameModeSeparator++pitchNames :: [[String]]+-- [[language,_,_,cb,c,cs,db...bs]]+pitchNames =+  [["English",+    "",+    "",+    "C flat",+    "C",+    "C sharp",+    "D flat",+    "D",+    "D sharp",+    "E flat",+    "E",+    "F",+    "F sharp",+    "G flat",+    "G",+    "G sharp",+    "A flat",+    "A",+    "A sharp",+    "B flat",+    "B",+    "B sharp"],+  ["German",+    "",+    "",+    "Ces",+    "C",+    "Cis",+    "Des",+    "D",+    "Dis",+    "Es",+    "E",+    "F",+    "Fis",+    "Ges",+    "G",+    "Gis",+    "As",+    "A",+    "Ais",+    "B",+    "H",+    "His"],+    +  ["Dutch",+    "(Netherlands)",+    "(Written)",+    "Ces / C mol",+    "C",+    "Cis / C kruis",+    "Des / D mol",+    "D",+    "Dis / D kruis",+    "Es / E mol",+    "E",+    "F",+    "Fis / F kruis",+    "Ges / G mol",+    "G",+    "Gis / G kruis",+    "As / A mol",+    "A",+    "Ais / A kruis",+    "Bes / B mol",+    "B",+    "Bis / B kruis"],+    +  ["Japanese",+    "",+    "",+    "\22793\12495 (hen-ha)",+    "\12495 (ha)",+    "\23344\12495 (ei-ha)",+    "\22793\12491 (hen-ni)",+    "\12491 (ni)",+    "\23344\12491 (ei-ni)",+    "\22793\12507 (hen-ho)",+    "\12507 (ho)",+    "\12504 (he)",+    "\23344\12504 (ei-he)",+    "\22793\12488 (hen-to)",+    "\12488 (to)",+    "\23344\12488 (ei-to)",+    "\22793\12452 (hen-i)",+    "\12452 (i)",+    "\23344\12452 (ei-i)",+    "\22793\12525 (hen-ro)",+    "\12525 (ro)",+    ""],+    +  ["Italian",+    "",+    "",+    "Do bemolle",+    "Do",+    "Do diesis",+    "Re bemolle",+    "Re",+    "Re diesis",+    "Mi bemolle",+    "Mi",+    "Fa",+    "Fa diesis",+    "Sol bemolle",+    "Sol",+    "Sol diesis",+    "La bemolle",+    "La",+    "La diesis",+    "Si bemolle",+    "Si",+    "Si diesis"],+    +  ["French",+    "",+    "",+    "Do b\233mol",+    "Do (Ut)",+    "Do di\232se",+    "R\233 b\233mol",+    "R\233",+    "R\233 di\232se",+    "Mi b\233mol",+    "Mi",+    "Fa",+    "Fa di\232se",+    "Sol b\233mol",+    "Sol",+    "Sol di\232se",+    "La b\233mol",+    "La",+    "La di\232se",+    "Si b\233mol",+    "Si",+    "Si di\232se"],+    +  ["Spanish",+    "",+    "",+    "Do bemol",+    "Do",+    "Do sostenido",+    "Re bemol",+    "Re",+    "Re sostenido",+    "Mi bemol",+    "Mi",+    "Fa",+    "Fa sostenido",+    "Sol bemol",+    "Sol",+    "Sol sostenido",+    "La bemol",+    "La",+    "La sostenido",+    "Si bemol",+    "Si",+    "Si sostenido"],+    +  ["Portuguese",+    "",+    "",+    "D\243 bemol",+    "D\243",+    "D\243 sustenido",+    "R\233 bemol",+    "R\233",+    "R\233 sustenido",+    "Mi bemol",+    "Mi",+    "F\225",+    "F\225 sustenido",+    "Sol bemol",+    "Sol",+    "Sol sustenido",+    "L\225 bemol",+    "L\225",+    "L\225 sustenido",+    "Si bemol",+    "Si",+    "Si sustenido"],+    +  ["Russian",+    "",+    "",+    "\1044\1086-\1073\1077\1084\1086\1083\1100",+    "\1044\1086",+    "\1044\1086-\1076\1080\1077\1079",+    "\1056\1077-\1073\1077\1084\1086\1083\1100",+    "\1056\1077",+    "\1056\1077-\1076\1080\1077\1079",+    "\1052\1080-\1073\1077\1084\1086\1083\1100",+    "\1052\1080",+    "\1060\1072",+    "\1060\1072-\1076\1080\1077\1079",+    "\1057\1086\1083\1100-\1073\1077\1084\1086\1083\1100",+    "\1057\1086\1083\1100",+    "\1057\1086\1083\1100-\1076\1080\1077\1079",+    "\1051\1103-\1073\1077\1084\1086\1083\1100",+    "\1051\1103",+    "\1051\1103-\1076\1080\1077\1079",+    "\1057\1080-\1073\1077\1084\1086\1083\1100",+    "\1057\1080",+    ""],+    +  ["Romanian",+    "",+    "",+    "Do bemol",+    "Do",+    "Do diez",+    "Re bemol",+    "Re",+    "Re diez",+    "Mi bemol",+    "Mi",+    "Fa",+    "Fa diez",+    "Sol bemol",+    "Sol",+    "Sol diez",+    "La bemol",+    "La",+    "La diez",+    "Si bemol",+    "Si",+    "Si diez"],+    +  ["Belgian dutch",+    "",+    "",+    "Do mol",+    "Do",+    "Do kruis",+    "Re mol",+    "Re",+    "Re kruis",+    "Mi mol",+    "Mi",+    "Fa",+    "Fa kruis",+    "Sol mol",+    "Sol",+    "Sol kruis",+    "La mol",+    "La",+    "La kruis",+    "Si mol",+    "Si",+    "Si kruis"],+    +  ["Swedish",+    "",+    "",+    "Cess",+    "C",+    "Ciss",+    "Dess",+    "D",+    "Diss",+    "Ess",+    "E",+    "F",+    "Fiss",+    "Gess",+    "G",+    "Giss",+    "Ass",+    "A",+    "Aiss",+    "B",+    "H",+    "Hiss"],+    +  ["NewSwedish",+    "",+    "",+    "Cess",+    "C",+    "Ciss",+    "Dess",+    "D",+    "Diss",+    "Ess",+    "E",+    "F",+    "Fiss",+    "Gess",+    "G",+    "Giss",+    "Ass",+    "A",+    "Aiss",+    "Bess",+    "B",+    "Biss"]]++modeNames :: [[String]] -- [[language,major,minor]]+modeNames =+  [["English","major","minor"],+  ["German","Dur","Moll"],+  ["Dutch","groot","klein"],+  ["Japanese","\38263\35519 (ch\333ch\333)","\30701\35519 (tanch\333)"],+  ["Italian","maggiore","minore"],+  ["French","majeur","mineur"],+  ["Spanish","mayor","menor"],+  ["Portuguese","maior","menor"],+  ["Russian","\1084\1072\1078\1086\1088","\1084\1080\1085\1086\1088"],+  ["Romanian","major","minor"],+  ["Belgian dutch","groot","klein"],+  ["Swedish","dur","moll"],+  ["NewSwedish","dur","moll"],+  ["","dur","moll"]]++nameModeSeparator :: [(String, String)] -- [(language,separator)]+nameModeSeparator =+  [("English"," "),+  ("German","-"),+  ("Dutch"," "),+  ("Japanese"," "),+  ("Italian"," "),+  ("French"," "),+  ("Spanish"," "),+  ("Portuguese"," "),+  ("Russian"," "),+  ("Romanian"," "),+  ("Belgian dutch"," "),+  ("Swedish","-"),+  ("NewSwedish","-")]+

@@ -0,0 +1,142 @@++{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoMonomorphismRestriction  #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TypeFamilies               #-}++module Music.Pitch.Common.Number where++import Control.Lens+import Music.Pitch.Common.Diatonic++{-++-- ** Number+Number,+HasNumber(..),+unison,+prime,+second,+third,+fourth,+fifth,+sixth,+seventh,+octave,+ninth,+tenth,+twelfth,+duodecim,+thirteenth,+fourteenth,+fifteenth,++-}+++-- |+-- 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 :: Int }+  deriving (Eq, Ord, Num, Enum, Real, Integral)++instance Show Number where { show = show . getNumber }+instance HasNumber Number where number = id++-- | A synonym for @1@.+unison      :: Number+unison      = 1++-- | A synonym for @1@.+prime       :: Number+prime       = 1++-- | A synonym for @2@.+second      :: Number+second      = 2++-- | A synonym for @3@.+third       :: Number+third       = 3++-- | A synonym for @4@.+fourth      :: Number+fourth      = 4++-- | A synonym for @5@.+fifth       :: Number+fifth       = 5++-- | A synonym for @6@.+sixth       :: Number+sixth       = 6++-- | A synonym for @7@.+seventh     :: Number+seventh     = 7++-- | A synonym for @8@.+octave      :: Number+octave      = 8++-- | A synonym for @9@.+ninth       :: Number+ninth       = 9++-- | A synonym for @10@.+tenth       :: Number+tenth       = 10++-- | A synonym for @11@.+eleventh    :: Number+eleventh    = 11++-- | A synonym for @12@.+twelfth     :: Number+twelfth     = 12++-- | A synonym for @12@.+duodecim    :: Number+duodecim    = 12++-- | A synonym for @13@.+thirteenth  :: Number+thirteenth  = 13++-- | A synonym for @14@.+fourteenth  :: Number+fourteenth  = 14++-- | A synonym for @15@.+fifteenth   :: Number+fifteenth   = 15++class HasNumber a where+    -- |+    -- 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 :: a -> Number+++-- TODO rename numberDiatonicSteps+diatonicSteps :: Iso' Number DiatonicSteps+diatonicSteps = iso n2d d2n+  where+    n2d n | n > 0  = fromIntegral (n - 1)+    n2d n | n == 0 = error "diatonicSteps: Invalid number 0"+    n2d n | n < 0  = fromIntegral (n + 1)++    d2n n | n >= 0 = fromIntegral (n + 1)+    d2n n | n <  0 = fromIntegral (n - 1)+

@@ -1,6 +1,9 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving, TypeFamilies, -    FlexibleInstances, DeriveDataTypeable #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TypeFamilies               #-}  ------------------------------------------------------------------------------------ -- |@@ -19,48 +22,61 @@ module Music.Pitch.Common.Pitch (         -- * Accidentals         Accidental,-        natural, -        flat, -        sharp, -        doubleFlat, +        natural,+        flat,+        sharp,+        doubleFlat,         doubleSharp,          -- ** Inspecting accidentals         isNatural,         isFlattened,         isSharpened,-        isStandard,+        isStandardAccidental,          -- ** Name         Name(..),          -- * Pitch         Pitch,-        Pitch(..),-                 mkPitch,         name,         accidental,++        -- ** Diatonic and chromatic pitch+        upDiatonicP,+        downDiatonicP,+        upChromaticP,+        downChromaticP,+        invertDiatonicallyP,+        invertChromaticallyP,+        +        -- ** Utility         asPitch   ) where -import Data.Maybe-import Data.Either-import Data.Semigroup-import Data.VectorSpace-import Data.AffineSpace-import Data.Typeable-import Control.Monad-import Control.Applicative-import qualified Data.Char as Char-import qualified Data.List as List+import           Control.Applicative+import           Control.Monad+import           Control.Lens hiding (simple)+import           Data.AffineSpace+import           Data.AffineSpace.Point+import qualified Data.Char                    as Char+import           Data.Either+import qualified Data.List                    as List+import           Data.Maybe+import           Data.Semigroup+import           Data.Typeable+import           Data.VectorSpace -import Music.Pitch.Absolute-import Music.Pitch.Literal-import Music.Pitch.Alterable-import Music.Pitch.Augmentable-import Music.Pitch.Common.Interval-import Music.Pitch.Common.Semitones+import           Music.Pitch.Absolute+import           Music.Pitch.Alterable+import           Music.Pitch.Augmentable+import           Music.Pitch.Common.Number+import           Music.Pitch.Common.Interval+import           Music.Pitch.Common.Semitones+import           Music.Pitch.Common.Chromatic+import           Music.Pitch.Common.Diatonic+import           Music.Pitch.Literal  -- | -- An accidental is either flat, natural or sharp.@@ -68,31 +84,31 @@ -- This representation allows for an arbitrary number of flats or sharps rather than just -- single and double. ----- The 'Num' and 'Enum' instances treat 'Accidental' as the number of altered semitones, +-- The 'Num' and 'Enum' instances treat 'Accidental' as the number of altered semitones, -- i.e. a double flat is @-2@, natural @0@ and so on. -- newtype Accidental = Accidental { getAccidental :: Integer }-    deriving (Eq, Ord, Num, Enum, Real, Integral)-    +  deriving (Eq, Ord, Num, Enum, Real, Integral)+ instance Show Accidental where-    show n | n == 0    = "natural"-           | n == 1    = "sharp"-           | n == (-1) = "flat"-           | n == 2    = "doubleSharp"-           | n == (-2) = "doubleFlat"-           | n > 0     = "sharp * " ++ show (getAccidental n)-           | n < 0     = "flat * " ++ show (negate $ getAccidental n)+  show n | n == 0    = "natural"+         | n == 1    = "sharp"+         | n == (-1) = "flat"+         | n == 2    = "doubleSharp"+         | n == (-2) = "doubleFlat"+         | n > 0     = "sharp * " ++ show (getAccidental n)+         | n < 0     = "flat * " ++ show (negate $ getAccidental n)  instance Alterable Accidental where-    sharpen = succ-    flatten = pred+  sharpen = succ+  flatten = pred --- | +-- | -- Magic instance that allow us to write @c sharp@ instead of @sharpen c@. -- instance (IsPitch a, Alterable a) => IsPitch (Accidental -> a) where-    fromPitch l 1       = sharpen (fromPitch l)-    fromPitch l (-1)    = flatten (fromPitch l)+  fromPitch l 1     = sharpen (fromPitch l)+  fromPitch l (-1)  = flatten (fromPitch l) -- Requires FlexibleInstances  sharp, flat, natural, doubleFlat, doubleSharp :: Accidental@@ -114,27 +130,27 @@  isNatural, isSharpened, isFlattened :: Accidental -> Bool --- | Returns whether this is a natural accidental.+-- | Returns whether this is a natural accidental. isNatural   = (== 0) --- | Returns whether this is a sharp, double sharp etc.+-- | Returns whether this is a sharp, double sharp etc. isSharpened = (> 0) --- | Returns whether this is a flat, double flat etc.+-- | Returns whether this is a flat, double flat etc. isFlattened = (< 0)  --- | Returns whether this is a standard accidental, i.e.+-- | Returns whether this is a standard accidental, i.e. --   either a double flat, flat, natural, sharp or double sharp.-isStandard :: Accidental -> Bool-isStandard a = abs a < 2-+isStandardAccidental :: Accidental -> Bool+isStandardAccidental a = abs a < 2+-- was: isStandard  -- | -- A pitch name. -- data Name = C | D | E | F | G | A | B-    deriving (Eq, Ord, Show, Enum)+  deriving (Eq, Ord, Show, Enum)  -- | -- Common pitch representation.@@ -188,51 +204,52 @@ -- > d5  == diminished fifth == diminish (perfect fifth) -- newtype Pitch = Pitch { getPitch :: Interval }-    deriving (Eq, Ord, Typeable)-    -instance Num Pitch where-    Pitch a + Pitch b = Pitch (a + b)-    negate (Pitch a)  = Pitch (negate a)-    abs (Pitch a)     = Pitch (abs a)-    (*)           = error  "Music.Pitch.Common.Pitch: no overloading for (*)"-    signum        = error "Music.Pitch.Common.Pitch: no overloading for signum"-    fromInteger   = error "Music.Pitch.Common.Pitch: no overloading for fromInteger"+  deriving (Eq, Ord, Typeable) -instance AffineSpace Pitch where-    type Diff Pitch     = Interval-    Pitch a .-. Pitch b = a ^-^ b-    Pitch a .+^ b       = Pitch (a ^+^ b)+instance IsPitch Pitch where+  fromPitch (PitchL (c, a, o)) =+    Pitch $ (\a b -> (fromIntegral a, fromIntegral b)^.interval') (qual a) c ^+^ (_P8^* fromIntegral o)+    where+      qual Nothing  = 0+      qual (Just n) = round n -instance Show Pitch where-    show p = showName (name p) ++ showAccidental (accidental p) ++ showOctave (octaves $ getPitch p)-        where        -            showName = fmap Char.toLower . show-            showOctave n-                | n > 0     = replicate' n '\''-                | otherwise = replicate' (negate n) '_'-            showAccidental n-                | n > 0     = replicate' n 's'-                | otherwise = replicate' (negate n) 'b'+instance Enum Pitch where+  toEnum = Pitch . (\a b -> (fromIntegral a, fromIntegral b)^.interval') 0 . fromIntegral+  fromEnum = fromIntegral . pred . number . (.-. c)  instance Alterable Pitch where-    sharpen (Pitch a) = Pitch (augment a)-    flatten (Pitch a) = Pitch (diminish a)+  sharpen (Pitch a) = Pitch (augment a)+  flatten (Pitch a) = Pitch (diminish a) -instance Enum Pitch where-    toEnum = Pitch . mkInterval' 0 . fromIntegral-    fromEnum = fromIntegral . pred . number . (.-. c)+instance Show Pitch where+  show p = showName (name p) ++ showAccidental (accidental p) ++ showOctave (octaves $ getPitch p)+    where+      showName = fmap Char.toLower . show+      showOctave n+        | n > 0     = replicate (fromIntegral n) '\''+        | otherwise = replicate (negate $ fromIntegral n) '_'+      showAccidental n+        | n > 0     = replicate (fromIntegral n) 's'+        | otherwise = replicate (negate $ fromIntegral n) 'b' --- |--- This is just the identity function, but is useful to fix the type of 'Pitch'.----asPitch :: Pitch -> Pitch-asPitch = id+instance Num Pitch where+  Pitch a + Pitch b = Pitch (a + b)+  negate (Pitch a)  = Pitch (negate a)+  abs (Pitch a)     = Pitch (abs a)+  (*)           = error  "Music.Pitch.Common.Pitch: no overloading for (*)"+  signum        = error "Music.Pitch.Common.Pitch: no overloading for signum"+  fromInteger   = error "Music.Pitch.Common.Pitch: no overloading for fromInteger" +instance AffineSpace Pitch where+  type Diff Pitch     = Interval+  Pitch a .-. Pitch b = a ^-^ b+  Pitch a .+^ b       = Pitch (a ^+^ b)+ -- | -- Creates a pitch from name accidental. -- mkPitch :: Name -> Accidental -> Pitch-mkPitch name acc = Pitch $ mkInterval' (fromIntegral acc) (fromEnum name)+mkPitch name acc = Pitch $ (\a b -> (fromIntegral a, fromIntegral b)^.interval') (fromIntegral acc) (fromEnum name)  -- | -- Returns the name of a pitch.@@ -245,7 +262,7 @@ -- @ -- name :: Pitch -> Name-name x               +name x   | i == 7           = toEnum 0 -- Arises for flat C etc.   | 0 <= i && i <= 6 = toEnum i   | otherwise        = error $ "Pitch.name: Bad value " ++ show i@@ -259,22 +276,31 @@ -- accidental :: Pitch -> Accidental accidental = fromIntegral . intervalDiff . simple . getPitch+  where+    intervalDiff = view (from interval'._1) --- | The same as 'c', but fixed to 'Pitch'. This is useful if you want---   to treat 'Pitch' as an affine space around middle C, that is /C4/ in Scientific Pitch Notation.-middleC :: Pitch-middleC = c+-- |+-- This is just the identity function, but is useful to fix the type of 'Pitch'.+--+asPitch :: Pitch -> Pitch+asPitch = id -instance IsPitch Pitch where-    fromPitch (PitchL (c, a, o)) =-        Pitch $ mkInterval' (qual a) c-            ^+^-            (perfect octave^* fromIntegral o)-        where-            qual Nothing  = 0-            qual (Just n) = round n+upChromaticP :: Pitch -> ChromaticSteps -> Pitch -> Pitch+upChromaticP origin n = relative origin $ (_alteration +~ n) --- midiNumber :: Pitch -> Integer--- midiNumber = fromIntegral . semitones . getPitch+downChromaticP :: Pitch -> ChromaticSteps -> Pitch -> Pitch+downChromaticP origin n = relative origin $ (_alteration -~ n) -replicate' n = replicate (fromIntegral n)+upDiatonicP :: Pitch -> DiatonicSteps -> Pitch -> Pitch+upDiatonicP origin n = relative origin $ (_steps +~ n)++downDiatonicP :: Pitch -> DiatonicSteps -> Pitch -> Pitch+downDiatonicP origin n = relative origin $ (_steps -~ n)++invertDiatonicallyP :: Pitch -> Pitch -> Pitch+invertDiatonicallyP origin = relative origin $ (_steps %~ negate)++invertChromaticallyP :: Pitch -> Pitch -> Pitch+invertChromaticallyP origin = relative origin $ (_alteration %~ negate)++

@@ -0,0 +1,153 @@++{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoMonomorphismRestriction  #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TypeFamilies               #-}++module Music.Pitch.Common.Quality where+{-+-- * Quality+Quality(..),+HasQuality(..),+invertQuality,+isPerfect,+isMajor,+isMinor,+isAugmented,+isDiminished,++QualityType(..),+expectedQualityType,+qualityTypes,+qualityToDiff,++-}+import           Music.Pitch.Augmentable+import           Music.Pitch.Common.Number+import           Music.Pitch.Common.Chromatic++-- | Types of value that has an interval quality (mainly 'Interval' and 'Quality' itself).+class HasQuality a where+  quality :: a -> Quality++-- |+-- 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 }++-- |+-- Interval quality is either perfect, major, minor, augmented, and+-- diminished. This representation allows for an arbitrary number of+-- augmentations or diminutions, 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+  -- TODO we really want to use Positive here, but that requires a+  -- rewrite of extractQuality below+  | Augmented Integer+  | Diminished Integer+  deriving (Eq, Ord, Show)++instance HasQuality Quality where+  quality = id+++-- | Augmentable Quality instance+--+-- This Augmentable instance exists solely for use of the extractQuality+-- function, which ensures that there is never any ambiguity around+-- diminished/augmented intervals turning into major/minor/perfect+-- intervals.++instance Augmentable Quality where+  augment Major = Augmented 1+  augment Minor = Major+  augment Perfect = Augmented 1+  augment (Augmented n) = Augmented (n + 1)+  augment (Diminished n) = Diminished (n - 1)+  diminish Major = Minor+  diminish Minor = Diminished 1+  diminish Perfect = Diminished 1+  diminish (Augmented n) = Augmented (n - 1)+  diminish (Diminished n) = Diminished (n + 1)++-- |+-- Invert a quality.+--+-- Perfect is unaffected, major becomes minor and vice versa, augmented+-- becomes diminished and vice versa.+--+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+++data QualityType = PerfectType | MajorMinorType+  deriving (Eq, Ord, Read, Show)++expectedQualityType :: HasNumber a => a -> QualityType+expectedQualityType x = if ((abs (number x) - 1) `mod` 7) + 1 `elem` [1,4,5]+  then PerfectType else MajorMinorType++qualityTypes :: Quality -> [QualityType]+qualityTypes Perfect = [PerfectType]+qualityTypes Major   = [MajorMinorType]+qualityTypes Minor   = [MajorMinorType]+qualityTypes _       = [PerfectType, MajorMinorType]++-- FIXME problem that this treats major as neutral, while this only holds for positive intervals+qualityToDiff :: Bool -> QualityType -> Quality -> ChromaticSteps+qualityToDiff positive qt q = fromIntegral $ go positive qt q+  where+    go True MajorMinorType (Augmented n)  = 0 + n+    go True MajorMinorType Major          = 0+    go True MajorMinorType Minor          = (-1)+    go True MajorMinorType (Diminished n) = -(1 + n)++    go False MajorMinorType (Augmented n)  = -(1 + n)+    go False MajorMinorType Major          = -1+    go False MajorMinorType Minor          = 0+    go False MajorMinorType (Diminished n) = 0 + n+    +    go _ PerfectType (Augmented n)  = 0 + n+    go _ PerfectType Perfect        = 0+    go _ PerfectType (Diminished n) = 0 - n+    +    go _ qt q = error $ "qualityToDiff: Unknown interval expression (" ++ show qt ++ ", " ++ show q ++ ")"

@@ -1,5 +1,6 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving         #-}  ------------------------------------------------------------------------------------ -- |@@ -35,7 +36,7 @@         isSemitone,         isTone,         isTritone,-        +         -- * Enharmonic equivalence         (=:=),         (/:=),@@ -48,8 +49,8 @@ -- > octaves a = semitones a `div` 12 -- > steps   a = semitones a `mod` 12 ---newtype Octaves = Octaves { getOctaves :: Integer }     -    deriving (Eq, Ord, Num, Enum, Real, Integral)+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 }@@ -58,19 +59,19 @@ -- 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+  -- |+  -- 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   @@ -81,9 +82,9 @@ -- > steps   a = semitones a `mod` 12 -- newtype Steps = Steps { getSteps :: Integer }-    deriving (Eq, Ord, Num, Enum, Real, Integral)+  deriving (Eq, Ord, Num, Enum, Real, Integral) -instance Show     Steps where { show = show . getSteps }+instance Show Steps where { show = show . getSteps } -- instance HasSteps Steps where { steps = id }  {-@@ -91,16 +92,16 @@ -- 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+  -- |+  -- 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 -}  @@ -122,7 +123,7 @@ -- d5 -- newtype Semitones = Semitones { getSemitones :: Integer }-    deriving (Eq, Ord, Num, Enum, Real, Integral)+  deriving (Eq, Ord, Num, Enum, Real, Integral)  instance Show         Semitones where { show = show . getSemitones } instance HasSemitones Semitones where { semitones = id }@@ -132,22 +133,22 @@ -- 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.-    ---    -- >>> semitones (perfect unison)-    -- 0-    -- >>> semitones tritone-    -- 6-    -- >>> semitones d5-    -- 6-    -- >>> semitones (-_P8)-    -- -12-    ---    semitones :: a -> Semitones+  -- |+  -- Returns the number of semitones spanned by an interval.+  --+  -- The number of semitones is negative if and only if the interval is+  -- negative.+  --+  -- >>> semitones (perfect unison)+  -- 0+  -- >>> semitones tritone+  -- 6+  -- >>> semitones d5+  -- 6+  -- >>> semitones (-_P8)+  -- -12+  --+  semitones :: a -> Semitones   

@@ -1,6 +1,8 @@- -{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving, TypeFamilies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TypeFamilies               #-}+ ------------------------------------------------------------------------------------ -- | -- Copyright   : (c) Hans Hoglund, Edward Lilley 2012–2014@@ -24,47 +26,49 @@         Spelling,         spell,         spelled,-        +         -- ** Standard spellings         modally,         usingSharps,         usingFlats,   ) where -import Data.VectorSpace-import Data.AffineSpace+import           Data.AffineSpace+import           Data.VectorSpace+import           Control.Lens -import Music.Pitch.Absolute-import Music.Pitch.Literal-import Music.Pitch.Alterable-import Music.Pitch.Augmentable-import Music.Pitch.Common.Pitch-import Music.Pitch.Common.Interval-import Music.Pitch.Common.Semitones+import           Music.Pitch.Absolute+import           Music.Pitch.Alterable+import           Music.Pitch.Augmentable+import           Music.Pitch.Common.Interval+import           Music.Pitch.Common.Number+import           Music.Pitch.Common.Pitch+import           Music.Pitch.Common.Semitones+import           Music.Pitch.Literal  -- $semitonesAndSpellings -- -- TODO document better -- -- 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 `spellings`--- +-- -- > spellings :: Semitones -> [Interval] -- > spellings 4 = [majorThird, diminishedFourth] -- -- /Law/--- +-- -- > map semitones (spellings a) = replicate n a    for all n > 0 -- -- /Lemma/--- +-- -- > map semitones (spellings a) --- | +-- | -- A spelling provide a way of notating a semitone interval such as 'tritone'. -- -- Examples:@@ -81,27 +85,27 @@ -- spell :: HasSemitones a => Spelling -> a -> Interval spell spelling x = let-    -- TODO use Steps etc to remove fromIntegral-    (octaves, steps) = semitones x `divMod` 12-    num  = fromIntegral (spelling steps)-    diff = fromIntegral steps - fromIntegral (diatonicToChromatic num)-    in mkInterval' diff num ^+^ _P8^*(fromIntegral octaves)+  -- TODO use Steps etc to remove fromIntegral+  (octaves, steps) = semitones x `divMod` 12+  num  = fromIntegral (spelling steps)+  diff = fromIntegral steps - fromIntegral (diatonicToChromatic num)+  in (\a b -> (fromIntegral a, fromIntegral b)^.interval') diff num ^+^ _P8^*(fromIntegral octaves)     where-        diatonicToChromatic = go-            where-                go 0 = 0-                go 1 = 2-                go 2 = 4-                go 3 = 5-                go 4 = 7-                go 5 = 9-                go 6 = 11+      diatonicToChromatic = go+        where+          go 0 = 0+          go 1 = 2+          go 2 = 4+          go 3 = 5+          go 4 = 7+          go 5 = 9+          go 6 = 11  -- | -- Flipped version of 'spell'. To be used infix, as in: -- -- > d5 `spelled` usingSharps---        +-- spelled :: HasSemitones a => a -> Spelling -> Interval spelled = flip spell @@ -115,19 +119,19 @@ -- modally :: Spelling modally = go-    where-        go 0  = 0-        go 1  = 0-        go 2  = 1-        go 3  = 2-        go 4  = 2-        go 5  = 3-        go 6  = 3-        go 7  = 4-        go 8  = 4-        go 9  = 5-        go 10 = 6-        go 11 = 6+  where+    go 0  = 0+    go 1  = 0+    go 2  = 1+    go 3  = 2+    go 4  = 2+    go 5  = 3+    go 6  = 3+    go 7  = 4+    go 8  = 4+    go 9  = 5+    go 10 = 6+    go 11 = 6  -- | -- Spell using sharps. Double sharps and flats are not preserved.@@ -136,19 +140,19 @@ -- usingSharps :: Spelling usingSharps = 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+  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  -- | -- Spell using flats. Double sharps and flats are not preserved.@@ -157,17 +161,17 @@ -- usingFlats :: Spelling usingFlats = 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-                         +  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,5 +1,8 @@ +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}  ------------------------------------------------------------------------------------- -- |@@ -11,99 +14,167 @@ -- Stability   : experimental -- Portability : portable ----- Equal temperament pitch of any size.+-- Generic equal temperament pitch. --+-- Use the type-level numbers from @type-unary@ to construct an temperement dividing+-- the octave in any number of steps. Common cases such as 6-TET (whole-tones),+-- 12-TET (half-tones) and 24-TET (quarter-tones) are provided for convenience.+-- -------------------------------------------------------------------------------------  module Music.Pitch.Equal (-    -- Equal,-    -- toEqual,-    -- Equal6,-    -- Equal12,-    -- Equal17,-    -- Equal24,-    -- Equal36,-    -- -- toEqual',-    -- unsafeToEqual,-    -- value,-    -- size,-    -- cast,+    -- * Equal temperament+    Equal,+    toEqual,+    fromEqual,+    equalToRatio,+    size,+    cast,++    -- ** Synonyms+    Equal6,+    Equal12,+    Equal17,+    Equal24,+    Equal36,++    -- ** Extra type-level naturals+    N20,+    N30,+    N17,+    N24,+    N36, ) where --- {---- --- TODO mixing things up here--- ---   This type implements limited values (useful for interval *steps*)---   An ET-interval is just an int, with a type-level size (divMod is "separate")--- --- --- -}--- --- --- import Data.Maybe--- import Data.Either--- import Data.Semigroup--- import Control.Monad--- import Control.Applicative--- import Music.Pitch.Absolute--- --- import Data.TypeLevel.Num hiding ((<), (>), (+), (<=), (*))--- import qualified Data.TypeLevel.Num as TL--- --- data Foo = Foo Int deriving Show--- --- newtype Equal a = Equal { getEqual :: Pos a => Int }---   deriving ()--- --- instance Pos a => Show (Equal a) where---   -- show (Equal x) = "(Equal " ++ (show x) ++ ")"---   showsPrec d (Equal x) = showParen (d > app_prec) $---        showString "Equal " . showsPrec (app_prec+1) x---     where app_prec = 10--- --- -- Convenience to avoid ScopedTypeVariables etc    --- getSize :: Pos a => Equal a -> a--- getSize = undefined--- --- -- | Value, which is in @[0,size x)@.--- value :: Pos a => Equal a -> Int--- value = getEqual--- --- -- | Size of this type (value not evaluated).--- size :: Pos a => Equal a -> Int--- size = toInt . getSize--- --- toEqual :: Pos a => Int -> Maybe (Equal a)--- toEqual = toEqual' undefined--- --- toEqual' :: Pos a => a -> Int -> Maybe (Equal a)--- toEqual' s n = if 0 <= n && n < toInt s then Just (Equal n) else Nothing--- --- unsafeToEqual :: Int -> Equal a--- unsafeToEqual n = Equal n+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++import TypeUnary.Nat++-- Based on Data.Fixed++newtype Equal a = Equal { getEqual :: Int }++deriving instance {-IsNat a =>-} Eq (Equal a)+deriving instance {-IsNat a =>-} Ord (Equal a)++instance {-IsNat a =>-} Show (Equal a) where+  show (Equal a) = show a+  -- showsPrec d (Equal x) = showParen (d > app_prec) $+  --      showString "Equal " . showsPrec (app_prec+1) x+  --   where app_prec = 10++instance IsNat a => Num (Equal a) where+  Equal a + Equal b = Equal (a + b)+  Equal a * Equal b = Equal (a * b)+  negate (Equal a)  = Equal (negate a)+  abs (Equal a)     = Equal (abs a)+  signum (Equal a)  = Equal (signum a)+  fromInteger       = toEqual . fromIntegral++instance IsNat a => Semigroup (Equal a) where+  (<>)    = (+)++instance IsNat a => Monoid (Equal a) where+  mempty  = 0+  mappend = (+)++instance IsNat a => AdditiveGroup (Equal a) where+  zeroV   = 0+  (^+^)   = (+)+  negateV = negate++instance IsNat a => VectorSpace (Equal a) where+  type Scalar (Equal a) = Equal a+  (*^) = (*)++-- Convenience to avoid ScopedTypeVariables etc    +getSize :: IsNat a => Equal a -> Nat a+getSize _ = nat ++-- | Size of this type (value not evaluated). -- --- type Equal6  = Equal D6--- type Equal12 = Equal D12--- type Equal17 = Equal D17--- type Equal24 = Equal D24--- type Equal36 = Equal D36+-- >>> size (undefined :: Equal N2)+-- 2 -- --- -- unsafemapValue :: (Int -> Int) -> Equal a -> Equal b--- -- mapValue+-- >>> size (undefined :: Equal N12)+-- 12 -- --- -- b = 24, a = 12, mul = 24/12--- -- | Safely cast a tempered value to a larger size.--- ----- -- >>> cast (unsafeToEqual 1 :: Equal12) :: Equal24--- -- Equal 2 :: Equal24--- ----- cast :: (Pos a, Pos b, Pos c, Div b a c) => Equal a -> Equal b--- cast = cast' undefined+size :: IsNat a => Equal a -> Int+size = natToZ . getSize++-- TODO I got this part wrong -- --- cast' :: (Pos a, Pos b, Pos c, Div b a c) => Equal c -> Equal a -> Equal b--- cast' cDummy (Equal a) = Equal (a * size cDummy)+-- This type implements limited values (useful for interval *steps*)+-- An ET-interval is just an int, with a type-level size (divMod is "separate")++-- -- | Create an equal-temperament value.+-- toEqual :: IsNat a => Int -> Maybe (Equal a)+-- toEqual = checkSize . Equal -- +-- -- | Unsafely create an equal-temperament value.+-- unsafeToEqual :: IsNat a => Int -> Equal a+-- unsafeToEqual n = case toEqual n of+--   Nothing -> error $ "Bad equal: " ++ show n+--   Just x  -> x -- +-- checkSize :: IsNat a => Equal a -> Maybe (Equal a)+-- checkSize x = if 0 <= fromEqual x && fromEqual x < size x then Just x else Nothing -- ++-- | Create an equal-temperament value.+toEqual :: IsNat a => Int -> Equal a+toEqual = Equal++-- | Extract an equal-temperament value.+fromEqual :: IsNat a => Equal a -> Int+fromEqual = getEqual++-- | Convert an equal-temeperament value to a frequency ratio.+--+-- >>> equalToRatio (7 :: Equal12)+-- 1.4983070768766815+--+-- >>> equalToRatio (4 :: Equal12)+-- 1.2599210498948732+--+equalToRatio :: IsNat a => Equal a -> Double+equalToRatio x = 2**(realToFrac (fromEqual x) / realToFrac (size x))++-- | Safely cast a tempered value to another size.+--+-- >>> cast (1 :: Equal12) :: Equal24+-- 2 :: Equal24+--+-- >>> cast (8 :: Equal12) :: Equal6+-- 4 :: Equal6+--+-- >>> (2 :: Equal12) + cast (2 :: Equal24)+-- 3 :: Equal12+--+cast :: (IsNat a, IsNat b) => Equal a -> Equal b+cast = cast' undefined++cast' :: (IsNat a, IsNat b) => Equal b -> Equal a -> Equal b+cast' bDummy aDummy@(Equal a) = Equal $ (a * size bDummy) `div` size aDummy++type Equal6  = Equal N6+type Equal12 = Equal N12+type Equal17 = Equal N17+type Equal24 = Equal N24+type Equal36 = Equal N36++type N20 = N10 :*: N2+type N30 = N10 :*: N3+type N17 = N10 :+: N7+type N24 = N20 :+: N4+type N36 = N30 :+: N6+

@@ -1,4 +1,6 @@ +{-# LANGUAGE ViewPatterns #-}+ ------------------------------------------------------------------------------------- -- | -- Copyright   : (c) Hans Hoglund 2012@@ -9,7 +11,7 @@ -- Stability   : experimental -- Portability : portable ----- Provides intonation.+-- Provides intonation, i.e. mappings from relative to absolute pitch. -- ------------------------------------------------------------------------------------- @@ -47,9 +49,10 @@ import Data.AffineSpace import Control.Monad import Control.Applicative+import Control.Lens  import Music.Pitch.Absolute-import Music.Pitch.Literal+import Music.Pitch.Literal as Intervals import Music.Pitch.Common.Interval import Music.Pitch.Common.Pitch @@ -57,10 +60,10 @@ type Tuning i = i -> {-FreqRatio-}Hertz  synTune :: (Interval, {-FreqRatio-}Hertz) -> (Interval, {-FreqRatio-}Hertz) -> Interval -> {-FreqRatio-}Hertz-synTune (i1, i1rat) (i2, i2rat) (Interval (a1, d2)) =+synTune (i1, i1rat) (i2, i2rat) (view (from interval') -> (a1, d2)) =   ((makeA1 (i1, i1rat) (i2, i2rat)) ^* (fromIntegral a1)) ^+^ ((maked2 (i1, i1rat) (i2, i2rat)) ^* (fromIntegral d2))-  where makeA1 = makeBasis basis_A1-        maked2 = makeBasis basis_d2+  where makeA1 = makeBasis (Intervals._A1 :: Interval)+        maked2 = makeBasis (Intervals.d2  :: Interval)  makeBasis :: Interval -> (Interval, {-FreqRatio-}Hertz) -> (Interval, {-FreqRatio-}Hertz) -> {-FreqRatio-}Hertz makeBasis i (i1, r1) (i2, r2) = case (convertBasisFloat i i1 i2) of

@@ -12,6 +12,20 @@ {-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE TypeFamilies               #-} +------------------------------------------------------------------------------------+-- |+-- Copyright   : (c) Hans Hoglund, Edward Lilley 2012–2014+--+-- License     : BSD-style+--+-- Maintainer  : hans@hanshoglund.se+-- Stability   : experimental+-- Portability : non-portable (TF,GNTD)+--+-- Lines and staff positions.+--+-------------------------------------------------------------------------------------+ module Music.Pitch.StaffLines (         StaffLines,         HalfSpaces,