\begin{code} -- | -- Maintainer : silva.samuel@alumni.uminho.pt -- Stability : experimental -- Portability: HaXML -- module Text.XML.MusicXML.Score where import Text.XML.MusicXML.Common import Text.XML.MusicXML.Attributes import Text.XML.MusicXML.Link import Text.XML.MusicXML.Barline import Text.XML.MusicXML.Note import Text.XML.MusicXML.Layout hiding (Tenths) import Text.XML.MusicXML.Identity import Text.XML.MusicXML.Direction import Text.XML.HaXml.Types (Content) import Control.Monad (MonadPlus(..)) import Prelude (Maybe(..), Monad(..), Functor(..), Show, Eq, (++), (.)) \end{code} \begin{musicxml} Works and movements are optionally identified by number and title. The work element also may indicate a link to the opus document that composes multiple movements into a collection. \end{musicxml} \begin{code} -- * Work -- | type Work = (Maybe Work_Number, Maybe Work_Title, Maybe Opus) -- | read_Work :: StateT Result [Content i] Work read_Work = do y <- read_ELEMENT "work" read_3 (read_MAYBE read_Work_Number) (read_MAYBE read_Work_Title) (read_MAYBE read_Opus) (childs y) -- | show_Work :: Work -> [Content ()] show_Work (a,b,c) = show_ELEMENT "work" [] (show_MAYBE show_Work_Number a ++ show_MAYBE show_Work_Title b ++ show_MAYBE show_Opus c) -- | type Work_Number = PCDATA -- | read_Work_Number :: StateT Result [Content i] Work_Number read_Work_Number = do y <- read_ELEMENT "work-number" read_1 read_PCDATA (childs y) -- | show_Work_Number :: Work_Number -> [Content ()] show_Work_Number a = show_ELEMENT "work-number" [] (show_PCDATA a) -- | type Work_Title = PCDATA -- | read_Work_Title :: StateT Result [Content i] Work_Title read_Work_Title = do y <- read_ELEMENT "work-title" read_1 read_PCDATA (childs y) -- | show_Work_Title :: Work_Title -> [Content ()] show_Work_Title a = show_ELEMENT "work-title" [] (show_PCDATA a) -- | type Opus = (Link_Attributes, ()) -- | read_Opus :: StateT Result [Content i] Opus read_Opus = do y <- read_ELEMENT "opus" y1 <- read_1 read_Link_Attributes (attributes y) return (y1,()) -- | show_Opus :: Opus -> [Content ()] show_Opus (a,_) = show_ELEMENT "opus" (show_Link_Attributes a) [] -- | type Movement_Number = PCDATA -- | read_Movement_Number :: StateT Result [Content i] Movement_Number read_Movement_Number = do y <- read_ELEMENT "movement-number" read_1 read_PCDATA (childs y) -- | show_Movement_Number :: Movement_Number -> [Content ()] show_Movement_Number a = show_ELEMENT "movement-number" [] (show_PCDATA a) -- | type Movement_Title = PCDATA -- | read_Movement_Title :: StateT Result [Content i] Movement_Title read_Movement_Title = do y <- read_ELEMENT "movement-title" read_1 read_PCDATA (childs y) -- | show_Movement_Title :: Movement_Title -> [Content ()] show_Movement_Title a = show_ELEMENT "movement-title" [] (show_PCDATA a) \end{code} \begin{musicxml} Collect score-wide defaults. This includes scaling and layout, defined in layout.mod, and default values for the music font, word font, lyric font, and lyric language. The number and name attributes in lyric-font and lyric-language elements are typically used when lyrics are provided in multiple languages. If the number and name attributes are omitted, the lyric-font and lyric-language values apply to all numbers and names. \end{musicxml} \begin{code} -- * Defaults -- | type Defaults = (Maybe Scaling, Maybe Page_Layout, Maybe System_Layout, [Staff_Layout], Maybe Appearance, Maybe Music_Font, Maybe Word_Font, [Lyric_Font], [Lyric_Language]) -- | read_Defaults :: Eq i => StateT Result [Content i] Defaults read_Defaults = do y <- read_ELEMENT "defaults" read_9 (read_MAYBE read_Scaling) (read_MAYBE read_Page_Layout) (read_MAYBE read_System_Layout) (read_LIST read_Staff_Layout) (read_MAYBE read_Appearance) (read_MAYBE read_Music_Font) (read_MAYBE read_Word_Font) (read_LIST read_Lyric_Font) (read_LIST read_Lyric_Language) (childs y) -- | show_Defaults :: Defaults -> [Content ()] show_Defaults (a,b,c,d,e,f,g,h,i) = show_ELEMENT "defaults" [] (show_MAYBE show_Scaling a ++ show_MAYBE show_Page_Layout b ++ show_MAYBE show_System_Layout c ++ show_LIST show_Staff_Layout d ++ show_MAYBE show_Appearance e ++ show_MAYBE show_Music_Font f ++ show_MAYBE show_Word_Font g ++ show_LIST show_Lyric_Font h ++ show_LIST show_Lyric_Language i) -- | type Music_Font = (Font, ()) -- | read_Music_Font :: Eq i => StateT Result [Content i] Music_Font read_Music_Font = do y <- read_ELEMENT "music-font" y1 <- read_1 read_Font (attributes y) return (y1,()) -- | show_Music_Font :: Music_Font -> [Content ()] show_Music_Font (a,_) = show_ELEMENT "music-font" (show_Font a) [] -- | type Word_Font = (Font, ()) -- | read_Word_Font :: Eq i => StateT Result [Content i] Word_Font read_Word_Font = do y <- read_ELEMENT "word-font" y1 <- read_1 read_Font (attributes y) return (y1,()) -- | show_Word_Font :: Word_Font -> [Content ()] show_Word_Font (a,_) = show_ELEMENT "word-font" (show_Font a) [] -- | type Lyric_Font = ((Maybe CDATA, Maybe CDATA, Font), ()) -- | read_Lyric_Font :: Eq i => StateT Result [Content i] Lyric_Font read_Lyric_Font = do y <- read_ELEMENT "lyric-font" y1 <- read_3 (read_IMPLIED "number" read_CDATA) (read_IMPLIED "name" read_CDATA) read_Font (attributes y) return (y1,()) -- | show_Lyric_Font :: Lyric_Font -> [Content ()] show_Lyric_Font ((a,b,c),_) = show_ELEMENT "lyric-font" (show_IMPLIED "number" show_CDATA a ++ show_IMPLIED "name" show_CDATA b ++ show_Font c) [] -- | type Lyric_Language = ((Maybe CDATA, Maybe CDATA, CDATA), ()) -- | read_Lyric_Language :: Eq i => StateT Result [Content i] Lyric_Language read_Lyric_Language = do y <- read_ELEMENT "lyric-language" y1 <- read_3 (read_IMPLIED "number" read_CDATA) (read_IMPLIED "name" read_CDATA) (read_REQUIRED "xml:lang" read_CDATA) (attributes y) return (y1,()) -- | show_Lyric_Language :: Lyric_Language -> [Content ()] show_Lyric_Language ((a,b,c),_) = show_ELEMENT "lyric-language" (show_IMPLIED "number" show_CDATA a ++ show_IMPLIED "name" show_CDATA b ++ show_REQUIRED "xml:lang" show_CDATA c) [] \end{code} \begin{musicxml} Credit elements refer to the title, composer, arranger, lyricist, copyright, dedication, and other text that usually appears on the first page of a score. The credit-words and credit-image elements are similar to the words and image elements for directions. However, since the credit is not part of a measure, the default-x and default-y attributes adjust the origin relative to the bottom left-hand corner of the first page. The enclosure for credit-words is none by default. By default, a series of credit-words elements within a single credit element follow one another in sequence visually. Non-positional formatting attributes are carried over from the previous element by default. The page attribute for the credit element, new in Version 2.0, specifies the page number where the credit should appear. This is an integer value that starts with 1 for the first page. Its value is 1 by default. Since credits occur before the music, these page numbers do not refer to the page numbering specified by the print element's page-number attribute. In the initial release of Version 2.0, the credit element had a non-deterministic definition. The current credit element definition has the same meaning, but avoids the validity errors arising from a non-deterministic definition. \end{musicxml} \begin{code} -- * Credit -- | type Credit = (Maybe CDATA, ([Link], [Bookmark], Credit_)) -- | read_Credit :: Eq i => StateT Result [Content i] Credit read_Credit = do y <- read_ELEMENT "credit" y1 <- read_1 (read_IMPLIED "page" read_CDATA) (attributes y) y2 <- read_3 (read_LIST read_Link) (read_LIST read_Bookmark) read_Credit_ (childs y) return (y1,y2) -- | show_Credit :: Credit -> [Content ()] show_Credit (a,(b,c,d)) = show_ELEMENT "credit" (show_IMPLIED "page" show_CDATA a) (show_LIST show_Link b ++ show_LIST show_Bookmark c ++ show_Credit_ d) -- | data Credit_ = Credit_1 Credit_Image | Credit_2 (Credit_Words, [([Link], [Bookmark], Credit_Words)]) deriving (Eq, Show) -- | read_Credit_ :: Eq i => StateT Result [Content i] Credit_ read_Credit_ = (read_Credit_Image >>= return . Credit_1) `mplus` (read_Credit_aux1 >>= return . Credit_2) -- | show_Credit_ :: Credit_ -> [Content ()] show_Credit_ (Credit_1 a) = show_Credit_Image a show_Credit_ (Credit_2 (a,b)) = show_Credit_Words a ++ show_LIST show_Credit_aux1 b -- | read_Credit_aux1 :: Eq i => StateT Result [Content i] (Credit_Words, [([Link], [Bookmark], Credit_Words)]) read_Credit_aux1 = do y1 <- read_Credit_Words y2 <- read_LIST read_Credit_aux2 return (y1,y2) -- | read_Credit_aux2 :: Eq i => StateT Result [Content i] ([Link],[Bookmark],Credit_Words) read_Credit_aux2 = do y1 <- read_LIST read_Link y2 <- read_LIST read_Bookmark y3 <- read_Credit_Words return (y1,y2,y3) -- | show_Credit_aux1 :: ([Link],[Bookmark],Credit_Words) -> [Content ()] show_Credit_aux1 (a,b,c) = show_LIST show_Link a ++ show_LIST show_Bookmark b ++ show_Credit_Words c -- | type Credit_Words = (Text_Formatting, PCDATA) -- | read_Credit_Words :: StateT Result [Content i] Credit_Words read_Credit_Words = do y <- read_ELEMENT "credit-words" y1 <- read_1 read_Text_Formatting (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Credit_Words :: Credit_Words -> [Content ()] show_Credit_Words (a,b) = show_ELEMENT "credit-words" (show_Text_Formatting a) (show_PCDATA b) -- | type Credit_Image = ((CDATA, CDATA, Position, Halign, Valign_Image), ()) -- | read_Credit_Image :: StateT Result [Content i] Credit_Image read_Credit_Image = do y <- read_ELEMENT "credit-image" y1 <- read_5 (read_REQUIRED "source" read_CDATA) (read_REQUIRED "type" read_CDATA) read_Position read_Halign read_Valign_Image (attributes y) return (y1,()) -- | show_Credit_Image :: Credit_Image -> [Content ()] show_Credit_Image ((a,b,c,d,e),_) = show_ELEMENT "credit-image" (show_REQUIRED "source" show_CDATA a ++ show_REQUIRED "type" show_CDATA b ++ show_Position c ++ show_Halign d ++ show_Valign_Image e) [] -- | \end{code} \begin{musicxml} The part-list identifies the different musical parts in this movement. Each part has an ID that is used later within the musical data. Since parts may be encoded separately and combined later, identification elements are present at both the score and score-part levels. There must be at least one score-part, combined as desired with part-group elements that indicate braces and brackets. Parts are ordered from top to bottom in a score based on the order in which they appear in the part-list. Each MusicXML part corresponds to a track in a Standard MIDI Format 1 file. The score-instrument elements are used when there are multiple instruments per track. The midi-device element is used to make a MIDI device or port assignment for the given track. Initial midi-instrument assignments may be made here as well. The part-name and part-abbreviation elements are defined in the common.mod file, as they can be used within both the part-list and print elements. \end{musicxml} \begin{code} -- * Part_List -- | type Part_List = ([Part_Group], Score_Part, [Part_List_]) -- | read_Part_List :: Eq i => StateT Result [Content i] Part_List read_Part_List = do y <- read_ELEMENT "part-list" read_3 (read_LIST read_Part_Group) read_Score_Part (read_LIST read_Part_List_) (childs y) -- | show_Part_List :: Part_List -> [Content ()] show_Part_List (a,b,c) = show_ELEMENT "part-list" [] (show_LIST show_Part_Group a ++ show_Score_Part b ++ show_LIST show_Part_List_ c) -- | data Part_List_ = Part_List_1 Part_Group | Part_List_2 Score_Part deriving (Eq, Show) -- | read_Part_List_ :: Eq i => StateT Result [Content i] Part_List_ read_Part_List_ = (read_Part_Group >>= return . Part_List_1) `mplus` (read_Score_Part >>= return . Part_List_2) -- | show_Part_List_ :: Part_List_ -> [Content ()] show_Part_List_ (Part_List_1 a) = show_Part_Group a show_Part_List_ (Part_List_2 a) = show_Score_Part a -- | type Score_Part = (ID, (Maybe Identification, Part_Name, Maybe Part_Name_Display, Maybe Part_Abbreviation, Maybe Part_Abbreviation_Display, [Group], [Score_Instrument], Maybe Midi_Device, [Midi_Instrument])) -- | read_Score_Part :: Eq i => StateT Result [Content i] Score_Part read_Score_Part = do y <- read_ELEMENT "score-part" y1 <- read_1 (read_REQUIRED "id" read_ID) (attributes y) y2 <- read_9 (read_MAYBE read_Identification) read_Part_Name (read_MAYBE read_Part_Name_Display) (read_MAYBE read_Part_Abbreviation) (read_MAYBE read_Part_Abbreviation_Display) (read_LIST read_Group) (read_LIST read_Score_Instrument) (read_MAYBE read_Midi_Device) (read_LIST read_Midi_Instrument) (childs y) return (y1,y2) -- | show_Score_Part :: Score_Part -> [Content ()] show_Score_Part (a,(b,c,d,e,f,g,h,i,j)) = show_ELEMENT "score-part" (show_REQUIRED "id" show_ID a) (show_MAYBE show_Identification b ++ show_Part_Name c ++ show_MAYBE show_Part_Name_Display d ++ show_MAYBE show_Part_Abbreviation e ++ show_MAYBE show_Part_Abbreviation_Display f ++ show_LIST show_Group g ++ show_LIST show_Score_Instrument h ++ show_MAYBE show_Midi_Device i ++ show_LIST show_Midi_Instrument j) \end{code} \begin{musicxml} The part-name indicates the full name of the musical part. The part-abbreviation indicates the abbreviated version of the name of the musical part. The part-name will often precede the first system, while the part-abbreviation will precede the other systems. The formatting attributes for these elements are deprecated in Version 2.0 in favor of the new part-name-display and part-abbreviation-display elements. These are defined in the common.mod file as they are used in both the part-list and print elements. They provide more complete formatting control for how part names and abbreviations appear in a score. \end{musicxml} \begin{code} -- | type Part_Name = ((Print_Style, Print_Object, Justify), PCDATA) -- | read_Part_Name :: StateT Result [Content i] Part_Name read_Part_Name = do y <- read_ELEMENT "part-name" y1 <- read_3 read_Print_Style read_Print_Object read_Justify (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Part_Name :: Part_Name -> [Content ()] show_Part_Name ((a,b,c),d) = show_ELEMENT "part-name" (show_Print_Style a ++ show_Print_Object b ++ show_Justify c) (show_PCDATA d) -- | type Part_Abbreviation = ((Print_Style, Print_Object, Justify), PCDATA) -- | read_Part_Abbreviation :: StateT Result [Content i] Part_Abbreviation read_Part_Abbreviation = do y <- read_ELEMENT "part-abbreviation" y1 <- read_3 read_Print_Style read_Print_Object read_Justify (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Part_Abbreviation :: Part_Abbreviation -> [Content ()] show_Part_Abbreviation ((a,b,c),d) = show_ELEMENT "part-abbreviation" (show_Print_Style a ++ show_Print_Object b ++ show_Justify c) (show_PCDATA d) \end{code} \begin{musicxml} The part-group element indicates groupings of parts in the score, usually indicated by braces and brackets. Braces that are used for multi-staff parts should be defined in the attributes element for that part. The part-group start element appears before the first score-part in the group. The part-group stop element appears after the last score-part in the group. The number attribute is used to distinguish overlapping and nested part-groups, not the sequence of groups. As with parts, groups can have a name and abbreviation. Formatting attributes for group-name and group-abbreviation are deprecated in Version 2.0 in favor of the new group-name-display and group-abbreviation-display elements. Formatting specified in the group-name-display and group-abbreviation-display elements overrides formatting specified in the group-name and group-abbreviation elements, respectively. The group-symbol element indicates how the symbol for a group is indicated in the score. Values include none, brace, line, and bracket; the default is none. The group-barline element indicates if the group should have common barlines. Values can be yes, no, or Mensurstrich. The group-time element indicates that the displayed time signatures should stretch across all parts and staves in the group. Values for the child elements are ignored at the stop of a group. A part-group element is not needed for a single multi-staff part. By default, multi-staff parts include a brace symbol and (if appropriate given the bar-style) common barlines. The symbol formatting for a multi-staff part can be more fully specified using the part-symbol element, defined in the attributes.mod file. \end{musicxml} \begin{code} -- | type Part_Group = ((Start_Stop, CDATA), (Maybe Group_Name, Maybe Group_Name_Display, Maybe Group_Abbreviation, Maybe Group_Abbreviation_Display, Maybe Group_Symbol, Maybe Group_Barline, Maybe Group_Time, Editorial)) -- | read_Part_Group :: Eq i => StateT Result [Content i] Part_Group read_Part_Group = do y <- read_ELEMENT "part-group" y1 <- read_2 (read_REQUIRED "type" read_Start_Stop) (read_DEFAULT "number" read_CDATA "1") (attributes y) y2 <- read_8 (read_MAYBE read_Group_Name) (read_MAYBE read_Group_Name_Display) (read_MAYBE read_Group_Abbreviation) (read_MAYBE read_Group_Abbreviation_Display) (read_MAYBE read_Group_Symbol) (read_MAYBE read_Group_Barline) (read_MAYBE read_Group_Time) read_Editorial (childs y) return (y1,y2) -- | show_Part_Group :: Part_Group -> [Content ()] show_Part_Group ((a,b),(c,d,e,f,g,h,i,j)) = show_ELEMENT "part-group" (show_REQUIRED "type" show_Start_Stop a ++ show_DEFAULT "number" show_CDATA b) (show_MAYBE show_Group_Name c ++ show_MAYBE show_Group_Name_Display d ++ show_MAYBE show_Group_Abbreviation e ++ show_MAYBE show_Group_Abbreviation_Display f ++ show_MAYBE show_Group_Symbol g ++ show_MAYBE show_Group_Barline h ++ show_MAYBE show_Group_Time i ++ show_Editorial j) -- | type Group_Name = ((Print_Style, Justify), PCDATA) -- | read_Group_Name :: StateT Result [Content i] Group_Name read_Group_Name = do y <- read_ELEMENT "group-name" y1 <- read_2 read_Print_Style read_Justify (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Group_Name :: Group_Name -> [Content ()] show_Group_Name ((a,b),c) = show_ELEMENT "group-name" (show_Print_Style a ++ show_Justify b) (show_PCDATA c) -- | type Group_Name_Display = (Print_Object, [Group_Name_Display_]) -- | read_Group_Name_Display :: Eq i => StateT Result [Content i] Group_Name_Display read_Group_Name_Display = do y <- read_ELEMENT "group-name-display" y1 <- read_1 read_Print_Object (attributes y) y2 <- read_1 (read_LIST read_Group_Name_Display_) (childs y) return (y1,y2) -- | show_Group_Name_Display :: Group_Name_Display -> [Content ()] show_Group_Name_Display (a,b) = show_ELEMENT "group-name-display" (show_Print_Object a) (show_LIST show_Group_Name_Display_ b) -- | data Group_Name_Display_ = Group_Name_Display_1 Display_Text | Group_Name_Display_2 Accidental_Text deriving (Eq, Show) -- | read_Group_Name_Display_ :: StateT Result [Content i] Group_Name_Display_ read_Group_Name_Display_ = (read_Display_Text >>= return . Group_Name_Display_1) `mplus` (read_Accidental_Text >>= return . Group_Name_Display_2) -- | show_Group_Name_Display_ :: Group_Name_Display_ -> [Content ()] show_Group_Name_Display_ (Group_Name_Display_1 a) = show_Display_Text a show_Group_Name_Display_ (Group_Name_Display_2 a) = show_Accidental_Text a -- | type Group_Abbreviation = ((Print_Style, Justify), PCDATA) -- | read_Group_Abbreviation :: StateT Result [Content i] Group_Abbreviation read_Group_Abbreviation = do y <- read_ELEMENT "group-abbreviation" y1 <- read_2 read_Print_Style read_Justify (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Group_Abbreviation :: Group_Abbreviation -> [Content ()] show_Group_Abbreviation ((a,b),c) = show_ELEMENT "group-abbreviation" (show_Print_Style a ++ show_Justify b) (show_PCDATA c) -- | type Group_Abbreviation_Display = (Print_Object, [Group_Abbreviation_Display_]) -- | read_Group_Abbreviation_Display :: Eq i => StateT Result [Content i] Group_Abbreviation_Display read_Group_Abbreviation_Display = do y <- read_ELEMENT "group-abbreviation-display" y1 <- read_1 read_Print_Object (attributes y) y2 <- read_1 (read_LIST read_Group_Abbreviation_Display_) (childs y) return (y1,y2) -- | show_Group_Abbreviation_Display :: Group_Abbreviation_Display -> [Content ()] show_Group_Abbreviation_Display (a,b) = show_ELEMENT "group-abbreviation-display" (show_Print_Object a) (show_LIST show_Group_Abbreviation_Display_ b) -- | data Group_Abbreviation_Display_ = Group_Abbreviation_Display_1 Display_Text | Group_Abbreviation_Display_2 Accidental_Text deriving (Eq, Show) -- | read_Group_Abbreviation_Display_ :: StateT Result [Content i] Group_Abbreviation_Display_ read_Group_Abbreviation_Display_ = (read_Display_Text >>= return . Group_Abbreviation_Display_1) `mplus` (read_Accidental_Text >>= return . Group_Abbreviation_Display_2) -- | show_Group_Abbreviation_Display_ :: Group_Abbreviation_Display_ -> [Content ()] show_Group_Abbreviation_Display_ (Group_Abbreviation_Display_1 a) = show_Display_Text a show_Group_Abbreviation_Display_ (Group_Abbreviation_Display_2 a) = show_Accidental_Text a -- | type Group_Symbol = ((Position, Color), PCDATA) -- | read_Group_Symbol :: StateT Result [Content i] Group_Symbol read_Group_Symbol = do y <- read_ELEMENT "group-symbol" y1 <- read_2 read_Position read_Color (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Group_Symbol :: Group_Symbol -> [Content ()] show_Group_Symbol ((a,b),c) = show_ELEMENT "group-symbol" (show_Position a ++ show_Color b) (show_PCDATA c) -- | type Group_Barline = (Color, PCDATA) -- | read_Group_Barline :: StateT Result [Content i] Group_Barline read_Group_Barline = do y <- read_ELEMENT "group-barline" y1 <- read_1 read_Color (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Group_Barline :: Group_Barline -> [Content ()] show_Group_Barline (a,b) = show_ELEMENT "group-barline" (show_Color a) (show_PCDATA b) -- | type Group_Time = () -- | read_Group_Time :: StateT Result [Content i] Group_Time read_Group_Time = read_ELEMENT "group-time" >> return () -- | show_Group_Time :: Group_Time -> [Content ()] show_Group_Time _ = show_ELEMENT "group-time" [] [] \end{code} \begin{musicxml} The score-instrument element allows for multiple instruments per score-part. As with the score-part element, each score-instrument has a required ID attribute, a name, and an optional abbreviation. The instrument-name and instrument-abbreviation are typically used within a software application, rather than appearing on the printed page of a score. A score-instrument element is also required if the score specifies MIDI 1.0 channels, banks, or programs. An initial midi-instrument assignment can also be made here. MusicXML software should be able to automatically assign reasonable channels and instruments without these elements in simple cases, such as where part names match General MIDI instrument names. The solo and ensemble elements are new as of Version 2.0. The solo element is present if performance is intended by a solo instrument. The ensemble element is present if performance is intended by an ensemble such as an orchestral section. The text of the ensemble element contains the size of the section, or is empty if the ensemble size is not specified. The midi-instrument element is defined in the common.mod file, as it can be used within both the score-part and sound elements. \end{musicxml} \begin{code} -- | type Score_Instrument = (ID, (Instrument_Name, Maybe Instrument_Abbreviation, Maybe Score_Instrument_)) -- | read_Score_Instrument :: StateT Result [Content i] Score_Instrument read_Score_Instrument = do y <- read_ELEMENT "score-instrument" y1 <- read_1 (read_REQUIRED "id" read_ID) (attributes y) y2 <- read_3 read_Instrument_Name (read_MAYBE read_Instrument_Abbreviation) (read_MAYBE read_Score_Instrument_) (childs y) return (y1,y2) -- | show_Score_Instrument :: Score_Instrument -> [Content ()] show_Score_Instrument (a,(b,c,d)) = show_ELEMENT "score-instrument" (show_REQUIRED "id" show_ID a) (show_Instrument_Name b ++ show_MAYBE show_Instrument_Abbreviation c ++ show_MAYBE show_Score_Instrument_ d) -- | data Score_Instrument_ = Score_Instrument_1 Solo | Score_Instrument_2 Ensemble deriving (Eq, Show) -- | read_Score_Instrument_ :: StateT Result [Content i] Score_Instrument_ read_Score_Instrument_ = (read_Solo >>= return . Score_Instrument_1) `mplus` (read_Ensemble >>= return . Score_Instrument_2) -- | show_Score_Instrument_ :: Score_Instrument_ -> [Content ()] show_Score_Instrument_ (Score_Instrument_1 a) = show_Solo a show_Score_Instrument_ (Score_Instrument_2 a) = show_Ensemble a -- | type Instrument_Name = PCDATA -- | read_Instrument_Name :: StateT Result [Content i] Instrument_Name read_Instrument_Name = do y <- read_ELEMENT "instrument-name" read_1 read_PCDATA (childs y) -- | show_Instrument_Name :: Instrument_Name -> [Content ()] show_Instrument_Name a = show_ELEMENT "instrument-name" [] (show_PCDATA a) -- | type Instrument_Abbreviation = PCDATA -- | read_Instrument_Abbreviation :: StateT Result [Content i] Instrument_Abbreviation read_Instrument_Abbreviation = do y <- read_ELEMENT "instrument-abbreviation" read_1 read_PCDATA (childs y) -- | show_Instrument_Abbreviation :: Instrument_Abbreviation -> [Content ()] show_Instrument_Abbreviation a = show_ELEMENT "instrument-abbreviation" [] (show_PCDATA a) -- | type Solo = () -- | read_Solo :: StateT Result [Content i] Solo read_Solo = read_ELEMENT "solo" >> return () -- | show_Solo :: Solo -> [Content ()] show_Solo _ = show_ELEMENT "solo" [] [] -- | type Ensemble = PCDATA -- | read_Ensemble :: StateT Result [Content i] Ensemble read_Ensemble = do y <- read_ELEMENT "ensemble" read_1 read_PCDATA (childs y) -- | show_Ensemble :: Ensemble -> [Content ()] show_Ensemble a = show_ELEMENT "ensemble" [] (show_PCDATA a) \end{code} \begin{musicxml} The midi-device content corresponds to the DeviceName meta event in Standard MIDI Files. The optional port attribute is a number from 1 to 16 that can be used with the unofficial MIDI port (or cable) meta event. \end{musicxml} \begin{code} -- | type Midi_Device = (Maybe CDATA, PCDATA) -- | read_Midi_Device :: StateT Result [Content i] Midi_Device read_Midi_Device = do y <- read_ELEMENT "midi-device" y1 <- read_1 (read_IMPLIED "port" read_CDATA) (attributes y) y2 <- read_1 read_PCDATA (childs y) return (y1,y2) -- | show_Midi_Device :: Midi_Device -> [Content ()] show_Midi_Device (a,b) = show_ELEMENT "midi-device" (show_IMPLIED "port" show_CDATA a) (show_PCDATA b) \end{code} \begin{musicxml} The group element allows the use of different versions of the part for different purposes. Typical values include score, parts, sound, and data. Ordering information that is directly encoded in MuseData can be derived from the ordering within a MusicXML score or opus. \end{musicxml} \begin{code} -- | type Group = PCDATA -- | read_Group :: StateT Result [Content i] Group read_Group = do y <- read_ELEMENT "group" read_1 read_PCDATA (childs y) -- | show_Group :: Group -> [Content ()] show_Group a = show_ELEMENT "group" [] (show_PCDATA a) \end{code} \begin{musicxml} Here is the basic musical data that is either associated with a part or a measure, depending on whether partwise or timewise hierarchy is used. \end{musicxml} \begin{code} -- * Music_Data -- | type Music_Data = [Music_Data_] -- | read_Music_Data :: Eq i => StateT Result [Content i] Music_Data read_Music_Data = read_LIST read_Music_Data_ -- | show_Music_Data :: Music_Data -> [Content ()] show_Music_Data x = show_LIST show_Music_Data_ x -- | data Music_Data_ = Music_Data_1 Note | Music_Data_2 Backup | Music_Data_3 Forward | Music_Data_4 Direction | Music_Data_5 Attributes | Music_Data_6 Harmony | Music_Data_7 Figured_Bass | Music_Data_8 Print | Music_Data_9 Sound | Music_Data_10 Barline | Music_Data_11 Grouping | Music_Data_12 Link | Music_Data_13 Bookmark deriving (Eq, Show) -- | read_Music_Data_ :: Eq i => StateT Result [Content i] Music_Data_ read_Music_Data_ = (read_Note >>= return . Music_Data_1) `mplus` (read_Backup >>= return . Music_Data_2) `mplus` (read_Forward >>= return . Music_Data_3) `mplus` (read_Direction >>= return . Music_Data_4) `mplus` (read_Attributes >>= return . Music_Data_5) `mplus` (read_Harmony >>= return . Music_Data_6) `mplus` (read_Figured_Bass >>= return . Music_Data_7) `mplus` (read_Print >>= return . Music_Data_8) `mplus` (read_Sound >>= return . Music_Data_9) `mplus` (read_Barline >>= return . Music_Data_10) `mplus` (read_Grouping >>= return . Music_Data_11) `mplus` (read_Link >>= return . Music_Data_12) `mplus` (read_Bookmark >>= return . Music_Data_13) -- | show_Music_Data_ :: Music_Data_ -> [Content ()] show_Music_Data_ (Music_Data_1 x) = show_Note x show_Music_Data_ (Music_Data_2 x) = show_Backup x show_Music_Data_ (Music_Data_3 x) = show_Forward x show_Music_Data_ (Music_Data_4 x) = show_Direction x show_Music_Data_ (Music_Data_5 x) = show_Attributes x show_Music_Data_ (Music_Data_6 x) = show_Harmony x show_Music_Data_ (Music_Data_7 x) = show_Figured_Bass x show_Music_Data_ (Music_Data_8 x) = show_Print x show_Music_Data_ (Music_Data_9 x) = show_Sound x show_Music_Data_ (Music_Data_10 x) = show_Barline x show_Music_Data_ (Music_Data_11 x) = show_Grouping x show_Music_Data_ (Music_Data_12 x) = show_Link x show_Music_Data_ (Music_Data_13 x) = show_Bookmark x \end{code} \begin{musicxml} The score-header entity contains basic score metadata about the work and movement, score-wide defaults for layout and fonts, credits that appear on the first page, and the part list. \end{musicxml} \begin{code} -- * Score_Header -- | type Score_Header = (Maybe Work, Maybe Movement_Number, Maybe Movement_Title, Maybe Identification, Maybe Defaults, [Credit], Part_List) -- | read_Score_Header :: Eq i => StateT Result [Content i] Score_Header read_Score_Header = do y1 <- read_MAYBE read_Work y2 <- read_MAYBE read_Movement_Number y3 <- read_MAYBE read_Movement_Title y4 <- read_MAYBE read_Identification y5 <- read_MAYBE read_Defaults y6 <- read_LIST read_Credit y7 <- read_Part_List return (y1,y2,y3,y4,y5,y6,y7) -- | show_Score_Header :: Score_Header -> [Content ()] show_Score_Header (a,b,c,d,e,f,g) = show_MAYBE show_Work a ++ show_MAYBE show_Movement_Number b ++ show_MAYBE show_Movement_Title c ++ show_MAYBE show_Identification d ++ show_MAYBE show_Defaults e ++ show_LIST show_Credit f ++ show_Part_List g -- | update_Score_Header :: ([Software], Encoding_Date) -> Score_Header -> Score_Header update_Score_Header x (a,b,c,d,e,f,g) = (a, b, c, fmap (update_Identification x) d, e, f, g) \end{code}