-- | Simple table based spelling rules for common music notation.
module Music.Theory.Pitch.Spelling.Table where

import Data.Maybe {- base -}

import qualified Music.Theory.Pitch as T {- hmt -}
import Music.Theory.Pitch.Note {- hmt -}

type Spelling_Table i = [(i,(Note,Alteration))]

-- | Spelling table for natural (♮) notes only.
pc_spell_natural_tbl :: Integral i => Spelling_Table i
pc_spell_natural_tbl :: forall i. Integral i => Spelling_Table i
pc_spell_natural_tbl =
    [(i
0,(Note
C,Alteration
Natural))
    ,(i
2,(Note
D,Alteration
Natural))
    ,(i
4,(Note
E,Alteration
Natural))
    ,(i
5,(Note
F,Alteration
Natural))
    ,(i
7,(Note
G,Alteration
Natural))
    ,(i
9,(Note
A,Alteration
Natural))
    ,(i
11,(Note
B,Alteration
Natural))]

-- | Spelling table for sharp (♯) notes only.
pc_spell_sharp_tbl :: Integral i => Spelling_Table i
pc_spell_sharp_tbl :: forall i. Integral i => Spelling_Table i
pc_spell_sharp_tbl =
    [(i
1,(Note
C,Alteration
Sharp))
    ,(i
3,(Note
D,Alteration
Sharp))
    ,(i
6,(Note
F,Alteration
Sharp))
    ,(i
8,(Note
G,Alteration
Sharp))
    ,(i
10,(Note
A,Alteration
Sharp))]

-- | Spelling table for flat (♭) notes only.
pc_spell_flat_tbl :: Integral i => Spelling_Table i
pc_spell_flat_tbl :: forall i. Integral i => Spelling_Table i
pc_spell_flat_tbl =
    [(i
1,(Note
D,Alteration
Flat))
    ,(i
3,(Note
E,Alteration
Flat))
    ,(i
6,(Note
G,Alteration
Flat))
    ,(i
8,(Note
A,Alteration
Flat))
    ,(i
10,(Note
B,Alteration
Flat))]

-- | Spelling table from simplest key-signature.  Note that this is
-- ambiguous for @8@, which could be either G Sharp (♯) in /A Major/
-- or A Flat (♭) in /E Flat (♭) Major/.
pc_spell_ks_tbl :: Integral i => Spelling_Table i
pc_spell_ks_tbl :: forall i. Integral i => Spelling_Table i
pc_spell_ks_tbl =
      [(i
1,(Note
C,Alteration
Sharp)) -- 2♯
      ,(i
3,(Note
E,Alteration
Flat)) -- 3♭
      ,(i
6,(Note
F,Alteration
Sharp)) -- 1♯
      ,(i
8,(Note
A,Alteration
Flat)) -- 3♭/3♯
      ,(i
10,(Note
B,Alteration
Flat))] -- 1♭

pc_spell_tbl :: Integral i => Spelling_Table i -> T.Spelling i
pc_spell_tbl :: forall i. Integral i => Spelling_Table i -> Spelling i
pc_spell_tbl Spelling_Table i
tbl = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"pc_spell_tbl") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Spelling_Table i
tbl

-- | Spell using indicated table prepended to and 'pc_spell_natural_tbl' and 'pc_spell_ks_tbl'
pc_spell_tbl_ks :: Integral i => Spelling_Table i -> T.Spelling i
pc_spell_tbl_ks :: forall i. Integral i => Spelling_Table i -> Spelling i
pc_spell_tbl_ks Spelling_Table i
tbl = forall i. Integral i => Spelling_Table i -> Spelling i
pc_spell_tbl (Spelling_Table i
tbl forall a. [a] -> [a] -> [a]
++ forall i. Integral i => Spelling_Table i
pc_spell_natural_tbl forall a. [a] -> [a] -> [a]
++ forall i. Integral i => Spelling_Table i
pc_spell_ks_tbl)

-- | Spelling for natural (♮) notes only.
--
-- > map pc_spell_natural_m [0,1] == [Just (C,Natural),Nothing]
pc_spell_natural_m :: Integral i => T.Spelling_M i
pc_spell_natural_m :: forall i. Integral i => Spelling_M i
pc_spell_natural_m = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup forall i. Integral i => Spelling_Table i
pc_spell_natural_tbl

