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

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

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 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

-- Re-define WriteError and Writer locally to avoid circular imports
data WriteError
  = WriteIOError Text
  | UnsupportedWriteFormat AudioFormat  
  | InvalidMetadata Text
  | CorruptedWrite Text
  deriving (Int -> WriteError -> ShowS
[WriteError] -> ShowS
WriteError -> String
(Int -> WriteError -> ShowS)
-> (WriteError -> String)
-> ([WriteError] -> ShowS)
-> Show WriteError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WriteError -> ShowS
showsPrec :: Int -> WriteError -> ShowS
$cshow :: WriteError -> String
show :: WriteError -> String
$cshowList :: [WriteError] -> ShowS
showList :: [WriteError] -> ShowS
Show, WriteError -> WriteError -> Bool
(WriteError -> WriteError -> Bool)
-> (WriteError -> WriteError -> Bool) -> Eq WriteError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WriteError -> WriteError -> Bool
== :: WriteError -> WriteError -> Bool
$c/= :: WriteError -> WriteError -> Bool
/= :: WriteError -> WriteError -> Bool
Eq)

type Writer = ExceptT WriteError IO

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

-- | Write metadata to MP3 file incrementally without loading the entire file
-- Takes optional AlbumArt separately since Metadata only stores AlbumArtInfo
writeMP3Metadata :: Metadata -> Maybe AlbumArt -> OsPath -> Writer ()
writeMP3Metadata :: Metadata -> Maybe AlbumArt -> OsPath -> Writer ()
writeMP3Metadata Metadata
metadata Maybe AlbumArt
maybeAlbumArt OsPath
filePath = do
  -- Open file in read/write mode
  Either IOException (Either WriteError ())
result <- IO (Either IOException (Either WriteError ()))
-> ExceptT
     WriteError IO (Either IOException (Either WriteError ()))
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException (Either WriteError ()))
 -> ExceptT
      WriteError IO (Either IOException (Either WriteError ())))
-> IO (Either IOException (Either WriteError ()))
-> ExceptT
     WriteError IO (Either IOException (Either WriteError ()))
forall a b. (a -> b) -> a -> b
$ IO (Either WriteError ())
-> IO (Either IOException (Either WriteError ()))
forall a. IO a -> IO (Either IOException a)
tryIO (IO (Either WriteError ())
 -> IO (Either IOException (Either WriteError ())))
-> IO (Either WriteError ())
-> IO (Either IOException (Either WriteError ()))
forall a b. (a -> b) -> a -> b
$ OsPath
-> IOMode
-> (Handle -> IO (Either WriteError ()))
-> IO (Either WriteError ())
forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile OsPath
filePath IOMode
ReadWriteMode ((Handle -> IO (Either WriteError ()))
 -> IO (Either WriteError ()))
