{- | Load a 'Song' from a Standard MIDI File via the @HCodecs@ library.

This is a lossy, rhythm-free conversion: it exists to get MIDI note data
onto the fretless (non-tab) side of the model quickly, not to preserve a
MIDI file's original structure. Every 'MIDI.NoteOn' event becomes its own
'Quarter'-duration 'Beat' (so original note timing\/duration is
discarded), and every converted 'Track' is placed entirely under
'MeasureIndex' @0@ (so 'songMeasures' is left empty — there is no bar
structure to derive one from).
-}
module Termtab.Parser.MIDI (parseMidi) where

import Data.Map.Strict qualified as Map
import Data.Maybe (mapMaybe)
import Data.Text qualified as T

import Codec.Midi qualified as MIDI

import Termtab.Types

{- | Read and parse a Standard MIDI File, converting a decode failure into
'ParseErrorMalformed' and a successful decode into a 'Song' via
'convertMidi'.
-}
parseMidi :: FilePath -> IO (Either ParseError Song)
parseMidi :: FilePath -> IO (Either ParseError Song)
parseMidi FilePath
path = do
    result <- FilePath -> IO (Either FilePath Midi)
MIDI.importFile FilePath
path
    case result of
        Left FilePath
err -> Either ParseError Song -> IO (Either ParseError Song)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseError -> Either ParseError Song
forall a b. a -> Either a b
Left (FilePath -> ParseError
ParseErrorMalformed FilePath
err))
        Right Midi
mf -> Either ParseError Song -> IO (Either ParseError Song)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Song -> Either ParseError Song
forall a b. b -> Either a b
Right (Midi -> Song
convertMidi Midi
mf))

{- | Build a 'Song' from a decoded 'MIDI.Midi': title\/artist are left
blank (not present in MIDI), 'songTempo' comes from the first tempo
meta-event found across all tracks (defaulting to 120 BPM via
'tempoFromTracks'), and each MIDI track becomes one 'Track' via
'convertTrack'.
-}
convertMidi :: MIDI.Midi -> Song
convertMidi :: Midi -> Song
convertMidi Midi
mf =
    Song
        { songTitle :: Text
songTitle = Text
""
        , songArtist :: Text
songArtist = Text
""
        , songTempo :: Tempo
songTempo = [Track Int] -> Tempo
forall t. [Track t] -> Tempo
tempoFromTracks (Midi -> [Track Int]
MIDI.tracks Midi
mf)
        , songTracks :: [Track]
songTracks = (Int -> Track Int -> Track) -> [Int] -> [Track Int] -> [Track]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Track Int -> Track
forall t. Int -> Track t -> Track
convertTrack [Int
0 ..] (Midi -> [Track Int]
MIDI.tracks Midi
mf)
        , songMeasures :: [Measure]
songMeasures = []
        }

{- | The BPM of the first 'MIDI.TempoChange' event found across all tracks
(converted from microseconds-per-quarter-note), or 120 if none is
present.
-}
tempoFromTracks :: [MIDI.Track t] -> Tempo
tempoFromTracks :: forall t. [Track t] -> Tempo
tempoFromTracks [Track t]
ts =
    case [Int -> Tempo
Tempo (Int
60000000 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
us) | (t
_, MIDI.TempoChange Int
us) <- [Track t] -> Track t
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Track t]
ts] of
        (Tempo
t : [Tempo]
_) -> Tempo
t
        [] -> Int -> Tempo
Tempo Int
120

{- | Convert one MIDI track to a 'Track', named by its 0-based @idx@ (MIDI
tracks have no inherent name field consulted here), always as a
'Standard' instrument on channel 0, with all of its notes placed under
'MeasureIndex' @0@ via 'beatsFromEvents'.
-}
convertTrack :: Int -> MIDI.Track t -> Track
convertTrack :: forall t. Int -> Track t -> Track
convertTrack Int
idx Track t
events =
    Track
        { trackName :: Text
trackName = Text
"Track " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
idx)
        , trackInstrument :: Instrument
trackInstrument = MidiProgram -> Instrument
Standard (Int -> MidiProgram
MidiProgram Int
0)
        , trackChannel :: MidiChannel
trackChannel = Int -> MidiChannel
MidiChannel Int
0
        , trackBeats :: Map MeasureIndex [Beat]
trackBeats = [(MeasureIndex, [Beat])] -> Map MeasureIndex [Beat]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Int -> MeasureIndex
MeasureIndex Int
0, Track t -> [Beat]
forall t. Track t -> [Beat]
beatsFromEvents Track t
events)]
        }

{- | Extract every note-on event from a MIDI track and wrap each in its own
'Beat' via 'singleNoteBeat', dropping all other event types (including
note-off — durations are not reconstructed).
-}
beatsFromEvents :: MIDI.Track t -> [Beat]
beatsFromEvents :: forall t. Track t -> [Beat]
beatsFromEvents = (Note -> Beat) -> [Note] -> [Beat]
forall a b. (a -> b) -> [a] -> [b]
map Note -> Beat
singleNoteBeat ([Note] -> [Beat]) -> (Track t -> [Note]) -> Track t -> [Beat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((t, Message) -> Maybe Note) -> Track t -> [Note]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (t, Message) -> Maybe Note
forall t. (t, Message) -> Maybe Note
toNote

{- | Convert a note-on message with nonzero velocity into a fretless 'Note'
('noteString'\/'noteFret' both 'Nothing'). Zero-velocity note-ons (the
common MIDI encoding of note-off) and all non-note messages yield
'Nothing'.
-}
toNote :: (t, MIDI.Message) -> Maybe Note
toNote :: forall t. (t, Message) -> Maybe Note
toNote (t
_, MIDI.NoteOn Int
_ Int
k Int
v)
    | Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
        Note -> Maybe Note
forall a. a -> Maybe a
Just
            Note
                { notePitch :: Pitch
notePitch = Int -> Pitch
Pitch Int
k
                , noteVelocity :: Velocity
noteVelocity = Int -> Velocity
Velocity Int
v
                , noteEffects :: [NoteEffect]
noteEffects = []
                , noteString :: Maybe StringIndex
noteString = Maybe StringIndex
forall a. Maybe a
Nothing
                , noteFret :: Maybe FretNumber
noteFret = Maybe FretNumber
forall a. Maybe a
Nothing
                }
toNote (t, Message)
_ = Maybe Note
forall a. Maybe a
Nothing

-- | Wrap a single 'Note' in a non-rest, 'Quarter'-duration 'Beat'.
singleNoteBeat :: Note -> Beat
singleNoteBeat :: Note -> Beat
singleNoteBeat Note
note =
    Beat
        { beatDuration :: Duration
beatDuration = Duration
Quarter
        , beatNotes :: [Note]
beatNotes = [Note
note]
        , beatIsRest :: Bool
beatIsRest = Bool
False
        }