-- | Common music notation duration model.
module Music.Theory.Duration where

import Data.List {- base -}
import Data.Maybe {- base -}
import Data.Ratio {- base -}

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

type Division = Integer
type Dots = Int

-- | Common music notation durational model
data Duration =
  Duration
  {Duration -> Division
division :: Division -- ^ division of whole note
  ,Duration -> Int
dots :: Int -- ^ number of dots
  ,Duration -> Rational
multiplier :: Rational} -- ^ tuplet modifier
  deriving (Duration -> Duration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Duration -> Duration -> Bool
$c/= :: Duration -> Duration -> Bool
== :: Duration -> Duration -> Bool
$c== :: Duration -> Duration -> Bool
Eq,Int -> Duration -> ShowS
[Duration] -> ShowS
Duration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Duration] -> ShowS
$cshowList :: [Duration] -> ShowS
show :: Duration -> String
$cshow :: Duration -> String
showsPrec :: Int -> Duration -> ShowS
$cshowsPrec :: Int -> Duration -> ShowS
Show)

-- | Are multipliers equal?
duration_meq :: Duration -> Duration -> Bool
duration_meq :: Duration -> Duration -> Bool
duration_meq Duration
p Duration
q = Duration -> Rational
multiplier Duration
p forall a. Eq a => a -> a -> Bool
== Duration -> Rational
multiplier Duration
q