-> (Handle -> IO (Either WriteError ()))
-> IO (Either WriteError ())
forall a b. (a -> b) -> a -> b
$ \Handle
handle -> do
    Writer () -> IO (Either WriteError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (Writer () -> IO (Either WriteError ()))
-> Writer () -> IO (Either WriteError ())
forall a b. (a -> b) -> a -> b
$ Metadata -> Maybe AlbumArt -> Handle -> Writer ()
writeMP3HandleIncremental Metadata
metadata Maybe AlbumArt
maybeAlbumArt Handle
handle
  case Either IOException (Either WriteError ())
result of
    Left (IOException
e :: IOException) -> WriteError -> Writer ()
forall a. WriteError -> ExceptT WriteError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (WriteError -> Writer ()) -> WriteError -> Writer ()
forall a b. (a -> b) -> a -> b
$ Text -> WriteError
WriteIOError (Text -> WriteError) -> Text -> WriteError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ IOException -> String
forall a. Show a => a -> String
show IOException
e
    Right (Left WriteError
err) -> WriteError -> Writer ()
forall a. WriteError -> ExceptT WriteError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError WriteError
err
    Right (Right ()) -> () -> Writer ()
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    tryIO :: IO a -> IO (Either IOException a)
    tryIO :: forall a. IO a -> IO (Either IOException a)
tryIO IO a
action = IO (Either IOException a)
-> (IOException -> IO (Either IOException a))
-> IO (Either IOException a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (a -> Either IOException a
forall a b. b -> Either a b
Right (a -> Either IOException a) -> IO a -> IO (Either IOException a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
action) (Either IOException a -> IO (Either IOException a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either IOException a -> IO (Either IOException a))
-> (IOException -> Either IOException a)
-> IOException
-> IO (Either IOException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> Either IOException a
forall a b. a -> Either a b
Left)

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

  -- Generate new ID3v2 tag
  ByteString
newTagData <- Metadata -> Maybe AlbumArt -> Writer ByteString
generateID3v2Tag Metadata
metadata Maybe AlbumArt
maybeAlbumArt
  let newTagSize :: Int
newTagSize = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
L.length ByteString
newTagData
  
  -- Get file size
  Integer
_ <- IO Integer -> ExceptT WriteError IO Integer
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Integer -> ExceptT WriteError IO Integer)
-> IO Integer -> ExceptT WriteError IO Integer
forall a b. (a -> b) -> a -> b
$ Handle -> IO Integer
hFileSize Handle
handle
  
  -- Now we need to either insert or delete bytes depending on size difference
  let sizeDiff :: Int
sizeDiff = Int
newTagSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
audioDataOffset
  
  if Int
sizeDiff Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then do
    -- Same size, just overwrite
    IO () -> Writer ()
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Writer ()) -> IO () -> Writer ()
forall a b. (a -> b) -> a -> b
$ do
      Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
AbsoluteSeek Integer
0
      Handle -> ByteString -> IO ()
L.hPut Handle
handle ByteString
newTagData
  else if Int
sizeDiff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then do
    -- Need to insert bytes
    Handle -> Int -> Int -> Writer ()
insertBytesInFile Handle
handle Int
sizeDiff Int
audioDataOffset
    -- Write new tag
    IO () -> Writer ()
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Writer ()) -> IO () -> Writer ()
forall a b. (a -> b) -> a -> b
$ do
      Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
AbsoluteSeek Integer
0
      Handle -> ByteString -> IO ()
L.hPut Handle
handle ByteString
newTagData
  else do
    -- Need to delete bytes
    let bytesToDelete :: Int
bytesToDelete = Int -> Int
forall a. Num a => a -> a
negate Int
sizeDiff
    -- Write new tag first
    IO () -> Writer ()
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Writer ()) -> IO () -> Writer ()
forall a b. (a -> b) -> a -> b
$ do
      Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
AbsoluteSeek Integer
0
      Handle -> ByteString -> IO ()
L.hPut Handle
handle ByteString
newTagData
    -- Then delete the extra space
    Handle -> Int -> Int -> Writer ()
deleteBytesInFile Handle
handle Int
bytesToDelete Int
newTagSize

-- | Find the start of audio data by skipping existing ID3v2 tag using a handle
findAudioDataOffsetHandle :: Handle -> Writer Int
findAudioDataOffsetHandle :: Handle -> Writer Int
findAudioDataOffsetHandle Handle
handle = do
  -- Seek to beginning
  IO () -> Writer ()
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Writer ()) -> IO () -> Writer ()
forall a b. (a -> b) -> a -> b
$ Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
AbsoluteSeek Integer
0
  
  -- Read first 10 bytes for ID3v2 header
  ByteString
headerBytes <- IO ByteString -> ExceptT WriteError IO ByteString
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ExceptT WriteError IO ByteString)
-> IO ByteString -> ExceptT WriteError IO ByteString
forall a b. (a -> b) -> a -> b
$ Handle -> Int -> IO ByteString
BS.hGet Handle
handle Int
10
  
  if ByteString -> Int
BS.length ByteString
headerBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 then
    Int -> Writer Int
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
  else
    case ByteString -> [Word8]
BS.unpack (Int -> ByteString -> ByteString
BS.take Int
3 ByteString
headerBytes) of
      [Word8
0x49, Word8
0x44, Word8
0x33] -> do  -- "ID3"
        -- Parse the ID3v2 header to get tag size
        case ByteString -> [Word8]
BS.unpack (Int -> ByteString -> ByteString
BS.drop Int
6 ByteString
headerBytes) of
          [Word8
s1, Word8
s2, Word8
s3, Word8
s4] -> do
            -- ID3v2 size is stored as a syncsafe integer (28 bits)
            let tagSize :: Int
