module Music.Theory.Instrument.Choir where

import Data.List.Split {- split -}

import qualified Music.Theory.Clef as T {- hmt -}
import qualified Music.Theory.List as T {- hmt -}
import qualified Music.Theory.Pitch as T {- hmt -}
import qualified Music.Theory.Pitch.Name as T {- hmt -}

-- | Voice types.
data Voice = Bass | Tenor | Alto | Soprano
           deriving (Voice -> Voice -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Voice -> Voice -> Bool
$c/= :: Voice -> Voice -> Bool
== :: Voice -> Voice -> Bool
$c== :: Voice -> Voice -> Bool
Eq,Eq Voice
Voice -> Voice -> Bool
Voice -> Voice -> Ordering
Voice -> Voice -> Voice
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 :: Voice -> Voice -> Voice
$cmin :: Voice -> Voice -> Voice
max :: Voice -> Voice -> Voice
$cmax :: Voice -> Voice -> Voice
>= :: Voice -> Voice -> Bool
$c>= :: Voice -> Voice -> Bool
> :: Voice -> Voice -> Bool
$c> :: Voice -> Voice -> Bool
<= :: Voice -> Voice -> Bool
$c<= :: Voice -> Voice -> Bool
< :: Voice -> Voice -> Bool
$c< :: Voice -> Voice -> Bool
compare :: Voice -> Voice -> Ordering
$ccompare :: Voice -> Voice -> Ordering
Ord,Int -> Voice
Voice -> Int
Voice -> [Voice]
Voice -> Voice
Voice -> Voice -> [Voice]
Voice -> Voice -> Voice -> [Voice]
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 :: Voice -> Voice -> Voice -> [Voice]
$cenumFromThenTo :: Voice -> Voice -> Voice -> [Voice]
enumFromTo :: Voice -> Voice -> [Voice]
$cenumFromTo :: Voice -> Voice -> [Voice]
enumFromThen :: Voice -> Voice -> [Voice]
$cenumFromThen :: Voice -> Voice -> [Voice]
enumFrom :: Voice -> [Voice]
$cenumFrom :: Voice -> [Voice]
fromEnum :: Voice -> Int
$cfromEnum :: Voice -> Int
toEnum :: Int -> Voice
$ctoEnum :: Int -> Voice
pred :: Voice -> Voice
$cpred :: Voice -> Voice
succ :: Voice -> Voice
$csucc :: Voice -> Voice
Enum,Voice
forall a. a -> a -> Bounded a
maxBound :: Voice
$cmaxBound :: Voice
minBound :: Voice
$cminBound :: Voice
Bounded,Int -> Voice -> ShowS
[Voice] -> ShowS
Voice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Voice] -> ShowS
$cshowList :: [Voice] -> ShowS
show :: Voice -> String
$cshow :: Voice -> String
showsPrec :: Int -> Voice -> ShowS
$cshowsPrec :: Int -> Voice -> ShowS
Show)

-- | Single character abbreviation for 'Voice'.
voice_abbrev :: Voice -> Char
voice_abbrev :: Voice -> Char
voice_abbrev = forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

-- | Standard 'Clef' for 'Voice'.
voice_clef :: Integral i => Voice -> T.Clef i
voice_clef :: forall i. Integral i => Voice -> Clef i
voice_clef Voice
v =
    case Voice
v of
      Voice
Bass -> forall i. Clef_Type -> i -> Clef i
T.Clef Clef_Type
T.Bass i
0
      Voice
Tenor -> forall i. Clef_Type -> i -> Clef i
T.Clef Clef_Type
T.Treble (-i
1)
      Voice
Alto -> forall i. Clef_Type -> i -> Clef i
T.Clef Clef_Type
T.Treble i
0
      Voice
Soprano -> forall i. Clef_Type -> i -> Clef i
T.Clef Clef_Type
T.Treble i
0

-- | Table giving ranges for 'Voice's.
type Voice_Rng_Tbl = [(Voice,(T.Pitch,T.Pitch))]

