Writer.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}

module Monatone.MP3.Writer
  ( writeMP3Metadata
  , WriteError(..)
  , Writer
  ) where

import Control.Applicative ((<|>))
import Control.Exception (catch, IOException)
import Control.Monad.Except (ExceptT, throwError, runExceptT)
import Control.Monad.IO.Class (liftIO)
import Data.Binary.Put
import Data.Bits ((.|.), shiftL, shiftR, (.&.))
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as L
import qualified Data.HashMap.Strict as HM
import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Word
import System.IO hiding (withBinaryFile)
import System.OsPath
import System.File.OsPath (withBinaryFile)

import Monatone.Metadata
import Monatone.MP3 (extractRawFrames)

-- Re-define WriteError and Writer locally to avoid circular imports
data WriteError
  = WriteIOError Text
  | UnsupportedWriteFormat AudioFormat  
  | InvalidMetadata Text
  | CorruptedWrite Text
  deriving (Show, Eq)

type Writer = ExceptT WriteError IO

-- | Buffer size for file operations (64KB)
bufferSize :: Int
bufferSize = 65536

-- | Write metadata to MP3 file incrementally without loading the entire file
writeMP3Metadata :: Metadata -> AlbumArtUpdate -> OsPath -> Writer ()
writeMP3Metadata metadata artUpdate filePath = do
  -- Open file in read/write mode
  result <- liftIO $ tryIO $ withBinaryFile filePath ReadWriteMode $ \handle -> do
    runExceptT $ writeMP3HandleIncremental metadata artUpdate handle
  case result of
    Left (e :: IOException) -> throwError $ WriteIOError $ T.pack $ show e
    Right (Left err) -> throwError err
    Right (Right ()) -> return ()
  where
    tryIO :: IO a -> IO (Either IOException a)
    tryIO action = catch (Right <$> action) (return . Left)

-- | Write MP3 metadata using a file handle incrementally
writeMP3HandleIncremental :: Metadata -> AlbumArtUpdate -> Handle -> Writer ()
writeMP3HandleIncremental metadata artUpdate handle = do
  -- Find where the audio data starts (after existing ID3v2 tag if present)
  audioDataOffset <- findAudioDataOffsetHandle handle

  -- Frames that cannot be regenerated from text (APIC, USLT, PRIV, GEOB,
  -- foreign UFIDs, ...) are carried over from the existing tag verbatim
  existingRawFrames <- liftIO $ readExistingRawFrames handle

  -- Generate new ID3v2 tag
  newTagData <- generateID3v2Tag metadata artUpdate existingRawFrames
  let newTagSize = fromIntegral $ L.length newTagData
  
  -- Get file size
  _ <- liftIO $ hFileSize handle
  
  -- Now we need to either insert or delete bytes depending on size difference
  let sizeDiff = newTagSize - audioDataOffset
  
  if sizeDiff == 0 then do
    -- Same size, just overwrite
    liftIO $ do
      hSeek handle AbsoluteSeek 0
      L.hPut handle newTagData
  else if sizeDiff > 0 then do
    -- Need to insert bytes
    insertBytesInFile handle sizeDiff audioDataOffset
    -- Write new tag
    liftIO $ do
      hSeek handle AbsoluteSeek 0
      L.hPut handle newTagData
  else do
    -- Need to delete bytes
    let bytesToDelete = negate sizeDiff
    -- Write new tag first
    liftIO $ do
      hSeek handle AbsoluteSeek 0
      L.hPut handle newTagData
    -- Then delete the extra space
    deleteBytesInFile handle bytesToDelete newTagSize

  -- Refresh any existing ID3v1 tag: it would otherwise keep showing the
  -- pre-update fields to v1-only readers
  liftIO $ refreshID3v1 metadata handle

-- | Rewrite an existing ID3v1 tag at the end of the file from the current
-- metadata; files without a v1 tag are left alone
refreshID3v1 :: Metadata -> Handle -> IO ()
refreshID3v1 metadata handle = do
  fileSize <- hFileSize handle
  if fileSize <= 128
    then return ()
    else do
      hSeek handle AbsoluteSeek (fileSize - 128)
      existing <- BS.hGet handle 3
      if existing /= "TAG"
        then return ()
        else do
          hSeek handle AbsoluteSeek (fileSize - 128)
          BS.hPut handle (generateID3v1Tag metadata)

