-- | Common music notation note and alteration values.
module Music.Theory.Pitch.Note where

import Data.Char {- base -}
import Data.Maybe {- base -}

import qualified Text.Parsec as P {- parsec -}

import qualified Music.Theory.List as T {- hmt -}
import qualified Music.Theory.Parse as T {- hmt -}

-- * Note

-- | Enumeration of common music notation note names (@C@ to @B@).
data Note = C | D | E | F | G | A | B
              deriving (Note -> Note -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Note -> Note -> Bool
$c/= :: Note -> Note -> Bool
== :: Note -> Note -> Bool
$c== :: Note -> Note -> Bool
Eq,Int -> Note
Note -> Int
Note -> [Note]
Note -> Note
Note -> Note -> [Note]
Note -> Note -> Note -> [Note]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Note -> Note -> Note -> [Note]
$cenumFromThenTo :: Note -> Note -> Note -> [Note]
enumFromTo :: Note -> Note -> [Note]
$cenumFromTo :: Note -> Note -> [Note]
enumFromThen :: Note -> Note -> [Note]
$cenumFromThen :: Note -> Note -> [Note]
enumFrom :: Note -> [Note]
$cenumFrom :: Note -> [Note]
fromEnum :: Note -> Int
$cfromEnum :: Note -> Int
toEnum :: Int -> Note
$ctoEnum :: Int -> Note
pred :: Note -> Note
$cpred :: Note -> Note
succ :: Note -> Note
$csucc :: Note -> Note
Enum,Note
forall a. a -> a -> Bounded a
maxBound :: Note
$cmaxBound :: Note
minBound :: Note
$cminBound :: Note
Bounded,Eq Note
Note -> Note -> Bool
Note -> Note -> Ordering
Note -> Note -> Note
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Note -> Note -> Note
$cmin :: Note -> Note -> Note
max :: Note -> Note -> Note
$cmax :: Note -> Note -> Note
>= :: Note -> Note -> Bool
$c>= :: Note -> Note -> Bool
> :: Note -> Note -> Bool
$c> :: Note -> Note -> Bool
<= :: Note -> Note -> Bool
$c<= :: Note -> Note -> Bool
< :: Note -> Note -> Bool
$c< :: Note -> Note -> Bool
compare :: Note -> Note -> Ordering
$ccompare :: Note -> Note -> Ordering
Ord,ReadPrec [Note]
ReadPrec Note
Int -> ReadS Note
ReadS [Note]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Note]
$creadListPrec :: ReadPrec [Note]
readPrec :: ReadPrec Note
$creadPrec :: ReadPrec Note
readList :: ReadS [Note]
$creadList :: ReadS [Note]
readsPrec :: Int -> ReadS Note
$creadsPrec :: Int -> ReadS Note
Read,Int -> Note -> ShowS
[Note] -> ShowS
Note -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Note] -> ShowS
$cshowList :: [Note] -> ShowS
show :: Note -> String
$cshow :: Note -> String
showsPrec :: Int -> Note -> ShowS
$cshowsPrec :: Int -> Note -> ShowS
Show)

-- | Note sequence as usually understood, ie. 'C' - 'B'.
note_seq :: [Note]
note_seq :: [Note]
note_seq = [Note
C .. Note
B]

-- | Char variant of 'show'.
note_pp :: Note -> Char
note_pp :: Note -> Char
note_pp = forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

-- | Note name in lilypond syntax (ie. lower case).
note_pp_ly :: Note -> String
note_pp_ly :: Note -> String
note_pp_ly = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

-- | Table of 'Note' and corresponding pitch-classes.
note_pc_tbl :: Num i => [(Note,i)]
note_pc_tbl :: forall i. Num i => [(Note, i)]
note_pc_tbl = forall a b. [a] -> [b] -> [(a, b)]
zip [Note
C .. Note
B] [i
0,i
2,i
4,i
5,i
7,i
9,i
11]

-- | Transform 'Note' to pitch-class number.
--
-- > map note_to_pc [C,E,G] == [0,4,7]
note_to_pc :: Num i => Note -> i
note_to_pc :: forall i. Num i => Note -> i
note_to_pc Note
n = forall k v. (Eq k, Show k) => String -> k -> [(k, v)] -> v
T.lookup_err_msg String
"note_to_pc" Note
n forall i. Num i => [(Note, i)]
note_pc_tbl

