-- | Spelling rules for 'Interval' values.
module Music.Theory.Interval.Spelling where

import Music.Theory.Interval

-- | Simplest spelling for semitone intervals.  This is ambiguous for
-- @6@ which could be either /aug.4/ or /dim.5/.
--
-- > i_to_interval 6 == Interval Fourth Augmented LT 0
-- > map i_to_interval [0..11]
i_to_interval :: Int -> Interval
i_to_interval :: Int -> Interval
i_to_interval Int
x =
    let iv :: Interval_Type -> Interval_Quality -> Interval
iv Interval_Type
ty Interval_Quality
qu = Interval_Type -> Interval_Quality -> Ordering -> Int -> Interval
Interval Interval_Type
ty Interval_Quality
qu Ordering
LT Int
0
    in case Int
x of
         Int
0 -> Interval_Type -> Interval_Quality -> Interval
iv Interval_Type
Unison Interval_Quality
Perfect
         Int
1 -> Interval_Type -> Interval_Quality -> Interval
iv Interval_Type
Second Interval_Quality
Minor
         Int
2 -> Interval_Type -> Interval_Quality -> Interval
iv Interval_Type
Second Interval_Quality
Major
         Int
3 -> Interval_Type -> Interval_Quality -> Interval
iv Interval_Type
Third Interval_Quality
Minor
         Int
4 -> Interval_Type -> Interval_Quality -> Interval
iv Interval_Type
Third Interval_Quality
Major
         Int
5 -> Interval_Type -> Interval_Quality -> Interval
iv Interval_Type
Fourth Interval_Quality
Perfect
         Int
6 -> Interval_Type -> Interval_Quality -> Interval
iv Interval_Type
Fourth Interval_Quality
Augmented -- Fifth Diminished
         Int
7 -> Interval_Type -> Interval_Quality -> Interval
iv Interval_Type
Fifth Interval_Quality
Perfect
         Int
8 -> Interval_Type -> Interval_Quality -> Interval
iv Interval_Type
Sixth Interval_Quality
Minor
         Int
9 -> Interval_Type -> Interval_Quality -> Interval
iv Interval_Type
Sixth Interval_Quality
Major
         Int
10 -> Interval_Type -> Interval_Quality -> Interval
iv Interval_Type
Seventh Interval_Quality
Minor
         Int
11 -> Interval_Type -> Interval_Quality -> Interval
iv Interval_Type
Seventh Interval_Quality
Major
         Int
_ -> forall a. HasCallStack => [Char] -> a
error ([Char]
"i_to_interval: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
x)

-- | Perform some interval simplifications.  For non-tonal music some
-- spellings are poor, ie. (f,g#).
--
-- > interval_simplify (Interval Second Augmented LT 0) == Interval Third Minor LT 0
-- > interval_simplify (Interval Seventh Augmented GT 0) == Interval Unison Perfect GT 1
interval_simplify :: Interval -> Interval
interval_simplify :: Interval -> Interval
interval_simplify Interval
x =
    let (Interval Interval_Type
ty Interval_Quality
qu Ordering
d Int
o) = Interval
x
        (Interval_Quality
qu',Interval_Type
ty',Int
o') = case (Interval_Quality
qu,Interval_Type
ty) of
                         (Interval_Quality
Diminished,Interval_Type
Second) -> (Interval_Quality
Perfect,Interval_Type
Unison,Int
o)
                         (Interval_Quality
Diminished,Interval_Type
Third) -> (Interval_Quality
Major,Interval_Type
Second,Int
o)
                         (Interval_Quality
Augmented,Interval_Type
Second) -> (Interval_Quality
Minor,Interval_Type
Third,Int
o)
                         (Interval_Quality
Augmented,Interval_Type
Third) -> (Interval_Quality
Perfect,Interval_Type
Fourth,Int
o)
                         (Interval_Quality
Diminished,Interval_Type
Sixth) -> (Interval_Quality
Perfect,Interval_Type
Fifth,Int
o)
                         (Interval_Quality
Diminished,Interval_Type
Seventh) -> (Interval_Quality
Major,Interval_Type
Sixth,Int
o)
                         (Interval_Quality
Augmented,Interval_Type
Sixth) -> (Interval_Quality
Minor,Interval_Type
Seventh,Int
o)
                         (Interval_Quality
Augmented,Interval_Type
Seventh) -> (Interval_Quality
Perfect,Interval_Type
Unison,Int
o forall a. Num a => a -> a -> a
+ Int
1)
                         (Interval_Quality, Interval_Type)
_ -> (Interval_Quality
qu,Interval_Type
ty,Int
o)
    in Interval_Type -> Interval_Quality -> Ordering -> Int -> Interval
Interval Interval_Type
ty' Interval_Quality
qu' Ordering
d Int
o'