-- | Render a 128-byte ID3v1 tag (v1.1 when a track number is present)
generateID3v1Tag :: Metadata -> BS.ByteString
generateID3v1Tag metadata = BS.concat
  [ "TAG"
  , field 30 (title metadata)
  , field 30 (artist metadata)
  , field 30 (album metadata)
  , field 4 (T.pack . show <$> year metadata)
  , commentAndTrack
  , BS.singleton 0xFF  -- genre: none (no reliable text-to-index mapping)
  ]
  where
    field n maybeText =
      BS.take n $ toLatin1 (fromMaybe "" maybeText) <> BS.replicate n 0
    -- ID3v1 is Latin-1; characters outside it become '?'
    toLatin1 = BS.pack . map (\c -> if fromEnum c < 256 then fromIntegral (fromEnum c) else 0x3F) . T.unpack
    commentAndTrack = case trackNumber metadata of
      Just n | n > 0 && n < 256 ->
        field 28 (comment metadata) <> BS.pack [0, fromIntegral n]
      _ -> field 30 (comment metadata)

-- | Find the start of audio data by skipping existing ID3v2 tag using a handle
findAudioDataOffsetHandle :: Handle -> Writer Int
findAudioDataOffsetHandle handle = do
  -- Seek to beginning
  liftIO $ hSeek handle AbsoluteSeek 0
  
  -- Read first 10 bytes for ID3v2 header
  headerBytes <- liftIO $ BS.hGet handle 10
  
  if BS.length headerBytes < 10 then
    return 0
  else
    case BS.unpack (BS.take 3 headerBytes) of
      [0x49, 0x44, 0x33] -> do  -- "ID3"
        -- Parse the ID3v2 header to get tag size
        case BS.unpack (BS.drop 6 headerBytes) of
          [s1, s2, s3, s4] -> do
            -- ID3v2 size is stored as a syncsafe integer (28 bits); a tag
            -- with the footer flag has 10 more bytes after the tag data,
            -- which must be replaced too or they would linger before the
            -- audio
            let tagSize = syncSafeToInt s1 s2 s3 s4
                footerSize = if BS.index headerBytes 5 .&. 0x10 /= 0 then 10 else 0
            return $ 10 + tagSize + footerSize
          _ -> throwError $ CorruptedWrite "Invalid ID3v2 header"
      _ -> return 0  -- No ID3v2 tag, audio data starts at beginning

-- | Insert bytes into file at given offset
insertBytesInFile :: Handle -> Int -> Int -> Writer ()
insertBytesInFile handle size offset = do
  -- Get current file size
  fileSize <- liftIO $ hFileSize handle
  let moveSize = fileSize - fromIntegral offset
  
  if moveSize < 0 then
    throwError $ WriteIOError "Invalid offset for insert"
  else do
    -- First, extend the file
    liftIO $ hSetFileSize handle (fileSize + fromIntegral size)
    
    -- Move data from offset to offset+size, working backwards to avoid overwriting
    moveDataBackwards handle (fromIntegral offset) (fromIntegral $ offset + size) moveSize

-- | Delete bytes from file at given offset  
deleteBytesInFile :: Handle -> Int -> Int -> Writer ()
deleteBytesInFile handle size offset = do
  -- Get current file size
  fileSize <- liftIO $ hFileSize handle
  let moveSize = fileSize - fromIntegral offset - fromIntegral size
  
  if moveSize < 0 then
    throwError $ WriteIOError "Invalid size/offset for delete"
  else do
    -- Move data from offset+size to offset
    moveDataForwards handle (fromIntegral $ offset + size) (fromIntegral offset) moveSize
    
    -- Truncate the file
    liftIO $ hSetFileSize handle (fileSize - fromIntegral size)

-- | Move data backwards in file (for insertions)
moveDataBackwards :: Handle -> Integer -> Integer -> Integer -> Writer ()
moveDataBackwards handle src dest count = do
  let go remaining = do
        if remaining <= 0 then
          return ()
        else do
          let chunkSize = min (fromIntegral bufferSize) remaining
          -- Read from end of source region
          hSeek handle AbsoluteSeek (src + remaining - chunkSize)
          chunk <- BS.hGet handle (fromIntegral chunkSize)
          -- Write to end of dest region
          hSeek handle AbsoluteSeek (dest + remaining - chunkSize)
          BS.hPut handle chunk
          go (remaining - chunkSize)
  
  liftIO $ go count

