module Music.LilyPond.Light.Measure where

import Music.LilyPond.Light.Model

type M_Annotation = Music
data Measure = Measure [M_Annotation] [Music] deriving (Eq,Show)

-- | Prepend annotation to existing annotations at measure.
m_annotate_pre :: M_Annotation -> Measure -> Measure
m_annotate_pre a (Measure as xs) = Measure (a : as) xs

-- | Append annotation to existing annotations at measure.
m_annotate :: M_Annotation -> Measure -> Measure
m_annotate a (Measure as xs) = Measure (as++[a]) xs

m_annotate' :: [M_Annotation] -> Measure -> Measure
m_annotate' as' (Measure as xs) = Measure (as++as') xs

m_annotate_first' :: [M_Annotation] -> [Measure] -> [Measure]
m_annotate_first' as xs =
    case xs of
      (x:xs') -> m_annotate' as x : xs'
      [] -> error "m_annotate_first'"

m_annotate_last' :: [M_Annotation] -> [Measure] -> [Measure]
m_annotate_last' as xs =
    case xs of
      [] -> []
      [x] -> [m_annotate' as x]
      (x:xs') -> x : m_annotate_last' as xs'

m_append :: [Music] -> Measure -> Measure
m_append c (Measure as xs) = Measure as (xs++c)

m_elements :: Measure -> [Music]
m_elements (Measure as xs) = as ++ xs

mm_elements :: [Measure] -> [Music]
mm_elements = concatMap m_elements