{- | Load a 'Song' from a Guitar Pro 5 (@.gp5@) file.

This module drives the low-level binary readers in
"Termtab.Parser.GP5.Internal" in the fixed order GP5's format requires,
then converts the resulting @GP5*@ values (file-shaped: raw duration
codes, 1-based string numbers, a flat measure×track bar grid) into the
domain 'Termtab.Types.Song' \/ 'Termtab.Types.Track' \/
'Termtab.Types.Measure' shape, where bars are keyed by
'Termtab.Types.MeasureIndex' inside each track instead of living in a
separate grid.
-}
module Termtab.Parser.GP5 (parseGP5) where

import Control.Monad (forM, replicateM)
import Data.Binary.Get
import Data.ByteString.Lazy qualified as LBS
import Data.List (transpose)
import Data.Map.Strict qualified as Map
import Termtab.Parser.GP5.Internal
import Termtab.Types

{- | Read and parse a @.gp5@ file. Any failure from the underlying 'Get'
decoder (wrong version, truncated file, unrecognized structure) becomes
'ParseErrorMalformed' with the decoder's error message.
-}
parseGP5 :: FilePath -> IO (Either ParseError Song)
parseGP5 :: String -> IO (Either ParseError Song)
parseGP5 String
path = do
    bytes <- String -> IO ByteString
LBS.readFile String
path
    case runGetOrFail parseGP5File bytes of
        Left (ByteString
_, ByteOffset
_, String
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 (String -> ParseError
ParseErrorMalformed String
err))
        Right (ByteString
_, ByteOffset
_, Song
song) -> 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 Song
song)

{- | The full GP5 binary grammar, in file order: version, then score info
and several skipped metadata blocks, then global tempo\/key\/channels,
then counts, measure headers, track headers, and finally the bar grid.
Bars are stored on disk one full row of tracks per measure
(@measureCount × trackCount@, measure-major); 'transpose' flips that to
track-major so 'convertTrack' can pair each track with its own list of
bars in measure order.
-}
parseGP5File :: Get Song
parseGP5File :: Get Song
parseGP5File = do
    (major, minor) <- Get (Int, Int)
getVersion
    if major /= 5
        then fail ("Expected GP5 file, got version " <> show major <> "." <> show minor)
        else return ()
    info <- getScoreInfo
    skipLyrics
    skipPageSetup
    skipRSEMaster minor
    _tempoName <- getTempoName
    bpm <- getInt32le'
    skip 1 -- hide tempo flag
    _key <- getInt32le'
    skip 1 -- octave
    programs <- getChannels
    measureCount <- getInt32le'
    trackCount <- getInt32le'
    headers <- parseMeasureHeaders measureCount
    tracks <- replicateM trackCount (getTrack programs)
    -- bars: measureCount × trackCount, row-major (measure first)
    barRows <- forM [0 .. measureCount - 1] $ \Int
_ ->
        (Int -> Get GP5Bar) -> [Int] -> Get [GP5Bar]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Int
_ -> Get GP5Bar
getBar) [Int
1 .. Int
trackCount]
    -- transpose to [trackIdx][measureIdx]
    let barCols = [[GP5Bar]] -> [[GP5Bar]]
forall a. [[a]] -> [[a]]
transpose [[GP5Bar]]
barRows
    return (convertSong info bpm headers tracks barCols)

{- | Read @n@ measure headers in sequence, threading each header's
resolved time\/key signature into the next call to
'Termtab.Parser.GP5.Internal.getMeasureHeader' as its \"previous value\"
fallback (starting from an implicit 4\/4, C major before the first
measure).
-}
parseMeasureHeaders :: Int -> Get [GP5MeasureHeader]
parseMeasureHeaders :: Int -> Get [GP5MeasureHeader]
parseMeasureHeaders Int
n = Int
-> (Int, Int)
-> (Int, Int)
-> [GP5MeasureHeader]
-> Get [GP5MeasureHeader]
go Int
n (Int
4, Int
4) (Int
0, Int
0) []
  where
    go :: Int
-> (Int, Int)
-> (Int, Int)
-> [GP5MeasureHeader]
-> Get [GP5MeasureHeader]
go Int
0 (Int, Int)
_ (Int, Int)
_ [GP5MeasureHeader]
acc = [GP5MeasureHeader] -> Get [GP5MeasureHeader]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ([GP5MeasureHeader] -> [GP5MeasureHeader]
forall a. [a] -> [a]
reverse [GP5MeasureHeader]
acc)
    go Int
left (Int, Int)
prevSig (Int, Int)
prevKey [GP5MeasureHeader]
acc = do
        h <- Int -> (Int, Int) -> (Int, Int) -> Get GP5MeasureHeader
