module Music.Typesetting.Process where

import Data.List
import qualified Music.Typesetting.Literal.Dynamic as M
import Music.Typesetting.Model
import Music.Typesetting.Query

-- * Clef

-- | If 'M_Annotation' is a 'M_Clef' set the staff number.
m_clef_set_staff :: Integer -> M_Annotation -> Maybe M_Annotation
m_clef_set_staff n a =
    case a of
      M_Clef c _ -> Just (M_Clef c n)
      _ -> Nothing

--  * Note

-- | Process a 'Note' sequence adding 'D_End_Hairpin' annotations as
-- required, ie. where there is an open hairpin annotation and a
-- 'Note' has a dyamic annotation without a close hairpin annotation.
n_add_end_hairpins :: [Note] -> [Note]
n_add_end_hairpins =
    let f st n =
            case n of
              [] -> []
              [Note d a] -> [Note d (if st then M.end_hairpin : a else a)]
              Note d a : n' ->
                  let (a',st') = if st &&
                                    any na_is_begin_dynamic a &&
                                    M.end_hairpin `notElem` a
                                 then (M.end_hairpin : a
                                      ,any na_is_begin_hairpin a)
                                 else (a
                                      ,st || any na_is_begin_hairpin a)
                  in Note d a' : f st' n'
    in f False

-- * Measure

-- | Delete persistent annotations or like.
prune :: (a -> a -> Bool) -> (b -> Maybe a) -> (a -> b -> b) -> [b] -> [b]
prune cmp get del =
    let go _ [] = []
        go Nothing (x:xs) = x : go (get x) xs
        go (Just st) (x:xs) =
            case get x of
              Nothing -> x : go (Just st) xs
              Just y -> if cmp st y
                        then del y x : go (Just st) xs
                        else x : go (Just y) xs
    in go Nothing

m_delete_annotation :: M_Annotation -> Measure -> Measure
m_delete_annotation i (Measure a n) = Measure (delete i a) n

m_remove_duplicate_ts :: [Measure] -> [Measure]
m_remove_duplicate_ts =
    let get = m_time_signature'
        del = m_delete_annotation
    in prune (==) get del

m_remove_duplicate_tempo_marking :: [Measure] -> [Measure]
m_remove_duplicate_tempo_marking =
    let get = m_tempo_marking'
        del = m_delete_annotation
    in prune (==) get del