-- | Move data forwards in file (for deletions)
moveDataForwards :: Handle -> Integer -> Integer -> Integer -> Writer ()
moveDataForwards handle src dest count = do
  let go moved = do
        if moved >= count then
          return ()
        else do
          let chunkSize = min (fromIntegral bufferSize) (count - moved)
          -- Read from source
          hSeek handle AbsoluteSeek (src + moved)
          chunk <- BS.hGet handle (fromIntegral chunkSize)
          -- Write to dest
          hSeek handle AbsoluteSeek (dest + moved)
          BS.hPut handle chunk
          go (moved + chunkSize)
  
  liftIO $ go 0

-- | Convert syncsafe integer (4 bytes) to regular integer
syncSafeToInt :: Word8 -> Word8 -> Word8 -> Word8 -> Int
syncSafeToInt b1 b2 b3 b4 = 
  let s1 = fromIntegral b1 .&. 0x7F
      s2 = fromIntegral b2 .&. 0x7F
      s3 = fromIntegral b3 .&. 0x7F
      s4 = fromIntegral b4 .&. 0x7F
  in (s1 `shiftL` 21) .|. (s2 `shiftL` 14) .|. (s3 `shiftL` 7) .|. s4

-- | Convert regular integer to syncsafe integer (4 bytes)
intToSyncSafe :: Int -> (Word8, Word8, Word8, Word8)
intToSyncSafe n =
  let b1 = fromIntegral $ (n `shiftR` 21) .&. 0x7F
      b2 = fromIntegral $ (n `shiftR` 14) .&. 0x7F
      b3 = fromIntegral $ (n `shiftR` 7) .&. 0x7F
      b4 = fromIntegral $ n .&. 0x7F
  in (b1, b2, b3, b4)

-- | Like intToSyncSafe, but rejects sizes beyond the 28-bit syncsafe range
-- instead of silently truncating them into a corrupt tag
syncSafeOrFail :: Int -> Writer (Word8, Word8, Word8, Word8)
syncSafeOrFail n
  | n < 0 || n >= 0x10000000 =
      throwError $ InvalidMetadata "Content exceeds ID3v2's 256MiB syncsafe size limit"
  | otherwise = return $ intToSyncSafe n

-- | Read raw frames from an existing ID3v2.3/2.4 tag at the start of the
-- file (empty when there is none)
readExistingRawFrames :: Handle -> IO [(ByteString, ByteString)]
readExistingRawFrames handle = do
  hSeek handle AbsoluteSeek 0
  header <- BS.hGet handle 10
  if BS.length header < 10 || BS.take 3 header /= "ID3"
    then return []
    else do
      let version = BS.index header 3
          flags = BS.index header 5
          [s1, s2, s3, s4] = BS.unpack $ BS.take 4 $ BS.drop 6 header
          tagSize = syncSafeToInt s1 s2 s3 s4
      tagData <- BS.hGet handle tagSize
      return $ extractRawFrames version flags tagData

-- | Generate complete ID3v2.4 tag
generateID3v2Tag :: Metadata -> AlbumArtUpdate -> [(ByteString, ByteString)] -> Writer L.ByteString
generateID3v2Tag metadata artUpdate existingRawFrames = do
  -- Generate all frames
  frames <- generateFrames metadata artUpdate existingRawFrames
  let framesData = L.concat frames
      framesSize = fromIntegral $ L.length framesData
  
  -- Create ID3v2.4 header
  (s1, s2, s3, s4) <- syncSafeOrFail framesSize
  let header = runPut $ do
        putByteString "ID3"      -- Signature
        putWord8 4               -- Major version (2.4)
        putWord8 0               -- Revision version
        putWord8 0               -- Flags (no unsync, no extended header, etc.)
        putWord8 s1              -- Size as syncsafe integer
        putWord8 s2
        putWord8 s3
        putWord8 s4
  
  return $ header <> framesData