getMeasureHeader (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
left) (Int, Int)
prevSig (Int, Int)
prevKey
        go (left - 1) (gmhTimeNum h, gmhTimeDen h) (gmhKeyRoot h, gmhKeyMode h) (h : acc)

{- | Assemble the final 'Song' from every piece read by 'parseGP5File'.
@tracks@ and @barCols@ (already transposed to track-major) are zipped
positionally, so they must be the same length and in the same track
order — guaranteed here because both come from the same
@replicateM trackCount@\/transpose in 'parseGP5File'.
-}
convertSong :: GP5ScoreInfo -> Int -> [GP5MeasureHeader] -> [GP5Track] -> [[GP5Bar]] -> Song
convertSong :: GP5ScoreInfo
-> Int -> [GP5MeasureHeader] -> [GP5Track] -> [[GP5Bar]] -> Song
convertSong GP5ScoreInfo
info Int
bpm [GP5MeasureHeader]
headers [GP5Track]
tracks [[GP5Bar]]
barCols =
    Song
        { songTitle :: Text
songTitle = GP5ScoreInfo -> Text
gsiTitle GP5ScoreInfo
info
        , songArtist :: Text
songArtist = GP5ScoreInfo -> Text
gsiArtist GP5ScoreInfo
info
        , songTempo :: Tempo
songTempo = Int -> Tempo
Tempo Int
bpm
        , songTracks :: [Track]
songTracks = (GP5Track -> [GP5Bar] -> Track)
-> [GP5Track] -> [[GP5Bar]] -> [Track]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith GP5Track -> [GP5Bar] -> Track
convertTrack [GP5Track]
tracks [[GP5Bar]]
barCols
        , songMeasures :: [Measure]
songMeasures = (Int -> GP5MeasureHeader -> Measure)
-> [Int] -> [GP5MeasureHeader] -> [Measure]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> GP5MeasureHeader -> Measure
convertMeasure [Int
0 ..] [GP5MeasureHeader]
headers
        }

{- | Convert one 'GP5MeasureHeader' to a 'Measure' at position @idx@. GP5's
key mode is a raw 0-or-nonzero flag; anything nonzero is treated as
'Minor'. 'tempoChange' is always 'Nothing' — this parser doesn't track
per-measure tempo changes, only the single song-wide tempo read in
'parseGP5File'.
-}
convertMeasure :: Int -> GP5MeasureHeader -> Measure
convertMeasure :: Int -> GP5MeasureHeader -> Measure
convertMeasure Int
idx GP5MeasureHeader
h =
    Measure
        { measureIndex :: MeasureIndex
measureIndex = Int -> MeasureIndex
MeasureIndex Int
idx
        , timeSignature :: TimeSignature
timeSignature = Int -> Int -> TimeSignature
TimeSignature (GP5MeasureHeader -> Int
gmhTimeNum GP5MeasureHeader
h) (GP5MeasureHeader -> Int
gmhTimeDen GP5MeasureHeader
h)
        , keySignature :: KeySignature
keySignature = Int -> Mode -> KeySignature
KeySignature (GP5MeasureHeader -> Int
gmhKeyRoot GP5MeasureHeader
h) (if GP5MeasureHeader -> Int
gmhKeyMode GP5MeasureHeader
h Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Mode
Major else Mode
Minor)
        , tempoChange :: Maybe Tempo
tempoChange = Maybe Tempo
forall a. Maybe a
Nothing
        }

{- | Convert one 'GP5Track' plus its bars (one per measure, in order) into
a 'Track'. A drum track becomes a 'Standard' instrument keyed by its
resolved MIDI program; any other track becomes a 'Guitar' whose tuning
is exactly 'gtStrings' (this parser never distinguishes bass from
guitar — both surface as 'Guitar'). @bars@ is zipped against
@[0 ..]@ to become the 'MeasureIndex' keys of 'trackBeats', so it must
already be in measure order (guaranteed by 'parseGP5File''s transpose).
-}
convertTrack :: GP5Track -> [GP5Bar] -> Track
convertTrack :: GP5Track -> [GP5Bar] -> Track
convertTrack GP5Track
t [GP5Bar]
bars =
    Track
        { trackName :: Text
trackName = GP5Track -> Text
gtName GP5Track
t
        , trackInstrument :: Instrument
trackInstrument =
            if GP5Track -> Bool
gtIsDrums GP5Track
t
                then MidiProgram -> Instrument
Standard (Int -> MidiProgram
MidiProgram (GP5Track -> Int
gtProgram GP5Track
t))
                else
                    Guitar
                        { tuning :: [Pitch]
tuning = (Int -> Pitch) -> [Int] -> [Pitch]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Pitch
Pitch (GP5Track -> [Int]
gtStrings GP5Track
t)
                        , stringCount :: Int
stringCount = [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (GP5Track -> [Int]
gtStrings GP5Track
t)
                        }
        , trackChannel :: MidiChannel
trackChannel = Int -> MidiChannel
MidiChannel (GP5Track -> Int
gtChannel GP5Track
t)
        , 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
i, (GP5Beat -> Beat) -> [GP5Beat] -> [Beat]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> GP5Beat -> Beat
convertBeat (GP5Track -> [Int]
gtStrings GP5Track
t)) (GP5Bar -> [GP5Beat]
gbarBeats GP5Bar
bar))
                | (Int
i, GP5Bar
bar) <- [Int] -> [GP5Bar] -> [(Int, GP5Bar)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [GP5Bar]
bars
                ]
        }