-- | Is multiplier the identity (ie. @1@)?
duration_m1 :: Duration -> Bool
duration_m1 :: Duration -> Bool
duration_m1 = (forall a. Eq a => a -> a -> Bool
== Rational
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duration -> Rational
multiplier

-- | Compare durations with equal multipliers.
duration_compare_meq :: Duration -> Duration -> Maybe Ordering
duration_compare_meq :: Duration -> Duration -> Maybe Ordering
duration_compare_meq Duration
y0 Duration
y1 =
    let (Duration Division
x0 Int
n0 Rational
m0) = Duration
y0
        (Duration Division
x1 Int
n1 Rational
m1) = Duration
y1
    in if Duration
y0 forall a. Eq a => a -> a -> Bool
== Duration
y1
       then forall a. a -> Maybe a
Just Ordering
EQ
       else if Rational
m0 forall a. Eq a => a -> a -> Bool
/= Rational
m1
            then forall a. Maybe a
Nothing
            else forall a. a -> Maybe a
Just (if Division
x0 forall a. Eq a => a -> a -> Bool
== Division
x1
                       then forall a. Ord a => a -> a -> Ordering
compare Int
n0 Int
n1
                       else forall a. Ord a => a -> a -> Ordering
compare Division
x1 Division
x0)

-- | Erroring variant of 'duration_compare_meq'.
duration_compare_meq_err :: Duration -> Duration -> Ordering
duration_compare_meq_err :: Duration -> Duration -> Ordering
duration_compare_meq_err Duration
p =
    let err :: a
err = forall a. HasCallStack => String -> a
error String
"duration_compare_meq_err: non-equal multipliers"
    in forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duration -> Duration -> Maybe Ordering
duration_compare_meq Duration
p

-- | 'Ord' instance in terms of 'duration_compare_meq_err'.
instance Ord Duration where
    compare :: Duration -> Duration -> Ordering
compare = Duration -> Duration -> Ordering
duration_compare_meq_err

-- | True if neither duration is dotted.
no_dots :: (Duration, Duration) -> Bool
no_dots :: (Duration, Duration) -> Bool
no_dots (Duration
x0,Duration
x1) = Duration -> Int
dots Duration
x0 forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Duration -> Int
dots Duration
x1 forall a. Eq a => a -> a -> Bool
== Int
0

-- | Sum undotted divisions, input is required to be sorted.
sum_dur_undotted :: Rational -> (Division, Division) -> Maybe Duration
sum_dur_undotted :: Rational -> (Division, Division) -> Maybe Duration
sum_dur_undotted Rational
m (Division
x0, Division
x1)
    | Division
x0 forall a. Eq a => a -> a -> Bool
== Division
x1 = forall a. a -> Maybe a
Just (Division -> Int -> Rational -> Duration
Duration (Division
x0 forall a. Integral a => a -> a -> a
`div` Division
2) Int
0 Rational
m)
    | Division
x0 forall a. Eq a => a -> a -> Bool
== Division
x1 forall a. Num a => a -> a -> a
* Division
2 = forall a. a -> Maybe a
Just (Division -> Int -> Rational -> Duration
Duration Division
x1 Int
1 Rational
m)
    | Bool
otherwise = forall a. Maybe a
Nothing

{- | Sum dotted divisions, input is required to be sorted.

> sum_dur_dotted 1 (4,1,4,1) == Just (Duration 2 1 1)
> sum_dur_dotted 1 (4,0,2,1) == Just (Duration 1 0 1)
> sum_dur_dotted 1 (8,1,4,0) == Just (Duration 4 2 1)
> sum_dur_dotted 1 (16,0,4,2) == Just (Duration 2 0 1)
-}
sum_dur_dotted :: Rational -> (Division,Dots,Division,Dots) -> Maybe Duration
sum_dur_dotted :: Rational -> (Division, Int, Division, Int) -> Maybe Duration
sum_dur_dotted Rational
m (Division
x0, Int
n0, Division
x1, Int
n1)
    | Division
x0 forall a. Eq a => a -> a -> Bool
== Division
x1 Bool -> Bool -> Bool
&&
      Int
n0 forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&&
      Int
n1 forall a. Eq a => a -> a -> Bool
== Int
1 = forall a. a -> Maybe a
Just (Division -> Int -> Rational -> Duration
Duration (Division
x1 forall a. Integral a => a -> a -> a
`div` Division
2) Int
1 Rational
m)
    | Division
x0 forall a. Eq a => a -> a -> Bool
== Division
x1 forall a. Num a => a -> a -> a
* Division
2 Bool -> Bool -> Bool
&&
      Int
n0 forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&&
      Int
n1 forall a. Eq a => a -> a -> Bool
== Int
1 = forall a. a -> Maybe a
Just (Division -> Int -> Rational -> Duration
Duration (Division
x1 forall a. Integral a => a -> a -> a
`div` Division
2) Int
0 Rational
m)
    | Division
x0 forall a. Eq a => a -> a -> Bool
== Division
x1 forall a. Num a => a -> a -> a
* Division
4 Bool -> Bool -> Bool
&&
      Int
n0 forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&&
      Int
n1 forall a. Eq a => a -> a -> Bool
== Int
2 = forall a. a -> Maybe a
Just (Division -> Int -> Rational -> Duration
Duration (Division
x1 forall a. Integral a => a -> a -> a
`div` Division
2) Int
0 Rational
m)
    | Division
x0 forall a. Eq a => a -> a -> Bool
== Division
x1 forall a. Num a => a -> a -> a
* Division
2 Bool -> Bool -> Bool
&&
      Int
n0 forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&&
      Int
n1 forall a. Eq a => a -> a -> Bool
== Int
0 = forall a. a -> Maybe a
Just (Division -> Int -> Rational -> Duration
Duration Division
x1 Int
2 Rational
m)
    | Bool
otherwise = forall a. Maybe a
Nothing

{- | Sum durations.  Not all durations can be summed, and the present
     algorithm is not exhaustive.

> import Music.Theory.Duration
> import Music.Theory.Duration.Name
> sum_dur quarter_note eighth_note == Just dotted_quarter_note
> sum_dur dotted_quarter_note eighth_note == Just half_note
> sum_dur quarter_note dotted_eighth_note == Just double_dotted_quarter_note
-}
sum_dur :: Duration -> Duration -> Maybe Duration
sum_dur :: Duration -> Duration -> Maybe Duration
sum_dur Duration
y0 Duration
y1 =
    let (Rational
m0,Rational
m1) = (Duration -> Rational
multiplier Duration
y0,Duration -> Rational
multiplier Duration
y1)
        f :: (Duration, Duration) -> Maybe Duration
f (Duration
x0,Duration
x1) = if Rational
m0 forall a. Eq a => a -> a -> Bool
/= Rational
m1
                    then forall a. Maybe a
Nothing -- cannot sum durations with non-equal multipliers
                    else if (Duration, Duration) -> Bool
no_dots (Duration
x0,Duration
x1)
                         then Rational -> (Division, Division) -> Maybe Duration
sum_dur_undotted Rational
m0 (Duration -> Division
division Duration
x0, Duration -> Division
division Duration
x1)
                         else Rational -> (Division, Int, Division, Int) -> Maybe Duration
sum_dur_dotted Rational
m0 (Duration -> Division
division Duration
x0, Duration -> Int
dots Duration
x0
                                                ,Duration -> Division
division Duration
x1, Duration -> Int
dots Duration
x1)
    in forall t. (t -> t -> Maybe Ordering) -> (t, t) -> Maybe (t, t)
T.sort_pair_m Duration -> Duration -> Maybe Ordering
duration_compare_meq (Duration
y0,Duration
y1) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Duration, Duration) -> Maybe Duration
f