-- | Inverse of 'note_to_pc'.
--
-- > mapMaybe pc_to_note [0,4,7] == [C,E,G]
pc_to_note :: (Eq i,Num i) => i -> Maybe Note
pc_to_note :: forall i. (Eq i, Num i) => i -> Maybe Note
pc_to_note i
i = forall v k. Eq v => v -> [(k, v)] -> Maybe k
T.reverse_lookup i
i forall i. Num i => [(Note, i)]
note_pc_tbl

-- | Modal transposition of 'Note' value.
--
-- > note_t_transpose C 2 == E
note_t_transpose :: Note -> Int -> Note
note_t_transpose :: Note -> Int -> Note
note_t_transpose Note
x Int
n =
    let x' :: Int
x' = forall a. Enum a => a -> Int
fromEnum Note
x
        n' :: Int
n' = forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
maxBound::Note) forall a. Num a => a -> a -> a
+ Int
1
    in forall a. Enum a => Int -> a
toEnum ((Int
x' forall a. Num a => a -> a -> a
+ Int
n) forall a. Integral a => a -> a -> a
`mod` Int
n')

-- | Parser from 'Char', case insensitive flag.
--
-- > mapMaybe (parse_note True) "CDEFGab" == [C,D,E,F,G,A,B]
parse_note_t :: Bool -> Char -> Maybe Note
parse_note_t :: Bool -> Char -> Maybe Note
parse_note_t Bool
ci Char
c =
    let tbl :: [(Char, Note)]
tbl = forall a b. [a] -> [b] -> [(a, b)]
zip String
"CDEFGAB" [Note
C,Note
D,Note
E,Note
F,Note
G,Note
A,Note
B]
    in forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (if Bool
ci then Char -> Char
toUpper Char
c else Char
c) [(Char, Note)]
tbl

char_to_note_t :: Bool -> Char -> Note
char_to_note_t :: Bool -> Char -> Note
char_to_note_t Bool
ci = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"char_to_note_t") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Char -> Maybe Note
parse_note_t Bool
ci

-- | Inclusive set of 'Note' within indicated interval.  This is not
-- equal to 'enumFromTo' which is not circular.
--
-- > note_span E B == [E,F,G,A,B]
-- > note_span B D == [B,C,D]
-- > enumFromTo B D == []
note_span :: Note -> Note -> [Note]
note_span :: Note -> Note -> [Note]
note_span Note
n1 Note
n2 =
    let fn :: Int -> a
fn Int
x = forall a. Enum a => Int -> a
toEnum (Int
x forall a. Integral a => a -> a -> a
`mod` Int
7)
        n1' :: Int
n1' = forall a. Enum a => a -> Int
fromEnum Note
n1
        n2' :: Int
n2' = forall a. Enum a => a -> Int
fromEnum Note
n2
        n2'' :: Int
n2'' = if Int
n1' forall a. Ord a => a -> a -> Bool
> Int
n2' then Int
n2' forall a. Num a => a -> a -> a
+ Int
7 else Int
n2'
    in forall a b. (a -> b) -> [a] -> [b]
map forall a. Enum a => Int -> a
fn [Int
n1' .. Int
n2'']

-- * Alteration