tagSize = Word8 -> Word8 -> Word8 -> Word8 -> Int
syncSafeToInt Word8
s1 Word8
s2 Word8
s3 Word8
s4
            Int -> Writer Int
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Writer Int) -> Int -> Writer Int
forall a b. (a -> b) -> a -> b
$ Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tagSize  -- Header (10 bytes) + tag data
          [Word8]
_ -> WriteError -> Writer Int
forall a. WriteError -> ExceptT WriteError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (WriteError -> Writer Int) -> WriteError -> Writer Int
forall a b. (a -> b) -> a -> b
$ Text -> WriteError
CorruptedWrite Text
"Invalid ID3v2 header"
      [Word8]
_ -> Int -> Writer Int
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0  -- No ID3v2 tag, audio data starts at beginning

-- | Insert bytes into file at given offset
insertBytesInFile :: Handle -> Int -> Int -> Writer ()
insertBytesInFile :: Handle -> Int -> Int -> Writer ()
insertBytesInFile Handle
handle Int
size Int
offset = do
  -- Get current file size
  Integer
fileSize <- IO Integer -> ExceptT WriteError IO Integer
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Integer -> ExceptT WriteError IO Integer)
-> IO Integer -> ExceptT WriteError IO Integer
forall a b. (a -> b) -> a -> b
$ Handle -> IO Integer
hFileSize Handle
handle
  let moveSize :: Integer
moveSize = Integer
fileSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset
  
  if Integer
moveSize Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then
    WriteError -> Writer ()
forall a. WriteError -> ExceptT WriteError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (WriteError -> Writer ()) -> WriteError -> Writer ()
forall a b. (a -> b) -> a -> b
$ Text -> WriteError
WriteIOError Text
"Invalid offset for insert"
  else do
    -- First, extend the file
    IO () -> Writer ()
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Writer ()) -> IO () -> Writer ()
forall a b. (a -> b) -> a -> b
$ Handle -> Integer -> IO ()
hSetFileSize Handle
handle (Integer
fileSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
    
    -- Move data from offset to offset+size, working backwards to avoid overwriting
    Handle -> Integer -> Integer -> Integer -> Writer ()
moveDataBackwards Handle
handle (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size) Integer
moveSize

-- | Delete bytes from file at given offset  
deleteBytesInFile :: Handle -> Int -> Int -> Writer ()
deleteBytesInFile :: Handle -> Int -> Int -> Writer ()
deleteBytesInFile Handle
handle Int
size Int
offset = do
  -- Get current file size
  Integer
fileSize <- IO Integer -> ExceptT WriteError IO Integer
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Integer -> ExceptT WriteError IO Integer)
-> IO Integer -> ExceptT WriteError IO Integer
forall a b. (a -> b) -> a -> b
$ Handle -> IO Integer
hFileSize Handle
handle
  let moveSize :: Integer
moveSize = Integer
fileSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size
  
  if Integer
moveSize Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then
    WriteError -> Writer ()
forall a. WriteError -> ExceptT WriteError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (WriteError -> Writer ()) -> WriteError -> Writer ()
forall a b. (a -> b) -> a -> b
$ Text -> WriteError
WriteIOError Text
"Invalid size/offset for delete"
  else do
    -- Move data from offset+size to offset
    Handle -> Integer -> Integer -> Integer -> Writer ()
moveDataForwards Handle
handle (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset) Integer
moveSize
    
    -- Truncate the file
    IO () -> Writer ()
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Writer ()) -> IO () -> Writer ()
forall a b. (a -> b) -> a -> b
$ Handle -> Integer -> IO ()
hSetFileSize Handle
handle (Integer
fileSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)

-- | Move data backwards in file (for insertions)
moveDataBackwards :: Handle -> Integer -> Integer -> Integer -> Writer ()
moveDataBackwards :: Handle -> Integer -> Integer -> Integer -> Writer ()
moveDataBackwards Handle
handle Integer
src Integer
dest Integer
count = do
  let go :: Integer -> IO ()
go Integer
remaining = do
        if Integer
remaining Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 then
          () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else do
          let chunkSize :: Integer
chunkSize = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufferSize) Integer
remaining
          -- Read from end of source region
          Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
AbsoluteSeek (Integer
src Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
remaining Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
chunkSize)
          ByteString
chunk <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
chunkSize)
          -- Write to end of dest region
          Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
AbsoluteSeek (Integer
dest Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
remaining Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
chunkSize)
          Handle -> ByteString -> IO ()
