module Music.Pitch.Literal.Pitch (
IsPitch(..),
PitchL(..),
cs'', ds'', es'', fs'', gs'', as'', bs'',
c'' , d'' , e'' , f'' , g'' , a'' , b'' ,
cb'', db'', eb'', fb'', gb'', ab'', bb'',
cs' , ds' , es' , fs' , gs' , as' , bs' ,
c' , d' , e' , f' , g' , a' , b' ,
cb' , db' , eb' , fb' , gb' , ab' , bb' ,
cs , ds , es , fs , gs , as , bs ,
c , d , e , f , g , a , b ,
cb , db , eb , fb , gb , ab , bb ,
cs_ , ds_ , es_ , fs_ , gs_ , as_ , bs_ ,
c_ , d_ , e_ , f_ , g_ , a_ , b_ ,
cb_ , db_ , eb_ , fb_ , gb_ , ab_ , bb_ ,
cs__, ds__, es__, fs__, gs__, as__, bs__,
c__ , d__ , e__ , f__ , g__ , a__ , b__ ,
cb__, db__, eb__, fb__, gb__, ab__, bb__
) where
import Data.Semigroup
import Control.Applicative
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 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, 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)