module Music.LilyPond.Light.Annotation where

import Data.Maybe
import Data.Monoid
import Music.LilyPond.Light.Constant
import Music.LilyPond.Light.Model
import Music.LilyPond.Light.Notation
import Music.LilyPond.Light.Output.LilyPond
import Music.Theory.Pitch {- hmt -}

-- | Can a 'Music' element be annotated?  'Skip' and 'Command' do not
-- ordinarily allow annotations, though there are some cases...
allows_annotations :: Music -> Bool
allows_annotations m =
    is_note m ||
    is_chord m ||
    is_rest m ||
    is_mm_rest m
 -- is_skip m ||
 -- is_command m ||

-- | Attempt to add an 'Annotation' to a 'Music' element.
add_annotation :: Annotation -> Music -> Maybe Music
add_annotation a m =
    case m of
      Note n d as -> Just (Note n d (as ++ [a]))
      Chord n d as -> Just (Chord n d (as ++ [a]))
      Rest d as -> Just (Rest d (as ++ [a]))
      Skip d as -> Just (Skip d (as ++ [a]))
      MMRest i j as -> Just (MMRest i j (as ++ [a]))
      Command c as -> Just (Command c (as ++ [a]))
      _ -> Nothing

-- | Add an 'Annotation' to a 'Music' element or 'error'.
add_annotation_err :: Annotation -> Music -> Music
add_annotation_err a m =
    let err = error ("add_annotation: " ++ show (a,ly_music_elem m))
    in fromMaybe err (add_annotation a m)

-- | Infix form of 'add_annotation_err'.
(&) :: Music -> Annotation -> Music
m & a = add_annotation_err a m