BS.hPut Handle
handle ByteString
chunk
          Integer -> IO ()
go (Integer
remaining Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
chunkSize)
  
  IO () -> Writer ()
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Writer ()) -> IO () -> Writer ()
forall a b. (a -> b) -> a -> b
$ Integer -> IO ()
go Integer
count

-- | Move data forwards in file (for deletions)
moveDataForwards :: Handle -> Integer -> Integer -> Integer -> Writer ()
moveDataForwards :: Handle -> Integer -> Integer -> Integer -> Writer ()
moveDataForwards Handle
handle Integer
src Integer
dest Integer
count = do
  let go :: Integer -> IO ()
go Integer
moved = do
        if Integer
moved Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
count then
          () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else do
          let chunkSize :: Integer
chunkSize = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufferSize) (Integer
count Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
moved)
          -- Read from source
          Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
AbsoluteSeek (Integer
src Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
moved)
          ByteString
chunk <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
chunkSize)
          -- Write to dest
          Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
AbsoluteSeek (Integer
dest Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
moved)
          Handle -> ByteString -> IO ()
BS.hPut Handle
handle ByteString
chunk
          Integer -> IO ()
go (Integer
moved Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
chunkSize)
  
  IO () -> Writer ()
forall a. IO a -> ExceptT WriteError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Writer ()) -> IO () -> Writer ()
forall a b. (a -> b) -> a -> b
$ Integer -> IO ()
go Integer
0

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

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

-- | Generate complete ID3v2.4 tag
generateID3v2Tag :: Metadata -> Maybe AlbumArt -> Writer L.ByteString
generateID3v2Tag :: Metadata -> Maybe AlbumArt -> Writer ByteString
generateID3v2Tag Metadata
metadata Maybe AlbumArt
maybeAlbumArt = do
  -- Generate all frames
  [ByteString]
frames <- Metadata -> Maybe AlbumArt -> Writer [ByteString]
generateFrames Metadata
metadata Maybe AlbumArt
maybeAlbumArt
  let framesData :: ByteString
framesData = [ByteString] -> ByteString
L.concat [ByteString]
frames
      framesSize :: Int
framesSize = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
L.length ByteString
framesData
  
  -- Create ID3v2.4 header
  let (Word8
s1, Word8
s2, Word8
s3, Word8
s4) = Int -> (Word8, Word8, Word8, Word8)
intToSyncSafe Int
framesSize
      header :: ByteString
header = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
        ByteString -> Put
putByteString ByteString
"ID3"      -- Signature
        Word8 -> Put
putWord8 Word8
4               -- Major version (2.4)
        Word8 -> Put
putWord8 Word8
0               -- Revision version
        Word8 -> Put
putWord8 Word8
0               -- Flags (no unsync, no extended header, etc.)
        Word8 -> Put
putWord8 Word8
s1              -- Size as syncsafe integer
        Word8 -> Put
putWord8 Word8
s2
        Word8 -> Put
putWord8 Word8
s3
        Word8 -> Put
putWord8 Word8
s4
  
  ByteString -> Writer ByteString
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Writer ByteString)
-> ByteString -> Writer ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
header ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
framesData

-- | Generate all ID3v2.4 frames for the metadata
generateFrames :: Metadata -> Maybe AlbumArt -> Writer [L.ByteString]
generateFrames :: Metadata -> Maybe AlbumArt -> Writer [ByteString]
generateFrames Metadata
metadata Maybe AlbumArt
maybeAlbumArt = do
  -- Start with empty list
  [ByteString]
frames0 <- [ByteString] -> Writer [ByteString]
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  
  -- Add text frames
  [ByteString]
frames1 <- [ByteString] -> ByteString -> Maybe Text -> Writer [ByteString]
addTextFrame [ByteString]
frames0 ByteString
"TIT2" (Metadata -> Maybe Text
title Metadata
metadata)
  [ByteString]
frames2 <- [ByteString] -> ByteString -> Maybe Text -> Writer [ByteString]
addTextFrame [ByteString]
frames1 ByteString
"TPE1" (Metadata -> Maybe Text
artist Metadata
metadata)  
  [ByteString]
frames3 <- [ByteString] -> ByteString -> Maybe Text -> Writer [ByteString]
addTextFrame [ByteString]
frames2 ByteString
"TALB" (Metadata -> Maybe Text
album Metadata
metadata)
  [ByteString]