-- | Erroring variant of 'sum_dur'.
sum_dur_err :: Duration -> Duration -> Duration
sum_dur_err :: Duration -> Duration -> Duration
sum_dur_err Duration
y0 Duration
y1 =
    let y2 :: Maybe Duration
y2 = Duration -> Duration -> Maybe Duration
sum_dur Duration
y0 Duration
y1
        err :: a
err = forall a. HasCallStack => String -> a
error (String
"sum_dur': " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Duration
y0,Duration
y1))
    in forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err Maybe Duration
y2

{- | Standard divisions (from 1 to 256).
MusicXml allows 0 for breve and -1 for long.
Negative divisors can represent any number of longer durations, -2 be a breve, -4 a long, -8 a maximus, &etc.
-}
divisions_std_set :: [Division]
divisions_std_set :: [Division]
divisions_std_set = [Division
1,Division
2,Division
4,Division
8,Division
16,Division
32,Division
64,Division
128,Division
256]

divisions_musicxml_set :: [Division]
divisions_musicxml_set :: [Division]
divisions_musicxml_set = -Division
1 forall a. a -> [a] -> [a]
: Division
0 forall a. a -> [a] -> [a]
: [Division]
divisions_std_set

-- | Durations set derived from 'divisions_std_set' with up to /k/ dots.  Multiplier of @1@.
duration_set :: Dots -> [Duration]
duration_set :: Int -> [Duration]
duration_set Int
k = [Division -> Int -> Rational -> Duration
Duration Division
dv Int
dt Rational
1 | Division
dv <- [Division]
divisions_std_set, Int
dt <- [Int
0..Int
k]]

-- | Table of number of beams at notated division.
beam_count_tbl :: [(Division,Int)]
beam_count_tbl :: [(Division, Int)]
beam_count_tbl = forall a b. [a] -> [b] -> [(a, b)]
zip [Division]
divisions_musicxml_set [Int
0,Int
0,Int
0,Int
0,Int
0,Int
1,Int
2,Int
3,Int
4,Int
5,Int
6]

-- | Lookup 'beam_count_tbl'.
--
-- > whole_note_division_to_beam_count 32 == Just 3
whole_note_division_to_beam_count :: Division -> Maybe Int
whole_note_division_to_beam_count :: Division -> Maybe Int
whole_note_division_to_beam_count Division
x = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Division
x [(Division, Int)]
beam_count_tbl

-- | Calculate number of beams at 'Duration'.
--
-- > map duration_beam_count [Duration 2 0 1,Duration 16 0 1] == [0,2]
duration_beam_count :: Duration -> Int
duration_beam_count :: Duration -> Int
duration_beam_count (Duration Division
x Int
_ Rational
_) =
    let err :: a
err = forall a. HasCallStack => String -> a
error String
"duration_beam_count"
        bc :: Maybe Int
bc = Division -> Maybe Int
whole_note_division_to_beam_count Division
x
    in forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err Maybe Int
bc

-- * MusicXml

-- | Table giving MusicXml types for divisions.
division_musicxml_tbl :: [(Division,String)]
division_musicxml_tbl :: [(Division, String)]
division_musicxml_tbl =
    let nm :: [String]