-- | More or less standard choir ranges, /inclusive/.
voice_rng_tbl_std :: Voice_Rng_Tbl
voice_rng_tbl_std :: Voice_Rng_Tbl
voice_rng_tbl_std =
    [(Voice
Bass,(Pitch
T.d2,Pitch
T.c4))
    ,(Voice
Tenor,(Pitch
T.c3,Pitch
T.a4))
    ,(Voice
Alto,(Pitch
T.f3,Pitch
T.f5))
    ,(Voice
Soprano,(Pitch
T.c4,Pitch
T.a5))]

-- | More conservative ranges, /inclusive/.
voice_rng_tbl_safe :: Voice_Rng_Tbl
voice_rng_tbl_safe :: Voice_Rng_Tbl
voice_rng_tbl_safe =
    [(Voice
Bass,(Pitch
T.g2,Pitch
T.c4))
    ,(Voice
Tenor,(Pitch
T.c3,Pitch
T.f4))
    ,(Voice
Alto,(Pitch
T.g3,Pitch
T.c5))
    ,(Voice
Soprano,(Pitch
T.c4,Pitch
T.f5))]

-- | Lookup voice range table.
voice_rng :: Voice_Rng_Tbl -> Voice -> (T.Pitch,T.Pitch)
voice_rng :: Voice_Rng_Tbl -> Voice -> (Pitch, Pitch)
voice_rng Voice_Rng_Tbl
tbl Voice
v = forall k v. Eq k => k -> [(k, v)] -> v
T.lookup_err Voice
v Voice_Rng_Tbl
tbl

-- | Lookup 'voice_rng_tbl_std'.
voice_rng_std :: Voice -> (T.Pitch,T.Pitch)
voice_rng_std :: Voice -> (Pitch, Pitch)
voice_rng_std = Voice_Rng_Tbl -> Voice -> (Pitch, Pitch)
voice_rng Voice_Rng_Tbl
voice_rng_tbl_std

-- | Lookup 'voice_rng_tbl_safe'.
voice_rng_safe :: Voice -> (T.Pitch,T.Pitch)
voice_rng_safe :: Voice -> (Pitch, Pitch)
voice_rng_safe = Voice_Rng_Tbl -> Voice -> (Pitch, Pitch)
voice_rng Voice_Rng_Tbl
voice_rng_tbl_safe

-- | Is /p/ '>=' /l/ and '<=' /r/.
in_range_inclusive :: Ord a => a -> (a,a) -> Bool
in_range_inclusive :: forall a. Ord a => a -> (a, a) -> Bool
in_range_inclusive a
p (a
l,a
r) = a
p forall a. Ord a => a -> a -> Bool
>= a
l Bool -> Bool -> Bool
&& a
p forall a. Ord a => a -> a -> Bool
<= a
r

-- | Is /p/ in range for /v/, (/std/ & /safe/).
--
-- > map (in_voice_rng T.c4) [Bass .. Soprano]
in_voice_rng :: T.Pitch -> Voice -> (Bool,Bool)
in_voice_rng :: Pitch -> Voice -> (Bool, Bool)
in_voice_rng Pitch
p Voice
v =
    (forall a. Ord a => a -> (a, a) -> Bool
in_range_inclusive Pitch
p (Voice -> (Pitch, Pitch)
voice_rng_std Voice
v)
    ,forall a. Ord a => a -> (a, a) -> Bool
in_range_inclusive Pitch
p (Voice -> (Pitch, Pitch)
voice_rng_safe Voice
v))

-- | Given /tbl/ list 'Voice's that can sing 'T.Pitch'.
possible_voices :: Voice_Rng_Tbl -> T.Pitch -> [Voice]
possible_voices :: Voice_Rng_Tbl -> Pitch -> [Voice]
possible_voices Voice_Rng_Tbl
tbl Pitch
p =
    let f :: Voice -> Bool
f = forall a. Ord a => a -> (a, a) -> Bool
in_range_inclusive Pitch
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. Voice_Rng_Tbl -> Voice -> (Pitch, Pitch)
voice_rng Voice_Rng_Tbl
tbl
    in forall a. (a -> Bool) -> [a] -> [a]
filter Voice -> Bool
f [Voice
Bass .. Voice
Soprano]