frames4 <- [ByteString] -> ByteString -> Maybe Text -> Writer [ByteString]
addTextFrame [ByteString]
frames3 ByteString
"TPE2" (Metadata -> Maybe Text
albumArtist Metadata
metadata)
  [ByteString]
frames5 <- [ByteString] -> ByteString -> Maybe Text -> Writer [ByteString]
addTextFrame [ByteString]
frames4 ByteString
"TCON" (Metadata -> Maybe Text
genre Metadata
metadata)
  [ByteString]
frames6 <- [ByteString] -> ByteString -> Maybe Text -> Writer [ByteString]
addTextFrame [ByteString]
frames5 ByteString
"TPUB" (Metadata -> Maybe Text
publisher Metadata
metadata)
  
  -- Add comment frame (COMM has special structure)
  [ByteString]
frames7 <- case Metadata -> Maybe Text
comment Metadata
metadata of
    Maybe Text
Nothing -> [ByteString] -> Writer [ByteString]
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
frames6
    Just Text
c -> do
      ByteString
commFrame <- Text -> Writer ByteString
generateCOMMFrame Text
c
      [ByteString] -> Writer [ByteString]
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> Writer [ByteString])
-> [ByteString] -> Writer [ByteString]
forall a b. (a -> b) -> a -> b
$ [ByteString]
frames6 [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
commFrame]
  
  -- Add numeric frames
  [ByteString]
frames8 <- [ByteString] -> ByteString -> Maybe Int -> Writer [ByteString]
addNumericFrame [ByteString]
frames7 ByteString
"TRCK" (Metadata -> Maybe Int
trackNumber Metadata
metadata)
  [ByteString]
frames9 <- [ByteString] -> ByteString -> Maybe Int -> Writer [ByteString]
addNumericFrame [ByteString]
frames8 ByteString
"TPOS" (Metadata -> Maybe Int
discNumber Metadata
metadata)
  [ByteString]
frames10 <- [ByteString] -> ByteString -> Maybe Int -> Writer [ByteString]
addNumericFrame [ByteString]
frames9 ByteString
"TDRC" (Metadata -> Maybe Int
year Metadata
metadata)  -- TDRC for recording date in ID3v2.4

  -- Add additional metadata fields using TXXX frames
  [ByteString]
frames11 <- [ByteString] -> Text -> Maybe Text -> Writer [ByteString]
addTXXXFrame [ByteString]
frames10 Text
"BARCODE" (Metadata -> Maybe Text
barcode Metadata
metadata)
  [ByteString]
frames12 <- [ByteString] -> Text -> Maybe Text -> Writer [ByteString]
addTXXXFrame [ByteString]
frames11 Text
"CATALOGNUMBER" (Metadata -> Maybe Text
catalogNumber Metadata
metadata)
  [ByteString]
frames13 <- [ByteString] -> Text -> Maybe Text -> Writer [ByteString]
addTXXXFrame [ByteString]
frames12 Text
"LABEL" (Metadata -> Maybe Text
recordLabel Metadata
metadata)
  [ByteString]
frames14 <- [ByteString] -> Text -> Maybe Text -> Writer [ByteString]
addTXXXFrame [ByteString]
frames13 Text
"MusicBrainz Album Release Country" (Metadata -> Maybe Text
releaseCountry Metadata
metadata)
  [ByteString]
frames15 <- [ByteString] -> Text -> Maybe Text -> Writer [ByteString]
addTXXXFrame [ByteString]
frames14 Text
"MusicBrainz Album Status" (Metadata -> Maybe Text
releaseStatus Metadata
metadata)
  [ByteString]
frames16 <- [ByteString] -> Text -> Maybe Text -> Writer [ByteString]
addTXXXFrame [ByteString]
frames15 Text
"MusicBrainz Album Type" (Metadata -> Maybe Text
releaseType Metadata
metadata)

  -- Add date field (separate from year) if present
  [ByteString]
frames17 <- [ByteString] -> ByteString -> Maybe Text -> Writer [ByteString]
addTextFrame [ByteString]
frames16 ByteString
"TDRC" (Metadata -> Maybe Text
date Metadata
metadata)

  -- Add album art frame if provided
  [ByteString]
finalFrames <- case Maybe AlbumArt
maybeAlbumArt of
    Maybe AlbumArt