-- | Generate all ID3v2.4 frames for the metadata. Every field the MP3
-- parser maps is written back; unmapped text frames in rawTags and
-- unmapped binary frames from the existing tag are carried over so an
-- update never drops tags it does not understand.
generateFrames :: Metadata -> AlbumArtUpdate -> [(ByteString, ByteString)] -> Writer [L.ByteString]
generateFrames metadata artUpdate existingRawFrames = do
  mapped <- sequence $
    [ generateTextFrame frameId value | (frameId, value) <- textFrames ] ++
    [ generateTXXXFrame description value | (description, value) <- txxxFrames ]

  -- Picard convention: the recording id lives in UFID:http://musicbrainz.org
  ufidFrames <- case mbRecordingId mbIds of
    Nothing -> return []
    Just recordingId ->
      (: []) <$> generateUFIDFrame "http://musicbrainz.org" recordingId

  commFrames <- case comment metadata of
    Nothing -> return []
    Just c -> (: []) <$> generateCOMMFrame c

  preserved <- generatePreservedFrames metadata

  -- Carry frames that cannot be regenerated from text (lyrics, private
  -- data, foreign identifiers, ...) over verbatim
  carried <- mapM (uncurry generateRawFrame)
    [ frame | frame@(frameId, content) <- existingRawFrames
    , isCarriedVerbatim frameId content
    ]

  apicFrames <- case artUpdate of
    SetAlbumArt art -> (: []) <$> generateAPICFrame art
    KeepExistingArt ->
      -- Existing pictures pass through verbatim
      mapM (generateRawFrame "APIC")
        [ content | ("APIC", content) <- existingRawFrames ]
    RemoveAlbumArt -> return []

  return $ mapped ++ ufidFrames ++ commFrames ++ preserved ++ carried ++ apicFrames
  where
    mbIds = musicBrainzIds metadata
    showT = T.pack . show

    -- Verbatim carry-over covers everything the tag map cannot represent:
    -- not text frames (regenerated from fields/rawTags), not COMM (the
    -- comment field owns it), not APIC (owned by the art instruction),
    -- and not the MusicBrainz UFID (regenerated from mbRecordingId)
    isCarriedVerbatim frameId content
      | BS.isPrefixOf "T" frameId = False
      | frameId `elem` ["COMM", "APIC"] = False
      | frameId == "UFID" = BS.takeWhile (/= 0) content /= "http://musicbrainz.org"
      | otherwise = True

    -- "7" alone, or "7/12" when the total is known
    numWithTotal num total = renderNum <$> num
      where renderNum n = maybe (showT n) (\t -> showT n <> "/" <> showT t) total

    -- A scalar field is the first value of a possibly multi-valued key.
    -- If the field still matches what was parsed, write every stored value
    -- back (null-separated, ID3v2.4 style); if it was edited, the edit
    -- replaces the whole set.
    multi key field = case field of
      Nothing -> Nothing
      Just v ->
        let stored = HM.lookupDefault [] key (rawTags metadata)
        in Just $ if listToMaybe stored == Just v then stored else [v]

    single field = (: []) <$> field

    textFrames = catMaybes
      [ ("TIT2",) <$> multi "TIT2" (title metadata)
      , ("TPE1",) <$> multi "TPE1" (artist metadata)
      , ("TALB",) <$> multi "TALB" (album metadata)
      , ("TPE2",) <$> multi "TPE2" (albumArtist metadata)
      , ("TCON",) <$> multi "TCON" (genre metadata)
      , ("TPUB",) <$> multi "TPUB" (publisher metadata)
      , ("TRCK",) <$> single (numWithTotal (trackNumber metadata) (totalTracks metadata))
      , ("TPOS",) <$> single (numWithTotal (discNumber metadata) (totalDiscs metadata))
      , ("TDRC",) <$> single (date metadata <|> (showT <$> year metadata))
      ]

    txxxFrames = catMaybes
      [ ("BARCODE",) <$> single (barcode metadata)
      , ("CATALOGNUMBER",) <$> single (catalogNumber metadata)
      , ("LABEL",) <$> single (recordLabel metadata)
      , ("MusicBrainz Album Release Country",) <$> single (releaseCountry metadata)
      , ("MusicBrainz Album Status",) <$> single (releaseStatus metadata)
      , ("MusicBrainz Album Type",) <$> single (releaseType metadata)
      , ("MusicBrainz Release Track Id",) <$> single (mbTrackId mbIds)
      , ("MusicBrainz Album Id",) <$> single (mbReleaseId mbIds)
      , ("MusicBrainz Release Group Id",) <$> single (mbReleaseGroupId mbIds)
      -- Multiple credited artists mean multiple MusicBrainz artist ids
      , ("MusicBrainz Artist Id",) <$> multi "TXXX:MusicBrainz Artist Id" (mbArtistId mbIds)
      , ("MusicBrainz Album Artist Id",) <$> multi "TXXX:MusicBrainz Album Artist Id" (mbAlbumArtistId mbIds)
      , ("MusicBrainz Work Id",) <$> single (mbWorkId mbIds)
      , ("MusicBrainz Disc Id",) <$> single (mbDiscId mbIds)
      , ("Acoustid Fingerprint",) <$> single (acoustidFingerprint metadata)
      , ("Acoustid Id",) <$> single (acoustidId metadata)
      ]