-- | Enumeration of common music notation note alterations.
data Alteration =
    DoubleFlat
  | ThreeQuarterToneFlat | Flat | QuarterToneFlat
  | Natural
  | QuarterToneSharp | Sharp | ThreeQuarterToneSharp
  | DoubleSharp
    deriving (Alteration -> Alteration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Alteration -> Alteration -> Bool
$c/= :: Alteration -> Alteration -> Bool
== :: Alteration -> Alteration -> Bool
$c== :: Alteration -> Alteration -> Bool
Eq,Int -> Alteration
Alteration -> Int
Alteration -> [Alteration]
Alteration -> Alteration
Alteration -> Alteration -> [Alteration]
Alteration -> Alteration -> Alteration -> [Alteration]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Alteration -> Alteration -> Alteration -> [Alteration]
$cenumFromThenTo :: Alteration -> Alteration -> Alteration -> [Alteration]
enumFromTo :: Alteration -> Alteration -> [Alteration]
$cenumFromTo :: Alteration -> Alteration -> [Alteration]
enumFromThen :: Alteration -> Alteration -> [Alteration]
$cenumFromThen :: Alteration -> Alteration -> [Alteration]
enumFrom :: Alteration -> [Alteration]
$cenumFrom :: Alteration -> [Alteration]
fromEnum :: Alteration -> Int
$cfromEnum :: Alteration -> Int
toEnum :: Int -> Alteration
$ctoEnum :: Int -> Alteration
pred :: Alteration -> Alteration
$cpred :: Alteration -> Alteration
succ :: Alteration -> Alteration
$csucc :: Alteration -> Alteration
Enum,Alteration
forall a. a -> a -> Bounded a
maxBound :: Alteration
$cmaxBound :: Alteration
minBound :: Alteration
$cminBound :: Alteration
Bounded,Eq Alteration
Alteration -> Alteration -> Bool
Alteration -> Alteration -> Ordering
Alteration -> Alteration -> Alteration
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Alteration -> Alteration -> Alteration
$cmin :: Alteration -> Alteration -> Alteration
max :: Alteration -> Alteration -> Alteration
$cmax :: Alteration -> Alteration -> Alteration
>= :: Alteration -> Alteration -> Bool
$c>= :: Alteration -> Alteration -> Bool
> :: Alteration -> Alteration -> Bool
$c> :: Alteration -> Alteration -> Bool
<= :: Alteration -> Alteration -> Bool
$c<= :: Alteration -> Alteration -> Bool
< :: Alteration -> Alteration -> Bool
$c< :: Alteration -> Alteration -> Bool
compare :: Alteration -> Alteration -> Ordering
$ccompare :: Alteration -> Alteration -> Ordering
Ord,Int -> Alteration -> ShowS
[Alteration] -> ShowS
Alteration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Alteration] -> ShowS
$cshowList :: [Alteration] -> ShowS
show :: Alteration -> String
$cshow :: Alteration -> String
showsPrec :: Int -> Alteration -> ShowS
$cshowsPrec :: Int -> Alteration -> ShowS
Show)

-- | Generic form.
generic_alteration_to_diff :: Integral i => Alteration -> Maybe i
generic_alteration_to_diff :: forall i. Integral i => Alteration -> Maybe i
generic_alteration_to_diff Alteration
a =
    case Alteration
a of
      Alteration
DoubleFlat -> forall a. a -> Maybe a
Just (-i
2)
      Alteration
Flat -> forall a. a -> Maybe a
Just (-i
1)
      Alteration
Natural -> forall a. a -> Maybe a
Just i
0
      Alteration
Sharp -> forall a. a -> Maybe a
Just i
1
      Alteration
DoubleSharp -> forall a. a -> Maybe a
Just i
2
      Alteration
_ -> forall a. Maybe a
Nothing

-- | Transform 'Alteration' to semitone alteration.  Returns
-- 'Nothing' for non-semitone alterations.
--
-- > map alteration_to_diff [Flat,QuarterToneSharp] == [Just (-1),Nothing]
alteration_to_diff :: Alteration -> Maybe Int
alteration_to_diff :: Alteration -> Maybe Int
alteration_to_diff = forall i. Integral i => Alteration -> Maybe i
generic_alteration_to_diff

-- | Is 'Alteration' 12-ET.
alteration_is_12et :: Alteration -> Bool
alteration_is_12et :: Alteration -> Bool
alteration_is_12et = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alteration -> Maybe Int
alteration_to_diff

-- | Transform 'Alteration' to semitone alteration.
--
-- > map alteration_to_diff_err [Flat,Sharp] == [-1,1]
alteration_to_diff_err :: Integral i => Alteration -> i
alteration_to_diff_err :: forall i. Integral i => Alteration -> i
alteration_to_diff_err =
    let err :: a
err = forall a. HasCallStack => String -> a
error String
"alteration_to_diff: quarter tone"
    in forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => Alteration -> Maybe i
generic_alteration_to_diff

-- | Transform 'Alteration' to fractional semitone alteration,
-- ie. allow quarter tones.
--
-- > alteration_to_fdiff QuarterToneSharp == 0.5
alteration_to_fdiff :: Fractional n => Alteration -> n
alteration_to_fdiff :: forall n. Fractional n => Alteration -> n
alteration_to_fdiff Alteration
a =
    case Alteration
a of
      Alteration
ThreeQuarterToneFlat -> -n
1.5
      Alteration