-- | Add an 'Annotation' to a 'Pitch'.
(&#) :: Pitch -> Annotation -> Music
x &# y = Note x Nothing [y]

-- | Add an 'Annotation' to a 'Music' element.
perhaps_annotate :: Annotation -> Music -> Music
perhaps_annotate a m = fromMaybe m (add_annotation a m)

bracket_annotation_fn :: (Annotation -> Music -> Music) ->
                         (Annotation,Annotation) -> [Music] -> [Music]
bracket_annotation_fn fn (begin, end) xs =
    let x0 = head xs
        xn = last xs
        xs' = drop 1 (reverse (drop 1 (reverse xs)))
        xs_e = show (map ly_music_elem xs)
    in if length xs >= 2
       then [fn begin x0] ++ xs' ++ [fn end xn]
       else error ("bracket_annotation failed: " ++ xs_e)

bracket_annotation :: (Annotation,Annotation) -> [Music] -> [Music]
bracket_annotation = bracket_annotation_fn add_annotation_err

bracket_annotation' :: (Annotation,Annotation) -> [Music] -> [Music]
bracket_annotation' a x =
    case x of
      (_:_:_) -> bracket_annotation_fn perhaps_annotate a x
      _ -> x

beam' :: [Music] -> [Music]
beam' = bracket_annotation (begin_beam, end_beam)

-- | Manual beaming.
beam :: [Music] -> Music
beam = mconcat . beam'

slur' :: [Music] -> [Music]
slur' = bracket_annotation (begin_slur, end_slur)

slur :: [Music] -> Music
slur = mconcat . slur'

phrasing_slur' :: [Music] -> [Music]
phrasing_slur' =
    let a = (begin_phrasing_slur, end_phrasing_slur)
    in bracket_annotation a

phrasing_slur :: [Music] -> Music
phrasing_slur = mconcat . phrasing_slur'

text_above,text_below,text_mark :: String -> Annotation
text_above x = CompositeAnnotation [Place_Above, Text Text_Plain x]
text_below x = CompositeAnnotation [Place_Below, Text Text_Plain x]
text_mark x = CompositeAnnotation [Text_Mark, Text Text_Plain x]

text_above_fmt,text_below_fmt,text_mark_fmt :: String -> Annotation
text_above_fmt x = CompositeAnnotation [Place_Above,Text Text_Markup x]
text_below_fmt x = CompositeAnnotation [Place_Below,Text Text_Markup x]
text_mark_fmt x = CompositeAnnotation [Text_Mark, Text Text_Markup x]

arco,pizz :: Annotation
arco = text_above "arco"
pizz = text_above "pizz."

place_above,place_below :: Annotation -> Annotation
place_above x = CompositeAnnotation [Place_Above, x]
place_below x = CompositeAnnotation [Place_Below, x]

-- | Add an 'Annotation' to a @Note@ 'Music' element, else identity.
note_annotate :: Annotation -> Music -> Music
note_annotate a m =
    case m of
      Note n d xs -> Note n d (xs++[a])
      _ -> m

-- | Annotate the first note/chord element.
initial_note_chord_annotate :: Annotation -> [Music] -> [Music]
initial_note_chord_annotate a m =
    case m of
      [] -> []
      (x:xs) -> if is_note x || is_chord x
                then x & a : xs
                else x : initial_note_chord_annotate a xs

-- * Indirect annotations

allows_indirect_annotation :: Music -> Bool
allows_indirect_annotation m =
    case m of
      Grace x -> allows_indirect_annotation x
      AfterGrace x _ -> allows_indirect_annotation x
      Tuplet _ _ x -> allows_indirect_annotation x
      Join (x:_) -> allows_indirect_annotation x
      _ -> allows_annotations m

indirect_annotation :: Annotation -> Music -> Music
indirect_annotation a m =
    case m of
      Grace x -> Grace (indirect_annotation a x)
      AfterGrace x1 x2 -> AfterGrace (indirect_annotation a x1) x2
      Tuplet tm tt x -> Tuplet tm tt (indirect_annotation a x)
      Join (x:xs) -> Join (indirect_annotation a x : xs)
      _ -> m & a

attach_indirect_annotation :: Annotation -> [Music] -> [Music]
attach_indirect_annotation a m =
    case m of
      [] -> error "attach_indirect_annotation"
      x:xs -> if allows_indirect_annotation x
              then indirect_annotation a x : xs
              else x : attach_indirect_annotation a xs

-- * Pitch

-- | Add reminder accidental to note.
r_acc :: Music -> Music
r_acc x = x &rAcc

-- | Add cautionary accidental to note.
c_acc :: Music -> Music
c_acc x = x &cAcc

-- * Beaming

-- * Beaming

-- | Predicate composition.
p_cmp :: (t1 -> t2 -> t) -> (t3 -> t1) -> (t3 -> t2) -> t3 -> t
p_cmp fn p1 p2 x = p1 x `fn` p2 x

-- | Predicate composition (or).
--
-- > p_or even odd 1 == True
p_or :: (t -> Bool) -> (t -> Bool) -> t -> Bool
p_or = p_cmp (||)

-- | Predicate composition (and).
--
-- > p_and even odd 1 == False
p_and :: (t -> Bool) -> (t -> Bool) -> t -> Bool
p_and = p_cmp (&&)

-- | Variant of 'span' that further spans the reverse of the right
-- hand side.
--
--  > span_r (< 0) [-1,-2,1,2,3,-3,-4] == ([-1,-2],[1,2,3],[-3,-4])
span_r :: (a -> Bool) -> [a] -> ([a], [a], [a])
span_r fn xs =
    let (o1,o2) = span fn xs
        (o3,o4) = span fn (reverse o2)
    in (o1,reverse o4, reverse o3)

-- | Beam if at least two elements.
perhaps_beam :: [Music] -> [Music]
perhaps_beam xs =
    case xs of
      [] -> []
      [x] -> [x]
      _ -> beam' xs

-- | Beam interior notes/chords (ie. skip exterior
--   non-note/non-chords).
beam_notes :: [Music] -> Music
beam_notes xs =
    let (x1,x2,x3) = span_r (not . p_or is_note is_chord) xs
    in mconcat (x1 ++ perhaps_beam x2 ++ x3)

-- 2.13.29 (Issue #1083)
set_subdivide_beams :: Integer -> Music
set_subdivide_beams i =
    let x0 = "\\set subdivideBeams = ##t"
        x1 = "\\set baseMoment = #(ly:make-moment 1 " ++ show i ++ ")"
    in mconcat [Command (User x0) [], Command (User x1) []]