module Music.Typesetting.Model where

import Music.Theory.Duration
import Music.Theory.Key
import Music.Theory.Pitch

data Dynamic_Mark_T = PPPPP | PPPP | PPP | PP | P | MP
                    | MF | F | FF | FFF | FFFF | FFFFF
                    | FP | SF | SFP | SFPP | SFZ | SFFZ
                      deriving (Eq,Ord,Bounded,Show)

data Articulation_T = Accent
                    | Staccato
                    | Tenuto
                      deriving (Eq,Ord,Show)

data Clef_T = Bass | Tenor | Alto | Treble | Percussion
              deriving (Eq,Ord,Show)

type Time_Signature_T = (Integer,Integer)

data Placement_T = Above | Below
                   deriving (Eq,Ord,Show)

type Tuplet_T = (Integer,Duration,Integer,Duration)

type Tempo_Marking_T = (Duration,Integer)

-- | Ordered to meet musicxml requirements.
data N_Annotation = N_Grace | N_Chord
                  | N_Pitch Pitch | N_Unpitched
                  | N_Rest
                  | N_Begin_Slur | N_End_Slur
                  | N_Begin_Tied | N_End_Tied
                  | N_Begin_Tuplet (Maybe Tuplet_T) | N_End_Tuplet
                  | N_Stem_Tremolo Integer
                  | N_Articulation Articulation_T
                  | N_Dynamic_Mark Dynamic_Mark_T
                  | N_Crescendo | N_Diminuendo | N_End_Hairpin
                  | N_Voice Integer
                  | N_Backup [Duration]
                  | N_Natural_Harmonic
                    deriving (Eq,Ord,Show)

data Note = Note {n_duration :: Duration
                 ,n_annotations :: [N_Annotation]}
            deriving (Eq,Show)

data M_Annotation = M_Division Integer
                  | M_Key Note_T (Maybe Alteration_T) Mode_T
                  | M_Tempo_Marking Tempo_Marking_T
                  | M_Time_Signature Time_Signature_T
                  | M_Clef Clef_T Integer
                    deriving (Eq,Ord,Show)

data Measure = Measure { m_annotations :: [M_Annotation]
                       , m_notes :: [Note] }
               deriving (Eq,Show)

type Name = (String,String)

data Group_Symbol_T = None
                    | Brace
                    | Line
                    | Bracket
                      deriving (Eq,Show)

data P_Annotation = P_Name Name
                    deriving (Eq,Show)

data G_Annotation = G_Name Name
                  | G_Symbol Group_Symbol_T
                    deriving (Eq,Show)

type ID = Integer

data Part = Part (Maybe ID) [P_Annotation] [Measure]
          | Group (Maybe ID) [G_Annotation] [Part]
            deriving (Eq,Show)

data Score = Score [Part]
             deriving (Eq,Show)