QuarterToneFlat -> -n
0.5
      Alteration
QuarterToneSharp -> n
0.5
      Alteration
ThreeQuarterToneSharp -> n
1.5
      Alteration
_ -> forall a. Num a => Integer -> a
fromInteger (forall i. Integral i => Alteration -> i
alteration_to_diff_err Alteration
a)

-- | Transform fractional semitone alteration to 'Alteration',
-- ie. allow quarter tones.
--
-- > map fdiff_to_alteration [-0.5,0.5] == [Just QuarterToneFlat
-- >                                       ,Just QuarterToneSharp]
fdiff_to_alteration :: (Fractional n,Eq n) => n -> Maybe Alteration
fdiff_to_alteration :: forall n. (Fractional n, Eq n) => n -> Maybe Alteration
fdiff_to_alteration n
d =
    case n
d of
      -2 -> forall a. a -> Maybe a
Just Alteration
DoubleFlat
      -1.5 -> forall a. a -> Maybe a
Just Alteration
ThreeQuarterToneFlat
      -1 -> forall a. a -> Maybe a
Just Alteration
Flat
      -0.5 -> forall a. a -> Maybe a
Just Alteration
QuarterToneFlat
      n
0 -> forall a. a -> Maybe a
Just Alteration
Natural
      n
0.5 -> forall a. a -> Maybe a
Just Alteration
QuarterToneSharp
      n
1 -> forall a. a -> Maybe a
Just Alteration
Sharp
      n
1.5 -> forall a. a -> Maybe a
Just Alteration
ThreeQuarterToneSharp
      n
2 -> forall a. a -> Maybe a
Just Alteration
DoubleSharp
      n
_ -> forall a. HasCallStack => a
undefined

-- | Raise 'Alteration' by a quarter tone where possible.
--
-- > alteration_raise_quarter_tone Flat == Just QuarterToneFlat
-- > alteration_raise_quarter_tone DoubleSharp == Nothing
alteration_raise_quarter_tone :: Alteration -> Maybe Alteration
alteration_raise_quarter_tone :: Alteration -> Maybe Alteration
alteration_raise_quarter_tone Alteration
a =
    if Alteration
a forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
maxBound then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (forall a. Enum a => Int -> a
toEnum (forall a. Enum a => a -> Int
fromEnum Alteration
a forall a. Num a => a -> a -> a
+ Int
1))

-- | Lower 'Alteration' by a quarter tone where possible.
--
-- > alteration_lower_quarter_tone Sharp == Just QuarterToneSharp
-- > alteration_lower_quarter_tone DoubleFlat == Nothing
alteration_lower_quarter_tone :: Alteration -> Maybe Alteration
alteration_lower_quarter_tone :: Alteration -> Maybe Alteration
alteration_lower_quarter_tone Alteration
a =
    if Alteration
a forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
minBound then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (forall a. Enum a => Int -> a
toEnum (forall a. Enum a => a -> Int
fromEnum Alteration
a forall a. Num a => a -> a -> a
- Int
1))

-- | Edit 'Alteration' by a quarter tone where possible, @-0.5@
-- lowers, @0@ retains, @0.5@ raises.
--
-- > import Data.Ratio
-- > alteration_edit_quarter_tone (-1 % 2) Flat == Just ThreeQuarterToneFlat
alteration_edit_quarter_tone :: (Fractional n,Eq n) =>
                                n -> Alteration -> Maybe Alteration
alteration_edit_quarter_tone :: forall n.
(Fractional n, Eq n) =>
n -> Alteration -> Maybe Alteration
alteration_edit_quarter_tone n
n Alteration
a =
    case n
n of
      -0.5 -> Alteration -> Maybe Alteration
alteration_lower_quarter_tone Alteration
a
      n
0 -> forall a. a -> Maybe a
Just Alteration
a
      n
0.5 -> Alteration -> Maybe Alteration
alteration_raise_quarter_tone Alteration
a
      n
_ -> forall a. Maybe a
Nothing

-- | Simplify 'Alteration' to standard 12ET by deleting quarter tones.
--
-- > Data.List.nub (map alteration_clear_quarter_tone [minBound..maxBound])
alteration_clear_quarter_tone :: Alteration -> Alteration
alteration_clear_quarter_tone :: Alteration -> Alteration
alteration_clear_quarter_tone Alteration
x =
    case Alteration
