packages feed

Aoide 1.0.0.0 → 2.0.0.0

raw patch · 16 files changed

+2582/−2153 lines, 16 files

Files

Aoide.cabal view
@@ -3,15 +3,16 @@ category: Composition, Lilypond, MIDI, Music description:   This library provides data structures and a custom file format for describing music and generates Lilypond and MIDI files. In-  addition it contains a module with some music-theoretical functions. The library is focused on the very basics of standard-  Western musical notation and does not support dynamic indications, articulation marks, double accidentals, tempo changes,-  polyrhythms, time signature changes and microtonality.+  addition it contains a module with some music-theoretical functions and generates keyboard reductions. The library is focused+  on the very basics of Western musical notation and does not support dynamic indications, articulation marks, double+  accidentals, tempo changes, polyrhythms, time signature changes and microtonality.+extra-doc-files: Keyboard.key, README.md, Scores/**/*.aoi license: BSD-3-Clause license-file: LICENSE maintainer: liisikerik@hotmail.com name: Aoide synopsis: A simple music library that can generate Lilypond and MIDI files.-version: 1.0.0.0+version: 2.0.0.0 common Common   build-depends:     Kawaii-Parser, barbies, base < 4.22, bytestring, containers, directory, filepath, generic-lens, lens, mtl, process, transformers@@ -41,11 +42,11 @@     Composition.Keyboard,     Composition.Lilypond,     Composition.MIDI,+    Composition.Notation,     Composition.Notes,     Composition.Parser,     Composition.Score,     Composition.Theory,-    Composition.Time,     Composition.Write executable Aoide   import: Common@@ -55,11 +56,11 @@     Composition.Keyboard,     Composition.Lilypond,     Composition.MIDI,+    Composition.Notation,     Composition.Notes,     Composition.Parser,     Composition.Score,     Composition.Theory,-    Composition.Time,     Composition.Write source-repository head   location: https://github.com/liisikerik/aoide.git
Composition/Errors.hs view
@@ -1,42 +1,44 @@ {-|-Description: Errors.+Errors. -}-module Composition.Errors (Error (..), Is_out_of_range_type (..), write_error) where+module Composition.Errors (Error (..), Is_out_of_range_type (..)) where+  import Composition.Notes   import Parser.Files   import Parser.Locations-  import Parser.Utilities   -- | Errors.   data Error =-    An_event_crosses_the_bar_line | ----    Conflicting_key_signature | ----    Duplicate_header_fields Location | ----    Duplicate_keys Location | ----    Duplicate_note_names_in_key_signature Location | ----    Duplicate_notes Location | ----    Empty_triplet | ----    File_error File_error | ----    Invalid_character_in_text | ----    Invalid_keyword String | ----    Invalid_note_length Location | ----    Invalid_note_name Location | ----    Invalid_time_numerator_factor Location | ----    Invalid_word String Location | ---+    An_event_crosses_the_bar_line |+    Conflicting_accidentals_in_key_signature |+    Duplicate_header_fields (Maybe Location) |+    Duplicate_keys Location |+    Duplicate_note_names_in_key_signature Location |+    Duplicate_notes Location |+    Empty_triplet |+    Event_or_part_length_is_out_of_range_for_MIDI |+    File_error File_error |+    Initial_position_is_out_of_range |+    Invalid_character_in_text |+    Invalid_note_length Int Location |+    Invalid_note_name Natural_note_name Accidental Location |+    Invalid_time_numerator_factor Int Location |+    Invalid_word String (Maybe Location) |     Is_out_of_range_with_location Is_out_of_range_type Location |     Is_out_of_range_without_location Is_out_of_range_type |-    Non_positive_note_length | ----    Note_length_denominator_contains_factors_other_than_2_and_3 | ----    Parse_error Location | ----    Track_ends_with_an_incomplete_triplet | ----    Track_length_mismatch | ----    Velocity_out_of_range Location ----  -- | Out of range error types.+    Key_is_out_of_range Int Location |+    MIDI_instrument_code_is_out_of_range_command Int |+    MIDI_instrument_code_is_out_of_range_data Int |+    MIDI_instrument_code_is_out_of_range_score Int Location |+    Non_positive_note_length |+    Note_is_out_of_range_for_MIDI (Note Pitched) |+    Note_length_denominator_contains_factors_other_than_2_and_3 |+    Parse_error_command |+    Parse_error_playables Location |+    Parse_error_score Location |+    Track_ends_with_an_incomplete_triplet |+    Track_length_mismatch |+    Velocity_out_of_range Location   data Is_out_of_range_type =-    Event_or_part_length_IOOR |-    Initial_position_IOOR |-    Key_IOOR |-    MIDI_instrument_code_IOOR |-    Note_IOOR |-    Note_length_denominator_IOOR | ---+    Note_length_denominator_IOOR |     Tempo_IOOR |     The_least_common_denominator_of_note_lengths_IOOR |     The_number_of_pitched_tracks_IOOR |@@ -45,51 +47,3 @@     Velocity_IOOR   deriving instance Show Error   deriving instance Show Is_out_of_range_type-  -- | Writing errors. ----  write_error :: Error -> String ----  write_error err = ----    case err of ----      An_event_crosses_the_bar_line -> "An event crosses the bar line." ----      Conflicting_key_signature -> "Conflicting key signature." ----      Duplicate_header_fields location -> "Duplicate header fields at " <> write_location location <> "." ----      Duplicate_keys location -> "Duplicate keys at " <> write_location location <> "." ----      Duplicate_note_names_in_key_signature location -> ----        "Duplicate note names in key signature at " <> write_location location <> "." ----      Duplicate_notes location -> "Duplicate notes at " <> write_location location <> "." ----      Empty_triplet -> "Empty triplet." ----      File_error err' -> ----        case err' of ----          Failed_to_find_the_file file_path -> "Failed to find the file " <> file_path <> "." ----          Invalid_file_path -> "Invalid file path." ----          Unexpected_extension ext -> "Unexpected extension ." <> ext <> "." ----      Invalid_character_in_text -> "Invalid character in text." ----      Invalid_keyword keyword -> "Invalid keyword " <> keyword <> "." ----      Invalid_note_length location -> "Invalid note length at " <> write_location location <> "." ----      Invalid_note_name location -> "Invalid note name at " <> write_location location <> "."-      Invalid_time_numerator_factor location -> "Invalid time numerator at " <> write_location location <> "." ----      Invalid_word word location -> "Invalid word " <> word <> " at " <> write_location location <> "." ----      Is_out_of_range_with_location typ location ->-        write_is_out_of_range_type typ <-> "at" <-> write_location location <-> "is out of range."-      Is_out_of_range_without_location typ -> write_is_out_of_range_type typ <-> "is out of range."-      Non_positive_note_length -> "Non-positive note length." ----      Note_length_denominator_contains_factors_other_than_2_and_3 -> ----        "Note length denominator contains factors other than 2 and 3." ----      Parse_error location -> "Parse error at " <> write_location location <> "." ----      Track_ends_with_an_incomplete_triplet -> "Track ends with an incomplete triplet." ----      Track_length_mismatch -> "Track length mismatch." ----      Velocity_out_of_range location -> "Velocity out of range at " <> write_location location <> "." ----  write_is_out_of_range_type :: Is_out_of_range_type -> String-  write_is_out_of_range_type typ =-    case typ of-      Event_or_part_length_IOOR -> "Event or part length"-      Initial_position_IOOR -> "Initial position"-      Key_IOOR -> "Key"-      MIDI_instrument_code_IOOR -> "MIDI instrument code"-      Note_IOOR -> "Note"-      Note_length_denominator_IOOR -> "Note length denominator"-      Tempo_IOOR -> "Tempo"-      The_least_common_denominator_of_note_lengths_IOOR -> "The least common denominator of note lengths"-      The_number_of_pitched_tracks_IOOR -> "The number of pitched tracks"-      The_number_of_tracks_IOOR -> "The number of tracks"-      Track_length_IOOR -> "Track length"-      Velocity_IOOR -> "Velocity"
Composition/Keyboard.hs view
@@ -1,710 +1,373 @@-{-| ----Description: Functions that deal with keyboard instruments. ---- ----* Checking whether a set of notes is playable on the keyboard ----* Keyboard transcriptions -----} ----module Composition.Keyboard (Keyboard (..), Playable (..), is_playable, keyboard, parse_playable, set_is_playable) where ----  import Composition.Errors ----  import Composition.Notes ----  import Composition.Score ----  import Composition.Theory ----  import Control.Lens.Combinators hiding (parts) ----  import Control.Monad.Except ----  import Control.Monad.Trans.Except ----  import Data.Char ----  import Data.Foldable as Foldable ----  import Data.Functor ----  import Data.List as List ----  import Data.Map.Strict as Map hiding (keys) ----  import Data.Maybe as Maybe ----  import Data.Ord ----  import Data.Set as Set ----  import Parser.Files ----  import Parser.Locations ----  import Parser.Parser ----  import Parser.Utilities ----  data Char_class = Delimiter_char Token | Invalid_char | Nonzero_nat_char Char | Whitespace_char | Zero_char ----  -- | Data structure for storing the left and right hand part of a chord or a piece. ----  data Keyboard t = Keyboard t t ----  data Notes_in = Notes_in (Set (Note Pitched)) (Set (Note Pitched)) ----  data Notes_in' = Notes_in' (Set (Note Pitched)) | Tie_in' (Set (Note Pitched)) ----  data Notes_out = Rest_out | Notes_out (Set (Note Pitched)) | Tie_out ----  type Parser = Parser' Token Error ----  -- | Data structure for describing playable note combinations. For example, [15] [3 10] means that two notes with an interval ----  -- of 15 semitones are playable only starting from D#/Eb and A#/Bb. ----  data Playable = Playable {intervals :: [Int], starting_keys :: Set Int} ----  data Token = Left_square_bracket_token | Newline_token | Positive_int_token Int | Right_square_bracket_token | Zero_token ----  type Tokeniser = Tokeniser' Char_class Token Error ----  instance Applicative Keyboard where ----    Keyboard f g <*> Keyboard left_hand right_hand = Keyboard (f left_hand) (g right_hand) ----    pure x = Keyboard x x ----  deriving instance Eq Char_class ----  deriving instance Eq Token ----  instance Foldable Keyboard where ----    foldr f x (Keyboard left_hand right_hand) = f left_hand (f right_hand x) ----  instance Functor Keyboard where ----    fmap f (Keyboard left_hand right_hand) = Keyboard (f left_hand) (f right_hand) ----  instance Traversable Keyboard where ----    traverse f (Keyboard left_hand right_hand) = Keyboard <$> f left_hand <*> f right_hand ----  classify_char :: Char -> Char_class ----  classify_char c = ----    case c of ----      '\n' -> Delimiter_char Newline_token ----      ' ' -> Whitespace_char ----      '0' -> Zero_char ----      _ | isDigit c && c /= '0' -> Nonzero_nat_char c ----      '[' -> Delimiter_char Left_square_bracket_token ----      ']' -> Delimiter_char Right_square_bracket_token ----      _ -> Invalid_char ----  construct_keys :: [Int] -> Either (Location -> Error) (Set Int) ----  construct_keys keys = ----    case construct_set keys of ----      Nothing -> Left Duplicate_keys ----      Just keys' -> Right keys' ----  crossing_middle_c :: Keyboard (Set (Note Pitched)) -> Int ----  crossing_middle_c (Keyboard l r) = crossing_middle_c' id Set.findMax l `max` crossing_middle_c' flip Set.findMin r ----  crossing_middle_c' :: ----    ( ----      ((Note Pitched -> Note Pitched -> Int) -> Note Pitched -> Note Pitched -> Int) -> ----      (Set (Note Pitched) -> Note Pitched) -> ----      Set (Note Pitched) -> ----      Int) ----  crossing_middle_c' maybeflip aggr notes = ----    (maybeflip distance_in_semitones (Pitched_note 4 C)) (aggr (Set.insert (Pitched_note 4 C) notes)) ----  delimiter_char :: Char_class -> Maybe Token ----  delimiter_char char_class = ----    case char_class of ----      Delimiter_char token -> Just token ----      _ -> Nothing ----  events_to_events_in :: [[Event' (Set (Note Pitched))]] -> [Event' Notes_in] ----  events_to_events_in events = events_to_events_in' ((<$>) (over #event_notes Notes_in') <$> events) ----  events_to_events_in' :: [[Event' (Notes_in')]] -> [Event' Notes_in] ----  events_to_events_in' events = ----    case () of ----      () | all Foldable.null events -> [] ----      () -> ----        let ----          len = minimum (view #event_length <$> head <$> events) ----          heads_and_tails = head_and_tail len <$> events in ----          ( ----            Event' (Foldable.foldr join_notes (Notes_in Set.empty Set.empty) (fst <$> heads_and_tails)) len : ----            events_to_events_in' (snd <$> heads_and_tails)) ----  filter_by_key :: (Eq t) => ([t] -> t) -> (u -> t) -> [u] -> [u] ----  filter_by_key fold_keys compute_key x = List.filter (\ y -> fold_keys (compute_key <$> x) == compute_key y) x ----  gen_hands :: [Playable] -> [Note Pitched] -> [Set (Note Pitched)] ----  gen_hands playable notes = ----    Set.empty : gen_hands' Set.empty notes where ----    gen_hands' :: Set (Note Pitched) -> [Note Pitched] -> [Set (Note Pitched)] ----    gen_hands' picked_notes potential_notes = ----      case potential_notes of ----        [] -> [] ----        note : potential_notes' -> ----          let ----            picked_notes' = Set.insert note picked_notes in ----            case is_acceptable playable picked_notes' of ----              False -> gen_hands' picked_notes potential_notes' ----              True -> picked_notes' : gen_hands' picked_notes' potential_notes' ----  gen_keyboard_confs :: [Note Pitched] -> [Keyboard (Set (Note Pitched))] ----  gen_keyboard_confs notes = Keyboard Set.empty (Set.fromList notes) : gen_keyboard_confs' Set.empty notes ----  gen_keyboard_confs' :: Set (Note Pitched) -> [Note Pitched] -> [Keyboard (Set (Note Pitched))] ----  gen_keyboard_confs' l r = ----    case r of ----      [] -> [] ----      note : r' -> ----        let ----          l' = Set.insert note l in ----          Keyboard l' (Set.fromList r') : gen_keyboard_confs' l' r' ----  hand_span :: Set (Note Pitched) -> Int ----  hand_span notes = ----    case Set.elems notes of ----      [] -> -1 ----      _ -> distance_in_semitones (minimum notes) (maximum notes) ----  head_and_tail :: Length_fraction -> [Event' (Notes_in')] -> (Notes_in, [Event' (Notes_in')]) ----  head_and_tail target_len events = ----    case events of ----      [] -> undefined ----      Event' notes len : events' -> ----        ( ----          transf_notes_in notes, ----          case () of ----            () | target_len == len -> events' ----            () -> Event' (notes_to_tie notes) (len - target_len) : events') ----  is_acceptable :: [Playable] -> Set (Note Pitched) -> Bool ----  is_acceptable playable notes = ----    case Set.elems notes of ----      [] -> True ----      note@(Pitched_note _ note_name) : notes' -> ----        any ----          (\ (Playable intervs starts) -> intervs == tointervs note notes' && any ((==) (semitones_from_c note_name)) starts) ----          playable ----  -- | Check if this configuration is playable on the keyboard. ----  is_playable :: [Playable] -> Keyboard (Set (Note Pitched)) -> Bool ----  is_playable playable k@(Keyboard l r) = ----    is_acceptable (mirror_playable <$> playable) l && is_acceptable playable r && not_crossing k ----  join_notes :: Notes_in -> Notes_in -> Notes_in ----  join_notes (Notes_in notes_0 ties_0) (Notes_in notes_1 ties_1) = ----    Notes_in (Set.union notes_0 notes_1) (Set.union ties_0 ties_1) ----  join_notes_out :: [Event' Notes_out] -> [Event_fraction Pitched] ----  join_notes_out events = ----    case events of ----      [] -> [] ----      Event' notes len : events' -> join_notes_out' (Event' (notes_to_set notes) len) events' ----  join_notes_out' :: Event_fraction Pitched -> [Event' Notes_out] -> [Event_fraction Pitched] ----  join_notes_out' (Event' notes_0 len_0) events = ----    case events of ----      [] -> [Event' notes_0 len_0] ----      Event' maybe_notes_1 len_1 : events' -> ----        case maybe_notes_1 of ----          Rest_out -> ----            case Set.elems notes_0 of ----              [] -> join_notes_out' (Event' Set.empty (len_0 + len_1)) events' ----              _ : _ -> Event' notes_0 len_0 : join_notes_out' (Event' Set.empty len_1) events' ----          Notes_out notes_1 -> Event' notes_0 len_0 : join_notes_out' (Event' notes_1 len_1) events' ----          Tie_out -> join_notes_out' (Event' notes_0 (len_0 + len_1)) events' ----  keyboard :: [Playable] -> Maybe String -> MIDI_instrument -> Score -> Either Error Score ----  keyboard playable header_instrument midi_instrument (Score {title = score_title, header, parts}) = ----    do ----      keyboard_parts <- traverse keyboard_part parts ----      Right (Score {title = score_title, header = keyboard_header, parts = keyboard_parts}) where ----    gen_variants :: Set (Note Pitched) -> [Keyboard (Set (Note Pitched))] ----    gen_variants notes = ----      List.filter ----        not_crossing ----        ( ----          Keyboard <$> ----          gen_hands (mirror_playable <$> playable) (Set.elems notes) <*> ----          gen_hands playable (reverse (Set.elems notes))) ----    keyb :: Keyboard (Set (Note Pitched)) -> [Event' Notes_in] -> Keyboard [Event' Notes_out] ----    keyb (Keyboard old_notes_lft old_notes_rght) events = ----      case events of ----        [] -> pure [] ----        Event' (Notes_in notes ties) len : events' -> ----          let ----            Keyboard lft rght = ----              head ----                (( ----                  filter_by_key maximum right_hand_note_count <$> ----                  filter_by_key minimum narrower_hand_span <$> ----                  filter_by_key minimum wider_hand_note_count <$> ----                  filter_by_key minimum wider_hand_span <$> ----                  filter_by_key minimum crossing_middle_c <$> ----                  filter_by_key maximum number_of_notes) ----                  (gen_variants notes)) ----            (cont_notes_arg_lft, cont_notes_res_lft) = ----              case Set.elems lft of ----                [] -> ----                  case Set.elems (Set.union old_notes_lft ties) of ----                    [] -> (Set.empty, Rest_out) ----                    _ : _ -> (old_notes_lft, Tie_out) ----                _ : _ -> (lft, Notes_out lft) ----            (cont_notes_arg_rght, cont_notes_res_rght) = ----              case Set.elems rght of ----                [] -> ----                  case Set.elems (Set.union old_notes_rght ties) of ----                    [] -> (Set.empty, Rest_out) ----                    _ : _ -> (old_notes_rght, Tie_out) ----                _ : _ -> (rght, Notes_out rght) in ----            ( ----              (:) <$> ----              ((\ n -> Event' n len) <$> Keyboard cont_notes_res_lft cont_notes_res_rght) <*> ----              keyb (Keyboard cont_notes_arg_lft cont_notes_arg_rght) events') ----    keyboard_header :: Map Header_field String ----    keyboard_header = ----      case header_instrument of ----        Nothing -> header ----        Just header_instrument' -> Map.insert Instrument header_instrument' header ----    keyboard_part :: Part -> Either Error Part ----    keyboard_part (Part {title = part_title, key, time, initial_position, tempo, stave_groups}) = ----      do ----        let tracks = remove_notational_information stave_groups ----        _ <- tracks_length tracks ----        Keyboard left_hand_track right_hand_track <- ----          traverse ----            (notate time initial_position) ----            ( ----              join_notes_out <$> ----              (keyb ----                (pure Set.empty) ----                (events_to_events_in ----                  (Maybe.mapMaybe ----                    (pitched_or_unpitched (\ (Track {events}) -> Just events) (\ _ -> Nothing)) ----                    (remove_notational_information stave_groups))))) ----        Right ----          (Part { ----            title = part_title, ----            key, ----            time, ----            initial_position, ----            tempo, ----            stave_groups = ----              [ ----                [ ----                  Pitched ----                    (Instrument_clefs_and_staves { ----                      instrument_name = "", ----                      midi_instrument, ----                      velocity = max_velocity, ----                      clefs_and_staves = ----                        [ ----                          Clef_and_stave { ----                            clef = Pitched_clef {clef_name = Treble, transposition = 0}, ----                            stave = One_track right_hand_track}, ----                          Clef_and_stave { ----                            clef = Pitched_clef {clef_name = Bass, transposition = 0}, ----                            stave = One_track left_hand_track}]})]]}) ----  mirror_key :: Int -> Int ----  mirror_key key = mod (4 - key) 12 ----  mirror_playable :: Playable -> Playable ----  mirror_playable (Playable intervals keys) = Playable (reverse intervals) (Set.fromList (mirror_key <$> Set.elems keys)) ----  nat_char :: Char_class -> Maybe Char ----  nat_char char_class = ----    case char_class of ----      Zero_char -> Just '0' ----      Nonzero_nat_char c -> Just c ----      _ -> Nothing ----  narrower_hand_span :: Keyboard (Set (Note Pitched)) -> Int ----  narrower_hand_span k = minimum (hand_span <$> k) ----  next_location :: Char_class -> Location -> Location ----  next_location char_class = ----    case char_class of ----      Delimiter_char Newline_token -> next_line ----      _ -> next_char ----  nonzero_nat_char :: Char_class -> Maybe Char ----  nonzero_nat_char char_class = ----    case char_class of ----      Nonzero_nat_char c -> Just c ----      _ -> Nothing ----  not_crossing :: Keyboard (Set (Note Pitched)) -> Bool ----  not_crossing (Keyboard l r) = ----    case (Set.elems l, Set.elems r) of ----      (_ : _, _ : _) -> Set.findMax l < Set.findMin r ----      _ -> True ----  notes_to_set :: Notes_out -> Set (Note Pitched) ----  notes_to_set maybe_notes = ----    case maybe_notes of ----      Rest_out -> Set.empty ----      Notes_out notes -> notes ----      Tie_out -> Set.empty ----  notes_to_tie :: Notes_in' -> Notes_in' ----  notes_to_tie maybe_notes = ----    case maybe_notes of ----      Notes_in' notes -> Tie_in' notes ----      Tie_in' notes -> Tie_in' notes ----  number_of_notes :: Keyboard (Set (Note Pitched)) -> Int ----  number_of_notes k = sum (Set.size <$> k) ----  parse_key :: Parser Int ----  parse_key = filter_parser ((>=) 11) (Is_out_of_range_with_location Key_IOOR) parse_nat ----  parse_keys :: Parser (Set Int) ----  parse_keys = fmap_filter_parser construct_keys (parse_list' parse_key) ----  parse_list' :: Parser t -> Parser [t] ----  parse_list' parse_t = parse_square_brackets (parse_many parse_t) ----  parse_nat :: Parser Int ----  parse_nat = parse_zero <+> parse_positive_int ----  parse_playable :: File_path -> ExceptT Error IO [Playable] ----  parse_playable file_path = ----    do ----      file <- read_file "key" readFile File_error file_path ----      except (fromJust (parse' classify_char next_location tokenise parse_playable' Parse_error file)) ----  parse_playable' :: Parser [Playable] ----  parse_playable' = parse_list Newline_token (Playable <$> parse_list' parse_positive_int <*> parse_keys) ----  parse_positive_int :: Parser Int ----  parse_positive_int = parse_token' positive_int_token ----  parse_square_brackets :: Parser t -> Parser t ----  parse_square_brackets = parse_brackets Left_square_bracket_token Right_square_bracket_token ----  parse_zero :: Parser Int ----  parse_zero = ----    do ----      parse_token Zero_token ----      return 0 ----  positive_int_token :: Token -> Maybe Int ----  positive_int_token token = ----    case token of ----      Positive_int_token i -> Just i ----      _ -> Nothing ----  right_hand_note_count :: Keyboard (Set (Note Pitched)) -> Int ----  right_hand_note_count (Keyboard _ r) = Set.size r ----  -- | Check if the set of notes is playable on the keyboard. ----  set_is_playable :: [Playable] -> Set (Note Pitched) -> Bool ----  set_is_playable playable notes = any (is_playable playable) (gen_keyboard_confs (Set.elems notes)) ----  tointervs :: Note Pitched -> [Note Pitched] -> [Int] ----  tointervs note_0 notes = ----    case notes of ----      [] -> [] ----      note_1 : notes' -> distance_in_semitones note_0 note_1 : tointervs note_1 notes' ----  tokenise :: Tokeniser () ----  tokenise = void (parse_many tokenise_1) ----  tokenise_1 :: Tokeniser () ----  tokenise_1 = tokenise_delimiter <+> tokenise_nat <+> tokenise_whitespace ----  tokenise_delimiter :: Tokeniser () ----  tokenise_delimiter = add_token (parse_token' delimiter_char) ----  tokenise_nat :: Tokeniser () ----  tokenise_nat = add_token (tokenise_zero <+> tokenise_positive_int) ----  tokenise_positive_int :: Tokeniser Token ----  tokenise_positive_int = ----    Positive_int_token <$> read <$> ((:) <$> parse_token' nonzero_nat_char <*> parse_many (parse_token' nat_char)) ----  tokenise_whitespace :: Tokeniser () ----  tokenise_whitespace = parse_token Whitespace_char ----  tokenise_zero :: Tokeniser Token ----  tokenise_zero = ----    do ----      parse_token Zero_char ----      return Zero_token ----  transf_notes_in :: Notes_in' -> Notes_in ----  transf_notes_in maybe_notes = ----    case maybe_notes of ----      Notes_in' notes -> Notes_in notes Set.empty ----      Tie_in' notes -> Notes_in Set.empty notes ----  wider_hand_span :: Keyboard (Set (Note Pitched)) -> Int ----  wider_hand_span k = maximum (hand_span <$> k) ----  wider_hand_note_count :: Keyboard (Set (Note Pitched)) -> Int ----  wider_hand_note_count k = Set.size (maximumBy (comparing hand_span) k) ----{- ----  calc_intervs :: Note Pitched -> [Note Pitched] -> [Int] ----  calc_intervs note notes = ----    case notes of ----      [] -> [] ----      note' : notes' -> distance_in_semitones note note' : calc_intervs note' notes' ----  cat_head_tail :: Length_fraction -> Notes_in -> [Event_out] -> [Event_out] ----  cat_head_tail len notes_in evs = ----    case (notes_in, evs) of ----      (Rest_in, []) -> [Event_out Rest_out len] ----      (Rest_in, Event_out Rest_out len' : evs') -> Event_out Rest_out (len + len') : evs' ----      (Rest_in, Event_out (Notes_out notes') len' : evs') -> Event_out Rest_out len : Event_out (Notes_out notes') len' : evs' ----      (Rest_in, Event_out Tie_out _ : _) -> undefined ----      (Notes_in notes, []) -> [Event_out (Notes_out notes) len] ----      (Notes_in notes, Event_out Rest_out len' : evs') -> Event_out (Notes_out notes) len : Event_out Rest_out len' : evs' ----      (Notes_in notes, Event_out (Notes_out notes') len' : evs') -> ----        Event_out (Notes_out notes) len : Event_out (Notes_out notes') len' : evs' ----      (Notes_in notes, Event_out Tie_out len' : evs') -> Event_out (Notes_out notes) (len + len') : evs' ----      (Tie_in _, []) -> [Event_out Tie_out len] ----      (Tie_in _, Event_out Rest_out len' : evs') -> Event_out Tie_out len : Event_out Rest_out len' : evs' ----      (Tie_in _, Event_out (Notes_out notes') len' : evs') -> Event_out Tie_out len : Event_out (Notes_out notes') len' : evs' ----      (Tie_in _, Event_out Tie_out len' : evs') -> Event_out Tie_out (len + len') : evs' ----  choose_next_chord :: [([Int], [Int])] -> Keyboard Old_notes -> Set (Note Pitched) -> Set (Note Pitched) -> Keyboard Notes_in ----  choose_next_chord acceptable_combinations old_notes potential_tied_notes potential_new_notes = ----      min_wider_hand_range = minimum (wider_hand_range <$> all_lrs_3) ----      all_lrs_4 = List.filter (\ var -> min_wider_hand_range == wider_hand_range var) all_lrs_3 ----      min_max_notes = minimum (max_notes <$> all_lrs_4) ----      all_lrs_5 = List.filter (\ var -> min_max_notes == max_notes var) all_lrs_4 ----      min_narrower_hand_range = minimum (narrower_hand_range <$> all_lrs_5) ----      all_lrs_6 = List.filter (\ var -> min_narrower_hand_range == narrower_hand_range var) all_lrs_5 ----      max_right_hand_notes = maximum (right_hand_notes <$> all_lrs_6) ----      all_lrs_7 = List.filter (\ var -> max_right_hand_notes == right_hand_notes var) all_lrs_6 in ----      find_res potential_tied_notes <$> old_notes <*> head all_lrs_7 ----  constr_events_in :: [Event_fraction Pitched] -> Events_in ----  constr_events_in events = ----    case events of ----      [] -> Empty_events_in ----      Event_fraction notes len : events' -> Construct_events_in (First_event_in (constr_notes_in notes) len) events' ----  constr_notes_in :: Set (Note Pitched) -> Notes_in ----  constr_notes_in notes = ----    case Set.elems notes of ----      [] -> Rest_in ----      _ -> Notes_in notes ----  constr_events_out :: Time -> Initial_position -> [Event_out] -> Either Error [Event Pitched] ----  constr_events_out time initial_position events = notate time initial_position (constr_events_out' events) ----  constr_events_out' :: [Event_out] -> [Event_fraction Pitched] ----  constr_events_out' events = ----    case events of ----      [] -> [] ----      [Event_out notes len] -> ----        [ ----          Event_fraction ----            (case notes of ----              Rest_out -> Set.empty ----              Notes_out notes' -> notes' ----              Tie_out -> undefined) ----            len] ----      Event_out notes_0 len_0 : Event_out notes_1 len_1 : events' -> ----        case (notes_0, notes_1) of ----          (Rest_out, Rest_out) -> constr_events_out' (Event_out Rest_out (len_0 + len_1) : events') ----          (Rest_out, Notes_out _) -> ----            Event_fraction Set.empty len_0 : constr_events_out' (Event_out notes_1 len_1 : events') ----          (Notes_out notes'_0, Rest_out) -> ----            Event_fraction notes'_0 len_0 : constr_events_out' (Event_out notes_1 len_1 : events') ----          (Notes_out notes'_0, Notes_out _) -> ----            Event_fraction notes'_0 len_0 : constr_events_out' (Event_out notes_1 len_1 : events') ----          (Notes_out _, Tie_out) -> constr_events_out' (Event_out notes_0 (len_0 + len_1) : events') ----          _ -> undefined -----} ----{- ----  filter_new_notes :: Notes_in -> Maybe (Set (Note Pitched)) ----  filter_new_notes notes_in = ----    case notes_in of ----      New_notes_in notes -> Just notes ----      _ -> Nothing ----  filter_old_notes :: Notes_in -> Maybe (Set (Note Pitched)) ----  filter_old_notes notes_in = ----    case notes_in of ----      Old_notes_in notes -> Just notes ----      _ -> Nothing ----  filters :: Keyboard (Set (Note Pitched)) -> [Keyboard (Set (Note Pitched))] -> Keyboard (Set (Note Pitched)) ----  filters current_notes = _ -----} ----{- ----  find_res :: Set (Note Pitched) -> Old_notes -> Set (Note Pitched) -> Notes_in ----  find_res potential_tied_notes old_notes new_notes = ----    case Set.null new_notes of ----      False -> Notes_in new_notes ----      True -> ----        case old_notes of ----          Old_notes_rest -> Rest_in ----          Old_notes_notes old_notes' -> ----            case Set.null (Set.intersection potential_tied_notes old_notes') of ----              False -> Tie_in old_notes' ----              True -> Rest_in ----  is_acceptable :: Playable -> [Note Pitched] -> Bool ----  is_acceptable acceptable_combinations notes = ----    case notes of ----      [] -> True ----      note : notes' -> any (is_acceptable' note notes') acceptable_combinations ----  is_acceptable' :: Note Pitched -> [Note Pitched] -> ([Int], [Int]) -> Bool ----  is_acceptable' note@(Pitched_note _ note_name) notes (intervs, strts) = ----    calc_intervs note notes == intervs && elem (semitones_from_c note_name) strts ----  keyb :: [Playable] -> Keyboard Old_notes -> [[Event' Notes_in]] -> Keyboard [Event' Notes_out] ----  keyb playable old_notes tracks = ----    case all ((==) Empty_events_in) tracks of ----      False -> ----        let ----          (len, cont_notes, new_notes, tracks') = head_and_tail tracks ----          next_notes = choose_next_chord acceptable_combinations old_notes cont_notes new_notes ----          next_events = keyb acceptable_combinations (transf_notes' <$> next_notes) tracks' in ----          cat_head_tail len <$> next_notes <*> next_events ----      True -> pure [] ----  keyboard :: File_path -> String -> Instrument Pitched -> File_path -> Directory -> String -> IO () ----  keyboard acceptable_combinations_file_path instrument_name midi_instrument score_file_path dir fname = ----    do ----      res <- runExceptT (keyboard_h acceptable_combinations_file_path instrument_name midi_instrument score_file_path) ----      case res of ----        Left err -> putStrLn (write_error err) ----        Right score -> write dir fname score ----  keyboard_h :: File_path -> String -> Instrument Pitched -> File_path -> ExceptT Error IO Score ----  keyboard_h acceptable_combinations_file_path instrument_name midi_instrument score_file_path = ----    do ----      acceptable_combinations <- parse_keyboard acceptable_combinations_file_path ----      score <- parse score_file_path ----      ExceptT (return (keyboard_help acceptable_combinations instrument_name midi_instrument score)) -----} ----{- ----        let keyb_res = ----              keyb ----                acceptable_combinations ----                (pure Old_notes_rest) ----                (catMaybes ----                  (pitched_or_unpitched (\ (Track {events}) -> Just (constr_events_in events)) (return Nothing) <$> tracks)) ----        Keyboard left_hand_track right_hand_track <- traverse (constr_events_out time initial_position) keyb_res ----  max_notes :: Keyboard (Set (Note Pitched)) -> Int ----  max_notes k = maximum (Set.size <$> k) ----  narrower_hand_range :: Keyboard (Set (Note Pitched)) -> Int ----  narrower_hand_range k = minimum (hand_range <$> k) -----} ----{- ----  notes_out_to_notes_0 :: Notes_out -> Set (Note Pitched) ----  notes_out_to_notes_0 notes_out = ----    case notes_out of ----      New_notes_out notes -> notes ----      Old_notes_out notes -> Tie ----      Rest_notes_out -> Set.empty -----} ----{- ----  notes_out_to_notes_1 :: Notes' -> Notes Pitched ----  notes_out_to_notes_1 notes_out = ----    case notes_out of ----      Notes'_rest -> Notes (Set.empty) ----      Notes'_notes notes -> Notes notes ----      Notes'_tie _ -> Tie -----} ----{- ----  notes_to_notes_in :: Set (Note Pitched) -> Notes Pitched -> (Notes_in, Set (Note Pitched)) ----  notes_to_notes_in prev_notes maybe_notes = ----    case maybe_notes of ----      Notes notes -> ----        ( ----          case Set.size notes of ----            0 -> Rest_notes_in ----            _ -> New_notes_in notes, ----          notes) ----      Tie -> (Old_notes_in prev_notes, prev_notes) -----} ----{- ----  only_new :: Notes_in -> Set (Note Pitched) ----  only_new notes_in = ----    case notes_in of ----      Notes_in notes -> notes ----      _ -> Set.empty ----  only_ties :: Notes_in -> Set (Note Pitched) ----  only_ties notes_in = ----    case notes_in of ----      Tie_in notes -> notes ----      _ -> Set.empty ----  right_hand_notes :: Keyboard (Set (Note Pitched)) -> Int ----  right_hand_notes (Keyboard _ r) = Set.size r -----} ----{- ----  select_new_notes :: Set (Note Pitched) -> Set (Note Pitched) -> Set (Note Pitched) -> Notes_out ----  select_new_notes old_notes current_notes new_notes = ----    case () of ----      () | Set.null new_notes -> ----        case () of ----          () | not (Set.null current_notes) && isSubsetOf current_notes old_notes -> Old_notes_out ----          () -> Rest_notes_out ----      _ -> New_notes_out new_notes ----  seq2 :: Set (Note Pitched) -> [Event Pitched] -> Either String [Simultaneous_in] ----  seq2 prev_notes evs = ----    case evs of ----      [] -> Right [] ----      ev : evs' -> ----        do ----          (ev2, nxt_notes) <- simultaneous_to_simultaneous_in prev_notes ev ----          evs2 <- seq2 nxt_notes evs' ----          Right (ev2 : evs2) -----} ----{- ----  sequential_in_tail_to_sequential_in :: [Simultaneous_in] -> Sequential_in ----  sequential_in_tail_to_sequential_in sequential_in_tail = ----    case sequential_in_tail of ----      [] -> Empty_sequential_in ----      simultaneous_in : sequential_in_tail' -> Construct_sequential_in simultaneous_in sequential_in_tail' -----} ----{- ----  sequential_out_to_sequential :: Sequential_out -> [Event Pitched] ----  sequential_out_to_sequential sequential_out = ----    case sequential_out of ----      Empty_sequential_out -> [] ----      Construct_sequential_out simultaneous_out sequential -> simultaneous_out_to_simultaneous simultaneous_out : sequential ----  sequential_to_sequential_in :: Old_notes -> [Event Pitched] -> Either String ([Event'], Old_notes) ----  sequential_to_sequential_in maybe_old_notes sequential = ----    case sequential of ----      [] -> Right ([], maybe_old_notes) ----      ev : sequential' -> ----        case ev of ----          Event maybe_new_notes len -> ----            case maybe_new_notes of ----              Notes new_notes -> ----                case Set.size new_notes of ----                  0 -> first ((:) (Event' Notes'_rest len)) <$> sequential_to_sequential_in Old_notes_rest sequential' ----                  _ -> ----                    ( ----                      first ((:) (Event' (Notes'_notes new_notes) len)) <$> ----                      sequential_to_sequential_in (Old_notes_notes new_notes) sequential') ----              Tie -> ----                case maybe_old_notes of ----                  Old_notes_rest -> ----                    first ((:) (Event' Notes'_rest len)) <$> sequential_to_sequential_in Old_notes_rest sequential' ----                  Old_notes_notes old_notes -> ----                    ( ----                      first ((:) (Event' (Notes'_tie old_notes) len)) <$> ----                      sequential_to_sequential_in (Old_notes_notes old_notes) sequential') ----          Tuplet rat evs -> ----            do ----              (evs', maybe_old_notes') <- sequential_to_sequential_in maybe_old_notes evs ----              (evs'', maybe_old_notes'') <- sequential_to_sequential_in maybe_old_notes' sequential' ----              Right (Tuplet' rat evs' : evs'', maybe_old_notes'') ----  simultaneous_out_to_simultaneous :: Event' -> Event Pitched ----  simultaneous_out_to_simultaneous ev = ----    case ev of ----      Event' notes_out len -> Event (notes_out_to_notes_1 notes_out) len ----      Tuplet' rat evs -> Tuplet rat (simultaneous_out_to_simultaneous <$> evs) -----} ----{- ----  simultaneous_to_simultaneous_in :: Set (Note Pitched) -> Event Pitched -> Either String (Simultaneous_in, Set (Note Pitched)) ----  simultaneous_to_simultaneous_in prev_notes (Event notes len) = ----    do ----      check "Non-positive note length." (0 < len) ----      let (notes', notes'') = notes_to_notes_in prev_notes notes ----      Right (Simultaneous_in notes' len, notes'') ----  tail_notes :: Notes_in -> Notes_in ----  tail_notes notes_in = ----    case notes_in of ----      New_notes_in notes -> Old_notes_in notes ----      Old_notes_in notes -> Old_notes_in notes ----      Rest_notes_in -> Rest_notes_in -----} ----{- ----  transf_notes' :: Notes_in -> Old_notes ----  transf_notes' notes_in = ----    case notes_in of ----      Rest_in -> Old_notes_rest ----      Notes_in notes -> Old_notes_notes notes ----      Tie_in notes -> Old_notes_notes notes ----  transf_old_pos :: Old_notes -> Set (Note Pitched) ----  transf_old_pos notes' = ----    case notes' of ----      Old_notes_rest -> Set.empty ----      Old_notes_notes notes -> notes ----  var_size :: Keyboard (Set (Note Pitched)) -> Int ----  var_size k = sum (Set.size <$> k) ----  compute_distance :: Keyboard (Set Note) -> Keyboard (Set Note) -> Semitones ----  compute_distance keyboard_notes_0 keyboard_notes_1 = sum (compute_distance' <$> keyboard_notes_0 <*> keyboard_notes_1) ----  compute_distance' :: Set Note -> Set Note -> Semitones ----  compute_distance' notes_0 notes_1 = sum (abs <$> (distance_in_semitones <$> elems notes_0 <*> elems notes_1)) ----  compute_distances_in_semitones :: [Note] -> [Semitones] ----  compute_distances_in_semitones notes = zipWith distance_in_semitones (init notes) (tail notes) ----  -- | The lowest and highest voices are always included. The algorithm attempts to include as many middle voices as possible ----  -- while keeping the score playable. ----  number_of_notes :: Keyboard (Set Note) -> Int ----  number_of_notes keyboard_notes = sum (fmap size keyboard_notes) ----  order :: Ord t => t -> t -> (t, t) ----  order x y = ----    case compare' x y of ----      LT' -> (x, y) ----      EQ' z -> (z, z) ----      GT' -> (y, x) ----  -- | Checks whether a set of notes is playable on the keyboard. ----  playable :: Set Note -> Bool ----  playable notes = any playable' (divide_between_hands (elems notes)) ----  playable' :: Keyboard (Set Note) -> Bool ----  playable' (Keyboard left_hand_notes right_hand_notes) = ----    playable_with_the_left_hand left_hand_notes && playable_with_the_right_hand right_hand_notes ----  playable_with_one_hand :: ----    (Set Note -> Maybe Note) -> (Semitones -> Semitones) -> ([Semitones] -> [Semitones]) -> Set Note -> Bool ----  playable_with_one_hand reference_note mirror_semitones_from_c mirror_distances_in_semitones notes = ----    case reference_note notes of ----      Nothing -> True ----      Just (Note _ note_name) -> ----        elem ----          (mirror_semitones_from_c (semitones_from_c note_name)) ----          (playable_with_the_right_hand_table (mirror_distances_in_semitones (compute_distances_in_semitones (elems notes)))) ----  playable_with_the_left_hand :: Set Note -> Bool ----  playable_with_the_left_hand = playable_with_one_hand lookupMax (\) reverse ----  playable_with_the_right_hand :: Set Note -> Bool ----  playable_with_the_right_hand = playable_with_one_hand lookupMin id id ----  range :: Keyboard (Set Note) -> Range ----  range (Keyboard left_hand_notes right_hand_notes) = ----    uncurry Range (swap (order (range' left_hand_notes) (range' right_hand_notes))) ----  range' :: Set Note -> Maybe Semitones ----  range' notes = distance_in_semitones <$> lookupMin notes <*> lookupMax notes ----  shape :: Keyboard (Set Note) -> Shape ----  shape (Keyboard left_hand_notes right_hand_notes) = ----    construct_shape (shape' id lookupMin reverse left_hand_notes) (shape' flip lookupMax id right_hand_notes) ----  shape' :: ----    ( ----      ((Note -> Note -> Semitones) -> Note -> Note -> Semitones) -> ----      (Set Note -> Maybe Note) -> ----      ([Note] -> [Note]) -> ----      Set Note -> ----      Maybe [Semitones]) ----  shape' flip_or_not get_reference_note reverse_or_not notes = ----    do ----      reference_note <- get_reference_note notes ----      Just (flip_or_not distance_in_semitones reference_note <$> reverse_or_not (elems (delete reference_note notes))) ----  wrong_order :: Maybe Note -> Maybe Note -> Maybe Semitones -> Keyboard (Set Note) -> Maybe Semitones ----  wrong_order left_hand_limit right_hand_limit if_distance_zero (Keyboard left_hand_notes right_hand_notes) = ----    let ----      f = wrong_order' if_distance_zero ----    in ----      max (f (lookupMax left_hand_notes) left_hand_limit) (f right_hand_limit (lookupMin right_hand_notes)) ----  wrong_order' :: Maybe Semitones -> Maybe Note -> Maybe Note -> Maybe Semitones ----  wrong_order' if_distance_zero maybe_note_0 maybe_note_1 = ----    do ----      note_0 <- maybe_note_0 ----      note_1 <- maybe_note_1 ----      let distance = distance_in_semitones note_0 note_1 ----      case compare distance 0 of ----        LT -> Just (negate distance) ----        EQ -> if_distance_zero ----        GT -> Nothing ----  wrong_stave :: Keyboard (Set Note) -> Maybe Semitones ----  wrong_stave = wrong_order (Just (Note 4 C)) (Just (Note 4 C)) Nothing -----} ---+{-|+Keyboard playability and reductions.+-}+module Composition.Keyboard (+  Keyboard (..),+  Playable (..),+  keyboard_playable,+  notes_to_keyboard,+  parse_playables,+  reduction) where+  import Composition.Errors+  import Composition.Notation+  import Composition.Notes+  import Composition.Score+  import Composition.Theory+  import Control.Lens.Combinators hiding (parts)+  import Control.Monad.Except+  import Control.Monad.Trans.Except+  import Data.Char+  import Data.Foldable as Foldable+  import Data.Functor+  import Data.List as List+  import Data.Map.Strict as Map hiding (keys)+  import Data.Maybe as Maybe+  import Data.Ord+  import Data.Set as Set+  import Parser.Files+  import Parser.Locations+  import Parser.Parser+  import Parser.Utilities+  data Char_class = Delimiter_char Token | Invalid_char | Nonzero_nat_char Char | Whitespace_char | Zero_char+  -- | Data structure for storing the left and right hand part of a chord or score part.+  data Keyboard t = Keyboard t t+  data Notes_in = Notes_in (Set (Note Pitched)) (Set (Note Pitched))+  data Notes_in' = Notes_in' (Set (Note Pitched)) | Tie_in' (Set (Note Pitched))+  data Notes_out = Rest_out | Notes_out (Set (Note Pitched)) | Tie_out+  type Parser = Parser' Token Error+  -- | Data structure for describing playable note combinations. For example, [15] [3 10] means that two notes with an interval+  -- of 15 semitones are playable with the right hand only starting from D#/Eb and A#/Bb.+  data Playable = Playable {semitones :: [Semitones], starting_keys :: Set Int}+  data Token = Left_square_bracket_token | Newline_token | Positive_int_token Int | Right_square_bracket_token | Zero_token+  type Tokeniser = Tokeniser' Char_class Token Error+  instance Applicative Keyboard where+    Keyboard f g <*> Keyboard left_hand right_hand = Keyboard (f left_hand) (g right_hand)+    pure x = Keyboard x x+  deriving instance Eq Char_class+  deriving instance Eq Token+  instance Foldable Keyboard where+    foldr f x (Keyboard left_hand right_hand) = f left_hand (f right_hand x)+  instance Functor Keyboard where+    fmap f (Keyboard left_hand right_hand) = Keyboard (f left_hand) (f right_hand)+  instance Traversable Keyboard where+    traverse f (Keyboard left_hand right_hand) = Keyboard <$> f left_hand <*> f right_hand+  all_notes :: [Playable] -> [Note Pitched] -> [Set (Note Pitched)]+  all_notes playables notes =+    Set.empty : all_notes' Set.empty notes where+    all_notes' :: Set (Note Pitched) -> [Note Pitched] -> [Set (Note Pitched)]+    all_notes' picked_notes notes' =+      case notes' of+        [] -> []+        note : notes'' ->+          let+            picked_notes' = Set.insert note picked_notes in+            case notes_playable playables picked_notes' of+              False -> all_notes' picked_notes notes''+              True -> picked_notes' : all_notes' picked_notes' notes''+  best :: (Eq u) => (t -> u) -> ([u] -> u) -> [t] -> [t]+  best metric best_metric x = List.filter (\ y -> best_metric (metric <$> x) == metric y) x+  best_keyboard :: [Keyboard (Set (Note Pitched))] -> Keyboard (Set (Note Pitched))+  best_keyboard =+    (+      head <$>+      best right_hand_note_count maximum <$>+      best narrower_hand_span minimum <$>+      best wider_hand_note_count minimum <$>+      best wider_hand_span minimum <$>+      best crosses_middle_c minimum <$>+      best note_count maximum)+  classify_char :: Char -> Char_class+  classify_char c =+    case c of+      '\n' -> Delimiter_char Newline_token+      ' ' -> Whitespace_char+      '0' -> Zero_char+      _ | isDigit c && c /= '0' -> Nonzero_nat_char c+      '[' -> Delimiter_char Left_square_bracket_token+      ']' -> Delimiter_char Right_square_bracket_token+      _ -> Invalid_char+  construct_keys :: [Int] -> Either (Location -> Error) (Set Int)+  construct_keys keys =+    case construct_set keys of+      Nothing -> Left Duplicate_keys+      Just keys' -> Right keys'+  continuing_notes_and_event ::+    Set (Note Pitched) -> Length_fraction -> Set (Note Pitched) -> Set (Note Pitched) -> (Set (Note Pitched), Event' Notes_out)+  continuing_notes_and_event ties len old_notes new_notes =+    let+      (continuing_notes, notes_out) =+        case Set.elems new_notes of+          [] ->+            case Set.elems (Set.union old_notes ties) of+              [] -> (Set.empty, Rest_out)+              _ : _ -> (old_notes, Tie_out)+          _ : _ -> (new_notes, Notes_out new_notes) in+      (continuing_notes, Event' notes_out len)+  crosses_middle_c :: Keyboard (Set (Note Pitched)) -> Int+  crosses_middle_c (Keyboard left_hand_notes right_hand_notes) =+    crosses_middle_c' id Set.findMax left_hand_notes `max` crosses_middle_c' flip Set.findMin right_hand_notes+  crosses_middle_c' ::+    (+      ((Note Pitched -> Note Pitched -> Int) -> Note Pitched -> Note Pitched -> Int) ->+      (Set (Note Pitched) -> Note Pitched) ->+      Set (Note Pitched) ->+      Int)+  crosses_middle_c' order_arguments innermost_note notes =+    order_arguments distance_in_semitones (Pitched_note 4 C) (innermost_note (Set.insert (Pitched_note 4 C) notes))+  delimiter_char :: Char_class -> Maybe Token+  delimiter_char char_class =+    case char_class of+      Delimiter_char token -> Just token+      _ -> Nothing+  events_out_to_events :: [Event' Notes_out] -> [Event_fraction Pitched]+  events_out_to_events events =+    case events of+      [] -> []+      Event' notes len : events' -> events_out_to_events' (Event' (notes_out_to_set notes) len) events'+  events_out_to_events' :: Event_fraction Pitched -> [Event' Notes_out] -> [Event_fraction Pitched]+  events_out_to_events' event@(Event' notes_0 len_0) events =+    case events of+      [] -> [event]+      Event' maybe_notes_1 len_1 : events' ->+        case maybe_notes_1 of+          Rest_out ->+            case Set.elems notes_0 of+              [] -> events_out_to_events' (Event' Set.empty (len_0 + len_1)) events'+              _ : _ -> event : events_out_to_events' (Event' Set.empty len_1) events'+          Notes_out notes_1 -> event : events_out_to_events' (Event' notes_1 len_1) events'+          Tie_out -> events_out_to_events' (Event' notes_0 (len_0 + len_1)) events'+  events_to_events_in :: [[Event' (Set (Note Pitched))]] -> [Event' Notes_in]+  events_to_events_in events = events_to_events_in' ((<$>) (over #event_notes Notes_in') <$> events)+  events_to_events_in' :: [[Event' (Notes_in')]] -> [Event' Notes_in]+  events_to_events_in' events =+    case () of+      () | all Foldable.null events -> []+      () ->+        let+          len = minimum (view #event_length <$> head <$> events)+          heads_and_tails = head_and_tail len <$> events in+          (+            Event' (Foldable.foldr union_notes_in (Notes_in Set.empty Set.empty) (fst <$> heads_and_tails)) len :+            events_to_events_in' (snd <$> heads_and_tails))+  hand_span :: Set (Note Pitched) -> Int+  hand_span notes =+    case Set.elems notes of+      [] -> -1+      _ -> distance_in_semitones (minimum notes) (maximum notes)+  hands_not_crossed :: Keyboard (Set (Note Pitched)) -> Bool+  hands_not_crossed (Keyboard left_hand_notes right_hand_notes) =+    case (Set.elems left_hand_notes, Set.elems right_hand_notes) of+      (_ : _, _ : _) -> Set.findMax left_hand_notes < Set.findMin right_hand_notes+      _ -> True+  head_and_tail :: Length_fraction -> [Event' (Notes_in')] -> (Notes_in, [Event' (Notes_in')])+  head_and_tail len events =+    case events of+      [] -> undefined+      Event' notes len' : events' ->+        (+          transform_notes_in notes,+          case () of+            () | len == len' -> events'+            () -> Event' (notes_in_to_tie notes) (len' - len) : events')+  -- | Check if this configuration is playable on keyboard.+  keyboard_playable :: [Playable] -> Keyboard (Set (Note Pitched)) -> Bool+  keyboard_playable playables keyboard@(Keyboard left_hand_notes right_hand_notes) =+    (+      notes_playable (mirror_playables playables) left_hand_notes &&+      hands_not_crossed keyboard &&+      notes_playable playables right_hand_notes)+  mirror_key :: Int -> Int+  mirror_key key = mod (4 - key) 12+  mirror_playable :: Playable -> Playable+  mirror_playable (Playable semitones keys) = Playable (reverse semitones) (Set.fromList (mirror_key <$> Set.elems keys))+  mirror_playables :: [Playable] -> [Playable]+  mirror_playables = (<$>) mirror_playable+  nat_char :: Char_class -> Maybe Char+  nat_char char_class =+    case char_class of+      Zero_char -> Just '0'+      Nonzero_nat_char c -> Just c+      _ -> Nothing+  narrower_hand_span :: Keyboard (Set (Note Pitched)) -> Int+  narrower_hand_span keyboard = minimum (hand_span <$> keyboard)+  next_location :: Char_class -> Location -> Location+  next_location char_class =+    case char_class of+      Delimiter_char Newline_token -> next_line+      _ -> next_char+  nonzero_nat_char :: Char_class -> Maybe Char+  nonzero_nat_char char_class =+    case char_class of+      Nonzero_nat_char c -> Just c+      _ -> Nothing+  note_count :: Keyboard (Set (Note Pitched)) -> Int+  note_count keyboard = sum (Set.size <$> keyboard)+  notes_in_to_tie :: Notes_in' -> Notes_in'+  notes_in_to_tie maybe_notes =+    case maybe_notes of+      Notes_in' notes -> Tie_in' notes+      Tie_in' notes -> Tie_in' notes+  notes_out_to_set :: Notes_out -> Set (Note Pitched)+  notes_out_to_set maybe_notes =+    case maybe_notes of+      Rest_out -> Set.empty+      Notes_out notes -> notes+      Tie_out -> Set.empty+  notes_playable :: [Playable] -> Set (Note Pitched) -> Bool+  notes_playable playables notes =+    case Set.elems notes of+      [] -> True+      note@(Pitched_note _ note_name) : notes' ->+        any (notes_playable' (notes_to_semitones note notes') (semitones_from_c note_name)) playables+  notes_playable' :: [Int] -> Int -> Playable -> Bool+  notes_playable' semitones' starting_key (Playable semitones starting_keys) =+    semitones == semitones' && any ((==) starting_key) starting_keys+  notes_to_semitones :: Note Pitched -> [Note Pitched] -> [Int]+  notes_to_semitones note_0 notes =+    case notes of+      [] -> []+      note_1 : notes' -> distance_in_semitones note_0 note_1 : notes_to_semitones note_1 notes'+  -- | Check if the set of notes is playable on keyboard and distribute the notes between hands as well as possible.+  notes_to_keyboard :: [Playable] -> Set (Note Pitched) -> Maybe (Keyboard (Set (Note Pitched)))+  notes_to_keyboard playables notes =+    case List.filter (keyboard_playable playables) (split_notes_between_hands notes) of+      [] -> Nothing+      keyboards -> Just (best_keyboard keyboards)+  parse_key :: Parser Int+  parse_key = filter_parser ((>=) 11) Key_is_out_of_range parse_nat+  parse_keys :: Parser (Set Int)+  parse_keys = fmap_filter_parser construct_keys (parse_list' parse_key)+  parse_list' :: Parser t -> Parser [t]+  parse_list' parse_t = parse_square_brackets (parse_many parse_t)+  parse_nat :: Parser Int+  parse_nat = parse_zero <+> parse_positive_int+  parse_playable :: Parser Playable+  parse_playable = Playable <$> parse_list' parse_positive_int <*> parse_keys+  -- | Parse keyboard playability file.+  parse_playables :: File_path -> ExceptT Error IO [Playable]+  parse_playables file_path =+    do+      playables <- read_file "key" readFile File_error file_path+      except (fromJust (parse' classify_char next_location tokenise parse_playables' Parse_error_playables playables))+  parse_playables' :: Parser [Playable]+  parse_playables' = parse_list Newline_token parse_playable+  parse_positive_int :: Parser Int+  parse_positive_int = parse_token' positive_int_token+  parse_square_brackets :: Parser t -> Parser t+  parse_square_brackets = parse_brackets Left_square_bracket_token Right_square_bracket_token+  parse_zero :: Parser Int+  parse_zero =+    do+      parse_token Zero_token+      return 0+  pitched_events :: Pitched_or_unpitched Track -> Maybe [Event_fraction Pitched]+  pitched_events = pitched_or_unpitched (\ (Track {events}) -> Just events) (\ _ -> Nothing)+  positive_int_token :: Token -> Maybe Int+  positive_int_token token =+    case token of+      Positive_int_token i -> Just i+      _ -> Nothing+  -- | Keyboard reduction. You have to provide playability data, optional instrument score header field and a MIDI instrument+  -- code.+  reduction :: [Playable] -> Map Header_field String -> MIDI_instrument -> Score -> Either Error Score+  reduction playables header midi_instrument (Score {parts}) =+    do+      keyboard_parts <- traverse keyboard_part parts+      Right (Score {header, parts = keyboard_parts}) where+    all_keyboards :: Set (Note Pitched) -> [Keyboard (Set (Note Pitched))]+    all_keyboards notes =+      List.filter+        hands_not_crossed+        (+          Keyboard <$>+          all_notes (mirror_playables playables) (Set.elems notes) <*>+          all_notes playables (reverse (Set.elems notes)))+    events_to_keyboard :: Keyboard (Set (Note Pitched)) -> [Event' Notes_in] -> Keyboard [Event' Notes_out]+    events_to_keyboard old_keyboard events =+      case events of+        [] -> pure []+        Event' (Notes_in new_notes ties) len : events' ->+          let+            new_keyboard = best_keyboard (all_keyboards new_notes)+            continuing_notes_and_event_keyboard = continuing_notes_and_event ties len <$> old_keyboard <*> new_keyboard in+            (+              (:) <$>+              (snd <$> continuing_notes_and_event_keyboard) <*>+              events_to_keyboard (fst <$> continuing_notes_and_event_keyboard) events')+    keyboard_part :: Part -> Either Error Part+    keyboard_part (Part {title = part_title, key, time, initial_position, tempo, stave_groups}) =+      do+        let tracks = remove_notational_information stave_groups+        _ <- tracks_length tracks+        Keyboard left_hand_track right_hand_track <-+          traverse+            (add_notational_information time initial_position)+            (+              events_out_to_events <$>+              events_to_keyboard (pure Set.empty) (events_to_events_in (Maybe.mapMaybe pitched_events tracks)))+        Right+          (Part {+            title = part_title,+            key,+            time,+            initial_position,+            tempo,+            stave_groups =+              [+                [+                  Pitched+                    (Instrument_and_staves {+                      instrument_name = "",+                      short_instrument_name = "",+                      midi_instrument,+                      velocity = max_velocity,+                      staves =+                        [+                          Stave {+                            clef = Pitched_clef {clef_name = Treble, transposition = 0},+                            tracks = One_track right_hand_track},+                          Stave {+                            clef = Pitched_clef {clef_name = Bass, transposition = 0},+                            tracks = One_track left_hand_track}]})]]})+  right_hand_note_count :: Keyboard (Set (Note Pitched)) -> Int+  right_hand_note_count (Keyboard _ right_hand_notes) = Set.size right_hand_notes+  split_notes_between_hands :: Set (Note Pitched) -> [Keyboard (Set (Note Pitched))]+  split_notes_between_hands notes = Keyboard Set.empty notes : split_notes_between_hands' Set.empty (Set.elems notes)+  split_notes_between_hands' :: Set (Note Pitched) -> [Note Pitched] -> [Keyboard (Set (Note Pitched))]+  split_notes_between_hands' left_hand_notes notes =+    case notes of+      [] -> []+      note : notes' ->+        let+          left_hand_notes' = Set.insert note left_hand_notes in+          Keyboard left_hand_notes' (Set.fromList notes') : split_notes_between_hands' left_hand_notes' notes'+  tokenise :: Tokeniser ()+  tokenise = void (parse_many tokenise_1)+  tokenise_1 :: Tokeniser ()+  tokenise_1 = tokenise_delimiter <+> tokenise_nat <+> tokenise_whitespace+  tokenise_delimiter :: Tokeniser ()+  tokenise_delimiter = add_token (parse_token' delimiter_char)+  tokenise_nat :: Tokeniser ()+  tokenise_nat = add_token (tokenise_zero <+> tokenise_positive_int)+  tokenise_positive_int :: Tokeniser Token+  tokenise_positive_int =+    Positive_int_token <$> read <$> ((:) <$> parse_token' nonzero_nat_char <*> parse_many (parse_token' nat_char))+  tokenise_whitespace :: Tokeniser ()+  tokenise_whitespace = parse_token Whitespace_char+  tokenise_zero :: Tokeniser Token+  tokenise_zero =+    do+      parse_token Zero_char+      return Zero_token+  transform_notes_in :: Notes_in' -> Notes_in+  transform_notes_in maybe_notes =+    case maybe_notes of+      Notes_in' notes -> Notes_in notes Set.empty+      Tie_in' notes -> Notes_in Set.empty notes+  union_notes_in :: Notes_in -> Notes_in -> Notes_in+  union_notes_in (Notes_in notes_0 ties_0) (Notes_in notes_1 ties_1) =+    Notes_in (Set.union notes_0 notes_1) (Set.union ties_0 ties_1)+  wider_hand_span :: Keyboard (Set (Note Pitched)) -> Int+  wider_hand_span keyboard = maximum (hand_span <$> keyboard)+  wider_hand_note_count :: Keyboard (Set (Note Pitched)) -> Int+  wider_hand_note_count keyboard = Set.size (maximumBy (comparing hand_span) keyboard)
Composition/Lilypond.hs view
@@ -1,394 +1,380 @@-{-| ----Description: Generating Lilypond files. ---- ----* Generating Lilypond files -----} ----module Composition.Lilypond (lilypond) where ----  import Composition.Errors ----  import Composition.Notes ----  import Composition.Score ----  import Composition.Theory ----  import Composition.Time ----  import Control.Lens.Combinators hiding (index, parts) ----  import Control.Lens.Operators ----  import Control.Monad.Except ----  import Control.Monad.State.Strict ----  import Control.Monad.Trans.Except ----  import Data.Bifunctor ----  import Data.Char ----  import Data.Foldable ----  import Data.Generics.Labels () ----  import Data.List ----  import Data.Map.Strict as Map ----  import Data.Set as Set ----  import GHC.Generics ----  import GHC.Real ----  import Parser.Files ----  import Parser.Utilities ----  data Header_field' = Header_field' String String ----  data State = State {state_notes :: Bool, state_position :: Position} ----  deriving instance Generic Composition.Lilypond.State ----  deriving instance Show Header_field' ----  check_char :: Char -> Either Error () ----  check_char c = check Invalid_character_in_text (elem c " !#$%&'()*+,-./:;<=>?@[]^_`{|}~" || isDigit c || isLetter c) ----  convert_header_field :: (Header_field, String) -> Header_field' ----  convert_header_field (name, value) = Header_field' (write_header_field_name name) value ----  convert_events_to_pitched :: Note Pitched -> [Event note_type] -> [Event Pitched] ----  convert_events_to_pitched unpitched_note = (<$>) convert_event_to_pitched where ----    convert_event_to_pitched :: Event note_type -> Event Pitched ----    convert_event_to_pitched event = ----      case event of ----        Event notes len -> Event (convert_notes_to_pitched notes) len ----        Triplet events -> Triplet (convert_events_to_pitched unpitched_note events) ----    convert_note_to_pitched :: Note note_type -> Note Pitched ----    convert_note_to_pitched note = ----      case note of ----        Pitched_note _ _ -> note ----        Unpitched_note -> unpitched_note ----    convert_notes_to_pitched :: Notes note_type -> Notes Pitched ----    convert_notes_to_pitched maybe_notes = ----      case maybe_notes of ----        Notes notes -> Notes (Set.mapMonotonic convert_note_to_pitched notes) ----        Tie -> Tie ----  delete_default_tagline :: Header_field' ----  delete_default_tagline = Header_field' "tagline" "" ----  -- | Encodes the score in Lilypond format and writes it to the specified file. ----  lilypond :: File_path -> Score -> ExceptT Error IO () ----  lilypond file_path score = ----    do ----      written_score <- except (write_score score) ----      write_file "ly" writeFile File_error file_path written_score ----  write_accidental :: Accidental -> String ----  write_accidental accidental = ----    case accidental of ----      Flat -> "f" ----      Natural -> "" ----      Sharp -> "s" ----  write_angular_brackets :: String -> String ----  write_angular_brackets = write_brackets "<" ">" ----  write_angular_brackets_2 :: String -> String ----  write_angular_brackets_2 = write_brackets "<<" ">>" ----  write_basic_length :: Basic_length -> String ----  write_basic_length len = show (denominator (basic_length_to_fraction len)) ----  write_brackets :: String -> String -> String -> String ----  write_brackets left_bracket right_bracket x = left_bracket <> x <> right_bracket ----  write_clef :: Clef note_type -> String ----  write_clef clef = ----    case clef of ----      Percussion_clef -> "percussion" ----      Pitched_clef {clef_name, transposition} -> write_clef_name clef_name <> write_clef_transposition transposition ----  write_clef_name :: Clef_name -> String ----  write_clef_name clef_name = ----    case clef_name of ----      Subbass -> "subbass" ----      Bass -> "bass" ----      Baritone_F -> "baritonevarF" ----      Baritone_C -> "baritone" ----      Tenor -> "tenor" ----      Alto -> "alto" ----      Mezzosoprano -> "mezzosoprano" ----      Soprano -> "soprano" ----      Treble -> "treble" ----      French -> "french" ----  write_clef_transposition :: Steps -> String ----  write_clef_transposition transposition = ----    case compare transposition 0 of ----      LT -> write_clef_transposition' "_" (negate transposition) ----      EQ -> "" ----      GT -> write_clef_transposition' "^" transposition ----  write_clef_transposition' :: String -> Steps -> String ----  write_clef_transposition' index transposition = index <> show transposition ----  write_curly_brackets :: String -> String ----  write_curly_brackets = write_brackets "{" "}" ----  write_dot :: Dot -> Char ----  write_dot Dot = '.' ----  write_end_bar_line :: String ----  write_end_bar_line = "\\bar" <-> "\"|.\"" ----  write_eq :: String -> String -> String ----  write_eq x y = x <-> "=" <-> y ----  write_header :: [Header_field'] -> Either Error String ----  write_header header = ----    do ----      written_header_fields <- traverse write_header_field header ----      Right ("\\header" <-> write_curly_brackets (intercalate " " written_header_fields)) ----  write_header_field :: Header_field' -> Either Error String ----  write_header_field (Header_field' name value) = write_eq name <$> write_quotes value ----  write_header_field_name :: Header_field -> String ----  write_header_field_name name = ----    case name of ----      Composer -> "composer" ----      Instrument -> "instrument" ----      Subtitle -> "subtitle" ----  write_key :: Key -> Either Error String ----  write_key key = ----    do ----      note_names <- ----        traverse ----          (write_key_note_name (fromListWith (<>) (second return <$> deconstruct_note_name <$> Set.elems key))) ----          (enumFromTo C_natural B_natural) ----      Right (write_note_name C <-> "#" <> "`" <> write_round_brackets (intercalate " " note_names)) ----  write_key_accidental :: Accidental -> String ----  write_key_accidental accidental = ----    case accidental of ----      Flat -> "FLAT" ----      Natural -> "NATURAL" ----      Sharp -> "SHARP" ----  write_key_natural_note_name :: Natural_note_name -> String ----  write_key_natural_note_name natural_note_name = show (fromEnum natural_note_name) ----  write_key_note_name :: Map Natural_note_name [Accidental] -> Natural_note_name -> Either Error String ----  write_key_note_name key natural_note_name = ----    case Map.lookup natural_note_name key of ----      Nothing -> write_key_note_name' natural_note_name Natural ----      Just accidentals' -> ----        case accidentals' of ----          [accidental] -> write_key_note_name' natural_note_name accidental ----          _ -> Left Conflicting_key_signature ----  write_key_note_name' :: Natural_note_name -> Accidental -> Either Error String ----  write_key_note_name' natural_note_name accidental = ----    Right ----      (write_round_brackets (write_key_natural_note_name natural_note_name <-> "." <-> "," <> write_key_accidental accidental)) ----  write_language :: Either Error String ----  write_language = ----    do ----      written_language <- write_quotes "english.ly" ----      Right ("\\include" <-> written_language) ----  write_length :: Length -> String ----  write_length (Length len dots) = write_basic_length len <> (write_dot <$> dots) ----  write_natural_note_name :: Natural_note_name -> String ----  write_natural_note_name natural_note_name = ----    case natural_note_name of ----      C_natural -> "c" ----      D_natural -> "d" ----      E_natural -> "e" ----      F_natural -> "f" ----      G_natural -> "g" ----      A_natural -> "a" ----      B_natural -> "b" ----  write_note :: Note Pitched -> String ----  write_note (Pitched_note octave note_name) = write_note_name note_name <> write_octave octave ----  write_note_name :: Note_name -> String ----  write_note_name note_name = ----    let ----      (natural_note_name, accidental) = deconstruct_note_name note_name ----    in ----      write_natural_note_name natural_note_name <> write_accidental accidental ----  write_notes :: Notes Pitched -> StateT Composition.Lilypond.State (Either Error) (Bool, String) ----  write_notes maybe_notes = ----    case maybe_notes of ----      Notes notes -> ----        do ----          #state_notes .= not (Set.null notes) ----          return ----            ( ----              False, ----              case Set.elems notes of ----                [] -> "r" ----                notes' -> write_angular_brackets (intercalate " " (write_note <$> notes'))) ----      Tie -> ----        do ----          -- Composition.Lilypond.State {state_notes} <- get ----          notes <- use #state_notes ----          return ----            ( ----              notes, ----              case notes of ----                False -> "r" ----                True -> "") ----  write_octave :: Octave -> String ----  write_octave octave = ----    case compare octave 3 of ----      LT -> replicate (3 - octave) ',' ----      EQ -> "" ----      GT -> replicate (octave - 3) '\'' ----  write_option :: String -> String -> String ----  write_option option value = "#" <> write_round_brackets ("ly:set-option" <-> "'" <> option <-> value) ----  write_options :: String ----  write_options = intercalate " " [write_option "delete-intermediate-files" "#t", write_option "no-point-and-click" "#t"] ----  write_override :: String -> String -> String ----  write_override name value = "\\override" <-> write_eq name value ----  write_part :: Part -> Either Error String ----  write_part (Part {title, key, time, initial_position, stave_groups}) = ----    do ----      written_header <- write_header [Header_field' "piece" title] ----      written_set_key <- write_set_key key ----      written_time_and_initial_position <- write_time_and_initial_position ----      _ <- tracks_length (remove_notational_information stave_groups) ----      written_stave_groups <- traverse write_stave_group stave_groups ----      Right ----        ( ----          written_set_key <-> ----          written_time_and_initial_position <-> ----          "\\score" <-> ----          write_curly_brackets (written_header <-> write_angular_brackets_2 (intercalate " " written_stave_groups))) where ----    write_clef_and_stave :: Clef_and_stave note_type -> Either Error String ----    write_clef_and_stave (Clef_and_stave {clef, stave}) = ----      do ----        written_set_clef <- write_set_clef clef ----        written_tracks <- ----          case stave of ----            One_track events -> write_events (convert_events_to_pitched (Pitched_note 4 C) events) ----            Two_tracks events_0 events_1 -> ----              do ----                written_voice_0 <- write_voice "\\voiceOne" (convert_events_to_pitched (Pitched_note 4 D) events_0) ----                written_voice_1 <- write_voice "\\voiceTwo" (convert_events_to_pitched (Pitched_note 3 B) events_1) ----                Right (write_angular_brackets_2 (written_voice_0 <-> written_voice_1)) ----        Right ----          ( ----            "\\new" <-> ----            "Staff" <-> ----            "\\with" <-> ----            write_curly_brackets ----              (case clef of ----                Percussion_clef -> ----                  ( ----                    write_override "StaffSymbol.line-count" (show (length written_tracks)) <-> ----                    write_override "Stem.neutral-direction" "1") ----                Pitched_clef {} -> "") <-> ----            write_curly_brackets ----              ( ----                intercalate ----                  " " ----                  ( ----                    (case clef of ----                      Percussion_clef -> [] ----                      Pitched_clef {} -> ["\\Key"]) <> ----                    ["\\Time_and_initial_position", written_set_clef]) <-> ----                written_tracks <-> ----                write_end_bar_line)) ----    write_event :: Int -> Event Pitched -> StateT Composition.Lilypond.State (Either Error) (Bool, String) ----    write_event triplets event = ----      case event of ----        Event notes len -> ----          do ----            Composition.Lilypond.State {state_position} <- get ----            let position' = state_position + (2 % 3) ^ triplets * length_to_fraction len ----            position'' <- ----              case compare position' (measure_length time) of ----                LT -> return position' ----                EQ -> return 0 ----                GT -> throwError An_event_crosses_the_bar_line ----            #state_position .= position'' ----            (tie, written_notes) <- write_notes notes ----            return (tie, written_notes <> write_length len) ----        Triplet events -> ----          do ----            maybe_written_events <- write_events' (1 + triplets) events ----            case maybe_written_events of ----              Nothing -> throwError Empty_triplet ----              Just (tie, written_events) -> return (tie, "\\tuplet" <-> "3/2" <-> write_curly_brackets written_events) ----    write_events :: [Event Pitched] -> Either Error String ----    write_events events = ----      do ----        maybe_written_events <- ----          evalStateT ----            (write_events' 0 events) ----            (Composition.Lilypond.State {state_notes = False, state_position = initial_position_to_fraction initial_position}) ----        Right ----          (case maybe_written_events of ----            Nothing -> "" ----            Just (_, written_events) -> written_events) ----    write_events' :: Int -> [Event Pitched] -> StateT Composition.Lilypond.State (Either Error) (Maybe (Bool, String)) ----    write_events' triplets events = ----      case events of ----        [] -> return Nothing ----        event : events' -> ----          do ----            (tie_0, written_event) <- write_event triplets event ----            maybe_written_events <- write_events' triplets events' ----            return ----              (Just ----                ( ----                  tie_0, ----                  intercalate ----                    " " ----                    ( ----                      written_event : ----                      case maybe_written_events of ----                        Nothing -> [] ----                        Just (tie_1, written_events) -> ----                          ( ----                            (case tie_1 of ----                              False -> [] ----                              True -> ["~"]) <> ----                            [written_events])))) ----    write_initial_position :: Either Error String ----    write_initial_position = ----      do ----        let initial_position' = initial_position_to_fraction initial_position ----        check-          (Is_out_of_range_without_location Initial_position_IOOR)-          (between 0 (measure_length time - 1 % 128) initial_position') ----        let num :% den = measure_length time - initial_position' ----        Right (show den <-> "*" <-> show num) ----    write_instrument_clefs_and_staves :: Pitched_or_unpitched Instrument_clefs_and_staves -> Either Error String ----    write_instrument_clefs_and_staves = pitched_and_unpitched write_instrument_clefs_and_staves' ----    write_instrument_clefs_and_staves' :: Instrument_clefs_and_staves note_type -> Either Error String ----    write_instrument_clefs_and_staves' (Instrument_clefs_and_staves {instrument_name, clefs_and_staves}) = ----      do ----        written_instrument_name <- write_quotes instrument_name ----        written_clefs_and_staves <- traverse write_clef_and_stave clefs_and_staves ----        Right ----          ( ----            "\\new" <-> ----            "PianoStaff" <-> ----            "\\with" <-> ----            write_curly_brackets (write_eq "instrumentName" written_instrument_name) <-> ----            write_angular_brackets_2 (intercalate " " written_clefs_and_staves)) ----    write_set_initial_position :: Either Error String ----    write_set_initial_position = ----      do ----        written_initial_position <- write_initial_position ----        Right ("\\partial" <-> written_initial_position) ----    write_stave_group :: [Pitched_or_unpitched Instrument_clefs_and_staves] -> Either Error String ----    write_stave_group stave_group = ----      case stave_group of ----        [instrument_clefs_and_staves] -> write_instrument_clefs_and_staves instrument_clefs_and_staves ----        _ -> ----          do ----            written_instruments_clefs_and_staves <- traverse write_instrument_clefs_and_staves stave_group ----            Right ("\\new" <-> "StaffGroup" <-> write_angular_brackets_2 (intercalate " " written_instruments_clefs_and_staves)) ----    write_time_and_initial_position :: Either Error String ----    write_time_and_initial_position = ----      do ----        written_set_initial_position <- write_set_initial_position ----        Right ( ----          write_eq ----            "Time_and_initial_position" ----            (write_curly_brackets ----              (intercalate " " (["\\numericTimeSignature", write_set_time time, written_set_initial_position])))) ----    write_voice :: String -> [Event Pitched] -> Either Error String ----    write_voice voice_name events = ----      do ----        written_events <- write_events events ----        Right ("\\new" <-> "Voice" <-> write_curly_brackets (voice_name <-> write_curly_brackets written_events)) ----  write_quotes :: String -> Either Error String ----  write_quotes text = ----    do ----      traverse_ check_char text ----      Right (write_brackets "\"" "\"" text) ----  write_round_brackets :: String -> String ----  write_round_brackets = write_brackets "(" ")" ----  write_score :: Score -> Either Error String ----  write_score (Score {title, header, parts}) = ----    do ----      written_parts <- traverse write_part parts ----      written_language <- write_language ----      written_header <- ----        write_header (delete_default_tagline : Header_field' "title" title : (convert_header_field <$> assocs header)) ----      Right (write_options <-> written_language <-> written_header <-> intercalate " " written_parts) ----  write_set_clef :: Clef note_type -> Either Error String ----  write_set_clef clef = ----    do ----      written_clef <- write_quotes (write_clef clef) ----      Right ("\\clef" <-> written_clef) ----  write_set_key :: Key -> Either Error String ----  write_set_key key = ----    do ----      written_key <- write_key key ----      Right (write_eq "Key" (write_curly_brackets ("\\key" <-> written_key))) ----  write_set_time :: Time -> String ----  write_set_time time = "\\time" <-> write_time time ----  write_time :: Time -> String ----  write_time (Time num den) = write_time_numerator num <> "/" <> write_basic_length den ----  write_time_numerator :: [Time_numerator_factor] -> String ----  write_time_numerator num = show (time_numerator_to_int num) ---+{-|+Generates Lilypond files.+-}+module Composition.Lilypond (lilypond) where+  import Composition.Errors+  import Composition.Notation+  import Composition.Notes+  import Composition.Score+  import Composition.Theory+  import Control.Lens.Combinators hiding (index, parts)+  import Control.Lens.Operators+  import Control.Monad.Except+  import Control.Monad.State.Strict hiding (State)+  import Control.Monad.Trans.Except+  import Data.Bifunctor+  import Data.Char+  import Data.Foldable+  import Data.Generics.Labels ()+  import Data.List+  import Data.Map.Strict as Map+  import Data.Set as Set+  import GHC.Generics+  import GHC.Real+  import Parser.Files+  import Parser.Utilities+  data Header_field' = Header_field' String String+  data State = State {state_notes :: Bool, state_position :: Position}+  deriving instance Generic State+  deriving instance Show Header_field'+  deriving instance Show State+  check_char :: Char -> Either Error ()+  check_char c = check Invalid_character_in_text (elem c " !#$%&'()*+,-./:;<=>?@[]^_`{|}~" || isDigit c || isLetter c)+  convert_header_field :: (Header_field, String) -> Header_field'+  convert_header_field (name, value) = Header_field' write_header_field_name value where+    write_header_field_name :: String+    write_header_field_name =+      case name of+        Left_text -> "poet"+        Overtitle -> "dedication"+        Right_text -> "composer"+        Subtitle -> "subtitle"+        Subsubtitle -> "subsubtitle"+        Title -> "title"+  -- | Encodes the score in Lilypond format and writes it to the specified file.+  lilypond :: Score -> File_path -> ExceptT Error IO ()+  lilypond score file_path =+    do+      written_score <- except (write_score score)+      write_file "ly" writeFile File_error file_path written_score+  write_accidental :: Accidental -> String+  write_accidental accidental =+    case accidental of+      Flat -> "f"+      Natural -> ""+      Sharp -> "s"+  write_angular_brackets :: String -> String+  write_angular_brackets = write_brackets "<" ">"+  write_angular_brackets_2 :: String -> String+  write_angular_brackets_2 = write_brackets "<<" ">>"+  write_basic_length :: Basic_length -> String+  write_basic_length len = show (basic_length_denominator len)+  write_brackets :: String -> String -> String -> String+  write_brackets left_bracket right_bracket x = left_bracket <> x <> right_bracket+  write_clef_name :: Clef_name -> String+  write_clef_name clef_name =+    case clef_name of+      Subbass -> "subbass"+      Bass -> "bass"+      Baritone_F -> "baritonevarF"+      Baritone_C -> "baritone"+      Tenor -> "tenor"+      Alto -> "alto"+      Mezzosoprano -> "mezzosoprano"+      Soprano -> "soprano"+      Treble -> "treble"+      French -> "french"+  write_curly_brackets :: String -> String+  write_curly_brackets = write_brackets "{" "}"+  write_dot :: Dot -> Char+  write_dot Dot = '.'+  write_eq :: String -> String -> String+  write_eq x y = x <-> "=" <-> y+  write_header :: [Header_field'] -> Either Error String+  write_header header =+    do+      fields <- traverse write_header_field header+      Right ("\\header" <-> write_curly_brackets (intercalate " " fields))+  write_header_field :: Header_field' -> Either Error String+  write_header_field (Header_field' name value) = write_eq name <$> write_quotes value+  write_key_accidental :: Accidental -> String+  write_key_accidental accidental = toUpper <$> show accidental+  write_key_note_name :: Map Natural_note_name [Accidental] -> Natural_note_name -> Either Error String+  write_key_note_name key natural_note_name =+    (case Map.lookup natural_note_name key of+      Nothing -> write_key_note_name' Natural+      Just accidentals' ->+        case accidentals' of+          [accidental] -> write_key_note_name' accidental+          _ -> Left Conflicting_accidentals_in_key_signature) where+    write_key_natural_note_name :: String+    write_key_natural_note_name = show (fromEnum natural_note_name)+    write_key_note_name' :: Accidental -> Either Error String+    write_key_note_name' accidental =+      Right (write_round_brackets (write_key_natural_note_name <-> ". ," <> write_key_accidental accidental))+  write_language :: Either Error String+  write_language =+    do+      language <- write_quotes "english.ly"+      Right ("\\include" <-> language)+  write_length :: Length -> String+  write_length (Length len dots) = write_basic_length len <> (write_dot <$> dots)+  write_natural_note_name :: Natural_note_name -> String+  write_natural_note_name natural_note_name = [toLower (head (show natural_note_name))]+  write_note :: Note Pitched -> String+  write_note (Pitched_note octave note_name) = write_note_name note_name <> write_octave octave+  write_note_name :: Note_name -> String+  write_note_name note_name =+    let+      (natural_note_name, accidental) = deconstruct_note_name note_name in+      write_natural_note_name natural_note_name <> write_accidental accidental+  write_notes :: Notes Pitched -> StateT State (Either Error) (Bool, String)+  write_notes maybe_notes =+    case maybe_notes of+      Notes notes ->+        do+          #state_notes .= not (Set.null notes)+          return+            (+              False,+              case Set.elems notes of+                [] -> "r"+                notes' -> write_angular_brackets (intercalate " " (write_note <$> notes')))+      Tie ->+        do+          notes <- use #state_notes+          return+            (+              notes,+              case notes of+                False -> "r"+                True -> "")+  write_octave :: Octave -> String+  write_octave octave =+    case compare octave 3 of+      LT -> replicate (3 - octave) ','+      EQ -> ""+      GT -> replicate (octave - 3) '\''+  write_option :: String -> String -> String+  write_option name value = "#" <> write_round_brackets ("ly:set-option '" <> name <-> value)+  write_options :: String+  write_options = write_option "delete-intermediate-files" "#t" <-> write_option "no-point-and-click" "#t"+  write_override :: String -> String -> String+  write_override name value = "\\override" <-> write_eq name value+  write_part :: Part -> Either Error String+  write_part (Part {title, key, time, initial_position, stave_groups}) =+    do+      header <- write_header [Header_field' "piece" title]+      set_key <- write_set_key+      time_and_initial_position <- write_time_and_initial_position+      _ <- tracks_length (remove_notational_information stave_groups)+      written_stave_groups <- traverse write_stave_group stave_groups+      Right+        (+          set_key <->+          time_and_initial_position <->+          "\\score" <->+          write_curly_brackets (header <-> write_angular_brackets_2 (intercalate " " written_stave_groups))) where+    write_event :: Int -> Event Pitched -> StateT State (Either Error) (Bool, String)+    write_event triplets event =+      case event of+        Event notes len ->+          do+            State {state_position} <- get+            let position = state_position + (2 % 3) ^ triplets * length_to_fraction len+            position' <-+              case compare position (measure_length time) of+                LT -> return position+                EQ -> return 0+                GT -> throwError An_event_crosses_the_bar_line+            #state_position .= position'+            (tie, written_notes) <- write_notes notes+            return (tie, written_notes <> write_length len)+        Triplet events ->+          do+            maybe_events <- write_events' (1 + triplets) events+            case maybe_events of+              Nothing -> throwError Empty_triplet+              Just (tie, written_events) -> return (tie, "\\tuplet 3/2" <-> write_curly_brackets written_events)+    write_events :: [Event Pitched] -> Either Error String+    write_events events =+      do+        initial_position' <- initial_position_to_fraction time initial_position+        maybe_events <- evalStateT (write_events' 0 events) (State {state_notes = False, state_position = initial_position'})+        Right+          (case maybe_events of+            Nothing -> ""+            Just (_, written_events) -> written_events)+    write_events' :: Int -> [Event Pitched] -> StateT State (Either Error) (Maybe (Bool, String))+    write_events' triplets events =+      case events of+        [] -> return Nothing+        event : events' ->+          do+            (tie_0, written_event) <- write_event triplets event+            maybe_events <- write_events' triplets events'+            return+              (Just+                (+                  tie_0,+                  intercalate+                    " "+                    (+                      written_event :+                      case maybe_events of+                        Nothing -> []+                        Just (tie_1, written_events) ->+                          (+                            (case tie_1 of+                              False -> []+                              True -> ["~"]) <>+                            [written_events]))))+    write_initial_position :: Either Error (Maybe String)+    write_initial_position =+      do+        initial_position' <- initial_position_to_fraction time initial_position+        let num :% den = measure_length time - initial_position'+        Right+          (case initial_position' of+            0 -> Nothing+            _ -> Just (show den <-> "*" <-> show num))+    write_instrument_and_staves :: Instrument_and_staves note_type -> Either Error String+    write_instrument_and_staves (Instrument_and_staves {instrument_name, short_instrument_name, staves}) =+      do+        set_instrument_name <- write_set_instrument_name+        written_staves <- traverse write_stave staves+        Right+          (+            "\\new PianoStaff \\with" <->+            write_curly_brackets set_instrument_name <->+            write_angular_brackets_2 (intercalate " " written_staves)) where+      write_set_instrument_name :: Either Error String+      write_set_instrument_name =+        do+          written_instrument_name <- write_quotes instrument_name+          written_short_instrument_name <- write_quotes short_instrument_name+          Right+            (write_eq "instrumentName" written_instrument_name <-> write_eq "shortInstrumentName" written_short_instrument_name)+    write_key :: Either Error String+    write_key =+      do+        written_key <-+          traverse+            (write_key_note_name (fromListWith (<>) (second return <$> deconstruct_note_name <$> Set.elems key)))+            (enumFromTo C_natural B_natural)+        Right (write_note_name C <-> "#`" <> write_round_brackets (intercalate " " written_key))+    write_set_initial_position :: Either Error [String]+    write_set_initial_position =+      do+        maybe_written_initial_position <- write_initial_position+        Right+          (case maybe_written_initial_position of+            Nothing -> []+            Just written_initial_position -> ["\\partial" <-> written_initial_position])+    write_set_key :: Either Error String+    write_set_key =+      do+        written_key <- write_key+        Right (write_eq "Key" (write_curly_brackets ("\\key" <-> written_key)))+    write_set_time :: String+    write_set_time = "\\time" <-> write_time time+    write_stave :: Stave note_type -> Either Error String+    write_stave (Stave {clef, tracks}) =+      do+        set_clef <- write_set_clef+        written_tracks <- write_tracks+        Right+          (+            "\\new Staff \\with" <->+            write_curly_brackets+              (case clef of+                Percussion_clef ->+                  (+                    write_override "StaffSymbol.line-count" (show (length written_tracks)) <->+                    write_override "Stem.neutral-direction" "1")+                Pitched_clef {} -> "") <->+            write_curly_brackets+              (+                intercalate+                  " "+                  (+                    (case clef of+                      Percussion_clef -> []+                      Pitched_clef {} -> ["\\Key"]) <>+                    ["\\Time_and_initial_position", set_clef]) <->+                write_angular_brackets_2 written_tracks <->+                "\\bar \"|.\"")) where+      write_clef :: String+      write_clef =+        case clef of+          Percussion_clef -> "percussion"+          Pitched_clef {clef_name, transposition} -> write_clef_name clef_name <> write_transposition transposition+      write_set_clef :: Either Error String+      write_set_clef =+        do+          written_clef <- write_quotes write_clef+          Right ("\\clef" <-> written_clef)+      write_tracks :: Either Error String+      write_tracks =+        case tracks of+          One_track events -> write_track "\\oneVoice" (Pitched_note 4 C) events+          Two_tracks events_0 events_1 ->+            (+              (<->) <$>+              write_track "\\voiceOne" (Pitched_note 4 D) events_0 <*>+              write_track "\\voiceTwo" (Pitched_note 3 B) events_1)+    write_stave_group :: [Pitched_or_unpitched Instrument_and_staves] -> Either Error String+    write_stave_group stave_group =+      do+        instruments_and_staves <- traverse (pitched_and_unpitched write_instrument_and_staves) stave_group+        Right+          (case instruments_and_staves of+            [instrument_and_staves] -> instrument_and_staves+            _ -> "\\new StaffGroup" <-> write_angular_brackets_2 (intercalate " " instruments_and_staves))+    write_time_and_initial_position :: Either Error String+    write_time_and_initial_position =+      do+        set_initial_position <- write_set_initial_position+        Right (+          write_eq+            "Time_and_initial_position"+            (write_curly_brackets (intercalate " " (["\\numericTimeSignature", write_set_time] <> set_initial_position))))+    write_track :: String -> Note Pitched -> [Event note_type] -> Either Error String+    write_track voice unpitched_note events =+      do+        written_events <- write_events (convert_events_to_pitched events)+        Right ("\\new Voice" <-> write_curly_brackets (voice <-> write_curly_brackets written_events)) where+      convert_event_to_pitched :: Event note_type -> Event Pitched+      convert_event_to_pitched event =+        case event of+          Event notes len -> Event (convert_notes_to_pitched notes) len+          Triplet events' -> Triplet (convert_events_to_pitched events')+      convert_events_to_pitched :: [Event note_type] -> [Event Pitched]+      convert_events_to_pitched = (<$>) convert_event_to_pitched+      convert_note_to_pitched :: Note note_type -> Note Pitched+      convert_note_to_pitched note =+        case note of+          Pitched_note _ _ -> note+          Unpitched_note -> unpitched_note+      convert_notes_to_pitched :: Notes note_type -> Notes Pitched+      convert_notes_to_pitched maybe_notes =+        case maybe_notes of+          Notes notes -> Notes (mapMonotonic convert_note_to_pitched notes)+          Tie -> Tie+  write_quotes :: String -> Either Error String+  write_quotes text =+    do+      traverse_ check_char text+      Right (write_brackets "\"" "\"" text)+  write_round_brackets :: String -> String+  write_round_brackets = write_brackets "(" ")"+  write_score :: Score -> Either Error String+  write_score (Score {header, parts}) =+    do+      written_parts <- traverse write_part parts+      language <- write_language+      written_header <- write_header (Header_field' "tagline" "" : (convert_header_field <$> assocs header))+      Right+        (write_options <-> language <-> "\\layout {short-indent = 5\\mm}" <-> written_header <-> intercalate " " written_parts)+  write_time :: Time -> String+  write_time (Time num den) = write_time_numerator <> "/" <> write_basic_length den where+    write_time_numerator :: String+    write_time_numerator = show (time_numerator_to_int num)+  write_transposition :: Steps -> String+  write_transposition transposition =+    case compare transposition 0 of+      LT -> write_transposition' "_" (negate transposition)+      EQ -> ""+      GT -> write_transposition' "^" transposition+  write_transposition' :: String -> Steps -> String+  write_transposition' index transposition = index <> show transposition
Composition/MIDI.hs view
@@ -1,12 +1,12 @@ {-|-Description: Generating MIDI files.+Generates MIDI files. -} module Composition.MIDI (midi) where   import Composition.Errors+  import Composition.Notation   import Composition.Notes   import Composition.Score   import Composition.Theory-  import Composition.Time   import Control.Monad   import Control.Monad.Except   import Control.Monad.State.Strict@@ -45,7 +45,7 @@   encode_int_flexible' :: (MonadError Error f) => Integer -> Word8 -> Int -> f [Word8]   encode_int_flexible' max_bytes msb i =     case max_bytes of-      0 -> throwError (Is_out_of_range_without_location Event_or_part_length_IOOR)+      0 -> throwError (Event_or_part_length_is_out_of_range_for_MIDI)       _ ->         do           let (i', last_byte) = divMod i 128@@ -73,7 +73,7 @@     encode_events instrument channel velocity events =       do         check (Is_out_of_range_without_location Velocity_IOOR) (between 0 max_velocity velocity)-        check (Is_out_of_range_without_location MIDI_instrument_code_IOOR) (between 0 127 instrument)+        check (MIDI_instrument_code_is_out_of_range_data (fromIntegral instrument)) (between 0 127 instrument)         join <$> traverse encode_event (events <> [Event' Set.empty rest_after_part]) where       encode_event :: Event_fraction note_type -> StateT [Word8] (Either Error) [Word8]       encode_event (Event' notes len) =@@ -90,7 +90,7 @@         case note of           Pitched_note _ _ ->             do-              check (Is_out_of_range_without_location Note_IOOR) (between min_note max_note note)+              check (Note_is_out_of_range_for_MIDI note) (between min_note max_note note)               return (fromIntegral (distance_in_semitones min_note note))           Unpitched_note -> return instrument       encode_note_event :: Word8 -> Word8 -> StateT [Word8] (Either Error) [Word8]@@ -138,8 +138,7 @@           encoded_tempo <- encode_int_fixed 3 Tempo_IOOR quarter_note_length_in_microseconds           encode_metaevent 0 81 encoded_tempo       quarter_note_length_in_microseconds :: Int-      quarter_note_length_in_microseconds =-        round (60000000 * denominator (basic_length_to_fraction time_denominator) % (4 * tempo))+      quarter_note_length_in_microseconds = round ((60000000 * basic_length_denominator time_denominator) % (4 * tempo))     encode_pitched_track :: Track Pitched -> StateT [Word8] (Either Error) [Word8]     encode_pitched_track (Track {instrument, velocity, events}) =       do@@ -165,7 +164,7 @@   lcd_event (Event' _ len) = denominator len   lcd_part :: MIDI_part -> Int   lcd_part (MIDI_part {time_denominator, tracks}) =-    denominator (basic_length_to_fraction time_denominator) `lcm` lcm_all (pitched_and_unpitched lcd_track <$> tracks)+    basic_length_denominator time_denominator `lcm` lcm_all (pitched_and_unpitched lcd_track <$> tracks)   lcd_track :: Track note_type -> Int   lcd_track (Track {events}) = lcm_all (lcd_event <$> events)   max_note :: Note Pitched
+ Composition/Notation.hs view
@@ -0,0 +1,276 @@+module Composition.Notation (+  Event' (..),+  Event_fraction,+  Length_fraction,+  Position,+  Track (..),+  add_notational_information,+  events_length,+  initial_position_to_fraction,+  length_to_fraction,+  measure_length,+  remove_notational_information,+  scale_lengths,+  tracks_length,+  tracks_to_list) where+  import Composition.Errors+  import Composition.Notes+  import Composition.Score+  import Control.Lens.Combinators+  import Control.Monad+  import Control.Monad.Except+  import Data.Fixed+  import Data.Foldable+  import Data.Functor.Barbie+  import Data.Generics.Labels ()+  import Data.Maybe+  import Data.Ratio+  import Data.Set+  import GHC.Generics+  import GHC.Real+  import Parser.Utilities+  data Add_notational_information_notes note_type =+    Add_notational_information_rest |+    Add_notational_information_notes (Set (Note note_type)) |+    Add_notational_information_tie+  -- | Generalised events with arbitrary notes type stripped of note length display information. Mostly for internal use.+  data Event' notes = Event' {event_notes :: notes, event_length :: Length_fraction}+  -- | Events stripped of note length display information. Mostly for internal use.+  type Event_fraction note_type = Event' (Set (Note note_type))+  -- | Note length as a fraction. Mostly for internal use.+  type Length_fraction = Ratio Int+  -- | The position of an event relative to the start of the measure. Mostly for internal use.+  type Position = Ratio Int+  -- | Tracks stripped of notational information (brackets, instrument names, clefs and note length display information). Mostly+  -- for internal use.+  data Track note_type = Track {instrument :: MIDI_instrument, velocity :: Velocity, events :: [Event_fraction note_type]}+  deriving instance Generic (Event' notes)+  deriving instance Show (Add_notational_information_notes note_type)+  deriving instance (Show notes) => Show (Event' notes)+  deriving instance Show (Track note_type)+  -- | Add note length display information to events. Mostly for internal use.+  add_notational_information :: Time -> Initial_position -> [Event_fraction note_type] -> Either Error [Event note_type]+  add_notational_information time initial_position events =+    do+      traverse_ check_event_length events+      initial_position' <- initial_position_to_fraction time initial_position+      add_notational_information_events time initial_position' (transform_event <$> events)+  add_notational_information_basic_length :: Length_fraction -> Maybe Basic_length+  add_notational_information_basic_length (num :% den) =+    case num of+      1 -> denominator_to_basic_length den+      _ -> Nothing+  add_notational_information_events :: forall note_type .+    Time -> Position -> [Event' (Add_notational_information_notes note_type)] -> Either Error [Event note_type]+  add_notational_information_events time position events =+    join <$> traverse (add_notational_information_measure time) separate_measures where+    separate_measures :: [(Length_fraction, [Event' (Add_notational_information_notes note_type)])]+    separate_measures =+      case separate_measures' position events of+        [] -> []+        measure : measures' -> (position, measure) : ((,) 0 <$> measures')+    separate_measures' ::+      (+        Position ->+        [Event' (Add_notational_information_notes note_type)] ->+        [[Event' (Add_notational_information_notes note_type)]])+    separate_measures' position' events' =+      case events' of+        [] -> []+        Event' notes len : events'' ->+          let+            position'' = position' + len in+            case compare position'' (measure_length time) of+              LT ->+                case separate_measures' position'' events'' of+                  [] -> [[Event' notes len]]+                  measure : measures -> (Event' notes len : measure) : measures+              EQ -> [Event' notes len] : separate_measures' 0 events''+              GT ->+                let+                  len' = measure_length time - position' in+                  [Event' notes len'] : separate_measures' 0 (Event' (notes_to_tie notes) (len - len') : events'')+  add_notational_information_measure ::+    Time -> (Position, [Event' (Add_notational_information_notes note_type)]) -> Either Error [Event note_type]+  add_notational_information_measure time (position, events) =+    do+      binary_blocks <- separate_binary_blocks position events+      join <$> traverse add_notational_information_binary_block binary_blocks where+    add_notational_information_binary_block ::+      (Position, [Event' (Add_notational_information_notes note_type)]) -> Either Error [Event note_type]+    add_notational_information_binary_block (position', events') =+      (case events' of+        [event@(Event' notes len)] ->+          case add_notational_information_simple_length len of+            Nothing -> divide_time position' [event]+            Just len' -> Right [Event (add_notational_information_notes notes) len']+        _ ->+          let+            num :% den = events_length events' in+            (+              (\ events'' -> [Triplet events'']) <$>+              case num of+                1 ->+                  case denominator_to_basic_length (2 * den) of+                    Nothing -> Left (Is_out_of_range_without_location Note_length_denominator_IOOR)+                    Just den' -> add_notational_information_measure (Time [Three] den') (0, scale_lengths (3 % 2) events')+                _ -> divide_time position' events'))+    divide_time :: Position -> [Event' (Add_notational_information_notes note_type)] -> Either Error [Event note_type]+    divide_time position' events' =+      do+        time' <- time_subdivision time+        add_notational_information_events time' (mod' position' (measure_length time')) events'+    separate_binary_blocks ::+      (+        Position ->+        [Event' (Add_notational_information_notes note_type)] ->+        Either Error [(Position, [Event' (Add_notational_information_notes note_type)])])+    separate_binary_blocks position' events' =+      case events' of+        [] -> Right []+        event@(Event' _ len) : events'' ->+          do+            let position'' = position' + len+            binary_blocks <- separate_binary_blocks position'' events''+            case is_smooth [2] position'' of+              False ->+                case binary_blocks of+                  [] -> Left Track_ends_with_an_incomplete_triplet+                  (_, events''') : binary_blocks' -> Right ((position', event : events''') : binary_blocks')+              True -> Right ((position', [event]) : binary_blocks)+  add_notational_information_notes :: Add_notational_information_notes note_type -> Notes note_type+  add_notational_information_notes notes =+    case notes of+      Add_notational_information_rest -> Notes empty+      Add_notational_information_notes notes' -> Notes notes'+      Add_notational_information_tie -> Tie+  add_notational_information_simple_length :: Length_fraction -> Maybe Length+  add_notational_information_simple_length (num :% den) =+    do+      dots <- (\ i -> i - 1) <$> lg (1 + num)+      len <- add_notational_information_basic_length (2 ^ dots % den)+      Just (Length len (replicate dots Dot))+  check_event_length :: Event' notes -> Either Error ()+  check_event_length (Event' _ len) =+    do+      check Non_positive_note_length (0 < len)+      check Note_length_denominator_contains_factors_other_than_2_and_3 (is_smooth [2, 3] len)+      return ()+  -- | Events length.+  events_length :: [Event' notes] -> Length_fraction+  events_length events = sum (view #event_length <$> events)+  -- | Convert initial position to fraction. Mostly for internal use.+  initial_position_to_fraction :: (MonadError Error f) => Time -> Initial_position -> f Position+  initial_position_to_fraction time (Initial_position num den) =+    do+      let initial_position' = num % basic_length_denominator den+      check+        Initial_position_is_out_of_range+        (between 0 (measure_length time - length_to_fraction (Length maxBound [])) initial_position')+      return initial_position'+  is_smooth :: [Int] -> Ratio Int -> Bool+  is_smooth factors x = is_smooth' factors (denominator x)+  is_smooth' :: [Int] -> Int -> Bool+  is_smooth' factors i =+    case i of+      1 -> True+      _ ->+        case factors of+          [] -> False+          factor : factors' -> is_smooth' factors' (remove_factor factor i)+  join_events :: [Event' (Notes note_type)] -> [Event_fraction note_type]+  join_events events =+    case events of+      [] -> []+      Event' notes len : events' -> join_events' (Event' (notes_to_set notes) len) events'+  join_events' :: Event_fraction note_type -> [Event' (Notes note_type)] -> [Event_fraction note_type]+  join_events' (Event' notes_0 len_0) events =+    case events of+      [] -> [Event' notes_0 len_0]+      Event' maybe_notes_1 len_1 : events' ->+        case join_notes notes_0 maybe_notes_1 of+          Nothing -> join_events' (Event' notes_0 (len_0 + len_1)) events'+          Just notes_1 -> Event' notes_0 len_0 : join_events' (Event' notes_1 len_1) events'+  join_notes :: Set (Note note_type) -> Notes note_type -> Maybe (Set (Note note_type))+  join_notes notes_0 maybe_notes_1 =+    case maybe_notes_1 of+      Notes notes_1 ->+        case (elems notes_0, elems notes_1) of+          ([], []) -> Nothing+          _ -> Just notes_1+      Tie -> Nothing+  -- | Convert length to fraction. Mostly for internal use.+  length_to_fraction :: Length -> Length_fraction+  length_to_fraction (Length len dots) = (1 % basic_length_denominator len) * (2 - 1 % 2 ^ length dots)+  -- | The length of one measure. Mostly for internal use.+  measure_length :: Time -> Length_fraction+  measure_length (Time num den) = time_numerator_to_int num % basic_length_denominator den+  notes_to_set :: Notes note_type -> Set (Note note_type)+  notes_to_set maybe_notes =+    case maybe_notes of+      Notes notes -> notes+      Tie -> empty+  notes_to_tie :: Add_notational_information_notes note_type -> Add_notational_information_notes note_type+  notes_to_tie notes =+    case notes of+      Add_notational_information_rest -> Add_notational_information_rest+      Add_notational_information_notes _ -> Add_notational_information_tie+      Add_notational_information_tie -> Add_notational_information_tie+  remove_factor :: Int -> Int -> Int+  remove_factor factor i =+    case mod i factor of+      0 -> remove_factor factor (div i factor)+      _ -> i+  -- | Strip tracks of notational information (brackets, instrument names, clefs, note length display information). Mostly for+  -- internal use.+  remove_notational_information :: [[Pitched_or_unpitched Instrument_and_staves]] -> [Pitched_or_unpitched Track]+  remove_notational_information stave_groups =+    stave_groups >>= flip (>>=) (btraverse remove_notational_information_instrument_and_staves)+  remove_notational_information_stave :: Stave note_type -> [[Event_fraction note_type]]+  remove_notational_information_stave (Stave {tracks}) = remove_notational_information_events <$> tracks_to_list tracks+  remove_notational_information_events :: [Event note_type] -> [Event_fraction note_type]+  remove_notational_information_events events = join_events (remove_notational_information_events' events)+  remove_notational_information_events' :: [Event note_type] -> [Event' (Notes note_type)]+  remove_notational_information_events' events = events >>= remove_notational_information_event+  remove_notational_information_event :: Event note_type -> [Event' (Notes note_type)]+  remove_notational_information_event event =+    case event of+      Event notes len -> [Event' notes (length_to_fraction len)]+      Triplet events -> scale_lengths (2 % 3) (remove_notational_information_events' events)+  remove_notational_information_instrument_and_staves :: Instrument_and_staves note_type -> [Track note_type]+  remove_notational_information_instrument_and_staves (Instrument_and_staves {midi_instrument, velocity, staves}) =+    do+      events <- staves >>= remove_notational_information_stave+      [Track {instrument = midi_instrument, velocity, events}]+  -- | Scale the length of events. Mostly for internal use.+  scale_lengths :: Ratio Int -> [Event' notes] -> [Event' notes]+  scale_lengths x events = over #event_length ((*) x) <$> events+  time_subdivision :: Time -> Either Error Time+  time_subdivision (Time num den) =+    case num of+      [] ->+        case next_basic_length den of+          Nothing -> Left (Is_out_of_range_without_location Note_length_denominator_IOOR)+          Just den' -> Right (Time [] den')+      _ : num' -> Right (Time num' den)+  track_length :: Track note_type -> Ratio Int+  track_length (Track {events}) = events_length events+  -- | Calculate part length. Mostly for internal use.+  tracks_length :: [Pitched_or_unpitched Track] -> Either Error Length_fraction+  tracks_length tracks =+    case all_equal (pitched_and_unpitched track_length <$> tracks) of+      Nothing -> Left Track_length_mismatch+      Just maybe_len -> Right (fromMaybe 0 maybe_len)+  -- | Convert the stave to a list of voices. Mostly for internal use.+  tracks_to_list :: Tracks note_type -> [[Event note_type]]+  tracks_to_list stave =+    case stave of+      One_track events -> [events]+      Two_tracks events_0 events_1 -> [events_0, events_1]+  transform_event :: Event_fraction note_type -> Event' (Add_notational_information_notes note_type)+  transform_event (Event' notes len) = Event' (transform_notes notes) len+  transform_notes :: Set (Note note_type) -> Add_notational_information_notes note_type+  transform_notes notes =+    case elems notes of+      [] -> Add_notational_information_rest+      _ -> Add_notational_information_notes notes
Composition/Notes.hs view
@@ -8,10 +8,7 @@   Branch (..),   Dot (..),   Event (..),-  Event' (..),-  Event_fraction,   Length (..),-  Length_fraction,   Natural_note_name (..),   Note (..),   Note_name (..),@@ -20,127 +17,93 @@   Pitched_or_unpitched (..),   accidentals,   basic_length_denominator,-  basic_length_to_fraction,   construct_note_name,   deconstruct_note_name,   denominator_to_basic_length,-  events_length,-  length_to_fraction,   lg,   next_basic_length,   pitched_and_unpitched,-  pitched_or_unpitched,-  scale_lengths) where-  import Control.Lens.Combinators ----  import Data.Functor.Barbie ----  import Data.Generics.Labels () ----  import Data.Maybe ----  import Data.Ratio ---+  pitched_or_unpitched) where+  import Data.Functor.Barbie+  import Data.Maybe   import Data.Set-  import Data.Tuple ----  import GHC.Generics ----  import Parser.Utilities ---+  import Data.Tuple+  import Parser.Utilities   import Text.Read   -- | Notes can be either pitched or unpitched.   type data Note_type = Pitched | Unpitched-  -- | Accidentals. Mostly for internal use. ----  data Accidental = Flat | Natural | Sharp ---+  -- | Accidentals.+  data Accidental = Flat | Natural | Sharp   -- | Basic note lengths.   data Basic_length = Whole | Half | Quarter | Eighth | Sixteenth | Thirty_second | Sixty_fourth | One_hundred_and_twenty_eighth-  -- | A term-level representation of the pitched / unpitched type for branching over the type. Mostly for internal use. ----  data Branch note_type where ----    Branch_pitched :: Branch Pitched ----    Branch_unpitched :: Branch Unpitched ----  -- | Dots. ----  data Dot = Dot ----  -- | Events. ----  data Event note_type = Event (Notes note_type) Length | Triplet [Event note_type] ----  -- | Generalised events with arbitrary notes type stripped of note length display information. Mostly for internal use.-  data Event' notes = Event' {event_notes :: notes, event_length :: Length_fraction}-  -- | Events stripped of note length display information. Mostly for internal use. ----  type Event_fraction note_type = Event' (Set (Note note_type)) ----  -- | Note lengths. ----  data Length = Length Basic_length [Dot] ----  -- | Note length as a fraction. Mostly for internal use. ----  type Length_fraction = Ratio Int ----  -- | Natural note names. Mostly for internal use. ----  data Natural_note_name = C_natural | D_natural | E_natural | F_natural | G_natural | A_natural | B_natural ----  -- | Pitched and unpitched notes. ----  data Note note_type where ----    Pitched_note :: Octave -> Note_name -> Note Pitched ----    Unpitched_note :: Note Unpitched ----  -- | Note names. ----  data Note_name = ----    C | C_sharp | D_flat | D | D_sharp | E_flat | E | F | F_sharp | G_flat | G | G_sharp | A_flat | A | A_sharp | B_flat | B ----  -- | Play a new set of notes or continue the previous set of notes. ----  data Notes note_type = Notes (Set (Note note_type)) | Tie ----  -- | Octaves in scientific pitch notation. ----  type Octave = Int ----  -- | This data type allows you to, for example, mix pitched and unpitched tracks in one list. ----  data Pitched_or_unpitched f = Pitched (f Pitched) | Unpitched (f Unpitched) ----  deriving instance Eq Accidental ----  deriving instance Bounded Accidental-  deriving instance Bounded Natural_note_name ----  deriving instance Bounded Note_name ----  deriving instance Enum Accidental+  -- | A term-level representation of the pitched / unpitched type for branching over the type. Mostly for internal use.+  data Branch note_type where+    Branch_pitched :: Branch Pitched+    Branch_unpitched :: Branch Unpitched+  -- | Dots.+  data Dot = Dot+  -- | Events.+  data Event note_type = Event (Notes note_type) Length | Triplet [Event note_type]+  -- | Note lengths.+  data Length = Length Basic_length [Dot]+  -- | Natural note names.+  data Natural_note_name = C_natural | D_natural | E_natural | F_natural | G_natural | A_natural | B_natural+  -- | Pitched and unpitched notes.+  data Note note_type where+    Pitched_note :: Octave -> Note_name -> Note Pitched+    Unpitched_note :: Note Unpitched+  -- | Note names.+  data Note_name =+    C | C_sharp | D_flat | D | D_sharp | E_flat | E | F | F_sharp | G_flat | G | G_sharp | A_flat | A | A_sharp | B_flat | B+  -- | Play a new set of notes or continue the previous set of notes.+  data Notes note_type = Notes (Set (Note note_type)) | Tie+  -- | Octaves in scientific pitch notation.+  type Octave = Int+  -- | This data type allows you to, for example, mix pitched and unpitched tracks in one list.+  data Pitched_or_unpitched f = Pitched (f Pitched) | Unpitched (f Unpitched)+  deriving instance Bounded Basic_length+  deriving instance Bounded Note_name   deriving instance Enum Basic_length-  deriving instance Enum Natural_note_name ----  instance Enum (Note Pitched) where ----    fromEnum (Pitched_note octave note_name) = 17 * octave + fromEnum note_name ----    toEnum i = Pitched_note (div i 17) (toEnum (mod i 17)) ----  deriving instance Enum Note_name ----  deriving instance Generic (Event' notes) ----  deriving instance Eq Basic_length ----  deriving instance Eq Natural_note_name ----  deriving instance Eq (Note note_type) ----  deriving instance Eq Note_name ----  instance FunctorB Pitched_or_unpitched where ----    bmap f = pitched_or_unpitched (Pitched <$> f) (Unpitched <$> f) ---+  deriving instance Enum Natural_note_name+  instance Enum (Note Pitched) where+    fromEnum (Pitched_note octave note_name) = 17 * octave + fromEnum note_name+    toEnum i = Pitched_note (div i 17) (toEnum (mod i 17))+  deriving instance Enum Note_name+  deriving instance Eq Accidental+  deriving instance Eq Basic_length+  deriving instance Eq Natural_note_name+  deriving instance Eq (Note note_type)+  deriving instance Eq Note_name+  instance FunctorB Pitched_or_unpitched where+    bmap f = pitched_or_unpitched (Pitched <$> f) (Unpitched <$> f)   deriving instance Ord Accidental   deriving instance Ord Basic_length-  deriving instance Ord Natural_note_name ----  deriving instance Ord (Note note_type) ----  deriving instance Ord Note_name ---+  deriving instance Ord Natural_note_name+  deriving instance Ord (Note note_type)+  deriving instance Ord Note_name   deriving instance Read Natural_note_name   deriving instance Read Note_name-  deriving instance Show Accidental ----  deriving instance Show Basic_length ----  deriving instance Show (Branch note_type) ----  deriving instance Show Dot ----  deriving instance Show (Event note_type) ----  deriving instance (Show notes) => Show (Event' notes)-  deriving instance Show Length ----  deriving instance Show Natural_note_name ----  deriving instance Show (Note note_type) ----  deriving instance Show Note_name ----  deriving instance Show (Notes note_type) ----  deriving instance (forall note_type . Show (f note_type)) => Show (Pitched_or_unpitched f) ----  instance TraversableB Pitched_or_unpitched where ----    btraverse f = pitched_or_unpitched ((<$>) Pitched <$> f) ((<$>) Unpitched <$> f) ---+  deriving instance Show Accidental+  deriving instance Show Basic_length+  deriving instance Show (Branch note_type)+  deriving instance Show Dot+  deriving instance Show (Event note_type)+  deriving instance Show Length+  deriving instance Show Natural_note_name+  deriving instance Show (Note note_type)+  deriving instance Show Note_name+  deriving instance Show (Notes note_type)+  deriving instance (forall note_type . Show (f note_type)) => Show (Pitched_or_unpitched f)+  instance TraversableB Pitched_or_unpitched where+    btraverse f = pitched_or_unpitched ((<$>) Pitched <$> f) ((<$>) Unpitched <$> f)   -- | String representations of accidentals. Mostly for internal use.   accidentals :: [(Accidental, String)]   accidentals = [(Flat, "b"), (Natural, ""), (Sharp, "#")]   accidentals' :: [(Accidental, String)]   accidentals' = [(Flat, "_flat"), (Natural, ""), (Sharp, "_sharp")]-  -- | Convert basic length to fraction denominator. Mostly for internal use. ----  basic_length_denominator :: Basic_length -> Int ----  basic_length_denominator len = 2 ^ basic_length_to_lg_denominator len ----  -- | Convert basic length to fraction. Mostly for internal use. ----  basic_length_to_fraction :: Basic_length -> Length_fraction ----  basic_length_to_fraction len = 1 % basic_length_denominator len ----  basic_length_to_lg_denominator :: Basic_length -> Int ----  basic_length_to_lg_denominator len = fromJust (lookup len basic_lengths) ----  basic_lengths :: [(Basic_length, Int)] ----  basic_lengths = ----    [ ----      (Whole, 0), ----      (Half, 1), ----      (Quarter, 2), ----      (Eighth, 3), ----      (Sixteenth, 4), ----      (Thirty_second, 5), ----      (Sixty_fourth, 6), ----      (One_hundred_and_twenty_eighth, 7)] ---+  -- | Convert basic length to fraction denominator. Mostly for internal use.+  basic_length_denominator :: Basic_length -> Int+  basic_length_denominator len = 2 ^ fromEnum len   -- | Construct the note name from a natural note name and an accidental. Mostly for internal use.   construct_note_name :: Natural_note_name -> Accidental -> Maybe Note_name   construct_note_name natural_note_name accidental =@@ -152,44 +115,38 @@       "" -> undefined       natural_note_name : accidental ->         (read (natural_note_name : "_natural"), fromJust (lookup accidental (swap <$> accidentals')))-  -- | Convert fraction denominator to basic length. Mostly for internal use. ----  denominator_to_basic_length :: Int -> Maybe Basic_length ----  denominator_to_basic_length i = lg i >>= lg_denominator_to_basic_length ----  -- | Events length. ----  events_length :: [Event' notes] -> Length_fraction ----  events_length events = sum (view #event_length <$> events) ----  -- | Convert length to fraction. Mostly for internal use. ----  length_to_fraction :: Length -> Length_fraction ----  length_to_fraction (Length len dots) = basic_length_to_fraction len * (2 - 1 % (1 + length dots)) ----  -- | Binary logarithm. Mostly for internal use. ----  lg :: Int -> Maybe Int ----  lg i = ----    do ----      check () (i > 0) ----      lg' i ----  lg' :: Int -> Maybe Int ----  lg' i = ----    case i of ----      1 -> Just 0 ----      _ -> ----        case mod i 2 of ----          0 -> (+) 1 <$> lg' (div i 2) ----          1 -> Nothing ----          _ -> undefined ----  lg_denominator_to_basic_length :: Int -> Maybe Basic_length ----  lg_denominator_to_basic_length i = lookup i (swap <$> basic_lengths) ----  -- | Divide basic note length by two. ----  next_basic_length :: Basic_length -> Maybe Basic_length ----  next_basic_length len = lg_denominator_to_basic_length (1 + basic_length_to_lg_denominator len) ----  -- | Perform an operation that doesn't depend on whether the underlying structure contains pitched or unpitched notes. ----  pitched_and_unpitched :: (forall note_type . f note_type -> t) -> Pitched_or_unpitched f -> t ----  pitched_and_unpitched f = pitched_or_unpitched f f ---+  -- | Convert fraction denominator to basic length. Mostly for internal use.+  denominator_to_basic_length :: Int -> Maybe Basic_length+  denominator_to_basic_length i = lg i >>= lg_denominator_to_basic_length+  -- | Binary logarithm. Mostly for internal use.+  lg :: Int -> Maybe Int+  lg i =+    do+      check () (i > 0)+      lg' i+  lg' :: Int -> Maybe Int+  lg' i =+    case i of+      1 -> Just 0+      _ ->+        case mod i 2 of+          0 -> (+) 1 <$> lg' (div i 2)+          1 -> Nothing+          _ -> undefined+  lg_denominator_to_basic_length :: Int -> Maybe Basic_length+  lg_denominator_to_basic_length i =+    do+      check () (between minBound maxBound i)+      Just (toEnum i)+  -- | Divide basic note length by two.+  next_basic_length :: Basic_length -> Maybe Basic_length+  next_basic_length len = lg_denominator_to_basic_length (1 + fromEnum len)+  -- | Perform an operation that doesn't depend on whether the underlying structure contains pitched or unpitched notes.+  pitched_and_unpitched :: (forall note_type . f note_type -> t) -> Pitched_or_unpitched f -> t+  pitched_and_unpitched f = pitched_or_unpitched f f   -- | Perform an operation that behaves differently when the underlying structure contains pitched or unpitched notes.   pitched_or_unpitched :: (f Pitched -> t) -> (f Unpitched -> t) -> Pitched_or_unpitched f -> t   pitched_or_unpitched f_pitched f_unpitched x =     case x of       Pitched x' -> f_pitched x'       Unpitched x' -> f_unpitched x'-  -- | Scale the length of events. Mostly for internal use. ----  scale_lengths :: Ratio Int -> [Event' notes] -> [Event' notes] ----  scale_lengths x events = over #event_length ((*) x) <$> events ---
Composition/Parser.hs view
@@ -1,11 +1,10 @@ {-|-Parse the custom file format for scores.+Parse the custom score file format. -} module Composition.Parser (parse) where   import Composition.Errors   import Composition.Notes   import Composition.Score-  import Composition.Time   import Control.Applicative   import Control.Monad.Except   import Control.Monad.Trans.Except@@ -33,17 +32,15 @@     Zero_char   type Parser = Parser' Token Error   data Token =-    Clef_and_stave_token |     Clef_name_name_token |     Clef_name_value_token Clef_name |     Clef_token |-    Clefs_and_staves_token |     Dot_token |     Eq_token |     Header_field_token Header_field |     Header_token |     Initial_position_token |-    Instrument_clefs_and_staves_token |+    Instrument_and_staves_token |     Instrument_name_token |     Key_token |     Left_curly_bracket_token |@@ -60,15 +57,18 @@     Right_curly_bracket_token |     Right_square_bracket_token |     Score_token |+    Short_instrument_name_token |     Slash_token |-    Stave_groups_token |     Stave_token |+    Stave_groups_token |+    Staves_token |     Tempo_token |     Text_token String |     Tie_token |     Time_name_token |     Time_value_token |     Title_token |+    Tracks_token |     Transposition_token |     Unpitched_note_token |     Unpitched_token |@@ -91,22 +91,16 @@       '-' -> Minus_char       '0' -> Zero_char       _ | isDigit c && c /= '0' -> Nonzero_nat_char c-      '=' -> Delimiter_char Eq_token       _ -> Invalid_char   clef_name_token :: Token -> Maybe Clef_name   clef_name_token token =     case token of       Clef_name_value_token clef_name -> Just clef_name       _ -> Nothing-  construct_basic_length :: Int -> Either (Location -> Error) Basic_length-  construct_basic_length len =-    case denominator_to_basic_length len of-      Nothing -> Left Invalid_note_length-      Just len' -> Right len'   construct_header :: [(Header_field, String)] -> Either (Location -> Error) (Map Header_field String)   construct_header header =     case construct_map header of-      Nothing -> Left Duplicate_header_fields+      Nothing -> Left (Duplicate_header_fields <$> Just)       Just header' -> Right header'   construct_key :: [Note_name] -> Either (Location -> Error) (Set Note_name)   construct_key key =@@ -121,7 +115,7 @@   construct_word :: String -> Either (Location -> Error) Token   construct_word word =     (case construct_clef_name <|> construct_header_field <|> construct_keyword <|> construct_note_name' of-      Nothing -> Left (Invalid_word word)+      Nothing -> Left (Invalid_word word <$> Just)       Just token -> Right token) where     construct_clef_name :: Maybe Token     construct_clef_name = Clef_name_value_token <$> readMaybe word@@ -130,29 +124,30 @@     construct_keyword :: Maybe Token     construct_keyword =       case word of-        "Clef_and_stave" -> Just Clef_and_stave_token-        "Instrument_clefs_and_staves" -> Just Instrument_clefs_and_staves_token+        "Instrument_and_staves" -> Just Instrument_and_staves_token         "Part" -> Just Part_token         "Percussion_clef" -> Just Percussion_clef_token         "Pitched" -> Just Pitched_token         "Pitched_clef" -> Just Pitched_clef_token         "Score" -> Just Score_token+        "Stave" -> Just Stave_token         "Time" -> Just Time_value_token         "Unpitched" -> Just Unpitched_token         "clef" -> Just Clef_token         "clef_name" -> Just Clef_name_name_token-        "clefs_and_staves" -> Just Clefs_and_staves_token         "header" -> Just Header_token         "initial_position" -> Just Initial_position_token         "instrument_name" -> Just Instrument_name_token         "key" -> Just Key_token         "midi_instrument" -> Just MIDI_instrument_token         "parts" -> Just Parts_token-        "stave" -> Just Stave_token+        "short_instrument_name" -> Just Short_instrument_name_token         "stave_groups" -> Just Stave_groups_token+        "staves" -> Just Staves_token         "tempo" -> Just Tempo_token         "time" -> Just Time_name_token         "title" -> Just Title_token+        "tracks" -> Just Tracks_token         "transposition" -> Just Transposition_token         "velocity" -> Just Velocity_token         "x" -> Just Unpitched_note_token@@ -166,15 +161,20 @@             natural_note_name' <- read_natural_note_name natural_note_name             accidental' <- read_accidental accidental             Note_name_token <$> construct_note_name natural_note_name' accidental'+  convert_basic_length :: Int -> Either (Location -> Error) Basic_length+  convert_basic_length len =+    case denominator_to_basic_length len of+      Nothing -> Left (Invalid_note_length len)+      Just len' -> Right len'   convert_midi_instrument :: Int -> Either (Location -> Error) MIDI_instrument   convert_midi_instrument midi_instrument =     do-      check (Is_out_of_range_with_location MIDI_instrument_code_IOOR) (between 0 127 midi_instrument)+      check (MIDI_instrument_code_is_out_of_range_score midi_instrument) (between 0 127 midi_instrument)       Right (fromIntegral midi_instrument)   convert_time_numerator_factor :: Int -> Either (Location -> Error) Time_numerator_factor   convert_time_numerator_factor time_numerator_factor =     case int_to_time_numerator_factor time_numerator_factor of-      Nothing -> Left Invalid_time_numerator_factor+      Nothing -> Left (Invalid_time_numerator_factor time_numerator_factor)       Just time_numerator_factor' -> Right time_numerator_factor'   convert_velocity :: Int -> Either (Location -> Error) Velocity   convert_velocity velocity =@@ -233,13 +233,14 @@     case token of       Note_name_token note_name -> Just note_name       _ -> Nothing+  -- | Read the score from a .aoi file.   parse :: File_path -> ExceptT Error IO Score   parse file_path =     do       score <- read_file "aoi" readFile File_error file_path-      except (fromJust (parse' classify_char next_location tokenise parse_score Parse_error score))+      except (fromJust (parse' classify_char next_location tokenise parse_score Parse_error_score score))   parse_basic_length :: Parser Basic_length-  parse_basic_length = fmap_filter_parser construct_basic_length parse_positive_int+  parse_basic_length = fmap_filter_parser convert_basic_length parse_positive_int   parse_clef_name :: Parser Clef_name   parse_clef_name = parse_token' clef_name_token   parse_curly_brackets :: Parser t -> Parser t@@ -270,36 +271,27 @@   parse_header_field_name = parse_token' header_field_token   parse_initial_position :: Parser Initial_position   parse_initial_position = parse_zero_initial_position <+> parse_nonzero_initial_position-  parse_instrument_clefs_and_staves :: Parser (Pitched_or_unpitched Instrument_clefs_and_staves)-  parse_instrument_clefs_and_staves =-    (-      Pitched <$> parse_instrument_clefs_and_staves' Branch_pitched <+>-      Unpitched <$> parse_instrument_clefs_and_staves' Branch_unpitched)-  parse_instrument_clefs_and_staves' :: forall note_type . Branch note_type -> Parser (Instrument_clefs_and_staves note_type)-  parse_instrument_clefs_and_staves' branch =+  parse_instrument_and_staves :: Parser (Pitched_or_unpitched Instrument_and_staves)+  parse_instrument_and_staves =+    Pitched <$> parse_instrument_and_staves' Branch_pitched <+> Unpitched <$> parse_instrument_and_staves' Branch_unpitched+  parse_instrument_and_staves' :: forall note_type . Branch note_type -> Parser (Instrument_and_staves note_type)+  parse_instrument_and_staves' branch =     do       parse_pitched_or_unpitched       parse_struct-        Instrument_clefs_and_staves_token+        Instrument_and_staves_token         (do           instrument_name <- parse_field Instrument_name_token parse_text+          short_instrument_name <- parse_field Short_instrument_name_token parse_text           midi_instrument <- parse_field MIDI_instrument_token parse_midi_instrument           velocity <- parse_field Velocity_token parse_velocity-          clefs_and_staves <- parse_field Clefs_and_staves_token (parse_list' parse_clef_and_stave)-          return (Instrument_clefs_and_staves {instrument_name, midi_instrument, velocity, clefs_and_staves})) where+          staves <- parse_field Staves_token (parse_list' parse_stave)+          return (Instrument_and_staves {instrument_name, short_instrument_name, midi_instrument, velocity, staves})) where     parse_clef :: Parser (Clef note_type)     parse_clef =       case branch of         Branch_pitched -> parse_pitched_clef         Branch_unpitched -> parse_unpitched_clef-    parse_clef_and_stave :: Parser (Clef_and_stave note_type)-    parse_clef_and_stave =-      parse_struct-        Clef_and_stave_token-        (do-          clef <- parse_field Clef_token parse_clef-          stave <- parse_field Stave_token parse_stave-          return (Clef_and_stave {clef, stave}))     parse_event :: Parser (Event note_type)     parse_event = parse_event' <+> parse_triplet     parse_event' :: Parser (Event note_type)@@ -315,15 +307,23 @@     parse_notes = parse_notes' <+> parse_tie     parse_notes' :: Parser (Notes note_type)     parse_notes' = fmap_filter_parser construct_notes (parse_list' parse_note)-    parse_one_track :: Parser (Stave note_type)+    parse_one_track :: Parser (Tracks note_type)     parse_one_track = One_track <$> parse_events     parse_pitched_or_unpitched :: Parser ()     parse_pitched_or_unpitched = parse_token' pitched_or_unpitched_token     parse_stave :: Parser (Stave note_type)-    parse_stave = parse_square_brackets (parse_one_track <+> parse_two_tracks)+    parse_stave =+      parse_struct+        Stave_token+        (do+          clef <- parse_field Clef_token parse_clef+          tracks <- parse_field Tracks_token parse_tracks+          return (Stave {clef, tracks}))+    parse_tracks :: Parser (Tracks note_type)+    parse_tracks = parse_square_brackets (parse_one_track <+> parse_two_tracks)     parse_triplet :: Parser (Event note_type)     parse_triplet = Triplet <$> parse_events-    parse_two_tracks :: Parser (Stave note_type)+    parse_two_tracks :: Parser (Tracks note_type)     parse_two_tracks = Two_tracks <$> parse_events <*> parse_events     pitched_or_unpitched_token :: Token -> Maybe ()     pitched_or_unpitched_token token =@@ -364,7 +364,7 @@         time <- parse_field Time_name_token parse_time         initial_position <- parse_field Initial_position_token parse_initial_position         tempo <- parse_field Tempo_token parse_positive_int-        stave_groups <- parse_field Stave_groups_token (parse_list' (parse_list' parse_instrument_clefs_and_staves))+        stave_groups <- parse_field Stave_groups_token (parse_list' (parse_list' parse_instrument_and_staves))         return (Part {title, key, time, initial_position, tempo, stave_groups}))   parse_pitched_clef :: Parser (Clef Pitched)   parse_pitched_clef =@@ -383,10 +383,9 @@     parse_struct       Score_token       (do-        title <- parse_field Title_token parse_text         header <- parse_field Header_token parse_header         parts <- parse_field Parts_token (parse_list' parse_part)-        return (Score {title, header, parts}))+        return (Score {header, parts}))   parse_slash :: Parser ()   parse_slash = parse_token Slash_token   parse_square_brackets :: Parser t -> Parser t
Composition/Score.hs view
@@ -1,301 +1,117 @@-{-| ----Description: Lilypond + MIDI capable scores. ---- ----* Lilypond + MIDI capable scores -----} ----module Composition.Score ( ----  Clef (..), ----  Clef_and_stave (..), ----  Clef_name (..), ----  Header_field (..), ----  Instrument_clefs_and_staves (..), ----  Key, ----  MIDI_instrument, ----  Part (..), ----  Score (..), ----  Stave (..), ----  Tempo, ----  Track (..), ----  Velocity, ----  max_velocity, ----  notate, ----  remove_notational_information, ----  stave_to_events, ----  tracks_length) where ----  import Composition.Errors ----  import Composition.Notes ----  import Composition.Theory ----  import Composition.Time ----  import Control.Monad ----  import Data.Fixed ----  import Data.Foldable ----  import Data.Functor.Barbie ----  import Data.Map.Strict ----  import Data.Maybe ----  import Data.Ratio ----  import Data.Set as Set ----  import Data.Word ----  import GHC.Real ----  import Parser.Utilities ----  -- | Clefs (with transposition). ----  data Clef note_type where ----    Pitched_clef :: {clef_name :: Clef_name, transposition :: Steps} -> Clef Pitched ----    Percussion_clef :: Clef Unpitched ----  -- | Clef names. ----  data Clef_name = Subbass | Bass | Baritone_F | Baritone_C | Tenor | Alto | Mezzosoprano | Soprano | Treble | French ----  -- | Stave with clef. ----  data Clef_and_stave note_type = Clef_and_stave {clef :: Clef note_type, stave :: Stave note_type} ----  -- Score header fields. ----  data Header_field = Composer | Instrument | Subtitle ----  -- | A group of staves for one instrument. ----  data Instrument_clefs_and_staves note_type = ----    Instrument_clefs_and_staves { ----      instrument_name :: String, ----      midi_instrument :: MIDI_instrument, ----      velocity :: Velocity, ----      clefs_and_staves :: [Clef_and_stave note_type]} ----  -- | A set of note names that serves as a key signature. For example, the key signature of C minor would be @[E_flat, A_flat, ----  -- B_flat]@. Naturals and conflicting accidentals will result in an error. ----  type Key = Set Note_name ----  -- MIDI instrument code. ----  type MIDI_instrument = Word8 ----  data Notate_notes note_type = Notate_rest | Notate_notes (Set (Note note_type)) | Notate_tie ----  -- | Each part can have a different key, time signature and instrumentation. ----  data Part = ----    Part { ----      title :: String, ----      key :: Key, ----      time :: Time, ----      initial_position :: Initial_position, ----      tempo :: Tempo, ----      stave_groups :: [[Pitched_or_unpitched Instrument_clefs_and_staves]]} ----  -- A Lilypond + MIDI capable score. ----  data Score = Score {title :: String, header :: Map Header_field String, parts :: [Part]} ----  -- | A stave with one or two voices. Rhythmically independent voices require separate tracks. ----  data Stave note_type = One_track [Event note_type] | Two_tracks [Event note_type] [Event note_type] ----  -- | Tempo in beats per minute. ----  type Tempo = Int ----  -- | Tracks stripped of notational information (brackets, instrument names, clefs and note length display information). Mostly ----  -- for internal use. ----  data Track note_type = Track {instrument :: MIDI_instrument, velocity :: Velocity, events :: [Event_fraction note_type]} ----  -- | MIDI volume ranges from 0 to 127. ----  type Velocity = Word8 ----  deriving instance Eq Clef_name ----  deriving instance Eq Header_field ----  deriving instance Ord Clef_name ----  deriving instance Ord Header_field ---+{-|+Scores that can be converted to Lilypond and MIDI files.+-}+module Composition.Score (+  Clef (..),+  Clef_name (..),+  Header_field (..),+  Initial_position (..),+  Instrument_and_staves (..),+  Key,+  MIDI_instrument,+  Part (..),+  Score (..),+  Stave (..),+  Tempo,+  Time (..),+  Time_numerator_factor (..),+  Tracks (..),+  Velocity,+  int_to_time_numerator_factor,+  max_velocity,+  time_numerator_factor_to_int,+  time_numerator_to_int) where+  import Composition.Notes+  import Composition.Theory+  import Data.List as List+  import Data.Map.Strict+  import Data.Maybe+  import Data.Set as Set+  import Data.Tuple+  import Data.Word+  -- | Clefs (with transposition).+  data Clef note_type where+    Pitched_clef :: {clef_name :: Clef_name, transposition :: Steps} -> Clef Pitched+    Percussion_clef :: Clef Unpitched+  -- | Clef names.+  data Clef_name = Subbass | Bass | Baritone_F | Baritone_C | Tenor | Alto | Mezzosoprano | Soprano | Treble | French+  -- | Score header fields.+  data Header_field = Left_text | Overtitle | Right_text | Subtitle | Subsubtitle | Title+  -- | The timing of the first event relative to the start of the measure. For example, if the piece is in 3/4 and starts with a+  -- 1/4 partial bar the initial position can be written as @Initial_position 1 Half@ or @Initial_position 2 Quarter@. If the+  -- piece starts with a full bar the numerator is 0 (and you can use any length as the denominator).+  data Initial_position = Initial_position Int Basic_length+  -- | Group of staves for one instrument.+  data Instrument_and_staves note_type =+    Instrument_and_staves {+      instrument_name :: String,+      short_instrument_name :: String,+      midi_instrument :: MIDI_instrument,+      velocity :: Velocity,+      staves :: [Stave note_type]}+  -- | A set of note names that serves as a key signature. For example, the key signature of C minor would be @[E_flat, A_flat,+  -- B_flat]@. Conflicting accidentals will result in an error.+  type Key = Set Note_name+  -- | MIDI instrument code.+  type MIDI_instrument = Word8+  -- | Each part can have a different key, time signature and instrumentation.+  data Part =+    Part {+      title :: String,+      key :: Key,+      time :: Time,+      initial_position :: Initial_position,+      tempo :: Tempo,+      stave_groups :: [[Pitched_or_unpitched Instrument_and_staves]]}+  -- | Score that can be converted to Lilypond and MIDI files.+  data Score = Score {header :: Map Header_field String, parts :: [Part]}+  -- | Stave with clef.+  data Stave note_type = Stave {clef :: Clef note_type, tracks :: Tracks note_type}+  -- | Tempo in beats per minute.+  type Tempo = Int+  -- | Time signature numerators are written as a list of factors. For example, 2 is written as @[Two]@, 3 as @[Three]@, 4 as+  -- @[Two Two]@, 6 as @[Two Three]@, 8 as @[Two Two Two]@, 9 as @[Three Three]@, 12 as @[Two Two Three]@, and so on. Note that+  -- in some applications the order matters. For example, 18 as @[Three Two Three]@ means that the bar is divided into three+  -- parts, each part is divided in half and then each half is divided into three parts. But 18 as @[Two Three Three]@ means+  -- that the bar is divided in half, each half is divided into three parts and then each part is divided into three parts. This+  -- will affect the placement of ties in keyboard transcriptions.+  data Time_numerator_factor = Two | Three+  -- | Time signatures. For example, 2/2 is written as @Time [Two] Half@, 3/2 as @Time [Three] Half@, 2/4 as @Time [Two]+  -- Quarter@, and so on.+  data Time = Time [Time_numerator_factor] Basic_length+  -- | One stave can fit up to two rhythmically independent tracks.+  data Tracks note_type = One_track [Event note_type] | Two_tracks [Event note_type] [Event note_type]+  -- | MIDI volume ranges from 0 to 127.+  type Velocity = Word8+  deriving instance Eq Clef_name+  deriving instance Eq Header_field+  deriving instance Eq Time_numerator_factor+  deriving instance Ord Clef_name+  deriving instance Ord Header_field   deriving instance Read Clef_name   deriving instance Read Header_field-  deriving instance Show (Clef note_type) ----  deriving instance Show (Clef_and_stave note_type) ----  deriving instance Show Clef_name ----  deriving instance Show Header_field ----  deriving instance Show (Instrument_clefs_and_staves note_type) ----  deriving instance Show (Notate_notes note_type) ----  deriving instance Show Part ----  deriving instance Show Score ----  deriving instance Show (Stave note_type) ----  deriving instance Show (Track note_type) ----  check_length :: Event' notes -> Either Error () ----  check_length (Event' _ (num :% den)) = ----    do ----      check Non_positive_note_length (0 < num) ----      check Note_length_denominator_contains_factors_other_than_2_and_3 (is_smooth [2, 3] den) ----      return () ----  is_smooth :: [Int] -> Int -> Bool ----  is_smooth factors i = ----    case i of ----      1 -> True ----      _ -> ----        case factors of ----          [] -> False ----          factor : factors' -> is_smooth factors' (remove_factor factor i) ----  join_events :: [Event' (Notes note_type)] -> [Event_fraction note_type] ----  join_events events = ----    case events of ----      [] -> [] ----      Event' notes len : events' -> join_events' (Event' (notes_to_set notes) len) events' ----  join_events' :: Event_fraction note_type -> [Event' (Notes note_type)] -> [Event_fraction note_type] ----  join_events' (Event' notes_0 len_0) events = ----    case events of ----      [] -> [Event' notes_0 len_0] ----      Event' maybe_notes_1 len_1 : events' -> ----        case join_notes notes_0 maybe_notes_1 of ----          Nothing -> join_events' (Event' notes_0 (len_0 + len_1)) events' ----          Just notes_1' -> Event' notes_0 len_0 : join_events' (Event' notes_1' len_1) events' ----  join_notes :: Set (Note note_type) -> Notes note_type -> Maybe (Set (Note note_type)) ----  join_notes notes_0 maybe_notes_1 = ----    case maybe_notes_1 of ----      Notes notes_1 -> ----        case (Set.elems notes_0, Set.elems notes_1) of ----          ([], []) -> Nothing ----          _ -> Just notes_1 ----      Tie -> Nothing ----  -- | Maximum MIDI volume. ----  max_velocity :: Velocity ----  max_velocity = 127 ----  -- | Add note length display information to events. Mostly for internal use. ----  notate :: Time -> Initial_position -> [Event_fraction note_type] -> Either Error [Event note_type] ----  notate time initial_position events = ----    do ----      traverse_ check_length events ----      notate_events time (initial_position_to_fraction initial_position) (transform_event <$> events) ----  notate_basic_length :: Length_fraction -> Maybe Basic_length ----  notate_basic_length (num :% den) = ----    case num of ----      1 -> ----        case den of ----          1 -> Just Whole ----          2 -> Just Half ----          4 -> Just Quarter ----          8 -> Just Eighth ----          16 -> Just Sixteenth ----          32 -> Just Thirty_second ----          64 -> Just Sixty_fourth ----          128 -> Just One_hundred_and_twenty_eighth ----          _ -> Nothing ----      _ -> Nothing ----  notate_binary_block :: Time -> (Position, [Event' (Notate_notes note_type)]) -> Either Error [Event note_type] ----  notate_binary_block time (position, events) = ----    case events of ----      [event] -> notate_event time position event ----      _ -> ----        let ----          num :% den = events_length events in ----          ( ----            (\ evs -> [Triplet evs]) <$> ----            case num of ----              1 -> ----                case denominator_to_basic_length (2 * den) of ----                  Nothing -> Left (Is_out_of_range_without_location Note_length_denominator_IOOR) ----                  Just den' -> notate_measure (Time [Three] den') (0, scale_lengths (3 % 2) events) ----              _ -> ----                do ----                  time' <- time_subdivision time ----                  notate_events time' (mod' position (measure_length time')) events) ----  notate_event :: Time -> Position -> Event' (Notate_notes note_type) -> Either Error [Event note_type] ----  notate_event time position event@(Event' notes len) = ----    case notate_simple_length len of ----      Nothing -> ----        do ----          time' <- time_subdivision time ----          notate_events time' (mod' position (measure_length time')) [event] ----      Just len' -> Right [Event (notate_notes notes) len'] ----  notate_events :: Time -> Position -> [Event' (Notate_notes note_type)] -> Either Error [Event note_type] ----  notate_events time position events = join <$> traverse (notate_measure time) (separate_measures time position events) ----  notate_measure :: Time -> (Position, [Event' (Notate_notes note_type)]) -> Either Error [Event note_type] ----  notate_measure time (position, events) = ----    do ----      binary_blocks <- separate_binary_blocks time position events ----      join <$> traverse (notate_binary_block time) binary_blocks ----  notate_notes :: Notate_notes note_type -> Notes note_type ----  notate_notes notes = ----    case notes of ----      Notate_rest -> Notes Set.empty ----      Notate_notes notes' -> Notes notes' ----      Notate_tie -> Tie ----  notate_simple_length :: Length_fraction -> Maybe Length ----  notate_simple_length (num :% den) = ----    do ----      dots <- (\ i -> i - 1) <$> lg (1 + num) ----      basic_length <- notate_basic_length (2 ^ dots % den) ----      Just (Length basic_length (replicate dots Dot)) ----  notes_tie :: Notate_notes note_type -> Notate_notes note_type ----  notes_tie notes = ----    case notes of ----      Notate_rest -> Notate_rest ----      Notate_notes _ -> Notate_tie ----      Notate_tie -> Notate_tie ----  notes_to_set :: Notes note_type -> Set (Note note_type) ----  notes_to_set maybe_notes = ----    case maybe_notes of ----      Notes notes -> notes ----      Tie -> Set.empty ----  remove_factor :: Int -> Int -> Int ----  remove_factor factor i = ----    case mod i factor of ----      0 -> remove_factor factor (div i factor) ----      _ -> i ----  -- | Strip tracks of notational information (brackets, instrument names, clefs, note length display information). Mostly for ----  -- internal use. ----  remove_notational_information :: [[Pitched_or_unpitched Instrument_clefs_and_staves]] -> [Pitched_or_unpitched Track] ----  remove_notational_information stave_groups = ----    stave_groups >>= flip (>>=) (btraverse remove_notational_information_instrument_clefs_and_staves) ----  remove_notational_information_clef_and_stave :: Clef_and_stave note_type -> [[Event_fraction note_type]] ----  remove_notational_information_clef_and_stave (Clef_and_stave {stave}) = ----    remove_notational_information_events <$> stave_to_events stave ----  remove_notational_information_events :: [Event note_type] -> [Event_fraction note_type] ----  remove_notational_information_events events = join_events (remove_notational_information_events' events) ----  remove_notational_information_events' :: [Event note_type] -> [Event' (Notes note_type)] ----  remove_notational_information_events' events = events >>= remove_notational_information_event ----  remove_notational_information_event :: Event note_type -> [Event' (Notes note_type)] ----  remove_notational_information_event event = ----    case event of ----      Event notes len -> [Event' notes (length_to_fraction len)] ----      Triplet events -> scale_lengths (2 % 3) (remove_notational_information_events' events) ----  remove_notational_information_instrument_clefs_and_staves :: Instrument_clefs_and_staves note_type -> [Track note_type] ----  remove_notational_information_instrument_clefs_and_staves ----    (Instrument_clefs_and_staves {midi_instrument, velocity, clefs_and_staves}) = ----      ( ----        (\ events -> Track {instrument = midi_instrument, velocity, events}) <$> ----        (clefs_and_staves >>= remove_notational_information_clef_and_stave)) ----  separate_binary_blocks :: ----    Time -> Position -> [Event' (Notate_notes note_type)] -> Either Error [(Position, [Event' (Notate_notes note_type)])] ----  separate_binary_blocks time position events = ----    case events of ----      [] -> Right [] ----      event@(Event' _ len) : events' -> ----        do ----          let position' = position + len ----          case is_smooth [2] (denominator position') of ----            False -> ----              do ----                binary_blocks <- separate_binary_blocks time position' events' ----                case binary_blocks of ----                  [] -> Left Track_ends_with_an_incomplete_triplet ----                  (_, events'') : binary_blocks' -> Right ((position, event : events'') : binary_blocks') ----            True -> (:) (position, [event]) <$> separate_binary_blocks time position' events' ----  separate_measures :: ----    Time -> Position -> [Event' (Notate_notes note_type)] -> [(Length_fraction, [Event' (Notate_notes note_type)])] ----  separate_measures time initial_position events = ----    case separate_measures' time initial_position events of ----      [] -> [] ----      measure : measures' -> (initial_position, measure) : ((,) 0 <$> measures') ----  separate_measures' :: Time -> Position -> [Event' (Notate_notes note_type)] -> [[Event' (Notate_notes note_type)]] ----  separate_measures' time position events = ----    case events of ----      [] -> [] ----      Event' notes len : events' -> ----        let ----          position' = position + len in ----          case compare position' (measure_length time) of ----            LT -> ----              case separate_measures' time position' events' of ----                [] -> [[Event' notes len]] ----                measure : measures -> (Event' notes len : measure) : measures ----            EQ -> [Event' notes len] : separate_measures' time 0 events' ----            GT -> ----              let ----                len' = measure_length time - position in ----                [Event' notes len'] : separate_measures' time 0 (Event' (notes_tie notes) (len - len') : events') ----  -- | Convert the stave to a list of voices. Mostly for internal use. ----  stave_to_events :: Stave note_type -> [[Event note_type]] ----  stave_to_events stave = ----    case stave of ----      One_track events -> [events] ----      Two_tracks events_0 events_1 -> [events_0, events_1] ----  track_length :: Track note_type -> Ratio Int ----  track_length (Track {events}) = events_length events ----  -- | Calculate part length. Returns Nothing if there is a track length mismatch. ----  tracks_length :: [Pitched_or_unpitched Track] -> Either Error Length_fraction ----  tracks_length tracks = ----    case all_equal (pitched_and_unpitched track_length <$> tracks) of ----      Nothing -> Left Track_length_mismatch ----      Just maybe_len -> Right (fromMaybe 0 maybe_len) ----  transform_event :: Event_fraction note_type -> Event' (Notate_notes note_type) ----  transform_event (Event' notes len) = Event' (transform_notes notes) len ----  transform_notes :: Set (Note note_type) -> Notate_notes note_type ----  transform_notes notes = ----    case Set.elems notes of ----      [] -> Notate_rest ----      _ -> Notate_notes notes ---+  deriving instance Show (Clef note_type)+  deriving instance Show Clef_name+  deriving instance Show Header_field+  deriving instance Show Initial_position+  deriving instance Show (Instrument_and_staves note_type)+  deriving instance Show Part+  deriving instance Show Score+  deriving instance Show (Stave note_type)+  deriving instance Show Time+  deriving instance Show Time_numerator_factor+  deriving instance Show (Tracks note_type)+  -- | Convert int to time numerator factor. Mostly for internal use.+  int_to_time_numerator_factor :: Int -> Maybe Time_numerator_factor+  int_to_time_numerator_factor time_numerator_factor = List.lookup time_numerator_factor (swap <$> time_numerator_factors)+  -- | Maximum MIDI volume.+  max_velocity :: Velocity+  max_velocity = 127+  -- | Convert time numerator factor to int. Mostly for internal use.+  time_numerator_factor_to_int :: Time_numerator_factor -> Int+  time_numerator_factor_to_int time_numerator_factor = fromJust (List.lookup time_numerator_factor time_numerator_factors)+  time_numerator_factors :: [(Time_numerator_factor, Int)]+  time_numerator_factors = [(Two, 2), (Three, 3)]+  -- | Convert time numerator to int. Mostly for internal use.+  time_numerator_to_int :: [Time_numerator_factor] -> Int+  time_numerator_to_int num = product (time_numerator_factor_to_int <$> num)
Composition/Theory.hs view
@@ -1,5 +1,5 @@ {-|-Basic music theory.+Basic music theory: intervals. -} module Composition.Theory (   Interval (..),
− Composition/Time.hs 
@@ -1,70 +0,0 @@-{-| ----Description: Rhythmic organisation. ---- ----* Time signatures ----* Note positions ----* Measure subdivisions -----} ----module Composition.Time ( ----  Initial_position (..), ----  Position, ----  Time (..), ----  Time_numerator_factor (..), ----  initial_position_to_fraction, ----  int_to_time_numerator_factor,-  measure_length, ----  time_numerator_factor_to_int, ----  time_numerator_to_int, ----  time_subdivision) where ----  import Composition.Errors-  import Composition.Notes-  import Data.Maybe-  import Data.Ratio-  import Data.Tuple-  -- | The timing of the first event relative to the start of the measure. For example, if the piece is in 3/4 and starts with a ----  -- 1/4 pickup bar, the initial position can be written as @Initial_position 1 Half@ or @Initial_position 2 Quarter@. If the ----  -- piece starts with a full bar, the numerator is 0 (and you can use any length as the denominator). ----  data Initial_position = Initial_position Int Basic_length ----  -- | The position of an event relative to the start of the measure. Mostly for internal use. ----  type Position = Ratio Int ----  -- | Time signature numerators are written as a list of factors. For example, 2 is written as @[Two]@, 3 as @[Three]@, 4 as ----  -- @[Two Two]@, 6 as @[Two Three]@, 8 as @[Two Two Two]@, 9 as @[Three Three]@, 12 as @[Two Two Three]@, and so on. Note that ----  -- in some applications the order matters. For example, 18 as @[Three Two Three]@ means that the bar is divided into three ----  -- parts, each part is divided in half and then each half is divided into three parts. But 18 as @[Two Three Three]@ means ----  -- that the bar is divided in half, each half is divided into three parts and then each part is divided into three parts. This ----  -- will affect the placement of ties in keyboard transcriptions. ----  data Time_numerator_factor = Two | Three ----  -- | Time signatures. For example, 2/2 is written as @Time [Two] Half@, 3/2 as @Time [Three] Half@, 2/4 as @Time [Two] ----  -- Quarter@, and so on. ----  data Time = Time [Time_numerator_factor] Basic_length ----  deriving instance Eq Time_numerator_factor-  deriving instance Show Initial_position-  deriving instance Show Time-  deriving instance Show Time_numerator_factor-  -- | Convert initial position to fraction. Mostly for internal use. ----  initial_position_to_fraction :: Initial_position -> Position ----  initial_position_to_fraction (Initial_position num den) = fromIntegral num * basic_length_to_fraction den ----  -- | Convert int to time numerator factor. Mostly for internal use.-  int_to_time_numerator_factor :: Int -> Maybe Time_numerator_factor-  int_to_time_numerator_factor time_numerator_factor = lookup time_numerator_factor (swap <$> time_numerator_factors)-  -- | The length of one measure. ----  measure_length :: Time -> Length_fraction ----  measure_length (Time num den) = fromIntegral (time_numerator_to_int num) * basic_length_to_fraction den ----  -- | Convert time numerator factor to int. Mostly for internal use.-  time_numerator_factor_to_int :: Time_numerator_factor -> Int-  time_numerator_factor_to_int time_numerator_factor = fromJust (lookup time_numerator_factor time_numerator_factors)-  time_numerator_factors :: [(Time_numerator_factor, Int)]-  time_numerator_factors = [(Two, 2), (Three, 3)]-  -- | Convert time numerator to int. Mostly for internal use. ----  time_numerator_to_int :: [Time_numerator_factor] -> Int ----  time_numerator_to_int num = product (time_numerator_factor_to_int <$> num) ----  -- | Remove the topmost division from time signature. For example, 4/4 gets transformed into 2/4. 1/4 gets transformed into-  -- 1/8. Mostly for internal use.-  time_subdivision :: Time -> Either Error Time-  time_subdivision (Time num den) =-    case num of-      [] ->-        case next_basic_length den of-          Nothing -> Left (Is_out_of_range_without_location Note_length_denominator_IOOR)-          Just den' -> Right (Time [] den')-      _ : num' -> Right (Time num' den)
Composition/Write.hs view
@@ -1,137 +1,123 @@-{-| ----Description: Write the custom file format for scores. ---- ----* Write the custom file format for scores. -----} ----module Composition.Write (write) where ----  import Composition.Errors ----  import Composition.Notes ----  import Composition.Score ----  import Composition.Time ----  import Control.Monad.Except ----  import Data.List ----  import Data.Map ----  import Data.Set as Set ----  import Parser.Files ----  import Parser.Utilities ----  -- | Encode the score in .aoi format and write it to the specified file. ----  write :: File_path -> Score -> ExceptT Error IO () ----  write file_path score = write_file "aoi" writeFile File_error file_path (write_score score) ----  write_accidental :: Accidental -> String ----  write_accidental accidental = ----    case accidental of ----      Flat -> "b" ----      Natural -> "" ----      Sharp -> "#" ----  write_basic_length :: Basic_length -> String ----  write_basic_length len = show (basic_length_denominator len) ----  write_brackets :: String -> String -> String -> String ----  write_brackets left_bracket right_bracket x = left_bracket <> x <> right_bracket ----  write_clef :: Clef note_type -> String ----  write_clef clef = ----    case clef of ----      Pitched_clef {clef_name, transposition} -> ----        write_struct "Pitched_clef" [write_eq "clef_name" (show clef_name), write_eq "transposition" (show transposition)] ----      Percussion_clef -> "Percussion_clef" ----  write_clef_and_stave :: Clef_and_stave note_type -> String ----  write_clef_and_stave (Clef_and_stave {clef, stave}) = ----    write_struct "Clef_and_stave" [write_eq "clef" (write_clef clef), write_eq "stave" (write_stave stave)] ----  write_curly_brackets :: String -> String ----  write_curly_brackets = write_brackets "{" "}" ----  write_dot :: Dot -> Char ----  write_dot Dot = '.' ----  write_eq :: String -> String -> String ----  write_eq x y = x <-> "=" <-> y ----  write_event :: Event note_type -> String ----  write_event event = ----    case event of ----      Event notes len -> write_notes notes <> write_length len ----      Triplet events -> write_events events ----  write_events :: [Event note_type] -> String ----  write_events = write_list write_event ----  write_header :: Map Header_field String -> String ----  write_header header = write_list write_header_field (assocs header) ----  write_header_field :: (Header_field, String) -> String ----  write_header_field (name, value) = write_eq (show name) (write_quotes value) ----  write_initial_position :: Initial_position -> String ----  write_initial_position (Initial_position num den) = ----    case num of ----      0 -> "0" ----      _ -> show num <> "/" <> write_basic_length den ----  write_instrument_clefs_and_staves :: Instrument_clefs_and_staves note_type -> String ----  write_instrument_clefs_and_staves ----    (Instrument_clefs_and_staves {instrument_name, midi_instrument, velocity, clefs_and_staves}) = ----      write_struct ----        "Instrument_clefs_and_staves" ----        [ ----          write_eq "instrument_name" (write_quotes instrument_name), ----          write_eq "midi_instrument" (show midi_instrument), ----          write_eq "velocity" (show velocity), ----          write_eq "clefs_and_staves" (write_list write_clef_and_stave clefs_and_staves)] ----  write_key :: Set Note_name -> String ----  write_key key = write_list write_note_name (Set.elems key) ----  write_length :: Length -> String ----  write_length (Length len dots) = write_basic_length len <> (write_dot <$> dots) ----  write_list :: (t -> String) -> [t] -> String ----  write_list write_t x = write_square_brackets (intercalate " " (write_t <$> x)) ----  write_natural_note_name :: Natural_note_name -> String ----  write_natural_note_name natural_note_name = ----    case natural_note_name of ----      C_natural -> "C" ----      D_natural -> "D" ----      E_natural -> "E" ----      F_natural -> "F" ----      G_natural -> "G" ----      A_natural -> "A" ----      B_natural -> "B" ----  write_note :: Note note_type -> String ----  write_note note = ----    case note of ----      Pitched_note octave note_name -> write_note_name note_name <> show octave ----      Unpitched_note -> "x" ----  write_note_name :: Note_name -> String ----  write_note_name note_name = ----    let ----      (natural_note_name, accidental) = deconstruct_note_name note_name in ----      write_natural_note_name natural_note_name <> write_accidental accidental ----  write_notes :: Notes note_type -> String ----  write_notes maybe_notes = ----    case maybe_notes of ----      Notes notes -> write_list write_note (Set.elems notes) ----      Tie -> "+" ----  write_part :: Part -> String ----  write_part (Part {title, key, time, initial_position, tempo, stave_groups}) = ----    write_struct ----      "Part" ----      [ ----        write_eq "title" (write_quotes title), ----        write_eq "key" (write_key key), ----        write_eq "time" (write_time time), ----        write_eq "initial_position" (write_initial_position initial_position), ----        write_eq "tempo" (show tempo), ----        write_eq ----          "stave_groups" ----          (write_list (write_list (write_pitched_or_unpitched write_instrument_clefs_and_staves)) stave_groups)] ----  write_pitched_or_unpitched :: (forall note_type . f note_type -> String) -> Pitched_or_unpitched f -> String ----  write_pitched_or_unpitched write_f x = ----    pitched_or_unpitched (\ _ -> "Pitched") (\ _ -> "Unpitched") x <-> pitched_and_unpitched write_f x ----  write_quotes :: String -> String ----  write_quotes = write_brackets "\"" "\"" ----  write_score :: Score -> String ----  write_score (Score {title, header, parts}) = ----    write_struct ----      "Score" ----      [ ----        write_eq "title" (write_quotes title), ----        write_eq "header" (write_header header), ----        write_eq "parts" (write_list write_part parts)] ----  write_stave :: Stave note_type -> String ----  write_stave stave = write_list write_events (stave_to_events stave) ----  write_square_brackets :: String -> String ----  write_square_brackets = write_brackets "[" "]" ----  write_struct :: String -> [String] -> String ----  write_struct name fields = name <-> write_curly_brackets (intercalate " " fields) ----  write_time :: Time -> String ----  write_time (Time num den) = "Time" <-> write_list write_time_numerator_factor num <-> write_basic_length den ----  write_time_numerator_factor :: Time_numerator_factor -> String ----  write_time_numerator_factor time_numerator_factor = show (time_numerator_factor_to_int time_numerator_factor) ---+{-|+Write the custom file format.+-}+module Composition.Write (write, write_accidental, write_natural_note_name, write_note) where+  import Composition.Errors+  import Composition.Notation+  import Composition.Notes+  import Composition.Score+  import Control.Monad.Except+  import Data.List as List+  import Data.Map.Strict+  import Data.Maybe+  import Data.Set as Set+  import Parser.Files+  import Parser.Utilities+  -- | Encode the score in .aoi format and write it to the specified file.+  write :: File_path -> Score -> ExceptT Error IO ()+  write file_path score = write_file "aoi" writeFile File_error file_path (write_score score)+  -- | Write an accidental. Mostly for internal use.+  write_accidental :: Accidental -> String+  write_accidental accidental = fromJust (List.lookup accidental accidentals)+  write_basic_length :: Basic_length -> String+  write_basic_length len = show (basic_length_denominator len)+  write_brackets :: String -> String -> String -> String+  write_brackets left_bracket right_bracket x = left_bracket <> x <> right_bracket+  write_curly_brackets :: String -> String+  write_curly_brackets = write_brackets "{" "}"+  write_dot :: Dot -> Char+  write_dot Dot = '.'+  write_eq :: String -> String -> String+  write_eq x y = x <-> "=" <-> y+  write_event :: Event note_type -> String+  write_event event =+    case event of+      Event notes len -> write_notes notes <> write_length len+      Triplet events -> write_events events+  write_events :: [Event note_type] -> String+  write_events = write_list write_event+  write_header_field :: (Header_field, String) -> String+  write_header_field (name, value) = write_eq (show name) (write_quotes value)+  write_initial_position :: Initial_position -> String+  write_initial_position (Initial_position num den) =+    case num of+      0 -> "0"+      _ -> show num <> "/" <> write_basic_length den+  write_instrument_and_staves :: Instrument_and_staves note_type -> String+  write_instrument_and_staves+    (Instrument_and_staves {instrument_name, short_instrument_name, midi_instrument, velocity, staves}) =+      write_struct+        "Instrument_and_staves"+        (+          write_eq "instrument_name" (write_quotes instrument_name) <->+          write_eq "short_instrument_name" (write_quotes short_instrument_name) <->+          write_eq "midi_instrument" (show midi_instrument) <->+          write_eq "velocity" (show velocity) <->+          write_eq "staves" (write_list write_stave staves))+  write_length :: Length -> String+  write_length (Length len dots) = write_basic_length len <> (write_dot <$> dots)+  write_list :: (t -> String) -> [t] -> String+  write_list write_t x = write_square_brackets (intercalate " " (write_t <$> x))+  -- | Write a natural note name. Mostly for internal use.+  write_natural_note_name :: Natural_note_name -> String+  write_natural_note_name natural_note_name = [head (show natural_note_name)]+  write_note :: Note note_type -> String+  write_note note =+    case note of+      Pitched_note octave note_name -> write_note_name note_name <> show octave+      Unpitched_note -> "x"+  -- | Write a note name. Mostly for internal use.+  write_note_name :: Note_name -> String+  write_note_name note_name =+    let+      (natural_note_name, accidental) = deconstruct_note_name note_name in+      write_natural_note_name natural_note_name <> write_accidental accidental+  write_notes :: Notes note_type -> String+  write_notes maybe_notes =+    case maybe_notes of+      Notes notes -> write_list write_note (Set.elems notes)+      Tie -> "+"+  write_part :: Part -> String+  write_part (Part {title, key, time, initial_position, tempo, stave_groups}) =+    write_struct+      "Part"+      (+        write_eq "title" (write_quotes title) <->+        write_eq "key" write_key <->+        write_eq "time" (write_time time) <->+        write_eq "initial_position" (write_initial_position initial_position) <->+        write_eq "tempo" (show tempo) <->+        write_eq+          "stave_groups"+          (write_list (write_list (write_pitched_or_unpitched write_instrument_and_staves)) stave_groups)) where+    write_key :: String+    write_key = write_list write_note_name (Set.elems key)+  write_pitched_or_unpitched :: (forall note_type . f note_type -> String) -> Pitched_or_unpitched f -> String+  write_pitched_or_unpitched write_f x =+    pitched_or_unpitched (\ _ -> "Pitched") (\ _ -> "Unpitched") x <-> pitched_and_unpitched write_f x+  write_quotes :: String -> String+  write_quotes = write_brackets "\"" "\""+  write_score :: Score -> String+  write_score (Score {header, parts}) =+    write_struct "Score" (write_eq "header" write_header <-> write_eq "parts" (write_list write_part parts)) where+    write_header :: String+    write_header = write_list write_header_field (assocs header)+  write_square_brackets :: String -> String+  write_square_brackets = write_brackets "[" "]"+  write_stave :: Stave note_type -> String+  write_stave (Stave {clef, tracks}) =+    write_struct "Stave" (write_eq "clef" write_clef <-> write_eq "tracks" write_tracks) where+    write_clef :: String+    write_clef =+      case clef of+        Pitched_clef {clef_name, transposition} ->+          write_struct "Pitched_clef" (write_eq "clef_name" (show clef_name) <-> write_eq "transposition" (show transposition))+        Percussion_clef -> "Percussion_clef"+    write_tracks :: String+    write_tracks = write_list write_events (tracks_to_list tracks)+  write_struct :: String -> String -> String+  write_struct name fields = name <-> write_curly_brackets fields+  write_time :: Time -> String+  write_time (Time num den) = "Time" <-> write_list write_time_numerator_factor num <-> write_basic_length den+  write_time_numerator_factor :: Time_numerator_factor -> String+  write_time_numerator_factor time_numerator_factor = show (time_numerator_factor_to_int time_numerator_factor)
+ Keyboard.key view
@@ -0,0 +1,52 @@+[] [0 1 2 3 4 5 6 7 8 9 10 11]+[2] [0 1 2 3 4 5 6 7 8 9 10 11]+[2 3] [0 1 2 3 4 5 6 7 8 9 10 11]+[2 4] [0 1 2 3 4 5 6 7 8 9 10 11]+[2 6] [0 1 2 3 4 5 6 7 8 9 10 11]+[2 7] [0 1 2 3 4 5 6 7 8 9 10 11]+[2 10] [0 1 2 3 4 5 6 7 8 9 10 11]+[3] [0 1 2 3 4 5 6 7 8 9 10 11]+[3 2] [0 1 2 3 4 5 6 7 8 9 10 11]+[3 3] [0 1 2 3 4 5 6 7 8 9 10 11]+[3 4] [0 1 2 3 4 5 6 7 8 9 10 11]+[3 5] [0 1 2 3 4 5 6 7 8 9 10 11]+[3 6] [0 1 2 3 4 5 6 7 8 9 10 11]+[3 7] [0 1 2 3 4 5 6 7 8 9 10 11]+[3 9] [0 1 2 3 4 5 6 7 8 9 10 11]+[4] [0 1 2 3 4 5 6 7 8 9 10 11]+[4 2] [0 1 2 3 4 5 6 7 8 9 10 11]+[4 3] [0 1 2 3 4 5 6 7 8 9 10 11]+[4 5] [0 1 2 3 4 5 6 7 8 9 10 11]+[4 6] [0 1 2 3 4 5 6 7 8 9 10 11]+[4 8] [0 1 2 3 4 5 6 7 8 9 10 11]+[4 10] [0 1 2 3 5 6 7 8 9 10]+[5] [0 1 2 3 4 5 6 7 8 9 10 11]+[5 3] [0 1 2 3 4 5 6 7 8 9 10 11]+[5 4] [0 1 2 3 4 5 6 7 8 9 10 11]+[5 7] [0 1 2 3 4 5 6 7 8 9 10 11]+[5 9] [0 1 2 3 5 6 7 8 9 10]+[5 10] [3 10]+[6] [0 1 2 3 4 5 6 7 8 9 10 11]+[6 2] [0 1 2 3 4 5 6 7 8 9 10 11]+[6 3] [0 1 2 3 4 5 6 7 8 9 10 11]+[6 4] [0 1 2 3 4 5 6 7 8 9 10 11]+[6 8] [0 1 2 3 5 6 7 8 9 10]+[6 9] [3 10]+[7] [0 1 2 3 4 5 6 7 8 9 10 11]+[7 2] [0 1 2 3 4 5 6 7 8 9 10 11]+[7 3] [0 1 2 3 4 5 6 7 8 9 10 11]+[7 5] [0 1 2 3 4 5 6 7 8 9 10 11]+[7 8] [3 10]+[8] [0 1 2 3 4 5 6 7 8 9 10 11]+[8 4] [0 1 2 3 4 5 6 7 8 9 10 11]+[8 6] [0 1 2 3 5 6 7 8 9 10]+[8 7] [3 10]+[9] [0 1 2 3 4 5 6 7 8 9 10 11]+[9 3] [0 1 2 3 4 5 6 7 8 9 10 11]+[9 5] [0 1 2 3 5 6 7 8 9 10]+[9 6] [3 10]+[10] [0 1 2 3 4 5 6 7 8 9 10 11]+[10 4] [0 1 2 3 5 6 7 8 9 10]+[12] [0 1 2 3 4 5 6 7 8 9 10 11]+[14] [0 1 2 3 5 6 7 8 9 10]+[15] [3 10]
Main.hs view
@@ -1,267 +1,367 @@-module Main (main) where ---  import Composition.Errors ---  import Composition.Lilypond ---  import Composition.MIDI ---  import Composition.Keyboard ---  import Composition.Parser ---  import Composition.Score ---  import Composition.Write ---  import Control.Monad.Except ---  import Control.Monad.Trans.Except ---  import Data.Char ---  import Data.Functor ---  import Data.List ---  import Data.Maybe ---  import Parser.Files ---  import Parser.Locations ---  import Parser.Parser ---  import Parser.Utilities ---  import System.Environment ---  data Char_class = ---    Delimiter_char Token | ---    File_path_char Char | ---    Invalid_char | ---    Keyword_char Char | ---    Nonzero_char Char | ---    Quote_char | ---    Text_char Char | ---    Whitespace_char | ---    Zero_char ---  data Command = ---    Keyboard_command { ---      playable :: File_path, ---      source :: File_path, ---      header_instrument :: Maybe String, ---      midi_instrument :: MIDI_instrument, ---      destination :: File_path} | ---    Lilypond {source :: File_path, destination :: File_path} | ---    MIDI {source :: File_path, destination :: File_path} ---  type Parser = Parser' Token Error ---  data Token = ---    Destination_token | ---    Eq_token | ---    File_path_token String | ---    Instrument_name_token | ---    Keyboard_token | ---    Left_curly_bracket_token | ---    Lilypond_token | ---    MIDI_instrument_token | ---    MIDI_token | ---    Nat_token Integer | ---    Playable_token | ---    Right_curly_bracket_token | ---    Source_token | ---    Text_token String ---  type Tokeniser = Tokeniser' Char_class Token Error ---  deriving instance Eq Char_class ---  deriving instance Eq Token ---  deriving instance Show Char_class ---  deriving instance Show Command ---  deriving instance Show Token ---  classify_char :: Char -> Char_class ---  classify_char c = ---    case c of ---      ' ' -> Whitespace_char ---      _ | elem c "!#$%&'()*+-,:;<>?@[]^`|~" -> Text_char c ---      '"' -> Quote_char ---      _ | elem c "'_" || isLetter c -> Keyword_char c ---      _ | elem c "./" -> File_path_char c ---      '0' -> Zero_char ---      _ | isDigit c && c /= '0' -> Nonzero_char c ---      '=' -> Delimiter_char Eq_token ---      '{' -> Delimiter_char Left_curly_bracket_token ---      '}' -> Delimiter_char Right_curly_bracket_token ---      _ -> Invalid_char ---  construct_keyword :: String -> Either (Location -> Error) Token ---  construct_keyword keyword = ---    case lookup keyword keywords of ---      Nothing -> Left (\ _ -> Invalid_keyword keyword) ---      Just token -> Right token ---  convert_midi_instrument :: Integer -> Either (Location -> Error) MIDI_instrument ---  convert_midi_instrument midi_instrument = ---    do ---      check (Is_out_of_range_with_location MIDI_instrument_code_IOOR) (between 0 127 midi_instrument) ---      Right (fromIntegral midi_instrument) ---  delimiter_char :: Char_class -> Maybe Token ---  delimiter_char char_class = ---    case char_class of ---      Delimiter_char token -> Just token ---      _ -> Nothing ---  file_path_char :: Char_class -> Maybe Char ---  file_path_char char_class = ---    case char_class of ---      File_path_char c -> Just c ---      Keyword_char c -> Just c ---      Nonzero_char c -> Just c ---      Zero_char -> Just '0' ---      _ -> Nothing ---  file_path_token :: Token -> Maybe String ---  file_path_token token = ---    case token of ---      File_path_token file_path -> Just file_path ---      _ -> Nothing ---  keyword_char :: Char_class -> Maybe Char ---  keyword_char char_class = ---    case char_class of ---      Keyword_char c -> Just c ---      _ -> Nothing ---  keywords :: [(String, Token)] ---  keywords = ---    [ ---      ("Keyboard", Keyboard_token), ---      ("Lilypond", Lilypond_token), ---      ("MIDI", MIDI_token), ---      ("destination", Destination_token), ---      ("instrument_name", Instrument_name_token), ---      ("midi_instrument", MIDI_instrument_token), ---      ("playable", Playable_token), ---      ("source", Source_token)] ---  main :: IO () ---  main = ---    do ---      args <- getArgs ---      result <- runExceptT (main' (intercalate " " args)) ---      case result of ---        Left err -> putStrLn (write_error err) ---        Right () -> return () ---  main' :: String -> ExceptT Error IO () ---  main' text = ---    do ---      command <- except (Main.parse text) ---      case command of ---        Keyboard_command {playable = playable_file, source, header_instrument, midi_instrument, destination} -> ---          do ---            playable <- parse_playable playable_file ---            original_score <- Composition.Parser.parse source ---            keyboard_score <- except (keyboard playable header_instrument midi_instrument original_score) ---            write destination keyboard_score ---        Lilypond {source, destination} -> ---          do ---            score <- Composition.Parser.parse source ---            lilypond destination score ---        MIDI {source, destination} -> ---          do ---            score <- Composition.Parser.parse source ---            midi score destination ---      return () ---  nat_char :: Char_class -> Maybe Char ---  nat_char char_class = ---    case char_class of ---      Zero_char -> Just '0' ---      Nonzero_char c -> Just c ---      _ -> Nothing ---  nat_token :: Token -> Maybe Integer ---  nat_token token = ---    case token of ---      Nat_token i -> Just i ---      _ -> Nothing ---  nonzero_char :: Char_class -> Maybe Char ---  nonzero_char char_class = ---    case char_class of ---      Nonzero_char c -> Just c ---      _ -> Nothing ---  parse :: String -> Either Error Command ---  parse command = fromJust (parse' classify_char (return next_char) tokenise parse_command Parse_error command) ---  parse_command :: Parser Command ---  parse_command = parse_keyboard <+> parse_lilypond <+> parse_midi ---  parse_curly_brackets :: Parser t -> Parser t ---  parse_curly_brackets = parse_brackets Left_curly_bracket_token Right_curly_bracket_token ---  parse_eq :: Parser () ---  parse_eq = parse_token Eq_token ---  parse_field :: Token -> Parser t -> Parser t ---  parse_field name parse_t = ---    do ---      parse_token name ---      parse_eq ---      parse_t ---  parse_file_path :: String -> Parser File_path ---  parse_file_path ext = fmap_filter_parser (parse_file_path' (\ err _ -> File_error err) ext) (parse_token' file_path_token) ---  parse_keyboard :: Parser Command ---  parse_keyboard = ---    parse_struct ---      Keyboard_token ---      (do ---        playable <- parse_field Playable_token (parse_file_path "key") ---        source <- parse_field Source_token (parse_file_path "aoi") ---        header_instrument <- parse_optional_field Instrument_name_token parse_text ---        midi_instrument <- parse_field MIDI_instrument_token parse_midi_instrument ---        destination <- parse_field Destination_token (parse_file_path "aoi") ---        return (Keyboard_command {playable, source, header_instrument, midi_instrument, destination})) ---  parse_lilypond :: Parser Command ---  parse_lilypond = ---    parse_struct ---      Lilypond_token ---      (do ---        source <- parse_field Source_token (parse_file_path "aoi") ---        destination <- parse_field Destination_token (parse_file_path "ly") ---        return (Lilypond {source, destination})) ---  parse_midi :: Parser Command ---  parse_midi = ---    parse_struct ---      MIDI_token ---      (do ---        source <- parse_field Source_token (parse_file_path "aoi") ---        destination <- parse_field Destination_token (parse_file_path "mid") ---        return (MIDI {source, destination})) ---  parse_midi_instrument :: Parser MIDI_instrument ---  parse_midi_instrument = fmap_filter_parser convert_midi_instrument parse_nat ---  parse_nat :: Parser Integer ---  parse_nat = parse_token' nat_token ---  parse_optional_field :: Token -> Parser t -> Parser (Maybe t) ---  parse_optional_field name parse_t = parse_default Nothing (Just <$> parse_field name parse_t) ---  parse_struct :: Token -> Parser Command -> Parser Command ---  parse_struct name parse_fields' = ---    do ---      parse_token name ---      parse_curly_brackets parse_fields' ---  parse_text :: Parser String ---  parse_text = parse_token' text_token ---  text_char :: Char_class -> Maybe Char ---  text_char char_class = ---    case char_class of ---      Delimiter_char token -> ---        Just ---          (case token of ---            Eq_token -> '=' ---            Left_curly_bracket_token -> '{' ---            Right_curly_bracket_token -> '}' ---            _ -> undefined) ---      File_path_char c -> Just c ---      Invalid_char -> Nothing ---      Keyword_char c -> Just c ---      Nonzero_char c -> Just c ---      Quote_char -> Nothing ---      Text_char c -> Just c ---      Whitespace_char -> Just ' ' ---      Zero_char -> Just '0' ---  text_token :: Token -> Maybe String ---  text_token token = ---    case token of ---      Text_token text -> Just text ---      _ -> Nothing ---  tokenise :: Tokeniser () ---  tokenise = void (parse_many tokenise_1) ---  tokenise_1 :: Tokeniser () ---  tokenise_1 = ---    tokenise_delimiter <+> ((tokenise_nat <+> tokenise_keyword) <+ tokenise_file_path) <+> tokenise_text <+> tokenise_whitespace ---  tokenise_delimiter :: Tokeniser () ---  tokenise_delimiter = add_token (parse_token' delimiter_char) ---  tokenise_file_path :: Tokeniser () ---  tokenise_file_path = add_token (File_path_token <$> parse_some (parse_token' file_path_char)) ---  tokenise_keyword :: Tokeniser () ---  tokenise_keyword = add_token (fmap_filter_parser construct_keyword (parse_some (parse_token' keyword_char))) ---  tokenise_nat :: Tokeniser () ---  tokenise_nat = add_token (Nat_token <$> (tokenise_zero <+> tokenise_positive_int)) ---  tokenise_positive_int :: Tokeniser Integer ---  tokenise_positive_int = read <$> ((:) <$> parse_token' nonzero_char <*> parse_many (parse_token' nat_char)) ---  tokenise_quotes :: Tokeniser t -> Tokeniser t ---  tokenise_quotes = parse_brackets Quote_char Quote_char ---  tokenise_text :: Tokeniser () ---  tokenise_text = add_token (Text_token <$> tokenise_quotes (parse_many (parse_token' text_char))) ---  tokenise_whitespace :: Tokeniser () ---  tokenise_whitespace = parse_token Whitespace_char ---  tokenise_zero :: Tokeniser Integer ---  tokenise_zero = ---    do ---      parse_token Zero_char ---      return 0 --+module Main (main) where+  import Composition.Errors+  import Composition.Lilypond+  import Composition.MIDI+  import Composition.Keyboard+  import Composition.Parser+  import Composition.Score+  import Composition.Write+  import Control.Applicative+  import Control.Monad.Except+  import Control.Monad.Trans.Except+  import Data.Char+  import Data.Functor+  import Data.List as List+  import Data.Map.Strict+  import Data.Maybe+  import Data.Tuple+  import Parser.Files+  import Parser.Locations+  import Parser.Parser+  import Parser.Utilities+  import System.Environment+  import Text.Read+  data Char_class =+    Delimiter_char Token |+    File_path_char Char |+    Invalid_char |+    Nonzero_nat_char Char |+    Quote_char |+    Text_char Char |+    Whitespace_char |+    Word_char Char |+    Zero_char+  data Command =+    Keyboard_command {+      playables :: File_path,+      source :: File_path,+      header :: Map Header_field String,+      midi_instrument :: MIDI_instrument,+      destination :: File_path} |+    Lilypond_command {source :: File_path, destination :: File_path} |+    MIDI_command {source :: File_path, destination :: File_path}+  type Parser = Parser' Token Error+  data Token =+    Destination_token |+    Eq_token |+    File_path_token String |+    Header_field_token Header_field |+    Header_token |+    Keyboard_token |+    Left_curly_bracket_token |+    Left_square_bracket_token |+    Lilypond_token |+    MIDI_instrument_token |+    MIDI_token |+    Nat_token Int |+    Playables_token |+    Right_curly_bracket_token |+    Right_square_bracket_token |+    Source_token |+    Text_token String+  type Tokeniser = Tokeniser' Char_class Token Error+  deriving instance Eq Char_class+  deriving instance Eq Token+  deriving instance Show Char_class+  deriving instance Show Command+  deriving instance Show Token+  classify_char :: Char -> Char_class+  classify_char c =+    case c of+      ' ' -> Whitespace_char+      _ | elem c "!#$%&'()*+-,:;<>?@^`|~" -> Text_char c+      '"' -> Quote_char+      _ | elem c "'_" || isLetter c -> Word_char c+      _ | elem c "./" -> File_path_char c+      '0' -> Zero_char+      _ | isDigit c && c /= '0' -> Nonzero_nat_char c+      _ | elem c (fst <$> delimiters) -> Delimiter_char (fromJust (List.lookup c delimiters))+      _ -> Invalid_char+  construct_header :: [(Header_field, String)] -> Either (Location -> Error) (Map Header_field String)+  construct_header header =+    case construct_map header of+      Nothing -> Left (\ _ -> Duplicate_header_fields Nothing)+      Just header' -> Right header'+  construct_word :: String -> Either (Location -> Error) Token+  construct_word word =+    (case construct_header_field <|> construct_keyword of+      Nothing -> Left (\ _ -> Invalid_word word Nothing)+      Just token -> Right token) where+    construct_header_field :: Maybe Token+    construct_header_field = Header_field_token <$> readMaybe word+    construct_keyword :: Maybe Token+    construct_keyword =+      case word of+        "Keyboard" -> Just Keyboard_token+        "Lilypond" -> Just Lilypond_token+        "MIDI" -> Just MIDI_token+        "destination" -> Just Destination_token+        "header" -> Just Header_token+        "midi_instrument" -> Just MIDI_instrument_token+        "playables" -> Just Playables_token+        "source" -> Just Source_token+        _ -> Nothing+  convert_midi_instrument :: Int -> Either (Location -> Error) MIDI_instrument+  convert_midi_instrument midi_instrument =+    do+      check (\ _ -> MIDI_instrument_code_is_out_of_range_command midi_instrument) (between 0 127 midi_instrument)+      Right (fromIntegral midi_instrument)+  delimiter_char :: Char_class -> Maybe Token+  delimiter_char char_class =+    case char_class of+      Delimiter_char token -> Just token+      _ -> Nothing+  delimiters :: [(Char, Token)]+  delimiters =+    [+      ('=', Eq_token),+      ('[', Left_square_bracket_token),+      (']', Right_square_bracket_token),+      ('{', Left_curly_bracket_token),+      ('}', Right_curly_bracket_token)]+  file_path_char :: Char_class -> Maybe Char+  file_path_char char_class =+    case char_class of+      File_path_char c -> Just c+      Nonzero_nat_char c -> Just c+      Word_char c -> Just c+      Zero_char -> Just '0'+      _ -> Nothing+  file_path_token :: Token -> Maybe String+  file_path_token token =+    case token of+      File_path_token file_path -> Just file_path+      _ -> Nothing+  header_field_token :: Token -> Maybe Header_field+  header_field_token token =+    case token of+      Header_field_token header_field -> Just header_field+      _ -> Nothing+  main :: IO ()+  main =+    do+      args <- getArgs+      result <- runExceptT (main' (intercalate " " args))+      case result of+        Left err -> putStrLn (write_error err)+        Right () -> return ()+  main' :: String -> ExceptT Error IO ()+  main' command =+    (do+      command' <- except parse_command+      case command' of+        Keyboard_command {playables = playables_file_path, source, header, midi_instrument, destination} ->+          do+            playables <- parse_playables playables_file_path+            original_score <- parse source+            keyboard_score <- except (reduction playables header midi_instrument original_score)+            write destination keyboard_score+        Lilypond_command {source, destination} ->+          do+            score <- parse source+            lilypond score destination+        MIDI_command {source, destination} ->+          do+            score <- parse source+            midi score destination) where+    parse_command :: Either Error Command+    parse_command =+      fromJust (parse' classify_char (return next_char) tokenise parse_command' (\ _ -> Parse_error_command) command)+  nat_char :: Char_class -> Maybe Char+  nat_char char_class =+    case char_class of+      Zero_char -> Just '0'+      Nonzero_nat_char c -> Just c+      _ -> Nothing+  nat_token :: Token -> Maybe Int+  nat_token token =+    case token of+      Nat_token i -> Just i+      _ -> Nothing+  nonzero_nat_char :: Char_class -> Maybe Char+  nonzero_nat_char char_class =+    case char_class of+      Nonzero_nat_char c -> Just c+      _ -> Nothing+  parse_command' :: Parser Command+  parse_command' = parse_keyboard <+> parse_lilypond <+> parse_midi+  parse_curly_brackets :: Parser t -> Parser t+  parse_curly_brackets = parse_brackets Left_curly_bracket_token Right_curly_bracket_token+  parse_eq :: Parser ()+  parse_eq = parse_token Eq_token+  parse_field :: Token -> Parser t -> Parser t+  parse_field name parse_t =+    do+      parse_token name+      parse_eq+      parse_t+  parse_file_path :: String -> Parser File_path+  parse_file_path ext = fmap_filter_parser (parse_file_path' (\ err _ -> File_error err) ext) (parse_token' file_path_token)+  parse_header :: Parser (Map Header_field String)+  parse_header = fmap_filter_parser construct_header (parse_list' parse_header_field)+  parse_header_field :: Parser (Header_field, String)+  parse_header_field =+    do+      name <- parse_header_field_name+      parse_eq+      value <- parse_text+      return (name, value)+  parse_header_field_name :: Parser Header_field+  parse_header_field_name = parse_token' header_field_token+  parse_keyboard :: Parser Command+  parse_keyboard =+    parse_struct+      Keyboard_token+      (do+        playables <- parse_field Playables_token (parse_file_path "key")+        source <- parse_field Source_token (parse_file_path "aoi")+        header <- parse_field Header_token parse_header+        midi_instrument <- parse_field MIDI_instrument_token parse_midi_instrument+        destination <- parse_field Destination_token (parse_file_path "aoi")+        return (Keyboard_command {playables, source, header, midi_instrument, destination}))+  parse_lilypond :: Parser Command+  parse_lilypond =+    parse_struct+      Lilypond_token+      (do+        source <- parse_field Source_token (parse_file_path "aoi")+        destination <- parse_field Destination_token (parse_file_path "ly")+        return (Lilypond_command {source, destination}))+  parse_list' :: Parser t -> Parser [t]+  parse_list' parse_t = parse_square_brackets (parse_many parse_t)+  parse_midi :: Parser Command+  parse_midi =+    parse_struct+      MIDI_token+      (do+        source <- parse_field Source_token (parse_file_path "aoi")+        destination <- parse_field Destination_token (parse_file_path "mid")+        return (MIDI_command {source, destination}))+  parse_midi_instrument :: Parser MIDI_instrument+  parse_midi_instrument = fmap_filter_parser convert_midi_instrument parse_nat+  parse_nat :: Parser Int+  parse_nat = parse_token' nat_token+  parse_square_brackets :: Parser t -> Parser t+  parse_square_brackets = parse_brackets Left_square_bracket_token Right_square_bracket_token+  parse_struct :: Token -> Parser Command -> Parser Command+  parse_struct name parse_fields =+    do+      parse_token name+      parse_curly_brackets parse_fields+  parse_text :: Parser String+  parse_text = parse_token' text_token+  text_char :: Char_class -> Maybe Char+  text_char char_class =+    case char_class of+      Delimiter_char token -> List.lookup token (swap <$> delimiters)+      File_path_char c -> Just c+      Invalid_char -> Nothing+      Nonzero_nat_char c -> Just c+      Quote_char -> Nothing+      Text_char c -> Just c+      Whitespace_char -> Just ' '+      Word_char c -> Just c+      Zero_char -> Just '0'+  text_token :: Token -> Maybe String+  text_token token =+    case token of+      Text_token text -> Just text+      _ -> Nothing+  tokenise :: Tokeniser ()+  tokenise = void (parse_many tokenise_1)+  tokenise_1 :: Tokeniser ()+  tokenise_1 =+    tokenise_delimiter <+> ((tokenise_nat <+> tokenise_word) <+ tokenise_file_path) <+> tokenise_text <+> tokenise_whitespace+  tokenise_delimiter :: Tokeniser ()+  tokenise_delimiter = add_token (parse_token' delimiter_char)+  tokenise_file_path :: Tokeniser ()+  tokenise_file_path = add_token (File_path_token <$> parse_some (parse_token' file_path_char))+  tokenise_nat :: Tokeniser ()+  tokenise_nat = add_token (Nat_token <$> (tokenise_zero <+> tokenise_positive_int))+  tokenise_positive_int :: Tokeniser Int+  tokenise_positive_int = read <$> ((:) <$> parse_token' nonzero_nat_char <*> parse_many (parse_token' nat_char))+  tokenise_quotes :: Tokeniser t -> Tokeniser t+  tokenise_quotes = parse_brackets Quote_char Quote_char+  tokenise_text :: Tokeniser ()+  tokenise_text = add_token (Text_token <$> tokenise_quotes (parse_many (parse_token' text_char)))+  tokenise_whitespace :: Tokeniser ()+  tokenise_whitespace = parse_token Whitespace_char+  tokenise_word :: Tokeniser ()+  tokenise_word = add_token (fmap_filter_parser construct_word (parse_some (parse_token' word_char)))+  tokenise_zero :: Tokeniser Int+  tokenise_zero =+    do+      parse_token Zero_char+      return 0+  word_char :: Char_class -> Maybe Char+  word_char char_class =+    case char_class of+      Word_char c -> Just c+      _ -> Nothing+  -- | Writing errors.+  write_error :: Error -> String+  write_error err =+    case err of+      An_event_crosses_the_bar_line -> "An event crosses the bar line."+      Conflicting_accidentals_in_key_signature -> "Conflicting accidentals in key signature."+      Duplicate_header_fields location -> "Duplicate header fields" <-> write_maybe_location location <> "."+      Duplicate_keys location -> "Duplicate keys at" <-> write_location location <> "."+      Duplicate_note_names_in_key_signature location ->+        "Duplicate note name in key signature at" <-> write_location location <> "."+      Duplicate_notes location -> "Duplicate notes at" <-> write_location location <> "."+      Empty_triplet -> "Empty triplet."+      Event_or_part_length_is_out_of_range_for_MIDI -> "Event or part length is out of range for MIDI."+      File_error err' ->+        case err' of+          Failed_to_find_file file_path -> "Failed to find file" <-> file_path <> "."+          Invalid_file_path -> "Invalid file path."+          Unexpected_extension ext -> "Unexpected extension ." <> ext <> "."+      Initial_position_is_out_of_range -> "Initial position is out of range."+      Key_is_out_of_range key location -> "Key" <-> show key <-> "at" <-> write_location location <-> "is out of range."+      Invalid_character_in_text -> "Invalid character in text."+      Invalid_note_length len location -> "Invalid note length" <-> show len <-> "at" <-> write_location location <> "."+      Invalid_note_name natural_note_name accidental location ->+        (+          "Invalid note name" <->+          write_natural_note_name natural_note_name <>+          write_accidental accidental <->+          "at" <->+          write_location location <>+          ".")+      Invalid_time_numerator_factor time_numerator_factor location ->+        "Invalid time numerator factor" <-> show time_numerator_factor <-> "at" <-> write_location location <> "."+      Invalid_word word location -> "Invalid word" <-> word <-> write_maybe_location location <> "."+      Is_out_of_range_with_location typ location ->+        write_is_out_of_range_type typ <-> "at" <-> write_location location <-> "is out of range."+      Is_out_of_range_without_location typ -> write_is_out_of_range_type typ <-> "is out of range."+      MIDI_instrument_code_is_out_of_range_command instrument ->+        "MIDI instrument code" <-> show instrument <-> "in the command is out of range."+      MIDI_instrument_code_is_out_of_range_data instrument ->+        "MIDI instrument code" <-> show instrument <-> "is out of range."+      MIDI_instrument_code_is_out_of_range_score instrument location ->+        "MIDI instrument code" <-> show instrument <-> "in the score at" <-> write_location location <-> "is out of range."+      Non_positive_note_length -> "Non-positive note length."+      Note_is_out_of_range_for_MIDI note -> "Note" <-> write_note note <-> "is out of range for MIDI."+      Note_length_denominator_contains_factors_other_than_2_and_3 ->+        "Note length denominator contains factors other than 2 and 3."+      Parse_error_command -> "Parse error in the command."+      Parse_error_playables location -> "Parse error in the playables file at" <-> write_location location <> "."+      Parse_error_score location -> "Parse error in the score at" <-> write_location location <> "."+      Track_ends_with_an_incomplete_triplet -> "Track ends with an incomplete triplet."+      Track_length_mismatch -> "Track length mismatch."+      Velocity_out_of_range location -> "Velocity out of range at " <> write_location location <> "."+  write_is_out_of_range_type :: Is_out_of_range_type -> String+  write_is_out_of_range_type typ =+    case typ of+      Note_length_denominator_IOOR -> "Note length denominator"+      Tempo_IOOR -> "Tempo"+      The_least_common_denominator_of_note_lengths_IOOR -> "The least common denominator of note lengths"+      The_number_of_pitched_tracks_IOOR -> "The number of pitched tracks"+      The_number_of_tracks_IOOR -> "The number of tracks"+      Track_length_IOOR -> "Track length"+      Velocity_IOOR -> "Velocity"+  write_maybe_location :: Maybe Location -> String+  write_maybe_location maybe_location =+    case maybe_location of+      Nothing -> "in the command"+      Just location -> "at" <-> write_location location
+ README.md view
@@ -0,0 +1,272 @@+# Aoide++## Score file++Score files have to have a `.aoi` extension.++The best way to learn the syntax is to have a look at the example scores in `Scores` directory.++Score files aren't indentation-sensitive. Structure field order is fixed - for example, when you create a score the header comes+first and the parts come second.++### `SCORE`++~~~+Score {+  header = (HEADER)+  parts = [+    (PART)+    (PART)+    (PART)+    ...]}+~~~++### `HEADER`++~~~+[(HEADER_FIELD) (HEADER_FIELD) (HEADER_FIELD) ...]+~~~++You do not need to use all the possible header fields - use only the ones that you need. Header field order is flexible.++### `HEADER_FIELD`++~~~+(HEADER_FIELD_NAME) = ""+~~~++### `HEADER_FIELD_NAME`++* `Left_text`+* `Overtitle`+* `Right_text`+* `Subtitle`+* `Subsubtitle`+* `Title`++### `PART`++~~~+Part {+  title = ""+  key = (KEY)+  time = (TIME)+  initial_position = (INITIAL_POSITION)+  tempo = 100+  stave_groups = [+    (STAVE_GROUP)+    (STAVE_GROUP)+    (STAVE_GROUP)+    ...]}+~~~++### `KEY`++~~~+[(NOTE_NAME) (NOTE_NAME) (NOTE_NAME) ...]+~~~++You only need to specify the note names that have accidentals.++### `NOTE_NAME`++* `C`+* `C#`+* `Db`+* ...++### `TIME`++* `Time [2] 2` - 2/2+* `Time [2 2] 4` - 4/4+* `Time [2 2 2] 8` - 8/8+* `Time [2 2 3] 16` - 12/16+* `Time [2 3] 8` - 6/8+* `Time [3] 4` - 3/4+* `Time [3 3] 16` - 9/16+* ...++### `INITIAL_POSITION`++The timing of the first event relative to the start of the measure. If the piece starts with a full bar, the initial position is+0. If the piece is in 3/4 and starts with a 1/4 pickup bar, the initial position can be written as 1/2 or 2/4.++### `STAVE_GROUP`++~~~+[+  (INSTRUMENT_AND_STAVES)+  (INSTRUMENT_AND_STAVES)+  (INSTRUMENT_AND_STAVES)+  ...]+~~~++### `INSTRUMENT_AND_STAVES`++~~~+(PITCHED_OR_UNPITCHED) Instrument_and_staves {+  instrument_name = ""+  short_instrument_name = ""+  midi_instrument = 0+  velocity = 127+  staves = [+    (STAVE)+    (STAVE)+    (STAVE)+    ...]}+~~~++### `PITCHED_OR_UNPITCHED`++* `Pitched`+* `Unpitched`++### `STAVE`++~~~+Stave {+  clef = (CLEF)+  tracks = (TRACKS)}+~~~++### `CLEF`++~~~+Percussion_clef+~~~++~~~+Pitched_clef {clef_name = (CLEF_NAME) transposition = 0}+~~~++### `CLEF_NAME`++* `Subbass`+* `Bass`+* `Baritone_F`+* `Baritone_C`+* `Tenor`+* `Alto`+* `Mezzosoprano`+* `Soprano`+* `Treble`+* `French`++### `TRACKS`++~~~+[+  EVENTS]+~~~++~~~+[+  EVENTS+  EVENTS]+~~~++One stave can contain one or two tracks.++### `EVENTS`++~~~+[(EVENT) (EVENT) (EVENT) ...]+~~~++### `EVENT`++~~~+(NOTES)(LENGTH)+~~~++~~~+(EVENTS)+~~~++An event can be notes with a length or a triplet.++### `NOTES`++~~~+[(NOTE) (NOTE) (NOTE) ...]+~~~++~~~+++~~~++Notes can be either a set of new notes or a tie.++### `NOTE`++~~~+(NOTE_NAME)(OCTAVE)+~~~++### `LENGTH`++~~~+(BASIC_LENGTH)(DOTS)+~~~++### `BASIC_LENGTH`++* `1` - Whole+* `2` - Half+* `4` - Quarter+* ...++### `DOTS`++*+* `.`+* `..`+* ...++## Playables file++Playables file is needed if you want to generate keyboard reductions. A default playables file `Keyboard.key` is provided and+you can modify it according to your own preferred style of music (you might need to account for a greater variety of dissonant+chords) and your own hand hand span.++### `PLAYABLES`++~~~+(PLAYABLE)+(PLAYABLE)+(PLAYABLE)+...+~~~++### `PLAYABLE`++~~~+[(STEPS) (STEPS) (STEPS) ...] [(KEY) (KEY) (KEY) ...]+~~~++Each++## Commands++The whole command should be wrapped in quotation marks and given as one string argument to the program. Command argument order+is fixed.++File paths should be given with no quotation marks.++### Lilypond++~~~+Lilypond {source = (FILE_PATH) destination = (FILE_PATH)}+~~~++### MIDI++~~~+MIDI {source = (FILE_PATH) destination = (FILE_PATH)}+~~~++### Keyboard reduction++~~~+Keyboard {playables = (FILE_PATH) source = (FILE_PATH) header = (HEADER) midi_instrument = 0 destination = (FILE_PATH)}+~~~
+ Scores/Sileant_zephyri/Sileant_zephyri.aoi view
@@ -0,0 +1,438 @@+Score {+  header = [Right_text = "Antonio Vivaldi" Subtitle = "Filiae maestae Jerusalem" Subsubtitle = "RV 638" Title = "Sileant zephyri"]+  parts = [+    Part {+      title = ""+      key = [Db Eb Ab Bb]+      time = Time [3] 4+      initial_position = 0+      tempo = 90+      stave_groups = [+        [+          Pitched Instrument_and_staves {+            instrument_name = "Violin I"+            short_instrument_name = "vn I"+            midi_instrument = 40+            velocity = 127+            staves = [+              Stave {+                clef = Pitched_clef {clef_name = Treble transposition = 0}+                tracks = [+                  [+                    [Ab5]8 [Ab5]8 [Ab4]8 [Ab4]8 [Ab5]8 [Ab5]8+                    [G5]8 [G5]8 [G4]8 [G4]8 [G5]8 [G5]8+                    [Bb5]8 [Bb5]8 [G4]8 [G4]8 [Bb5]8 [Bb5]8+                    [Ab5]8 [Ab5]8 [Ab4]8 [Ab4]8 [Ab5]8 [Ab5]8+                    [Ab5]8 [Ab5]8 [D5]8 [D5]8 [Ab5]8 [Ab5]8+                    [G5]8 [G5]8 [G4]8 [G4]8 [G5]8 [G5]8+                    [G5]8 [G5]8 [C5]8 [C5]8 [G5]8 [G5]8+                    [F5]8 [F5]8 [F4]8 [F4]8 [F5]8 [F5]8+                    [F5]8 [F5]8 [F4]8 [F4]8 [F5]8 [F5]8+                    [G5]8 [G5]8 [G4]8 [G4]8 [G5]8 [G5]8+                    [Ab5]8 [Ab5]8 [Ab4]8 [Ab4]8 [Ab5]8 [Ab5]8+                    [G5]8 [G5]8 [G4]8 [G4]8 [G5]8 [G5]8+                    [Ab5]4 []2+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    [Eb5]8 [Eb5]8 [Eb4]8 [Eb4]8 [Eb5]8 [Eb5]8+                    [D5]8 [D5]8 [D4]8 [D4]8 [D5]8 [D5]8+                    [F5]8 [F5]8 [B4]8 [B4]8 [F5]8 [F5]8+                    [Eb5]4 []2+                    [G5]8 [G5]8 [G4]8 [G4]8 [G5]8 [G5]8+                    [F5]8 [F5]8 [C5]8 [C5]8 [F5]8 [F5]8+                    [F5]8 [F5]8 [C5]8 [C5]8 [F5]8 [F5]8+                    [F5]8 [F5]8 [Db4]8 [Db4]8 [F5]8 [F5]8+                    [G5]8 [G5]8 [Db5]8 [Db5]8 [G5]8 [G5]8+                    [G5]8 [G5]8 [Db5]8 [Db5]8 [G5]8 [G5]8+                    [G5]8 [G5]8 [E4]8 [E4]8 [G5]8 [G5]8+                    [G5]8 [G5]8 [E4]8 [E4]8 [G5]8 [G5]8+                    [G5]8 [G5]8 [E4]8 [E4]8 [G5]8 [G5]8+                    [G5]8 [G5]8 [E4]8 [E4]8 [G5]8 [G5]8+                    [F5]4 []2+                    []2.+                    [Ab5]8 [Ab5]8 [Ab4]8 [Ab4]8 [Ab5]8 [Ab5]8+                    [G5]8 [G5]8 [E4]8 [E4]8 [G5]8 [G5]8+                    [F5]4 []2+                    []2.+                    [Ab5]8 [Ab5]8 [Ab4]8 [Ab4]8 [Ab5]8 [Ab5]8+                    [G5]8 [G5]8 [G4]8 [G4]8 [G5]8 [G5]8+                    [Bb5]8 [Bb5]8 [G4]8 [G4]8 [Bb5]8 [Bb5]8+                    [Ab5]8 [Ab5]8 [Ab4]8 [Ab4]8 [Ab5]8 [Ab5]8+                    [Ab5]8 [Ab5]8 [D5]8 [D5]8 [Ab5]8 [Ab5]8+                    [G5]8 [G5]8 [G4]8 [G4]8 [G5]8 [G5]8+                    [G5]8 [G5]8 [C5]8 [C5]8 [G5]8 [G5]8+                    [F5]8 [F5]8 [F4]8 [F4]8 [F5]8 [F5]8+                    [F5]8 [F5]8 [F4]8 [F4]8 [F5]8 [F5]8+                    [G5]8 [G5]8 [G4]8 [G4]8 [G5]8 [G5]8+                    [Ab5]8 [Ab5]8 [Ab4]8 [Ab4]8 [Ab5]8 [Ab5]8+                    [G5]8 [G5]8 [G4]8 [G4]8 [G5]8 [G5]8+                    [Ab5]4 []2+                    []2.+                    []2.+                    [Ab5]8 [Ab5]8 [Ab4]8 [Ab4]8 [Ab5]8 [Ab5]8+                    [Ab5]8 [Ab5]8 [D5]8 [D5]8 [Ab5]8 [Ab5]8+                    [G5]8 [G5]8 [G4]8 [G4]8 [G5]8 [G5]8+                    [G5]8 [G5]8 [C5]8 [C5]8 [G5]8 [G5]8+                    [F5]8 [F5]8 [F4]8 [F4]8 [F5]8 [F5]8+                    [F5]4 []2+                    []2.+                    [G5]8 [G5]8 [G4]8 [G4]8 [G5]8 [G5]8+                    [G5]8 [G5]8 [G4]8 [G4]8 [G5]8 [G5]8+                    [G5]8 [G5]8 [G4]8 [G4]8 [G5]8 [G5]8+                    [G5]8 [G5]8 [G4]8 [G4]8 [G5]8 [G5]8+                    [Ab5]8 [Ab5]8 [C5]8 [C5]8 [Ab5]8 [Ab5]8+                    [Ab5]8 [Ab5]8 [Eb5]8 [Eb5]8 [Ab5]8 [Ab5]8+                    [Ab5]8 [Ab5]8 [Ab4]8 [Ab4]8 [Ab5]8 [Ab5]8+                    [Ab5]4 [G5]2+                    [Ab5]2.]]}]}+          Pitched Instrument_and_staves {+            instrument_name = "Violin II"+            short_instrument_name = "vn II"+            midi_instrument = 40+            velocity = 127+            staves = [+              Stave {+                clef = Pitched_clef {clef_name = Treble transposition = 0}+                tracks = [+                  [+                    [F5]8 [F5]8 [F4]8 [F4]8 [F5]8 [F5]8+                    [E5]8 [E5]8 [E4]8 [E4]8 [E5]8 [E5]8+                    [G5]8 [G5]8 [E4]8 [E4]8 [G5]8 [G5]8+                    [F5]8 [F5]8 [F4]8 [F4]8 [F5]8 [F5]8+                    [F5]8 [F5]8 [Bb4]8 [Bb4]8 [D5]8 [D5]8+                    [Db5]8 [Db5]8 [Eb4]8 [Eb4]8 [Db5]8 [Db5]8+                    [Eb5]8 [Eb5]8 [Ab4]8 [Ab4]8 [C5]8 [C5]8+                    [C5]8 [C5]8 [Db4]8 [Db4]8 [C5]8 [C5]8+                    [Bb4]8 [Bb4]8 [Db4]8 [Db4]8 [Bb4]8 [Bb4]8+                    [E5]8 [E5]8 [E4]8 [E4]8 [E5]8 [E5]8+                    [F5]8 [F5]8 [F4]8 [F4]8 [F5]8 [F5]8+                    [F5]8 [F5]8 [E4]8 [E4]8 [E5]8 [E5]8+                    [F5]4 []2+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    [C5]8 [C5]8 [C4]8 [C4]8 [C5]8 [C5]8+                    [B4]8 [B4]8 [B3]8 [B3]8 [B4]8 [B4]8+                    [D5]8 [D5]8 [G4]8 [G4]8 [D5]8 [D5]8+                    [C5]4 []2+                    [Eb5]8 [Eb5]8 [Eb4]8 [Eb4]8 [Eb5]8 [Eb5]8+                    [C5]8 [C5]8 [Ab4]8 [Ab4]8 [C5]8 [C5]8+                    [C5]8 [C5]8 [Ab4]8 [Ab4]8 [C5]8 [C5]8+                    [Db5]8 [Db5]8 [Bb3]8 [Bb3]8 [Db5]8 [Db5]8+                    [Db5]8 [Db5]8 [Bb4]8 [Bb4]8 [Db5]8 [Db5]8+                    [Db5]8 [Db5]8 [Bb4]8 [Bb4]8 [Db5]8 [Db5]8+                    [E5]8 [E5]8 [C4]8 [C4]8 [E5]8 [E5]8+                    [E5]8 [E5]8 [C4]8 [C4]8 [E5]8 [E5]8+                    [E5]8 [E5]8 [C4]8 [C4]8 [E5]8 [E5]8+                    [E5]8 [E5]8 [C4]8 [C4]8 [E5]8 [E5]8+                    [C5]4 []2+                    []2.+                    [F5]8 [F5]8 [F4]8 [F4]8 [F5]8 [F5]8+                    [E5]8 [E5]8 [C4]8 [C4]8 [E5]8 [E5]8+                    [C5]4 []2+                    []2.+                    [F5]8 [F5]8 [F4]8 [F4]8 [F5]8 [F5]8+                    [E5]8 [E5]8 [E4]8 [E4]8 [E5]8 [E5]8+                    [G5]8 [G5]8 [E4]8 [E4]8 [G5]8 [G5]8+                    [F5]8 [F5]8 [F4]8 [F4]8 [F5]8 [F5]8+                    [F5]8 [F5]8 [Bb4]8 [Bb4]8 [D5]8 [D5]8+                    [Db5]8 [Db5]8 [Eb4]8 [Eb4]8 [Db5]8 [Db5]8+                    [Eb5]8 [Eb5]8 [Ab4]8 [Ab4]8 [C5]8 [C5]8+                    [C5]8 [C5]8 [Db4]8 [Db4]8 [C5]8 [C5]8+                    [Bb4]8 [Bb4]8 [Db4]8 [Db4]8 [Bb4]8 [Bb4]8+                    [E5]8 [E5]8 [E4]8 [E4]8 [E5]8 [E5]8+                    [F5]8 [F5]8 [F4]8 [F4]8 [F5]8 [F5]8+                    [F5]8 [F5]8 [E4]8 [E4]8 [E5]8 [E5]8+                    [F5]4 []2+                    []2.+                    []2.+                    [F5]8 [F5]8 [F4]8 [F4]8 [F5]8 [F5]8+                    [F5]8 [F5]8 [Bb4]8 [Bb4]8 [D5]8 [D5]8+                    [Db5]8 [Db5]8 [Eb4]8 [Eb4]8 [Db5]8 [Db5]8+                    [Eb5]8 [Eb5]8 [Ab4]8 [Ab4]8 [C5]8 [C5]8+                    [C5]8 [C5]8 [C4]8 [C4]8 [C5]8 [C5]8+                    [D5]4 []2+                    []2.+                    [Eb5]8 [Eb5]8 [Eb4]8 [Eb4]8 [Eb5]8 [Eb5]8+                    [E5]8 [E5]8 [E4]8 [E4]8 [E5]8 [E5]8+                    [E5]8 [E5]8 [E4]8 [E4]8 [E5]8 [E5]8+                    [E5]8 [E5]8 [E4]8 [E4]8 [E5]8 [E5]8+                    [F5]8 [F5]8 [Ab4]8 [Ab4]8 [F5]8 [F5]8+                    [Eb5]8 [Eb5]8 [C5]8 [C5]8 [Eb5]8 [Eb5]8+                    [F5]8 [F5]8 [F4]8 [F4]8 [F5]8 [F5]8+                    [F5]8 [C5]8 [Bb4]2+                    [C5]2.]]}]}+          Pitched Instrument_and_staves {+            instrument_name = "Viola"+            short_instrument_name = "va"+            midi_instrument = 41+            velocity = 127+            staves = [+              Stave {+                clef = Pitched_clef {clef_name = Alto transposition = 0}+                tracks = [+                  [+                    [C4]4 [C4]4 [C4]4+                    [C4]4 [C4]4 [C4]4+                    [C4]4 [C4]4 [C4]4+                    [C4]4 [C4]4 [C4]4+                    [D4]4 [D4]4 [Bb3]4+                    [Bb3]4 [Bb3]4 [Bb3]4+                    [C4]4 [C4]4 [Ab3]4+                    [Ab3]4 [Ab3]4 [Ab3]4+                    [Bb3]4 [Bb3]4 [Bb3]4+                    [C4]4 [C4]4 [C4]4+                    [C4]4 [C4]4 [C4]4+                    [Db4]4 [C4]4 [C4]4+                    [C4]4 []2+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    [G3]4 [G3]4 [G3]4+                    [G3]4 [G3]4 [G3]4+                    [G3]4 [G3]4 [G3]4+                    [G3]4 []2+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    [C4]4 [C4]4 [C4]4+                    [C4]4 [C4]4 [C4]4+                    [C4]4 [C4]4 [C4]4+                    [C4]4 [C4]4 [C4]4+                    [D4]4 [D4]4 [Bb3]4+                    [Bb3]4 [Bb3]4 [Bb3]4+                    [C4]4 [C4]4 [Ab3]4+                    [Ab3]4 [Ab3]4 [Ab3]4+                    [Bb3]4 [Bb3]4 [Bb3]4+                    [Bb3]4 [Bb3]4 [Bb3]4+                    [Ab3]4 [C4]4 [C4]4+                    [Db4]4 [C4]4 [C4]4+                    [C4]4 []2+                    []2.+                    []2.+                    [F4]4 [F4]4 [F4]4+                    [Bb3]4 [Bb3]4 [Bb3]4+                    [Eb4]4 [Eb4]4 [Eb4]4+                    [Ab3]4 [Ab3]4 [Ab3]4+                    [Ab3]4 [Ab3]4 [Ab3]4+                    [Bb3]4 []2+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.]]}]}]+        [+          Pitched Instrument_and_staves {+            instrument_name = "Voice"+            short_instrument_name = "v"+            midi_instrument = 52+            velocity = 127+            staves = [+              Stave {+                clef = Pitched_clef {clef_name = Treble transposition = 0}+                tracks = [+                  [+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []4 [F4]4 [G4]8 [Ab4]8+                    [G4]8. [F4]16 [E4]8. [D4]16 [C4]4+                    []4 [G4]4 [Ab4]8 [Bb4]8+                    [Ab4]8. [G4]16 [F4]2+                    []4 [Ab4]4. [Bb4]8+                    [G4]4. [Ab4]16 [G4]16 [C5]8 [Ab4]8+                    [F4]4. [G4]16 [F4]16 [Bb4]8 [G4]8+                    [E4]8. [F4]16 [G4]8. [Ab4]16 [Bb4]8. [G4]16+                    [Ab4]8 [G4]8 [F4]4 []4+                    [Ab4]8 [G4]8 [F4]8 [Eb4]8 [D4]8 [Eb4]16 [C4]16+                    [B4]4. [A4]16 [G4]16 [C5]8 [Bb4]16 [Ab4]16+                    [G4]8 [F4]16 [Eb4]16 [D4]2+                    [C4]2 []4+                    []2.+                    []2.+                    [C4]8. [D4]16 [Eb4]8. [F4]16 [G4]8 [A4]16 [B4]16+                    [C5]8. [C4]16 [C4]4 []4+                    [Ab4]4 [+8 [C5]8 [Bb4]8] [[Ab4]8 [Bb4]8 [G4]8]+                    [F4]4 [+8 [Ab4]8 [G4]8] [[F4]8 [G4]8 [Eb4]8]+                    [Db4]8. [C4]16 [Bb3]4 []4+                    [Bb4]4 [+8 [Db5]8 [C5]8] [[Bb4]8 [C5]8 [Ab4]8]+                    [G4]4 [+8 [Bb4]8 [Ab4]8] [[G4]8 [Ab4]8 [F4]8]+                    [E4]8. [D4]16 [C4]4 []4+                    [C4]8. [D4]16 [E4]8. [F4]16 [G4]8 [Ab4]16 [Bb4]16+                    [C4]4 [+8 [G4]8 [Ab4]8] [[Bb4]8 [Ab4]8 [G4]8]+                    [C4]4 [+8 [G4]8 [Ab4]8] [[Bb4]8 [Ab4]8 [G4]8]+                    [Ab4]4. [G4]8 [[F4]8 [G4]8 [F4]8]+                    [G4]8. [D4]16 [E4]2+                    [F4]2 []4+                    [Bb4]4 [Ab4]4 [G4]4+                    [Ab4]4 [+8 [F4]8 [G4]8] [[Ab4]8 [Bb4]8 [C5]8]+                    [Db5]8 [F4]8 [E4]2+                    [F4]2 []4+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []2.+                    []4 [C4]4 [G4]4+                    [Eb4]4. [D4]8 [C4]4+                    []4 [Ab4]4 [Ab4]4+                    [Ab4]4. [G4]8 [F4]4+                    []4 [G4]4 [G4]4+                    [G4]4. [F4]8 [Eb4]4+                    []4 [F4]4 [Eb4]8 [F4]8+                    [D4]4. [Ab4]8 [G4]8 [F4]8+                    [G4]8 [Ab4]8 [F4]2+                    [Eb4]2 []4+                    []4 [G4]4 [Bb4]4+                    [E4]4. [F4]8 [E4]4+                    [Bb4]4 [G4]4 [F4]8 [E4]8+                    [F4]4. [G4]8 [F4]4+                    []4 [Ab4]8 [Bb4]8 [C5]8 [Ab4]8+                    [F4]4. [G4]8 [Ab4]8 [F4]8+                    [C5]8 [Ab4]8 [G4]4. [Ab4]8+                    [Ab4]2.]]}]}]+        [+          Pitched Instrument_and_staves {+            instrument_name = "Continuo"+            short_instrument_name = "bc"+            midi_instrument = 6+            velocity = 127+            staves = [+              Stave {+                clef = Pitched_clef {clef_name = Bass transposition = 0}+                tracks = [+                  [+                    [F3]4 [F3]4 [F3]4+                    [C3]4 [C3]4 [C3]4+                    [C3]4 [C3]4 [C3]4+                    [F3]4 [F3]4 [F3]4+                    [Bb2]4 [Bb2]4 [Bb2]4+                    [Eb3]4 [Eb3]4 [Eb3]4+                    [Ab2]4 [Ab2]4 [Ab2]4+                    [Db3]4 [Db3]4 [Db3]4+                    [Db3]4 [Db3]4 [Db3]4+                    [C3]4 [C3]4 [C3]4+                    [F2]4 [F2]4 [F2]4+                    [Bb2]4 [C3]4 [C3]4+                    [F2]4 []2+                    []2.+                    [C4]8 [C4]8 [C3]8 [C3]8 [C4]8 [C4]8+                    [F3]8 [F3]8 [F2]8 [F2]8 [F3]8 [F3]8+                    [F3]8 [F3]8 [F2]8 [F2]8 [F3]8 [F3]8+                    [F3]8 [F3]8 [Eb2]8 [Eb2]8 [Eb3]8 [Eb3]8+                    [Eb3]8 [Eb3]8 [Db2]8 [Db2]8 [Db3]8 [Db3]8+                    [C3]8 [C3]8 [C2]8 [C2]8 [C3]8 [C3]8+                    [F3]8 [F3]8 [F2]8 [F2]8 [F3]8 [F3]8+                    [F3]8 [F3]8 [F2]8 [F2]8 [F3]8 [F3]8+                    [F3]8 [F3]8 [F2]8 [F3]8 [Eb3]8 [Eb3]8+                    [F3]8 [F3]8 [G3]8 [G3]8 [G2]8 [G2]8+                    [C3]4 [C3]4 [C3]4+                    [G3]4 [G3]4 [G3]4+                    [B2]4 [B2]4 [B2]4+                    [C3]4 []2+                    [C3]4 [C3]4 [C3]4+                    [Ab2]4 [Ab2]4 [Ab2]4+                    [Ab2]4 [Ab2]4 [Ab2]4+                    [Bb2]4 [Bb2]4 [Bb2]4+                    [Bb2]4 [Bb2]4 [Bb2]4+                    [Bb2]4 [Bb2]4 [Bb2]4+                    [C3]4 [C3]4 [C3]4+                    [C3]4 [C3]4 [C3]4+                    [C3]4 [C3]4 [C3]4+                    [C3]4 [C3]4 [C3]4+                    [F2]4 []4 [Ab2]4+                    [Bb2]4 [C3]4 [C2]4+                    [F2]4 [F3]4 [F3]4+                    [C3]4 [C3]4 [C3]4+                    [F3]4 [F3]4 [F3]4+                    [Bb3]4 [C4]4 [C3]4+                    [F2]4 [F3]4 [F3]4+                    [C3]4 [C3]4 [C3]4+                    [C3]4 [C3]4 [C3]4+                    [F3]4 [F3]4 [F3]4+                    [Bb2]4 [Bb2]4 [Bb2]4+                    [Eb3]4 [Eb3]4 [Eb3]4+                    [Ab2]4 [Ab2]4 [Ab2]4+                    [Db3]4 [Db3]4 [Db3]4+                    [Db3]4 [Db3]4 [Db3]4+                    [C3]4 [C3]4 [C3]4+                    [F2]4 [F2]4 [F2]4+                    [Bb2]4 [C3]4 [C2]4+                    [F2]4 []2+                    [C4]8 [C4]8 [C3]8 [C3]8 [C4]8 [C4]8+                    [C4]8 [C4]8 [C3]8 [C3]8 [C4]8 [C4]8+                    [F3]4 []2+                    []2.+                    []2.+                    []2.+                    []2.+                    [Bb2]4 [Bb2]4 [Bb2]4+                    [Eb3]4 [Bb3]4 [Bb2]4+                    [Eb3]4 [Eb3]4 [Eb3]4+                    [Db3]4 [Db3]4 [Db3]4+                    [Db3]4 [Db3]4 [Db3]4+                    [Db3]4 [Db3]4 [Db3]4+                    [Ab2]4 [Ab2]4 [Ab2]4+                    [C3]4 [C3]4 [C3]4+                    [Db3]4 [Db3]4 [Db3]4+                    [Db3]4 [Eb3]4 [Eb2]4+                    [Ab2]2.]]}]}]]}]}