Nothing -> [ByteString] -> Writer [ByteString]
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
frames17
    Just AlbumArt
artData -> do
      ByteString
apicFrame <- AlbumArt -> Writer ByteString
generateAPICFrame AlbumArt
artData
      [ByteString] -> Writer [ByteString]
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> Writer [ByteString])
-> [ByteString] -> Writer [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString
apicFrame ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
frames17

  [ByteString] -> Writer [ByteString]
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
finalFrames
  where
    -- Helper to add text frame if value is present
    addTextFrame :: [L.ByteString] -> ByteString -> Maybe Text -> Writer [L.ByteString]
    addTextFrame :: [ByteString] -> ByteString -> Maybe Text -> Writer [ByteString]
addTextFrame [ByteString]
frameList ByteString
frameId Maybe Text
maybeText = case Maybe Text
maybeText of
      Maybe Text
Nothing -> [ByteString] -> Writer [ByteString]
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
frameList
      Just Text
text -> do
        ByteString
frame <- ByteString -> Text -> Writer ByteString
generateTextFrame ByteString
frameId Text
text
        [ByteString] -> Writer [ByteString]
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> Writer [ByteString])
-> [ByteString] -> Writer [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString
frame ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
frameList
    
    -- Helper to add numeric frame if value is present
    addNumericFrame :: [L.ByteString] -> ByteString -> Maybe Int -> Writer [L.ByteString]
    addNumericFrame :: [ByteString] -> ByteString -> Maybe Int -> Writer [ByteString]
addNumericFrame [ByteString]
frameList ByteString
frameId Maybe Int
maybeNum = case Maybe Int
maybeNum of
      Maybe Int
Nothing -> [ByteString] -> Writer [ByteString]
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
frameList
      Just Int
num -> do
        ByteString
frame <- ByteString -> Text -> Writer ByteString
generateTextFrame ByteString
frameId (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
num)
        [ByteString] -> Writer [ByteString]
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> Writer [ByteString])
-> [ByteString] -> Writer [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString
frame ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
frameList

    -- Helper to add TXXX frame if value is present
    addTXXXFrame :: [L.ByteString] -> Text -> Maybe Text -> Writer [L.ByteString]
    addTXXXFrame :: [ByteString] -> Text -> Maybe Text -> Writer [ByteString]
addTXXXFrame [ByteString]
frameList Text
description Maybe Text
maybeText = case Maybe Text
maybeText of
      Maybe Text
Nothing -> [ByteString] -> Writer [ByteString]
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
frameList
      Just Text
text -> do
        ByteString
frame <- Text -> Text -> Writer ByteString
generateTXXXFrame Text
description Text
text
        [ByteString] -> Writer [ByteString]
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> Writer [ByteString])
-> [ByteString] -> Writer [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString
frame ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
frameList

-- | Generate a text frame (TIT2, TPE1, TALB, etc.)
generateTextFrame :: ByteString -> Text -> Writer L.ByteString
generateTextFrame :: ByteString -> Text -> Writer ByteString
generateTextFrame ByteString
frameId Text
text = do
  -- Encode text as UTF-8 with BOM
  let textBytes :: ByteString
textBytes = Word8 -> ByteString -> ByteString
BS.cons Word8
0x03 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 Text
text  -- 0x03 = UTF-8 encoding
      frameSize :: Int
frameSize = ByteString -> Int
BS.length ByteString
textBytes
      (Word8
s1, Word8
s2, Word8
s3, Word8
s4) = Int -> (Word8, Word8, Word8, Word8)
intToSyncSafe Int
frameSize
      
  ByteString -> Writer ByteString
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Writer ByteString)
-> ByteString -> Writer ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    ByteString -> Put
putByteString ByteString
frameId       -- Frame ID (4 bytes)
    Word8 -> Put
putWord8 Word8
s1                 -- Frame size as syncsafe integer
    Word8 -> Put
putWord8 Word8
s2
    Word8 -> Put
putWord8 Word8
s3
    Word8 -> Put
putWord8 Word8
s4
    Word16 -> Put
putWord16be Word16
0               -- Frame flags
    ByteString -> Put
putByteString ByteString
textBytes     -- Frame content (encoding byte + UTF-8 text)