{- | Convert one 'GP5Beat' to a 'Beat'. @stringPitches@ is the owning
track's tuning ('gtStrings'), threaded through to 'convertNote' so each
note's absolute pitch can be computed from its fret position.
-}
convertBeat :: [Int] -> GP5Beat -> Beat
convertBeat :: [Int] -> GP5Beat -> Beat
convertBeat [Int]
stringPitches GP5Beat
b =
    Beat
        { beatDuration :: Duration
beatDuration = Int -> Bool -> Duration
decodeDuration (GP5Beat -> Int
gbDuration GP5Beat
b) Bool
False
        , beatIsRest :: Bool
beatIsRest = GP5Beat -> Bool
gbIsRest GP5Beat
b
        , beatNotes :: [Note]
beatNotes = (GP5Note -> Note) -> [GP5Note] -> [Note]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> GP5Note -> Note
convertNote [Int]
stringPitches) (GP5Beat -> [GP5Note]
gbNotes GP5Beat
b)
        }

{- | Convert one 'GP5Note' to a 'Note'. The sounding 'notePitch' is derived
as @openStringPitch + fret@, looking up the open pitch from
@stringPitches@ at the note's 0-based string index (falling back to
pitch 0 if the string index is out of range, which shouldn't happen for
well-formed input); 'noteVelocity' scales GP5's 1-16 dynamic level up to
roughly the MIDI 0-127 range by a fixed factor of 8. 'noteEffects' is
always empty — bend\/slide\/hammer-on data read by
"Termtab.Parser.GP5.Internal" is skipped, not retained.
-}
convertNote :: [Int] -> GP5Note -> Note
convertNote :: [Int] -> GP5Note -> Note
convertNote [Int]
stringPitches GP5Note
n =
    let strIdx :: Int
strIdx = GP5Note -> Int
gnString GP5Note
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        basePitch :: Int
basePitch =
            if Int
strIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
strIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
stringPitches
                then [Int]
stringPitches [Int] -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
strIdx
                else Int
0
     in Note
            { notePitch :: Pitch
notePitch = Int -> Pitch
Pitch (Int
basePitch Int -> Int -> Int
forall a. Num a => a -> a -> a
+ GP5Note -> Int
gnFret GP5Note
n)
            , noteVelocity :: Velocity
noteVelocity = Int -> Velocity
Velocity (GP5Note -> Int
gnDynamic GP5Note
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
            , noteEffects :: [NoteEffect]
noteEffects = []
            , noteString :: Maybe StringIndex
noteString = StringIndex -> Maybe StringIndex
forall a. a -> Maybe a
Just (Int -> StringIndex
StringIndex (GP5Note -> Int
gnString GP5Note
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
            , noteFret :: Maybe FretNumber
noteFret = FretNumber -> Maybe FretNumber
forall a. a -> Maybe a
Just (Int -> FretNumber
FretNumber (GP5Note -> Int
gnFret GP5Note
n))
            }

{- | Map GP5's raw signed duration code (-2 = whole ... 3 = thirty-second,
defaulting to 'Quarter' for any other value) to a 'Duration', optionally
wrapping it in 'Dotted'. Note that this parser never actually passes
'True' for @dotted@ — GP5's dotted-note flag isn't read by
"Termtab.Parser.GP5.Internal" — so in practice every converted duration
is undotted; the parameter exists for a future caller that does read it.
-}
decodeDuration :: Int -> Bool -> Duration
decodeDuration :: Int -> Bool -> Duration
decodeDuration Int
raw Bool
dotted =
    let base :: Duration
base = case Int
raw of
            (-2) -> Duration
Whole
            (-1) -> Duration
Half
            Int
0 -> Duration
Quarter
            Int
1 -> Duration
Eighth
            Int
2 -> Duration
Sixteenth
            Int
3 -> Duration
Thirty2nd
            Int
_ -> Duration
Quarter
     in if Bool
dotted then Duration -> Duration
Dotted Duration
base else Duration
base