-- | Re-emit raw frames the mapped fields do not own. rawTags only holds
-- text-decoded values, so preservation is limited to frames that can be
-- reproduced faithfully from text: T-frames and TXXX
generatePreservedFrames :: Metadata -> Writer [L.ByteString]
generatePreservedFrames metadata = mapM emit preservable
  where
    -- One frame per key: multi-valued keys become one null-separated
    -- frame, since duplicate frames of the same ID are invalid
    preservable =
      [ (key, values)
      | (key, values) <- HM.toList (rawTags metadata)
      , isPreservable key
      , not (null values)
      ]

    isPreservable key
      | Just description <- T.stripPrefix "TXXX:" key =
          T.toLower description `notElem` handledDescriptions
      | T.length key == 3 = key `elem` map fst v22TextFrames
      | otherwise =
          T.length key == 4 && T.isPrefixOf "T" key && key `notElem` handledTextFrames

    emit (key, values) = case T.stripPrefix "TXXX:" key of
      Just description -> generateTXXXFrame description values
      Nothing -> case lookup key v22TextFrames of
        Just v24Id -> generateTextFrame v24Id values
        Nothing -> generateTextFrame (TE.encodeUtf8 key) values

    -- ID3v2.2 3-character text frame ids translated to their v2.4
    -- equivalents so unmapped v2.2 values survive an update. Ids whose
    -- values are carried by mapped fields (TT2, TP1, ...) are absent.
    v22TextFrames :: [(Text, ByteString)]
    v22TextFrames =
      [ ("TT1", "TIT1"), ("TT3", "TIT3"), ("TP3", "TPE3"), ("TP4", "TPE4")
      , ("TCM", "TCOM"), ("TXT", "TEXT"), ("TLA", "TLAN"), ("TLE", "TLEN")
      , ("TMT", "TMED"), ("TKE", "TKEY"), ("TBP", "TBPM"), ("TSS", "TSSE")
      , ("TEN", "TENC"), ("TCR", "TCOP"), ("TDY", "TDLY"), ("TOT", "TOAL")
      , ("TOA", "TOPE"), ("TOL", "TOLY"), ("TFT", "TFLT"), ("TRC", "TSRC")
      ]

    -- Frames the mapped fields own (whether or not they are set right now):
    -- stale rawTags copies of these must not be written back
    handledTextFrames =
      [ "TIT2", "TPE1", "TALB", "TPE2", "TCON", "TPUB", "TRCK", "TPOS"
      , "TDRC", "TXXX"
      -- legacy v2.3 date frames, superseded by the TDRC we write
      , "TYER", "TDAT", "TIME", "TRDA"
      ]

    handledDescriptions = map T.toLower
      [ "BARCODE", "CATALOGNUMBER", "LABEL", "comment"
      , "MusicBrainz Album Release Country", "MusicBrainz Album Status"
      , "MusicBrainz Album Type"
      , "MusicBrainz Release Track Id", "MusicBrainz Recording Id"
      , "MusicBrainz Album Id", "MusicBrainz Release Group Id"
      , "MusicBrainz Artist Id", "MusicBrainz Album Artist Id"
      , "MusicBrainz Work Id", "MusicBrainz Disc Id"
      , "Acoustid Fingerprint", "Acoustid Id"
      ]

-- | Generate a text frame (TIT2, TPE1, TALB, etc.); several values are
-- encoded null-separated per ID3v2.4
generateTextFrame :: ByteString -> [Text] -> Writer L.ByteString
generateTextFrame frameId values = do
  let content = BS.intercalate "\0" (map TE.encodeUtf8 values)
      textBytes = BS.cons 0x03 content  -- 0x03 = UTF-8 encoding
      frameSize = BS.length textBytes
  (s1, s2, s3, s4) <- syncSafeOrFail frameSize

  return $ runPut $ do
    putByteString frameId       -- Frame ID (4 bytes)
    putWord8 s1                 -- Frame size as syncsafe integer
    putWord8 s2
    putWord8 s3
    putWord8 s4
    putWord16be 0               -- Frame flags
    putByteString textBytes     -- Frame content (encoding byte + UTF-8 text)