nm = [String
"long",String
"breve",String
"whole",String
"half",String
"quarter",String
"eighth"
             ,String
"16th",String
"32nd",String
"64th",String
"128th",String
"256th"]
    in forall a b. [a] -> [b] -> [(a, b)]
zip [Division]
divisions_musicxml_set [String]
nm

-- | Lookup 'division_musicxml_tbl'.
--
-- > map whole_note_division_to_musicxml_type [2,4] == ["half","quarter"]
whole_note_division_to_musicxml_type :: Division -> String
whole_note_division_to_musicxml_type :: Division -> String
whole_note_division_to_musicxml_type Division
x =
    forall k v. (Eq k, Show k) => String -> k -> [(k, v)] -> v
T.lookup_err_msg String
"division_musicxml_tbl" Division
x [(Division, String)]
division_musicxml_tbl

-- | Variant of 'whole_note_division_to_musicxml_type' extracting
-- 'division' from 'Duration', dots & multipler are ignored.
--
-- > duration_to_musicxml_type (Duration 4 0 1) == "quarter"
duration_to_musicxml_type :: Duration -> String
duration_to_musicxml_type :: Duration -> String
duration_to_musicxml_type = Division -> String
whole_note_division_to_musicxml_type forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duration -> Division
division

-- * Unicode

-- | Table giving @Unicode@ symbols for divisions.
division_unicode_tbl :: [(Integer,Char)]
division_unicode_tbl :: [(Division, Char)]
division_unicode_tbl = forall a b. [a] -> [b] -> [(a, b)]
zip [Division
0,Division
1,Division
2,Division
4,Division
8,Division
16,Division
32,Division
64,Division
128,Division
256] String
"𝅜𝅝𝅗𝅥𝅘𝅥𝅘𝅥𝅮𝅘𝅥𝅯𝅘𝅥𝅰𝅘𝅥𝅱𝅘𝅥𝅲"

-- | Lookup 'division_unicode_tbl'.
--
-- > map whole_note_division_to_unicode_symbol [1,2,4,8] == "𝅝𝅗𝅥𝅘𝅥𝅘𝅥𝅮"
whole_note_division_to_unicode_symbol :: Division -> Char
whole_note_division_to_unicode_symbol :: Division -> Char
whole_note_division_to_unicode_symbol Division
x =
    forall k v. (Eq k, Show k) => String -> k -> [(k, v)] -> v
T.lookup_err_msg String
"division_unicode_tbl" Division
x [(Division, Char)]
division_unicode_tbl

-- | Give Unicode string for 'Duration'. The duration multiplier is /not/ written.
--
-- > map duration_to_unicode [Duration 1 2 1,Duration 4 1 1] == ["𝅝𝅭𝅭","𝅘𝅥𝅭"]
duration_to_unicode :: Duration -> String
duration_to_unicode :: Duration -> String
duration_to_unicode (Duration Division
dv Int
d Rational
_) =
    let dv' :: Char
dv' = Division -> Char
whole_note_division_to_unicode_symbol Division
dv
    in Char
dv' forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d) Char
'𝅭'

-- * Lilypond

-- | Give /Lilypond/ notation for 'Duration'.
-- Note that the duration multiplier is /not/ written.
--
-- > map duration_to_lilypond_type [Duration 2 0 1,Duration 4 1 1] == ["2","4."]
duration_to_lilypond_type :: Duration -> String
duration_to_lilypond_type :: Duration -> String
duration_to_lilypond_type (Duration Division
dv Int
d Rational
_) =
    let dv' :: String
dv' = if Division
dv forall a. Eq a => a -> a -> Bool
== Division
0 then String
"\\breve" else forall a. Show a => a -> String
show Division
dv
    in String
dv' forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d) Char
'.'

-- * Humdrum

{- | Duration to @**recip@ notation.

<http://humdrum.org/Humdrum/representations/recip.rep.html>

> let d = map (\z -> Duration z 0 1) [0,1,2,4,8,16,32]
> map duration_recip_pp d == ["0","1","2","4","8","16","32"]

> let d = [Duration 1 1 (1/3),Duration 4 1 1,Duration 4 1 (2/3)]
> map duration_recip_pp d == ["3.","4.","6."]
-}
duration_recip_pp :: Duration -> String
duration_recip_pp :: Duration -> String
duration_recip_pp (Duration Division
x Int
d Rational
m) =
    let (Division
mn,Division
md) = (forall a. Ratio a -> a
numerator Rational
m,forall a. Ratio a -> a
denominator Rational
m)
        r :: Rational
