{-# LANGUAGE NoMonomorphismRestriction #-} ------------------------------------------------------------------------------------- -- | -- Copyright : (c) Hans Hoglund 2012 -- -- License : BSD-style -- -- Maintainer : hans@hanshoglund.se -- Stability : experimental -- Portability : portable -- -- Provides overloaded pitch literals. -- ------------------------------------------------------------------------------------- module Music.Pitch.Literal.Pitch ( -- * IsPitch class IsPitch(..), PitchL(..), -- * Literal values -- ** Four octaves up cs'''', ds'''', es'''', fs'''', gs'''', as'''', bs'''', c'''' , d'''' , e'''' , f'''' , g'''' , a'''' , b'''' , cb'''', db'''', eb'''', fb'''', gb'''', ab'''', bb'''', -- ** Three octaves up cs''', ds''', es''', fs''', gs''', as''', bs''', c''' , d''' , e''' , f''' , g''' , a''' , b''' , cb''', db''', eb''', fb''', gb''', ab''', bb''', -- ** Two octaves up cs'', ds'', es'', fs'', gs'', as'', bs'', c'' , d'' , e'' , f'' , g'' , a'' , b'' , cb'', db'', eb'', fb'', gb'', ab'', bb'', -- ** One octave up cs' , ds' , es' , fs' , gs' , as' , bs' , c' , d' , e' , f' , g' , a' , b' , cb' , db' , eb' , fb' , gb' , ab' , bb' , -- ** Standard octave cs , ds , es , fs , gs , as , bs , c , d , e , f , g , a , b , cb , db , eb , fb , gb , ab , bb , -- ** One octave down cs_ , ds_ , es_ , fs_ , gs_ , as_ , bs_ , c_ , d_ , e_ , f_ , g_ , a_ , b_ , cb_ , db_ , eb_ , fb_ , gb_ , ab_ , bb_ , -- ** Two octaves down cs__, ds__, es__, fs__, gs__, as__, bs__, c__ , d__ , e__ , f__ , g__ , a__ , b__ , cb__, db__, eb__, fb__, gb__, ab__, bb__, -- ** Three octaves down cs___, ds___, es___, fs___, gs___, as___, bs___, c___ , d___ , e___ , f___ , g___ , a___ , b___ , cb___, db___, eb___, fb___, gb___, ab___, bb___, -- ** Four octaves down cs____, ds____, es____, fs____, gs____, as____, bs____, c____ , d____ , e____ , f____ , g____ , a____ , b____ , cb____, db____, eb____, fb____, gb____, ab____, bb____, ) where import Control.Applicative import Data.Fixed import Data.Int import Data.Ratio import Data.Semigroup import Data.Word -- Pitch literal, defined as @(class, alteration, octave)@, where -- -- * @class@ is a pitch class number in @[0..6]@, starting from C. -- -- * @alteration@ is the number of semitones, i.e. 0 is natural, 1 for sharp 2 for double sharp, -1 for flat and -2 for double flat. -- Alteration is in 'Maybe' because some pitch representations differ between explicit and explicit accidentals, i.e. a diatonic -- pitch type may assume @(0,Nothing,...)@ to mean C sharp rather than C. -- -- * @octave@ is octave number in scientific pitch notation. -- -- Middle C is represented by the pitch literal @(0, Nothing, 0)@. -- newtype PitchL = PitchL { getPitchL :: (Int, Maybe Double, Int) } deriving (Eq, Show, Ord) class IsPitch a where fromPitch :: PitchL -> a instance IsPitch PitchL where fromPitch = id instance IsPitch a => IsPitch (Maybe a) where fromPitch = pure . fromPitch instance IsPitch a => IsPitch (First a) where fromPitch = pure . fromPitch instance IsPitch a => IsPitch (Last a) where fromPitch = pure . fromPitch instance IsPitch a => IsPitch [a] where fromPitch = pure . fromPitch instance (Monoid b, IsPitch a) => IsPitch (b, a) where fromPitch = pure . fromPitch instance IsPitch Int where fromPitch x = fromIntegral (fromPitch x :: Integer) instance IsPitch Word where fromPitch x = fromIntegral (fromPitch x :: Integer) instance IsPitch Float where fromPitch x = realToFrac (fromPitch x :: Double) instance HasResolution a => IsPitch (Fixed a) where fromPitch x = realToFrac (fromPitch x :: Double) instance Integral a => IsPitch (Ratio a) where fromPitch x = realToFrac (fromPitch x :: Double) instance IsPitch Double where fromPitch (PitchL (pc, sem, oct)) = fromIntegral $ semitones sem + diatonic pc + oct * 12 where semitones = maybe 0 round diatonic pc = case pc of 0 -> 0 1 -> 2 2 -> 4 3 -> 5 4 -> 7 5 -> 9 6 -> 11 instance IsPitch Integer where fromPitch (PitchL (pc, sem, oct)) = fromIntegral $ semitones sem + diatonic pc + oct * 12 where semitones = maybe 0 round diatonic pc = case pc of 0 -> 0 1 -> 2 2 -> 4 3 -> 5 4 -> 7 5 -> 9 6 -> 11 cs'''' = fromPitch $ PitchL (0, Just 1, 4) ds'''' = fromPitch $ PitchL (1, Just 1, 4) es'''' = fromPitch $ PitchL (2, Just 1, 4) fs'''' = fromPitch $ PitchL (3, Just 1, 4) gs'''' = fromPitch $ PitchL (4, Just 1, 4) as'''' = fromPitch $ PitchL (5, Just 1, 4) bs'''' = fromPitch $ PitchL (6, Just 1, 4) c'''' = fromPitch $ PitchL (0, Nothing, 4) d'''' = fromPitch $ PitchL (1, Nothing, 4) e'''' = fromPitch $ PitchL (2, Nothing, 4) f'''' = fromPitch $ PitchL (3, Nothing, 4) g'''' = fromPitch $ PitchL (4, Nothing, 4) a'''' = fromPitch $ PitchL (5, Nothing, 4) b'''' = fromPitch $ PitchL (6, Nothing, 4) cb'''' = fromPitch $ PitchL (0, Just (-1), 4) db'''' = fromPitch $ PitchL (1, Just (-1), 4) eb'''' = fromPitch $ PitchL (2, Just (-1), 4) fb'''' = fromPitch $ PitchL (3, Just (-1), 4) gb'''' = fromPitch $ PitchL (4, Just (-1), 4) ab'''' = fromPitch $ PitchL (5, Just (-1), 4) bb'''' = fromPitch $ PitchL (6, Just (-1), 4) cs''' = fromPitch $ PitchL (0, Just 1, 3) ds''' = fromPitch $ PitchL (1, Just 1, 3) es''' = fromPitch $ PitchL (2, Just 1, 3) fs''' = fromPitch $ PitchL (3, Just 1, 3) gs''' = fromPitch $ PitchL (4, Just 1, 3) as''' = fromPitch $ PitchL (5, Just 1, 3) bs''' = fromPitch $ PitchL (6, Just 1, 3) c''' = fromPitch $ PitchL (0, Nothing, 3) d''' = fromPitch $ PitchL (1, Nothing, 3) e''' = fromPitch $ PitchL (2, Nothing, 3) f''' = fromPitch $ PitchL (3, Nothing, 3) g''' = fromPitch $ PitchL (4, Nothing, 3) a''' = fromPitch $ PitchL (5, Nothing, 3) b''' = fromPitch $ PitchL (6, Nothing, 3) cb''' = fromPitch $ PitchL (0, Just (-1), 3) db''' = fromPitch $ PitchL (1, Just (-1), 3) eb''' = fromPitch $ PitchL (2, Just (-1), 3) fb''' = fromPitch $ PitchL (3, Just (-1), 3) gb''' = fromPitch $ PitchL (4, Just (-1), 3) ab''' = fromPitch $ PitchL (5, Just (-1), 3) bb''' = fromPitch $ PitchL (6, Just (-1), 3) cs'' = fromPitch $ PitchL (0, Just 1, 2) ds'' = fromPitch $ PitchL (1, Just 1, 2) es'' = fromPitch $ PitchL (2, Just 1, 2) fs'' = fromPitch $ PitchL (3, Just 1, 2) gs'' = fromPitch $ PitchL (4, Just 1, 2) as'' = fromPitch $ PitchL (5, Just 1, 2) bs'' = fromPitch $ PitchL (6, Just 1, 2) c'' = fromPitch $ PitchL (0, Nothing, 2) d'' = fromPitch $ PitchL (1, Nothing, 2) e'' = fromPitch $ PitchL (2, Nothing, 2) f'' = fromPitch $ PitchL (3, Nothing, 2) g'' = fromPitch $ PitchL (4, Nothing, 2) a'' = fromPitch $ PitchL (5, Nothing, 2) b'' = fromPitch $ PitchL (6, Nothing, 2) cb'' = fromPitch $ PitchL (0, Just (-1), 2) db'' = fromPitch $ PitchL (1, Just (-1), 2) eb'' = fromPitch $ PitchL (2, Just (-1), 2) fb'' = fromPitch $ PitchL (3, Just (-1), 2) gb'' = fromPitch $ PitchL (4, Just (-1), 2) ab'' = fromPitch $ PitchL (5, Just (-1), 2) bb'' = fromPitch $ PitchL (6, Just (-1), 2) cs' = fromPitch $ PitchL (0, Just 1, 1) ds' = fromPitch $ PitchL (1, Just 1, 1) es' = fromPitch $ PitchL (2, Just 1, 1) fs' = fromPitch $ PitchL (3, Just 1, 1) gs' = fromPitch $ PitchL (4, Just 1, 1) as' = fromPitch $ PitchL (5, Just 1, 1) bs' = fromPitch $ PitchL (6, Just 1, 1) c' = fromPitch $ PitchL (0, Nothing, 1) d' = fromPitch $ PitchL (1, Nothing, 1) e' = fromPitch $ PitchL (2, Nothing, 1) f' = fromPitch $ PitchL (3, Nothing, 1) g' = fromPitch $ PitchL (4, Nothing, 1) a' = fromPitch $ PitchL (5, Nothing, 1) b' = fromPitch $ PitchL (6, Nothing, 1) cb' = fromPitch $ PitchL (0, Just (-1), 1) db' = fromPitch $ PitchL (1, Just (-1), 1) eb' = fromPitch $ PitchL (2, Just (-1), 1) fb' = fromPitch $ PitchL (3, Just (-1), 1) gb' = fromPitch $ PitchL (4, Just (-1), 1) ab' = fromPitch $ PitchL (5, Just (-1), 1) bb' = fromPitch $ PitchL (6, Just (-1), 1) cs = fromPitch $ PitchL (0, Just 1, 0) ds = fromPitch $ PitchL (1, Just 1, 0) es = fromPitch $ PitchL (2, Just 1, 0) fs = fromPitch $ PitchL (3, Just 1, 0) gs = fromPitch $ PitchL (4, Just 1, 0) as = fromPitch $ PitchL (5, Just 1, 0) bs = fromPitch $ PitchL (6, Just 1, 0) c = fromPitch $ PitchL (0, Nothing, 0) d = fromPitch $ PitchL (1, Nothing, 0) e = fromPitch $ PitchL (2, Nothing, 0) f = fromPitch $ PitchL (3, Nothing, 0) g = fromPitch $ PitchL (4, Nothing, 0) a = fromPitch $ PitchL (5, Nothing, 0) b = fromPitch $ PitchL (6, Nothing, 0) cb = fromPitch $ PitchL (0, Just (-1), 0) db = fromPitch $ PitchL (1, Just (-1), 0) eb = fromPitch $ PitchL (2, Just (-1), 0) fb = fromPitch $ PitchL (3, Just (-1), 0) gb = fromPitch $ PitchL (4, Just (-1), 0) ab = fromPitch $ PitchL (5, Just (-1), 0) bb = fromPitch $ PitchL (6, Just (-1), 0) cs_ = fromPitch $ PitchL (0, Just 1, -1) ds_ = fromPitch $ PitchL (1, Just 1, -1) es_ = fromPitch $ PitchL (2, Just 1, -1) fs_ = fromPitch $ PitchL (3, Just 1, -1) gs_ = fromPitch $ PitchL (4, Just 1, -1) as_ = fromPitch $ PitchL (5, Just 1, -1) bs_ = fromPitch $ PitchL (6, Just 1, -1) c_ = fromPitch $ PitchL (0, Nothing, -1) d_ = fromPitch $ PitchL (1, Nothing, -1) e_ = fromPitch $ PitchL (2, Nothing, -1) f_ = fromPitch $ PitchL (3, Nothing, -1) g_ = fromPitch $ PitchL (4, Nothing, -1) a_ = fromPitch $ PitchL (5, Nothing, -1) b_ = fromPitch $ PitchL (6, Nothing, -1) cb_ = fromPitch $ PitchL (0, Just (-1), -1) db_ = fromPitch $ PitchL (1, Just (-1), -1) eb_ = fromPitch $ PitchL (2, Just (-1), -1) fb_ = fromPitch $ PitchL (3, Just (-1), -1) gb_ = fromPitch $ PitchL (4, Just (-1), -1) ab_ = fromPitch $ PitchL (5, Just (-1), -1) bb_ = fromPitch $ PitchL (6, Just (-1), -1) cs__ = fromPitch $ PitchL (0, Just 1, -2) ds__ = fromPitch $ PitchL (1, Just 1, -2) es__ = fromPitch $ PitchL (2, Just 1, -2) fs__ = fromPitch $ PitchL (3, Just 1, -2) gs__ = fromPitch $ PitchL (4, Just 1, -2) as__ = fromPitch $ PitchL (5, Just 1, -2) bs__ = fromPitch $ PitchL (6, Just 1, -2) c__ = fromPitch $ PitchL (0, Nothing, -2) d__ = fromPitch $ PitchL (1, Nothing, -2) e__ = fromPitch $ PitchL (2, Nothing, -2) f__ = fromPitch $ PitchL (3, Nothing, -2) g__ = fromPitch $ PitchL (4, Nothing, -2) a__ = fromPitch $ PitchL (5, Nothing, -2) b__ = fromPitch $ PitchL (6, Nothing, -2) cb__ = fromPitch $ PitchL (0, Just (-1), -2) db__ = fromPitch $ PitchL (1, Just (-1), -2) eb__ = fromPitch $ PitchL (2, Just (-1), -2) fb__ = fromPitch $ PitchL (3, Just (-1), -2) gb__ = fromPitch $ PitchL (4, Just (-1), -2) ab__ = fromPitch $ PitchL (5, Just (-1), -2) bb__ = fromPitch $ PitchL (6, Just (-1), -2) cs___ = fromPitch $ PitchL (0, Just 1, -3) ds___ = fromPitch $ PitchL (1, Just 1, -3) es___ = fromPitch $ PitchL (2, Just 1, -3) fs___ = fromPitch $ PitchL (3, Just 1, -3) gs___ = fromPitch $ PitchL (4, Just 1, -3) as___ = fromPitch $ PitchL (5, Just 1, -3) bs___ = fromPitch $ PitchL (6, Just 1, -3) c___ = fromPitch $ PitchL (0, Nothing, -3) d___ = fromPitch $ PitchL (1, Nothing, -3) e___ = fromPitch $ PitchL (2, Nothing, -3) f___ = fromPitch $ PitchL (3, Nothing, -3) g___ = fromPitch $ PitchL (4, Nothing, -3) a___ = fromPitch $ PitchL (5, Nothing, -3) b___ = fromPitch $ PitchL (6, Nothing, -3) cb___ = fromPitch $ PitchL (0, Just (-1), -3) db___ = fromPitch $ PitchL (1, Just (-1), -3) eb___ = fromPitch $ PitchL (2, Just (-1), -3) fb___ = fromPitch $ PitchL (3, Just (-1), -3) gb___ = fromPitch $ PitchL (4, Just (-1), -3) ab___ = fromPitch $ PitchL (5, Just (-1), -3) bb___ = fromPitch $ PitchL (6, Just (-1), -3) cs____ = fromPitch $ PitchL (0, Just 1, -4) ds____ = fromPitch $ PitchL (1, Just 1, -4) es____ = fromPitch $ PitchL (2, Just 1, -4) fs____ = fromPitch $ PitchL (3, Just 1, -4) gs____ = fromPitch $ PitchL (4, Just 1, -4) as____ = fromPitch $ PitchL (5, Just 1, -4) bs____ = fromPitch $ PitchL (6, Just 1, -4) c____ = fromPitch $ PitchL (0, Nothing, -4) d____ = fromPitch $ PitchL (1, Nothing, -4) e____ = fromPitch $ PitchL (2, Nothing, -4) f____ = fromPitch $ PitchL (3, Nothing, -4) g____ = fromPitch $ PitchL (4, Nothing, -4) a____ = fromPitch $ PitchL (5, Nothing, -4) b____ = fromPitch $ PitchL (6, Nothing, -4) cb____ = fromPitch $ PitchL (0, Just (-1), -4) db____ = fromPitch $ PitchL (1, Just (-1), -4) eb____ = fromPitch $ PitchL (2, Just (-1), -4) fb____ = fromPitch $ PitchL (3, Just (-1), -4) gb____ = fromPitch $ PitchL (4, Just (-1), -4) ab____ = fromPitch $ PitchL (5, Just (-1), -4) bb____ = fromPitch $ PitchL (6, Just (-1), -4)