x of
      Alteration
ThreeQuarterToneFlat -> Alteration
Flat
      Alteration
QuarterToneFlat -> Alteration
Flat
      Alteration
QuarterToneSharp -> Alteration
Sharp
      Alteration
ThreeQuarterToneSharp -> Alteration
Sharp
      Alteration
_ -> Alteration
x

-- | Table of Unicode characters for alterations.
alteration_symbol_tbl :: [(Alteration,Char)]
alteration_symbol_tbl :: [(Alteration, Char)]
alteration_symbol_tbl =
    [(Alteration
DoubleFlat,Char
'𝄫')
    ,(Alteration
ThreeQuarterToneFlat,Char
'𝄭')
    ,(Alteration
Flat,Char
'♭')
    ,(Alteration
QuarterToneFlat,Char
'𝄳')
    ,(Alteration
Natural,Char
'♮')
    ,(Alteration
QuarterToneSharp,Char
'𝄲')
    ,(Alteration
Sharp,Char
'♯')
    ,(Alteration
ThreeQuarterToneSharp,Char
'𝄰')
    ,(Alteration
DoubleSharp,Char
'𝄪')]

-- | Unicode has entries for /Musical Symbols/ in the range @U+1D100@
-- through @U+1D1FF@.  The @3/4@ symbols are non-standard, here they
-- correspond to @MUSICAL SYMBOL FLAT DOWN@ and @MUSICAL SYMBOL SHARP
-- UP@.
--
-- > map alteration_symbol [minBound .. maxBound] == "𝄫𝄭♭𝄳♮𝄲♯𝄰𝄪"
alteration_symbol :: Alteration -> Char
alteration_symbol :: Alteration -> Char
alteration_symbol Alteration
a = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"alteration_symbol") (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Alteration
a [(Alteration, Char)]
alteration_symbol_tbl)

-- | Inverse of 'alteration_symbol'.
--
-- > mapMaybe symbol_to_alteration "♭♮♯" == [Flat,Natural,Sharp]
symbol_to_alteration :: Char -> Maybe Alteration
symbol_to_alteration :: Char -> Maybe Alteration
symbol_to_alteration Char
c = forall v k. Eq v => v -> [(k, v)] -> Maybe k
T.reverse_lookup Char
c [(Alteration, Char)]
alteration_symbol_tbl

-- | ISO alteration notation.  When not strict extended to allow ## for x.
symbol_to_alteration_iso :: Bool -> String -> Maybe Alteration
symbol_to_alteration_iso :: Bool -> String -> Maybe Alteration
symbol_to_alteration_iso Bool
strict String
txt =
    case String
txt of
      String
"bb" -> forall a. a -> Maybe a
Just Alteration
DoubleFlat
      String
"b" -> forall a. a -> Maybe a
Just Alteration
Flat
      String
"#" -> forall a. a -> Maybe a
Just Alteration
Sharp
      String
"##" -> if Bool
strict then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Alteration
DoubleSharp
      String
"x" -> forall a. a -> Maybe a
Just Alteration
DoubleSharp
      String
"" -> forall a. a -> Maybe a
Just Alteration
Natural
      String
_ -> forall a. Maybe a
Nothing

symbol_to_alteration_iso_err :: Bool -> String -> Alteration
symbol_to_alteration_iso_err :: Bool -> String -> Alteration
symbol_to_alteration_iso_err Bool
strict =
  forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"symbol_to_alteration_iso") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Bool -> String -> Maybe Alteration
symbol_to_alteration_iso Bool
strict

-- | 'symbol_to_alteration' extended to allow single character ISO notations.
symbol_to_alteration_unicode_plus_iso :: Char -> Maybe Alteration
symbol_to_alteration_unicode_plus_iso :: Char -> Maybe Alteration
symbol_to_alteration_unicode_plus_iso Char
c =
    case Char
c of
      Char
'b' -> forall a. a -> Maybe a
Just Alteration
Flat
      Char
'#' -> forall a. a -> Maybe a
Just Alteration
Sharp
      Char
'x' -> forall a. a -> Maybe a
Just Alteration
DoubleSharp
      Char
_ -> Char -> Maybe Alteration
symbol_to_alteration Char
c