-- | Erroring variant of 'pc_spell_natural_m'.
--
-- > map pc_spell_natural [0,5,7] == [(C,Natural),(F,Natural),(G,Natural)]
pc_spell_natural :: Integral i => T.Spelling i
pc_spell_natural :: forall i. Integral i => Spelling i
pc_spell_natural = forall i. Integral i => Spelling_Table i -> Spelling i
pc_spell_tbl forall i. Integral i => Spelling_Table i
pc_spell_natural_tbl

-- | Lookup 'pc_spell_ks_tbl'.
--
-- > map pc_spell_ks [6,8] == [(F,Sharp),(A,Flat)]
pc_spell_ks :: Integral i => T.Spelling i
pc_spell_ks :: forall i. Integral i => Spelling i
pc_spell_ks = forall i. Integral i => Spelling_Table i -> Spelling i
pc_spell_tbl_ks []

-- | Use always sharp (♯) spelling.
--
-- > map pc_spell_sharp [6,8] == [(F,Sharp),(G,Sharp)]
-- > Data.List.nub (map (snd . pc_spell_sharp) [1,3,6,8,10]) == [Sharp]
pc_spell_sharp :: Integral i => T.Spelling i
pc_spell_sharp :: forall i. Integral i => Spelling i
pc_spell_sharp = forall i. Integral i => Spelling_Table i -> Spelling i
pc_spell_tbl (forall i. Integral i => Spelling_Table i
pc_spell_sharp_tbl forall a. [a] -> [a] -> [a]
++ forall i. Integral i => Spelling_Table i
pc_spell_natural_tbl)

-- | Use always flat (♭) spelling.
--
-- >  map pc_spell_flat [6,8] == [(G,Flat),(A,Flat)]
-- >  Data.List.nub (map (snd . pc_spell_flat) [1,3,6,8,10]) == [Flat]
pc_spell_flat :: Integral i => T.Spelling i
pc_spell_flat :: forall i. Integral i => Spelling i
pc_spell_flat = forall i. Integral i => Spelling_Table i -> Spelling i
pc_spell_tbl (forall i. Integral i => Spelling_Table i
pc_spell_flat_tbl forall a. [a] -> [a] -> [a]
++ forall i. Integral i => Spelling_Table i
pc_spell_natural_tbl)

octpc_to_pitch_ks :: Integral i => T.Octave_PitchClass i -> T.Pitch
octpc_to_pitch_ks :: forall i. Integral i => Octave_PitchClass i -> Pitch
octpc_to_pitch_ks = forall i. Integral i => Spelling i -> Octave_PitchClass i -> Pitch
T.octpc_to_pitch forall i. Integral i => Spelling i
pc_spell_ks

-- | 'T.midi_to_pitch' 'pc_spell_ks'.
midi_to_pitch_ks :: Integral i => i -> T.Pitch
midi_to_pitch_ks :: forall i. Integral i => i -> Pitch
midi_to_pitch_ks = forall i k. (Integral i, Integral k) => Spelling k -> i -> Pitch
T.midi_to_pitch (forall i. Integral i => Spelling i
pc_spell_ks :: T.Spelling Int)

fmidi_to_pitch_ks :: (Show n,RealFrac n) => n -> T.Pitch
fmidi_to_pitch_ks :: forall n. (Show n, RealFrac n) => n -> Pitch
fmidi_to_pitch_ks = forall n. (Show n, RealFrac n) => Spelling Int -> n -> Pitch
T.fmidi_to_pitch_err forall i. Integral i => Spelling i
pc_spell_ks

midi_detune_to_pitch_ks :: (Integral m,Real c) => (m,c) -> T.Pitch
midi_detune_to_pitch_ks :: forall m c. (Integral m, Real c) => (m, c) -> Pitch
midi_detune_to_pitch_ks = forall m c. (Integral m, Real c) => Spelling Int -> (m, c) -> Pitch
T.midi_detune_to_pitch forall i. Integral i => Spelling i
pc_spell_ks

-- | 'T.midi_to_pitch' 'pc_spell_sharp'
midi_to_pitch_sharp :: Integral i => i -> T.Pitch
midi_to_pitch_sharp :: forall i. Integral i => i -> Pitch
midi_to_pitch_sharp = forall i k. (Integral i, Integral k) => Spelling k -> i -> Pitch
T.midi_to_pitch (forall i. Integral i => Spelling i
pc_spell_sharp :: T.Spelling Int)