module Music.Typesetting.Query where

import Data.Function
import Data.List
import Data.Maybe
import Data.Ratio
import Music.Theory.Duration
import Music.Theory.Pitch
import Music.Typesetting.Model

n_has_annotation :: N_Annotation -> Note -> Bool
n_has_annotation x (Note _ xs) = x `elem` xs

n_is_rest :: Note -> Bool
n_is_rest = n_has_annotation N_Rest

n_is_chord_elem :: Note -> Bool
n_is_chord_elem = n_has_annotation N_Chord

n_is_untied :: Note -> Bool
n_is_untied n = not (n_has_annotation N_Begin_Tied n ||
                     n_has_annotation N_End_Tied n)

n_is_initial_tie :: Note -> Bool
n_is_initial_tie n = n_has_annotation N_Begin_Tied n &&
                     not (n_has_annotation N_End_Tied n)

n_is_final_tie :: Note -> Bool
n_is_final_tie n = n_has_annotation N_End_Tied n &&
                   not (n_has_annotation N_Begin_Tied n)

na_pitch :: N_Annotation -> Maybe Pitch
na_pitch a =
    case a of
      (N_Pitch x) -> Just x
      _ -> Nothing

n_pitch :: Note -> Maybe Pitch
n_pitch (Note _ as) =
    case mapMaybe na_pitch as of
      [] -> Nothing
      [x] -> Just x
      _ -> error "n_pitch"

n_has_pitch :: Note -> Bool
n_has_pitch = isJust . n_pitch

na_dynamic :: N_Annotation -> Maybe Dynamic_Mark_T
na_dynamic a =
    case a of
      (N_Dynamic_Mark x) -> Just x
      _ -> Nothing

n_dynamic :: Note -> Maybe Dynamic_Mark_T
n_dynamic (Note _ as) =
    case mapMaybe na_dynamic as of
      [] -> Nothing
      [x] -> Just x
      _ -> error "n_dynamic"

n_has_dynamic :: Note -> Bool
n_has_dynamic = isJust . n_dynamic

n_duration_forward :: Note -> Maybe Duration
n_duration_forward n =
    let (Note d _) = n
    in if n_is_chord_elem n
       then Nothing
       else Just d

ma_time_signature_t :: M_Annotation -> Maybe Time_Signature_T
ma_time_signature_t m =
    case m of
      (M_Time_Signature x) -> Just x
      _ -> Nothing

m_time_signature :: Measure -> [M_Annotation]
m_time_signature = filter (isJust . ma_time_signature_t) . m_annotations

m_time_signature' :: Measure -> Maybe M_Annotation
m_time_signature' m =
    case m_time_signature m of
      [x] -> Just x
      _ -> Nothing

m_time_signature_t :: Measure -> [Time_Signature_T]
m_time_signature_t = mapMaybe ma_time_signature_t . m_annotations

ma_tempo_marking_t :: M_Annotation -> Maybe Tempo_Marking_T
ma_tempo_marking_t a =
    case a of
      (M_Tempo_Marking x) -> Just x
      _ -> Nothing

m_tempo_marking :: Measure -> [M_Annotation]
m_tempo_marking = filter (isJust . ma_tempo_marking_t) . m_annotations

m_tempo_marking_t :: Measure -> [Tempo_Marking_T]
m_tempo_marking_t = mapMaybe ma_tempo_marking_t . m_annotations

-- * Temporal map

type SI_Map a = [(Integer,a)]
type Time_Signature_Map = SI_Map Time_Signature_T
type Tempo_Marking_Map = SI_Map Tempo_Marking_T
type Temporal_Map = (Integer,Time_Signature_Map,Tempo_Marking_Map)

si_map_to_sequence :: Integer -> a -> SI_Map a -> [a]
si_map_to_sequence n df mp =
    let mp' = (0,df) : mp ++ [(n,undefined)]
        fn (i,x) (j,_) = genericReplicate (j - i) x
    in concat (zipWith fn mp' (tail mp'))

mm_time_signature_map :: [Measure] -> Time_Signature_Map
mm_time_signature_map =
    let fn (i,m) = case m_time_signature_t m of
                     [] -> Nothing
                     [x] -> Just (i,x)
                     _ -> error "mm_time_signature_map"
    in mapMaybe fn . zip [0..]

mm_tempo_marking_map :: [Measure] -> Tempo_Marking_Map
mm_tempo_marking_map =
    let fn (i,m) = case m_tempo_marking_t m of
                     [] -> Nothing
                     [x] -> Just (i,x)
                     _ -> error "mm_tempo_marking_map"
    in mapMaybe fn . zip [0..]

mm_temporal_map :: [Measure] -> Temporal_Map
mm_temporal_map xs =
    let ts_m = mm_time_signature_map xs
        tm_m = mm_tempo_marking_map xs
    in (genericLength xs,ts_m,tm_m)

-- | Duration, in RQ, of a measure of indicated time signature.
time_signature_to_rq :: Time_Signature_T -> Rational
time_signature_to_rq (n,d) = (4 * n) % d

-- | Duration of a RQ value, in seconds, given indicated tempo.
rq_to_seconds :: Tempo_Marking_T -> Rational -> Double
rq_to_seconds (d,n) x =
    let d' = duration_to_rq d
        s = 60 / fromIntegral n
    in (fromRational x * s) / fromRational d'

-- | The duration, in seconds, of a measure at the indicated time
--   signaure and tempo marking.
time_signature_to_seconds :: Time_Signature_T -> Tempo_Marking_T -> Double
time_signature_to_seconds ts tm =
    let i = time_signature_to_rq ts
    in rq_to_seconds tm i

-- | dx -> d
integrate :: (Num a) => [a] -> [a]
integrate [] = []
integrate (x:xs) =
    let fn i c = (i + c, i + c)
    in x : snd (mapAccumL fn x xs)

temporal_map_locate :: Temporal_Map -> [(Double,Double,Tempo_Marking_T)]
temporal_map_locate (n,ts_m,tm_m) =
    let ts_s = si_map_to_sequence n (4,4) ts_m
        tm_s = si_map_to_sequence n (quarter_note,60) tm_m
        dd = zipWith time_signature_to_seconds ts_s tm_s
        st = 0 : integrate dd
    in zip3 st dd tm_s

n_locate :: (Double,Double,Tempo_Marking_T) -> [Note] -> [(Double,Note)]
n_locate (st,_,tm) =
    let fn i n = let j = maybe 0 duration_to_rq (n_duration_forward n)
                     j' = rq_to_seconds tm j
                 in (i + j', (i,n))
    in snd . mapAccumL fn st

locate_notes :: [[Measure]] -> [(Double,Note)]
locate_notes mms =
    let tm = mm_temporal_map (head mms)
        lm = temporal_map_locate tm
        mk_ns ms = concat (zipWith n_locate lm (map m_notes ms))
    in sortBy (compare `on` fst) (concatMap mk_ns mms)