-- | Generate APIC frame for album art
generateAPICFrame :: AlbumArt -> Writer L.ByteString
generateAPICFrame :: AlbumArt -> Writer ByteString
generateAPICFrame AlbumArt
art = do
  let mimeBytes :: ByteString
mimeBytes = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ AlbumArt -> Text
albumArtMimeType AlbumArt
art
      descBytes :: ByteString
descBytes = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ AlbumArt -> Text
albumArtDescription AlbumArt
art
      imageData :: ByteString
imageData = AlbumArt -> ByteString
albumArtData AlbumArt
art
      
      -- Calculate frame content size
      frameSize :: Int
frameSize = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
mimeBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
descBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
imageData
      (Word8
s1, Word8
s2, Word8
s3, Word8
s4) = Int -> (Word8, Word8, Word8, Word8)
intToSyncSafe Int
frameSize
      
  ByteString -> Writer ByteString
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Writer ByteString)
-> ByteString -> Writer ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    ByteString -> Put
putByteString ByteString
"APIC"        -- Frame ID
    Word8 -> Put
putWord8 Word8
s1                 -- Frame size as syncsafe integer
    Word8 -> Put
putWord8 Word8
s2
    Word8 -> Put
putWord8 Word8
s3
    Word8 -> Put
putWord8 Word8
s4
    Word16 -> Put
putWord16be Word16
0               -- Frame flags
    Word8 -> Put
putWord8 Word8
0x03                           -- UTF-8 encoding
    ByteString -> Put
putByteString ByteString
mimeBytes                 -- MIME type
    Word8 -> Put
putWord8 Word8
0x00                           -- Null terminator
    Word8 -> Put
putWord8 (AlbumArt -> Word8
albumArtPictureType AlbumArt
art)      -- Picture type
    ByteString -> Put
putByteString ByteString
descBytes                 -- Description
    Word8 -> Put
putWord8 Word8
0x00                           -- Null terminator  
    ByteString -> Put
putByteString ByteString
imageData                 -- Image data

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

  ByteString -> Writer ByteString
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Writer ByteString)
-> ByteString -> Writer ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    ByteString -> Put
putByteString ByteString
"COMM"        -- Frame ID
    Word8 -> Put
putWord8 Word8
s1                 -- Frame size as syncsafe integer
    Word8 -> Put
putWord8 Word8
s2
    Word8 -> Put
putWord8 Word8
s3
    Word8 -> Put
putWord8 Word8
s4
    Word16 -> Put
putWord16be Word16
0               -- Frame flags
    ByteString -> Put
putByteString ByteString
frameContent  -- Frame content

-- | Generate TXXX frame for user-defined text information
generateTXXXFrame :: Text -> Text -> Writer L.ByteString
generateTXXXFrame :: Text -> Text -> Writer ByteString
generateTXXXFrame Text
description Text
text = do
  let descBytes :: ByteString
descBytes = Text -> ByteString
TE.encodeUtf8 Text
description
      textBytes :: ByteString
textBytes = Text -> ByteString
TE.encodeUtf8 Text
text
      -- TXXX structure: encoding + description + null + text value
      frameContent :: ByteString
frameContent = [ByteString] -> ByteString
BS.concat [
        Word8 -> ByteString
BS.singleton Word8
0x03,       -- UTF-8 encoding
        ByteString
descBytes,               -- Description
        Word8 -> ByteString
BS.singleton Word8
0x00,       -- Null terminator
        ByteString
textBytes                -- Text value
        ]
      frameSize :: Int
frameSize = ByteString -> Int
BS.length ByteString
frameContent
      (Word8
s1, Word8
s2, Word8
s3, Word8
s4) = Int -> (Word8, Word8, Word8, Word8)
intToSyncSafe Int
frameSize

  ByteString -> Writer ByteString
forall a. a -> ExceptT WriteError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Writer ByteString)
-> ByteString -> Writer ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
    ByteString -> Put
putByteString ByteString
"TXXX"        -- Frame ID
    Word8 -> Put
putWord8 Word8
s1                 -- Frame size as syncsafe integer
    Word8 -> Put
putWord8 Word8
s2
    Word8 -> Put
putWord8 Word8
s3
    Word8 -> Put
putWord8 Word8
s4
    Word16 -> Put
putWord16be Word16
0               -- Frame flags
    ByteString -> Put
putByteString ByteString
frameContent  -- Frame content