module Music.Typesetting.Literal where

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

import Music.Theory.Clef {- hmt -}
import Music.Theory.Duration {- hmt -}
import Music.Theory.Duration.Annotation {- hmt -}
import Music.Theory.Duration.RQ {- hmt -}
import Music.Theory.Dynamic_Mark {- hmt -}

import Music.Typesetting.Model
import Music.Typesetting.Query

-- * Functions for writing music by hand.

n_annotate :: N_Annotation -> Note -> Note
n_annotate a (Note d as) = Note d (a : as)

(&) :: Note -> N_Annotation -> Note
(&) = flip n_annotate

n_annotate_l :: [N_Annotation] -> Note -> Note
n_annotate_l a' (Note d a) = Note d (a ++ a')

-- | Apply function to first element of list.
--
-- > annotate_first (+) 9 [1,2,3] == [10,2,3]
annotate_first :: (a -> x -> x) -> a -> [x] -> [x]
annotate_first fn a ns =
    case ns of
      [] -> []
      (n:ns') -> fn a n : ns'

-- | Apply function to all but the last element of list.
--
-- > annotate_except_last (+) 7 [1,2,3] == [8,9,3]
annotate_except_last :: (a -> x -> x) -> a -> [x] -> [x]
annotate_except_last fn a ns =
    case ns of
      [] -> []
      [n] -> [n]
      n:ns' -> fn a n : annotate_except_last fn a ns'

-- | Apply function to middle elements of list.
--
-- > annotate_middle (+) 9 [1,2,3,4] == [1,11,12,4]
-- > annotate_middle (+) 9 [1,4] == [1,4]
annotate_middle :: (a -> x -> x) -> a -> [x] -> [x]
annotate_middle fn a ns =
    case ns of
      [] -> []
      n:ns' -> n : annotate_except_last fn a ns'

-- | Apply function to last element of list.
--
-- > annotate_last (+) 7 [1,2,3] == [1,2,10]
annotate_last :: (a -> x -> x) -> a -> [x] -> [x]
annotate_last fn a ns =
    case ns of
      [] -> []
      [n] -> [fn a n]
      (n:ns') -> n : annotate_last fn a ns'

-- | Apply function to first and last elements of list.
--
-- > annotate_bracket (+) (9,7) [1,2,3] == [10,2,10]
annotate_bracket :: (a -> x -> x) -> (a,a) -> [x] -> [x]
annotate_bracket fn (a0,an) = annotate_last fn an . annotate_first fn a0

n_annotate_first :: [N_Annotation] -> [Note] -> [Note]
n_annotate_first = annotate_first n_annotate_l

n_annotate_last :: [N_Annotation] -> [Note] -> [Note]
n_annotate_last = annotate_last n_annotate_l

n_annotate_bracket :: (N_Annotation,N_Annotation) -> [Note] -> [Note]
n_annotate_bracket = annotate_bracket n_annotate

-- | Apply annotations to the start and end points of each tied note.
n_annotate_tie_endpoints :: ([N_Annotation],[N_Annotation]) -> Note -> Note
n_annotate_tie_endpoints (a0,an) n
    | n_is_initial_tie n = n_annotate_l a0 n
    | n_is_final_tie n = n_annotate_l an n
    | otherwise = n

n_edit_duration :: (Duration -> Duration) -> Note -> Note
n_edit_duration fn (Note d xs) = Note (fn d) xs

-- note: ought to set Tuplet_T
tuplet :: (Integer,Integer) -> [Note] -> [Note]
tuplet (d,n) =
    let fn x = x { multiplier = n%d }
        ann = n_annotate_bracket (N_Begin_Tuplet Nothing,N_End_Tuplet)
    in map (n_edit_duration fn) . ann

m_annotate :: M_Annotation -> Measure -> Measure
m_annotate a (Measure as ns) = Measure (a : as) ns

-- | Infix variant of 'm_annotate' with reverse argument order.
(&.) :: Measure -> M_Annotation -> Measure
(&.) = flip m_annotate

m_annotate_l :: [M_Annotation] -> Measure -> Measure
m_annotate_l as' (Measure as ns) = Measure (as ++ as') ns

m_annotate_first :: [M_Annotation] -> [Measure] -> [Measure]
m_annotate_first = annotate_first m_annotate_l

m_annotate_last :: [M_Annotation] -> [Measure] -> [Measure]
m_annotate_last = annotate_last m_annotate_l

m_annotate_bracket :: (M_Annotation,M_Annotation) -> [Measure] -> [Measure]
m_annotate_bracket = annotate_bracket m_annotate

m_duration :: Measure -> [Duration]
m_duration (Measure _ ns) = mapMaybe n_duration_forward ns

m_duration_rq :: Measure -> Rational
m_duration_rq = sum . map duration_to_rq . m_duration

empty_measure :: (Integer,Integer) -> Measure
empty_measure n = Measure [M_Time_Signature n] []

stem_tremolo :: Integer -> Note -> Note
stem_tremolo n (Note d a) =
    let x = duration_beam_count d
        x' = max 0 (n - x)
    in Note d (N_Stem_Tremolo x' : a)

bass_clef,tenor_clef,alto_clef,treble_clef,percussion_clef :: M_Annotation
bass_clef = M_Clef (Clef Bass 0) 1
tenor_clef = M_Clef (Clef Tenor 0) 1
alto_clef = M_Clef (Clef Alto 0) 1
treble_clef = M_Clef (Clef Treble 0) 1
percussion_clef = M_Clef (Clef Percussion 0) 1

bass_8vb_clef,treble_8va_clef,treble_8vb_clef,treble_15ma_clef :: M_Annotation
bass_8vb_clef = M_Clef (Clef Bass (-1)) 1
treble_8va_clef = M_Clef (Clef Treble 1) 1
treble_8vb_clef = M_Clef (Clef Treble (-1)) 1
treble_15ma_clef = M_Clef (Clef Treble 2) 1

accent :: N_Annotation
accent = N_Articulation Accent

trill_mark :: N_Annotation
trill_mark = N_Ornament Trill_Mark

begin_slur :: N_Annotation
begin_slur = N_Begin_Slur

end_slur :: N_Annotation
end_slur = N_End_Slur

begin_slide :: N_Annotation
begin_slide = N_Begin_Slide

end_slide :: N_Annotation
end_slide = N_End_Slide

laissez_vibrer :: N_Annotation
laissez_vibrer = N_Direction (D_Words Above "l.v.")

fermata :: N_Annotation
fermata = N_Fermata

arpeggiate :: N_Annotation
arpeggiate = N_Arpeggiate

pedal_down_mark,pedal_up_mark :: N_Annotation
pedal_down_mark = N_Direction (D_Pedal Pedal_Start False True)
pedal_up_mark = N_Direction (D_Pedal Pedal_Stop False True)

pedal_down,pedal_up,pedal_change,pedal_continue :: N_Annotation
pedal_down = N_Direction (D_Pedal Pedal_Start True False)
pedal_up = N_Direction (D_Pedal Pedal_Stop True False)
pedal_change = N_Direction (D_Pedal Pedal_Change True False)
pedal_continue = N_Direction (D_Pedal Pedal_Continue True False)

dynamic_mark :: Dynamic_Mark_T -> N_Annotation
dynamic_mark = N_Direction . D_Dynamic_Mark -- N_Dynamic_Mark

-- * Parts, groups etc.

part :: Name -> [Measure] -> Part
part nm = Part Nothing [P_Name nm]

group :: Name -> [Part] -> Part
group nm = Group Nothing [G_Name nm]

-- | Merge parallel voices
voices :: [[Measure]] -> [Measure]
voices vs =
    let vs' = transpose vs
        vc_ann :: Integer -> Measure -> Measure
        vc_ann i (Measure as ns) = Measure as (map (& N_Voice i) ns)
        merge_m_ann :: [Measure] -> [M_Annotation]
        merge_m_ann = foldl1 union . map m_annotations
        fn ms = let (d:_) = map m_duration ms
                    bu = N_Backup d
                    ms' = zipWith vc_ann [1..] ms
                    ns = concatMap (n_annotate_last [bu] . m_notes) ms'
                    as = merge_m_ann ms
                in Measure as ns
    in map fn vs'

-- * Interop

-- | Translate from 'D_Annotation' to 'N_Annotation'.  Note: does not
-- necessarily translate 'Begin_Tuplet' correctly.
from_d_annotation :: D_Annotation -> N_Annotation
from_d_annotation x =
    case x of
      Tie_Right -> N_Begin_Tied
      Tie_Left -> N_End_Tied
      Begin_Tuplet (n,d,i) -> N_Begin_Tuplet (Just (n,i,d,i))
      End_Tuplet -> N_End_Tuplet