-- | Generate APIC frame for album art
generateAPICFrame :: AlbumArt -> Writer L.ByteString
generateAPICFrame art = do
  let mimeBytes = TE.encodeUtf8 $ albumArtMimeType art
      descBytes = TE.encodeUtf8 $ albumArtDescription art
      imageData = albumArtData art
      
      -- Calculate frame content size
      frameSize = 1 + BS.length mimeBytes + 1 + 1 + BS.length descBytes + 1 + BS.length imageData
  (s1, s2, s3, s4) <- syncSafeOrFail frameSize

  return $ runPut $ do
    putByteString "APIC"        -- Frame ID
    putWord8 s1                 -- Frame size as syncsafe integer
    putWord8 s2
    putWord8 s3
    putWord8 s4
    putWord16be 0               -- Frame flags
    putWord8 0x03                           -- UTF-8 encoding
    putByteString mimeBytes                 -- MIME type
    putWord8 0x00                           -- Null terminator
    putWord8 (albumArtPictureType art)      -- Picture type
    putByteString descBytes                 -- Description
    putWord8 0x00                           -- Null terminator  
    putByteString imageData                 -- Image data

-- | Generate a frame with pre-rendered content (used for UFID and for
-- frames carried over verbatim)
generateRawFrame :: ByteString -> ByteString -> Writer L.ByteString
generateRawFrame frameId frameContent = do
  (s1, s2, s3, s4) <- syncSafeOrFail (BS.length frameContent)
  return $ runPut $ do
    putByteString frameId
    putWord8 s1
    putWord8 s2
    putWord8 s3
    putWord8 s4
    putWord16be 0               -- Frame flags
    putByteString frameContent

-- | Generate UFID frame: null-terminated Latin-1 owner + identifier
generateUFIDFrame :: Text -> Text -> Writer L.ByteString
generateUFIDFrame owner identifier = generateRawFrame "UFID" $ BS.concat
  [ TE.encodeUtf8 owner     -- owner URLs are ASCII in practice
  , BS.singleton 0x00
  , TE.encodeUtf8 identifier
  ]

-- | Generate COMM frame for comments (has special structure)
generateCOMMFrame :: Text -> Writer L.ByteString
generateCOMMFrame commentText = do
  let textBytes = TE.encodeUtf8 commentText
      -- COMM structure: encoding + language (3 bytes) + short description (empty) + null + actual comment
      frameContent = BS.concat [
        BS.singleton 0x03,       -- UTF-8 encoding
        "eng",                   -- Language code (English)
        BS.singleton 0x00,       -- Empty short description + null terminator
        textBytes                -- Actual comment text
        ]
      frameSize = BS.length frameContent
  (s1, s2, s3, s4) <- syncSafeOrFail frameSize

  return $ runPut $ do
    putByteString "COMM"        -- Frame ID
    putWord8 s1                 -- Frame size as syncsafe integer
    putWord8 s2
    putWord8 s3
    putWord8 s4
    putWord16be 0               -- Frame flags
    putByteString frameContent  -- Frame content

-- | Generate TXXX frame for user-defined text information; several values
-- are encoded null-separated per ID3v2.4
generateTXXXFrame :: Text -> [Text] -> Writer L.ByteString
generateTXXXFrame description values = do
  let descBytes = TE.encodeUtf8 description
      textBytes = BS.intercalate "\0" (map TE.encodeUtf8 values)
      -- TXXX structure: encoding + description + null + text value(s)
      frameContent = BS.concat [
        BS.singleton 0x03,       -- UTF-8 encoding
        descBytes,               -- Description
        BS.singleton 0x00,       -- Null terminator
        textBytes                -- Text value(s)
        ]
      frameSize = BS.length frameContent
  (s1, s2, s3, s4) <- syncSafeOrFail frameSize

  return $ runPut $ do
    putByteString "TXXX"        -- Frame ID
    putWord8 s1                 -- Frame size as syncsafe integer
    putWord8 s2
    putWord8 s3
    putWord8 s4
    putWord16be 0               -- Frame flags
    putByteString frameContent  -- Frame content