-- | ISO alteration table, strings not characters because of double flat.
alteration_iso_tbl :: [(Alteration,String)]
alteration_iso_tbl :: [(Alteration, String)]
alteration_iso_tbl =
    [(Alteration
DoubleFlat,String
"bb")
    ,(Alteration
Flat,String
"b")
    ,(Alteration
Natural,String
"")
    ,(Alteration
Sharp,String
"#")
    ,(Alteration
DoubleSharp,String
"x")]

-- | The @ISO@ ASCII spellings for alterations.  Naturals are written
-- as the empty string.
--
-- > mapMaybe alteration_iso_m [Flat .. Sharp] == ["b","","#"]
-- > mapMaybe alteration_iso_m [DoubleFlat,DoubleSharp] == ["bb","x"]
alteration_iso_m :: Alteration -> Maybe String
alteration_iso_m :: Alteration -> Maybe String
alteration_iso_m Alteration
a = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Alteration
a [(Alteration, String)]
alteration_iso_tbl

-- | The @ISO@ ASCII spellings for alterations.
alteration_iso :: Alteration -> String
alteration_iso :: Alteration -> String
alteration_iso =
    let qt :: a
qt = forall a. HasCallStack => String -> a
error String
"alteration_iso: quarter tone"
    in forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
qt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alteration -> Maybe String
alteration_iso_m

-- | The /Tonhöhe/ ASCII spellings for alterations.
alteration_tonh_tbl :: [(Alteration, String)]
alteration_tonh_tbl :: [(Alteration, String)]
alteration_tonh_tbl =
  [(Alteration
DoubleFlat,String
"eses")
  ,(Alteration
ThreeQuarterToneFlat,String
"eseh")
  ,(Alteration
Flat,String
"es")
  ,(Alteration
QuarterToneFlat,String
"eh")
  ,(Alteration
Natural,String
"")
  ,(Alteration
QuarterToneSharp,String
"ih")
  ,(Alteration
Sharp,String
"is")
  ,(Alteration
ThreeQuarterToneSharp,String
"isih")
  ,(Alteration
DoubleSharp,String
"isis")]

-- | The /Tonhöhe/ ASCII spellings for alterations.
--
-- See <http://www.musiccog.ohio-state.edu/Humdrum/guide04.html> and
-- <http://lilypond.org/doc/v2.16/Documentation/notation/writing-pitches>
--
-- > map alteration_tonh [Flat .. Sharp] == ["es","eh","","ih","is"]
alteration_tonh :: Alteration -> String
alteration_tonh :: Alteration -> String
alteration_tonh Alteration
a = forall k v. Eq k => k -> [(k, v)] -> v
T.lookup_err Alteration
a [(Alteration, String)]
alteration_tonh_tbl

-- | Inverse of 'alteration_tonh'.
--
-- > mapMaybe tonh_to_alteration ["es","eh","","ih","is"] == [Flat .. Sharp]
tonh_to_alteration :: String -> Maybe Alteration
tonh_to_alteration :: String -> Maybe Alteration
tonh_to_alteration String
s = forall v k. Eq v => v -> [(k, v)] -> Maybe k
T.reverse_lookup String
s [(Alteration, String)]
alteration_tonh_tbl

tonh_to_alteration_err :: String -> Alteration
tonh_to_alteration_err :: String -> Alteration
tonh_to_alteration_err = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"tonh_to_alteration") forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Alteration
tonh_to_alteration

-- * 12-ET

-- | Note and alteration to pitch-class, or not.
note_alteration_to_pc :: (Note,Alteration) -> Maybe Int
note_alteration_to_pc :: (Note, Alteration) -> Maybe Int
note_alteration_to_pc (Note
n,Alteration
a) =
    let n_pc :: Int
n_pc = forall i. Num i => Note -> i
note_to_pc Note
n
    in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. Integral a => a -> a -> a
`mod` Int
12) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+ Int
n_pc)) (Alteration -> Maybe Int
alteration_to_diff Alteration
a)

-- | Error variant.
--
-- > map note_alteration_to_pc_err [(A,DoubleSharp),(B,Sharp),(C,Flat),(C,DoubleFlat)]
note_alteration_to_pc_err :: (Note, Alteration) -> Int
note_alteration_to_pc_err :: (Note, Alteration) -> Int
note_alteration_to_pc_err = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"note_alteration_to_pc") forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Note, Alteration) -> Maybe Int
note_alteration_to_pc