r = (Division
x forall a. Integral a => a -> a -> Ratio a
% Division
mn) forall a. Num a => a -> a -> a
* (Division
md forall a. Integral a => a -> a -> Ratio a
% Division
1)
    in if forall a. Ratio a -> a
denominator Rational
r forall a. Eq a => a -> a -> Bool
== Division
1
       then forall a. Show a => a -> String
show (forall a. Ratio a -> a
numerator Rational
r) forall a. [a] -> [a] -> [a]
++ forall i a. Integral i => i -> a -> [a]
genericReplicate Int
d Char
'.'
       else forall a. HasCallStack => String -> a
error (forall a. Show a => a -> String
show (String
"duration_recip_pp",Division
x,Int
d,Rational
m,Rational
r))

-- * Letter

{- | Names for note divisions.
Starting from 1/32 these names haev uniqe initial letters that can be used for concise notation.
-}
whole_note_division_name_tbl :: [(Division, String)]
whole_note_division_name_tbl :: [(Division, String)]
whole_note_division_name_tbl =
  [(Division
64,String
"sixtyfourth") -- hemidemisemiquaver
  ,(Division
32,String
"thirtysecond") -- demisemiquaver
  ,(Division
16,String
"sixteenth") -- semiquaver
  ,(Division
8,String
"eighth") -- quaver
  ,(Division
4,String
"quarter") -- crotchet
  ,(Division
2,String
"half") -- minim
  ,(Division
1,String
"whole") -- semibreve
  ,(Division
0,String
"breve")
  ,(-Division
1,String
"longa")
  ,(-Division
2,String
"maxima")]

whole_note_division_name :: Division -> Maybe String
whole_note_division_name :: Division -> Maybe String
whole_note_division_name = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(Division, String)]
whole_note_division_name_tbl

whole_note_division_letter_tbl :: [(Division, Char)]
whole_note_division_letter_tbl :: [(Division, Char)]
whole_note_division_letter_tbl = forall a b. (a -> b) -> [a] -> [b]
map (\(Division
d,String
n) -> (Division
d,forall a. [a] -> a
head String
n)) [(Division, String)]
whole_note_division_name_tbl

  -- > mapMaybe whole_note_division_letter_pp [-2, -1, 0, 1, 2, 4, 8, 16, 32] == "mlbwhqest"
whole_note_division_letter_pp :: Division -> Maybe Char
whole_note_division_letter_pp :: Division -> Maybe Char
whole_note_division_letter_pp = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (forall a. [a] -> [a]
tail [(Division, Char)]
whole_note_division_letter_tbl)

-- > mapMaybe duration_letter_pp [Duration 4 0 1,Duration 2 1 1,Duration 8 2 1] == ["q","h.","e.."]
-- > mapMaybe duration_letter_pp [Duration 4 1 (2/3)] == ["q./2:3"]
duration_letter_pp :: Duration -> Maybe String
duration_letter_pp :: Duration -> Maybe String
duration_letter_pp (Duration Division
x Int
d Rational
m) =
    let d' :: String
d' = forall i a. Integral i => i -> a -> [a]
genericReplicate Int
d Char
'.'
        m' :: String
m' = case (forall a. Ratio a -> a
numerator Rational
m,forall a. Ratio a -> a
denominator Rational
m) of
               (Division
1,Division
1) -> String
""
               (Division
i,Division
j) -> Char
'/' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Division
i forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Division
j
    in case Division -> Maybe Char
whole_note_division_letter_pp Division
x of
         Just Char
x' -> forall a. a -> Maybe a
Just (Char
x' forall a. a -> [a] -> [a]
: String
d' forall a. [a] -> [a] -> [a]
++ String
m')
         Maybe Char
_ -> forall a. Maybe a
Nothing