-- | /std/ variant.
possible_voices_std :: T.Pitch -> [Voice]
possible_voices_std :: Pitch -> [Voice]
possible_voices_std = Voice_Rng_Tbl -> Pitch -> [Voice]
possible_voices Voice_Rng_Tbl
voice_rng_tbl_std

-- | /safe/ variant.
possible_voices_safe :: T.Pitch -> [Voice]
possible_voices_safe :: Pitch -> [Voice]
possible_voices_safe = Voice_Rng_Tbl -> Pitch -> [Voice]
possible_voices Voice_Rng_Tbl
voice_rng_tbl_safe

-- | Enumeration of SATB voices.
satb :: [Voice]
satb :: [Voice]
satb = [Voice
Soprano,Voice
Alto,Voice
Tenor,Voice
Bass]

-- | Names of 'satb'.
satb_name :: [String]
satb_name :: [String]
satb_name = forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Voice]
satb

-- | 'voice_abbrev' of 'satb' as 'String's.
satb_abbrev :: [String]
satb_abbrev :: [String]
satb_abbrev = forall a b. (a -> b) -> [a] -> [b]
map (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Voice -> Char
voice_abbrev) [Voice]
satb

-- | Voice & part number.
type Part = (Voice,Int)

-- | /k/ part choir, ordered by voice.
ch_satb_seq :: Int -> [Part]
ch_satb_seq :: Int -> [Part]
ch_satb_seq Int
k = [(Voice
vc,Int
n) | Voice
vc <- [Voice]
satb, Int
n <- [Int
1..Int
k]]

-- | 'ch_satb_seq' grouped in parts.
--
-- > map (map part_nm) (ch_parts 8)
ch_parts :: Int -> [[Part]]
ch_parts :: Int -> [[Part]]
ch_parts Int
k = forall e. Int -> [e] -> [[e]]
chunksOf Int
k (Int -> [Part]
ch_satb_seq Int
k)

-- | Abreviated name for part.
--
-- > part_nm (Soprano,1) == "S1"
part_nm :: Part -> String
part_nm :: Part -> String
part_nm (Voice
v,Int
n) = Voice -> Char
voice_abbrev Voice
v forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Int
n

-- | /k/ SATB choirs, grouped by choir.
--
-- > k_ch_groups 2
k_ch_groups :: Int -> [[Part]]
k_ch_groups :: Int -> [[Part]]
k_ch_groups Int
k =
    let f :: b -> [(Voice, b)]
f b
n = forall a b. (a -> b) -> [a] -> [b]
map (\Voice
p -> (Voice
p,b
n)) [Voice]
satb
    in forall a b. (a -> b) -> [a] -> [b]
map forall {b}. b -> [(Voice, b)]
f [Int
1 .. Int
k]

-- | 'concat' of 'k_ch_groups'.
k_ch_groups' :: Int -> [Part]
k_ch_groups' :: Int -> [Part]
k_ch_groups' = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Part]]
k_ch_groups

-- | Two /k/ part SATB choirs in score order.
--
-- > map part_nm (concat (dbl_ch_parts 8))
dbl_ch_parts :: Int -> [[Part]]
dbl_ch_parts :: Int -> [[Part]]
dbl_ch_parts Int
k =
    let v :: [Voice]
v = [Voice]
satb
        f :: a -> [b] -> [(a, b)]
f a
p = forall a b. (a -> b) -> [a] -> [b]
map (\b
n -> (a
p,b
n))
        g :: [b] -> [[(Voice, b)]]
g = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a} {b}. a -> [b] -> [(a, b)]
f [Voice]
v forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> [a]
replicate Int
4
    in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {b}. [b] -> [[(Voice, b)]]
g (forall e. Int -> [e] -> [[e]]
chunksOf (Int
k forall a. Integral a => a -> a -> a
`div` Int
2) [Int
1 .. Int
k])

-- | 'voice_clef' for 'Part's.
mk_clef_seq :: [Part] -> [T.Clef Int]
mk_clef_seq :: [Part] -> [Clef Int]
mk_clef_seq = forall a b. (a -> b) -> [a] -> [b]
map (forall i. Integral i => Voice -> Clef i
voice_clef forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)