-- | Note & alteration sequence in key-signature spelling.
note_alteration_ks :: [(Note, Alteration)]
note_alteration_ks :: [(Note, Alteration)]
note_alteration_ks =
    [(Note
C,Alteration
Natural),(Note
C,Alteration
Sharp),(Note
D,Alteration
Natural),(Note
E,Alteration
Flat),(Note
E,Alteration
Natural),(Note
F,Alteration
Natural)
    ,(Note
F,Alteration
Sharp),(Note
G,Alteration
Natural),(Note
A,Alteration
Flat),(Note
A,Alteration
Natural),(Note
B,Alteration
Flat),(Note
B,Alteration
Natural)]

-- | Table connecting pitch class number with 'note_alteration_ks'.
pc_note_alteration_ks_tbl :: Integral i => [((Note,Alteration),i)]
pc_note_alteration_ks_tbl :: forall i. Integral i => [((Note, Alteration), i)]
pc_note_alteration_ks_tbl = forall a b. [a] -> [b] -> [(a, b)]
zip [(Note, Alteration)]
note_alteration_ks [i
0..i
11]

-- | 'T.reverse_lookup' of 'pc_note_alteration_ks_tbl'.
pc_to_note_alteration_ks :: Integral i => i -> Maybe (Note,Alteration)
pc_to_note_alteration_ks :: forall i. Integral i => i -> Maybe (Note, Alteration)
pc_to_note_alteration_ks i
i = forall v k. Eq v => v -> [(k, v)] -> Maybe k
T.reverse_lookup i
i forall i. Integral i => [((Note, Alteration), i)]
pc_note_alteration_ks_tbl

-- * Rational Alteration

-- | Alteration given as a rational semitone difference
-- and a string representation of the alteration.
type Alteration_R = (Rational,String)

-- | Transform 'Alteration' to 'Alteration_R'.
--
-- > let r = [(-1,"♭"),(0,"♮"),(1,"♯")]
-- > map alteration_r [Flat,Natural,Sharp] == r
alteration_r :: Alteration -> Alteration_R
alteration_r :: Alteration -> Alteration_R
alteration_r Alteration
a = (forall n. Fractional n => Alteration -> n
alteration_to_fdiff Alteration
a,[Alteration -> Char
alteration_symbol Alteration
a])

-- * Parsers

-- | Parser for ISO note name, upper case.
--
-- > map (T.run_parser_error p_note_t . return) "ABCDEFG"
p_note_t :: T.P Note
p_note_t :: P Note
p_note_t = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Char -> Note
char_to_note_t Bool
False) (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"ABCDEFG")

-- | Note name in lower case (not ISO)
p_note_t_lc :: T.P Note
p_note_t_lc :: P Note
p_note_t_lc = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Char -> Note
char_to_note_t Bool
True) (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"abcdefg")

-- | Case-insensitive note name (not ISO).
p_note_t_ci :: T.P Note
p_note_t_ci :: P Note
p_note_t_ci = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Char -> Note
char_to_note_t Bool
True) (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"abcdefgABCDEFG")

-- | Parser for ISO alteration name.
--
-- > map (T.run_parser_error p_alteration_t_iso) (words "bb b # x ##")
p_alteration_t_iso :: Bool -> T.P Alteration
p_alteration_t_iso :: Bool -> P Alteration
p_alteration_t_iso Bool
strict = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> String -> Alteration
symbol_to_alteration_iso_err Bool
strict) (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"b#x"))

-- > map (T.run_parser_error p_alteration_t_tonh) ["eses","es","is","isis"]
p_alteration_t_tonh :: T.P Alteration
p_alteration_t_tonh :: P Alteration
p_alteration_t_tonh = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Alteration
tonh_to_alteration_err (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"ehis"))

-- > map (T.run_parser_error p_note_alteration_ly) ["c","ees","fis","aeses"]
p_note_alteration_ly :: T.P (Note,Maybe Alteration)
p_note_alteration_ly :: P (Note, Maybe Alteration)
p_note_alteration_ly = do
  Note
n <- P Note
p_note_t_lc
  Maybe Alteration
a <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe P Alteration
p_alteration_t_tonh
  forall (m :: * -> *) a. Monad m => a -> m a
return (Note
n,Maybe Alteration
a)