module Music.Typesetting.Ascribe where

import qualified Music.Theory.Duration.Annotation as T {- hmt -}
import qualified Music.Theory.Duration.Sequence.Notate as T

import Music.Typesetting.Literal
import Music.Typesetting.Model
import Music.Typesetting.Process
import Music.Typesetting.Query

-- | Predicate /or/.
p_or :: (t -> Bool) -> (t -> Bool) -> t -> Bool
p_or f1 f2 x = f1 x || f2 x

-- | Drop annotation on repeated notes, and do not tie rests.
set_note_duration :: (T.Duration_A,Note) -> Note
set_note_duration (d,n) =
    let (da_d,da_a) = d
        Note _ a = n
        a' = map from_d_annotation da_a
    in if n_is_rest n
       then n_remove_ties (Note da_d (a ++ a'))
       else case T.duration_a_tied_lr d of
              (False,False) -> Note da_d (a ++ a')
              (False,True) -> let fn = not . na_annotation_at_end_tied_only
                              in Note da_d (filter fn a ++ a')
              (True,True) -> Note da_d (filter na_annotation_at_tied_either a ++ a')
              (True,False) -> let fn = na_annotation_at_tied_either `p_or`
                                       na_annotation_at_end_tied_only
                              in Note da_d (filter fn a ++ a')

-- | Variant of 'T.mm_ascribe_chd' post-processed by 'set_note_duration'.
mm_ascribe :: [[T.Duration_A]] -> [Note] -> [[Note]]
mm_ascribe n =
    map (map set_note_duration) .
    T.mm_ascribe_chd n_is_chord_elem n