{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}

module Monatone.MP3
  ( parseMP3
  , loadAlbumArtMP3
  ) where

import Control.Applicative ((<|>))
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Except (throwError)
import Data.Binary.Get
import Data.Bits
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as L
import Data.Maybe (fromMaybe)
import Data.Word
import System.IO (Handle, IOMode(..), hSeek, SeekMode(..), hFileSize, hTell)
import System.OsPath
import System.File.OsPath (withBinaryFile)
import qualified Data.HashMap.Strict as HM
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Encoding.Error as TEE

import Monatone.Metadata
import Monatone.Types

-- | ID3v2 signature "ID3" in bytes
id3v2Signature :: BS.ByteString
id3v2Signature :: ByteString
id3v2Signature = ByteString
"ID3"

-- | Parse MP3 file efficiently - only read ID3 tags and frame headers
parseMP3 :: OsPath -> Parser Metadata
parseMP3 :: OsPath -> Parser Metadata
parseMP3 OsPath
filePath = do
  Either ParseError Metadata
result <- IO (Either ParseError Metadata)
-> ExceptT ParseError IO (Either ParseError Metadata)
forall a. IO a -> ExceptT ParseError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ParseError Metadata)
 -> ExceptT ParseError IO (Either ParseError Metadata))
-> IO (Either ParseError Metadata)
-> ExceptT ParseError IO (Either ParseError Metadata)
forall a b. (a -> b) -> a -> b
$ OsPath
-> IOMode
-> (Handle -> IO (Either ParseError Metadata))
-> IO (Either ParseError Metadata)
forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile OsPath
filePath IOMode
ReadMode ((Handle -> IO (Either ParseError Metadata))
 -> IO (Either ParseError Metadata))
-> (Handle -> IO (Either ParseError Metadata))
-> IO (Either ParseError Metadata)
forall a b. (a -> b) -> a -> b
$ \Handle
handle -> do
    -- Parse ID3v2 tag at beginning if present
    Metadata
metadata <- Handle -> Metadata -> IO Metadata
parseID3v2FromHandle Handle
handle (AudioFormat -> Metadata
emptyMetadata AudioFormat
MP3)
    
    -- Parse ID3v1 tag at end if present (last 128 bytes)
    Metadata
metadataWithId3v1 <- Handle -> Metadata -> IO Metadata
parseID3v1FromHandle Handle
handle Metadata
metadata
    
    -- Parse MP3 audio properties from first frame
    AudioProperties
audioProps <- Handle -> IO AudioProperties
parseMP3AudioPropertiesFromHandle Handle
handle
    
    Either ParseError Metadata -> IO (Either ParseError Metadata)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError Metadata -> IO (Either ParseError Metadata))
-> Either ParseError Metadata -> IO (Either ParseError Metadata)
forall a b. (a -> b) -> a -> b
$ Metadata -> Either ParseError Metadata
forall a b. b -> Either a b
Right (Metadata -> Either ParseError Metadata)
-> Metadata -> Either ParseError Metadata
forall a b. (a -> b) -> a -> b
$ Metadata
metadataWithId3v1 { audioProperties = audioProps }
  
  case Either ParseError Metadata
result of
    Left ParseError
err -> ParseError -> Parser Metadata
forall a. ParseError -> ExceptT ParseError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ParseError
err
    Right Metadata
m -> Metadata -> Parser Metadata
forall a. a -> ExceptT ParseError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Metadata
m

-- | Parse ID3v2 tag from file handle if present
parseID3v2FromHandle :: Handle -> Metadata -> IO Metadata
parseID3v2FromHandle :: Handle -> Metadata -> IO Metadata
parseID3v2FromHandle Handle
handle Metadata
metadata = do
  -- Read first 10 bytes (ID3v2 header)
  Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
AbsoluteSeek Integer
0
  ByteString
header <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle Int
10
  
  if ByteString -> Int
BS.length ByteString
header Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 Bool -> Bool -> Bool
|| Int -> ByteString -> ByteString
BS.take Int
3 ByteString
header ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
id3v2Signature
    then Metadata -> IO Metadata
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Metadata
metadata  -- No ID3v2 tag
    else do
      -- Parse header to get tag size
      let version :: Word8
version = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
header Int
3
          _minorVersion :: Word8
_minorVersion = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
header Int
4
          flags :: Word8
flags = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
header Int
5
          -- Size is synchsafe integer (7 bits per byte)
          size :: Word32
size = ByteString -> Word32
parseSynchsafeInt (Int -> ByteString -> ByteString
BS.drop Int
6 ByteString
header)
      
      -- Read only the ID3v2 tag data
      ByteString
tagData <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size)
      
      -- Parse based on version
      Metadata -> IO Metadata
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Metadata -> IO Metadata) -> Metadata -> IO Metadata
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> ByteString -> Metadata -> Metadata
parseID3v2Tag Word8
version Word8
flags ByteString
tagData Metadata
metadata

-- | Parse synchsafe integer (ID3v2 uses 7 bits per byte for sizes)
parseSynchsafeInt :: BS.ByteString -> Word32
parseSynchsafeInt :: ByteString -> Word32
parseSynchsafeInt ByteString
bs =
  case (Word8 -> Word32) -> [Word8] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word8] -> [Word32]) -> [Word8] -> [Word32]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
4 ByteString
bs of
    [Word32
b1, Word32
b2, Word32
b3, Word32
b4] -> (Word32
b1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
21) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
b2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
14) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
b3 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
7) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
b4
    [Word32]
_ -> Word32
0  -- Should not happen with BS.take 4, but handle gracefully

-- | Parse ID3v2 tag data
parseID3v2Tag :: Word8 -> Word8 -> BS.ByteString -> Metadata -> Metadata
parseID3v2Tag :: Word8 -> Word8 -> ByteString -> Metadata -> Metadata
parseID3v2Tag Word8
version Word8
_flags ByteString
tagData Metadata
metadata =
  let frames :: [(Text, Text)]
frames = Word8 -> ByteString -> [(Text, Text)]
parseID3v2Frames Word8
version (ByteString -> ByteString
L.fromStrict ByteString
tagData)
      tagMap :: HashMap Text Text
tagMap = [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(Text, Text)]
frames
      -- Try to find and parse APIC frame for album art info (metadata only, not image data)
      parsedAlbumArtInfo :: Maybe AlbumArtInfo
parsedAlbumArtInfo = Word8 -> ByteString -> Maybe AlbumArtInfo
findAndParseAPICInfo Word8
version (ByteString -> ByteString
L.fromStrict ByteString
tagData)
  in Metadata
metadata
    { title = HM.lookup "TIT2" tagMap <|> HM.lookup "TT2" tagMap
    , artist = HM.lookup "TPE1" tagMap <|> HM.lookup "TP1" tagMap
    , album = HM.lookup "TALB" tagMap <|> HM.lookup "TAL" tagMap
    , albumArtist = HM.lookup "TPE2" tagMap <|> HM.lookup "TP2" tagMap
    , trackNumber = (HM.lookup "TRCK" tagMap <|> HM.lookup "TRK" tagMap) >>= parseTrackNumber
    , year = ((HM.lookup "TYER" tagMap <|> HM.lookup "TYE" tagMap) >>= readInt)
             <|> (HM.lookup "TDRC" tagMap >>= extractYearFromDate)
    , date = HM.lookup "TDRC" tagMap
    , genre = HM.lookup "TCON" tagMap <|> HM.lookup "TCO" tagMap
    , comment = HM.lookup "COMM" tagMap <|> HM.lookup "COM" tagMap <|> HM.lookup "TXXX:comment" tagMap
    , publisher = HM.lookup "TPUB" tagMap
    , recordLabel = HM.lookup "TXXX:LABEL" tagMap <|> HM.lookup "TPUB" tagMap
    , catalogNumber = HM.lookup "TXXX:CATALOGNUMBER" tagMap
    , barcode = HM.lookup "TXXX:BARCODE" tagMap
    , releaseCountry = HM.lookup "TXXX:MusicBrainz Album Release Country" tagMap
    , releaseStatus = HM.lookup "TXXX:MusicBrainz Album Status" tagMap
    , releaseType = HM.lookup "TXXX:MusicBrainz Album Type" tagMap
    , albumArtInfo = parsedAlbumArtInfo
    , musicBrainzIds = extractMusicBrainzIds tagMap
    , acoustidFingerprint = extractAcoustidFingerprint tagMap
    , acoustidId = extractAcoustidId tagMap
    , rawTags = tagMap  -- Populate rawTags with all parsed frames
    }
  where
    parseTrackNumber :: Text -> Maybe Int
parseTrackNumber Text
t = case (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
t of
      (Text
n:[Text]
_) -> Text -> Maybe Int
readInt Text
n
      [Text]
_ -> Maybe Int
forall a. Maybe a
Nothing
    extractMusicBrainzIds :: HashMap k Text -> MusicBrainzIds
extractMusicBrainzIds HashMap k Text
tags = MusicBrainzIds
      { mbTrackId :: Maybe Text
mbTrackId = k -> HashMap k Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
"UFID:http://musicbrainz.org" HashMap k Text
tags
      , mbRecordingId :: Maybe Text
mbRecordingId = k -> HashMap k Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
"TXXX:MusicBrainz Recording Id" HashMap k Text
tags
      , mbReleaseId :: Maybe Text
mbReleaseId = k -> HashMap k Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
"TXXX:MusicBrainz Album Id" HashMap k Text
tags
      , mbReleaseGroupId :: Maybe Text
mbReleaseGroupId = k -> HashMap k Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
"TXXX:MusicBrainz Release Group Id" HashMap k Text
tags
      , mbArtistId :: Maybe Text
mbArtistId = k -> HashMap k Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
"TXXX:MusicBrainz Artist Id" HashMap k Text
tags
      , mbAlbumArtistId :: Maybe Text
mbAlbumArtistId = k -> HashMap k Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
"TXXX:MusicBrainz Album Artist Id" HashMap k Text
tags
      , mbWorkId :: Maybe Text
mbWorkId = k -> HashMap k Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
"TXXX:MusicBrainz Work Id" HashMap k Text
tags
      , mbDiscId :: Maybe Text
mbDiscId = k -> HashMap k Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
"TXXX:MusicBrainz Disc Id" HashMap k Text
tags
      }
    extractAcoustidFingerprint :: HashMap k a -> Maybe a
extractAcoustidFingerprint HashMap k a
tags = 
      k -> HashMap k a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
"TXXX:Acoustid Fingerprint" HashMap k a
tags Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      k -> HashMap k a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
"TXXX:ACOUSTID_FINGERPRINT" HashMap k a
tags Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      k -> HashMap k a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
"TXXX:acoustid_fingerprint" HashMap k a
tags
    extractAcoustidId :: HashMap k a -> Maybe a
extractAcoustidId HashMap k a
tags =
      k -> HashMap k a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
"TXXX:Acoustid Id" HashMap k a
tags Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      k -> HashMap k a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
"TXXX:ACOUSTID_ID" HashMap k a
tags Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      k -> HashMap k a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
"TXXX:acoustid_id" HashMap k a
tags

-- | Parse ID3v2 frames
parseID3v2Frames :: Word8 -> L.ByteString -> [(Text, Text)]
parseID3v2Frames :: Word8 -> ByteString -> [(Text, Text)]
parseID3v2Frames Word8
version ByteString
bs
  | Word8
version Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
2 = ByteString -> [(Text, Text)]
parseID3v22Frames ByteString
bs  -- 3-char frame IDs
  | Word8
version Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
3 = Word8 -> ByteString -> [(Text, Text)]
parseID3v23Frames Word8
version ByteString
bs  -- 4-char frame IDs
  | Bool
otherwise = []

-- | Parse ID3v2.2 frames (3-character IDs)
parseID3v22Frames :: L.ByteString -> [(Text, Text)]
parseID3v22Frames :: ByteString -> [(Text, Text)]
parseID3v22Frames ByteString
bs
  | ByteString -> Int64
L.length ByteString
bs Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
6 = []
  | Bool
otherwise = 
      case Get (Maybe (Text, Text))
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, Maybe (Text, Text))
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail Get (Maybe (Text, Text))
parseID3v22Frame ByteString
bs of
        Left (ByteString, Int64, String)
_ -> []
        Right (ByteString
rest, Int64
_, Maybe (Text, Text)
Nothing) ->
          ByteString -> [(Text, Text)]
parseID3v22Frames ByteString
rest  -- Skip and continue
        Right (ByteString
rest, Int64
_, Just (Text, Text)
frame) ->
          (Text, Text)
frame (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: ByteString -> [(Text, Text)]
parseID3v22Frames ByteString
rest

parseID3v22Frame :: Get (Maybe (Text, Text))
parseID3v22Frame :: Get (Maybe (Text, Text))
parseID3v22Frame = do
  ByteString
frameId <- Int -> Get ByteString
getByteString Int
3
  -- Check for padding
  if (Word8 -> Bool) -> ByteString -> Bool
BS.all (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
frameId
    then String -> Get (Maybe (Text, Text))
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Padding reached"
    else do
      -- 24-bit size (big-endian)
      Word8
sizeByte1 <- Get Word8
getWord8
      Word8
sizeByte2 <- Get Word8
getWord8
      Word8
sizeByte3 <- Get Word8
getWord8
      let frameSize :: Word32
frameSize = ((Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
sizeByte1 :: Word32) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                      ((Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
sizeByte2 :: Word32) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                      (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
sizeByte3 :: Word32)
      
      ByteString
frameData <- Int -> Get ByteString
getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
frameSize)
      -- Skip PIC frames (ID3v2.2 version of APIC)
      if ByteString
frameId ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"PIC"
        then Maybe (Text, Text) -> Get (Maybe (Text, Text))
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Text, Text)
forall a. Maybe a
Nothing
        else do
          let frameIdText :: Text
frameIdText = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode ByteString
frameId
          let frameValue :: Text
frameValue = 
                if ByteString
frameId ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"COM"
                then ByteString -> Text
parseCOMMFrame ByteString
frameData
                else if ByteString
frameId ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"TXX"
                then (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> (Text, Text)
parseTXXXFrame ByteString
frameData  -- v2.2 doesn't have description prefix
                else if ByteString
frameId ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"ULT"
                then ByteString -> Text
parseUSLTFrame ByteString
frameData
                else ByteString -> Text
parseFrameContent ByteString
frameData
          Maybe (Text, Text) -> Get (Maybe (Text, Text))
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Text, Text) -> Get (Maybe (Text, Text)))
-> Maybe (Text, Text) -> Get (Maybe (Text, Text))
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
frameIdText, Text
frameValue)

-- | Parse ID3v2.3+ frames (4-character IDs)
parseID3v23Frames :: Word8 -> L.ByteString -> [(Text, Text)]
parseID3v23Frames :: Word8 -> ByteString -> [(Text, Text)]
parseID3v23Frames Word8
version ByteString
bs
  | ByteString -> Int64
L.length ByteString
bs Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
10 = []
  | Bool
otherwise =
      case Get (Maybe (Text, Text))
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, Maybe (Text, Text))
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail (Word8 -> Get (Maybe (Text, Text))
parseID3v23Frame Word8
version) ByteString
bs of
        Left (ByteString, Int64, String)
_ -> []
        Right (ByteString
rest, Int64
_, Maybe (Text, Text)
Nothing) ->
          -- Frame was skipped (e.g., APIC), continue with the rest
          Word8 -> ByteString -> [(Text, Text)]
parseID3v23Frames Word8
version ByteString
rest
        Right (ByteString
rest, Int64
_, Just (Text, Text)
frame) ->
          (Text, Text)
frame (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: Word8 -> ByteString -> [(Text, Text)]
parseID3v23Frames Word8
version ByteString
rest

parseID3v23Frame :: Word8 -> Get (Maybe (Text, Text))
parseID3v23Frame :: Word8 -> Get (Maybe (Text, Text))
parseID3v23Frame Word8
version = do
  ByteString
frameId <- Int -> Get ByteString
getByteString Int
4
  -- Check for padding
  if (Word8 -> Bool) -> ByteString -> Bool
BS.all (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
frameId
    then String -> Get (Maybe (Text, Text))
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Padding reached"
    else do
      -- Frame size (synchsafe for v2.4, normal for v2.3)
      Word32
frameSize <- if Word8
version Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
4
        then do
          Word8
b1 <- Get Word8
getWord8
          Word8
b2 <- Get Word8
getWord8
          Word8
b3 <- Get Word8
getWord8
          Word8
b4 <- Get Word8
getWord8
          Word32 -> Get Word32
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Get Word32) -> Word32 -> Get Word32
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
21) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                   (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
14) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                   (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b3 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
7) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                   Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b4
        else Get Word32
getWord32be
      
      Word16
_ <- Get Word16
getWord16be  -- frameFlags
      ByteString
frameData <- Int -> Get ByteString
getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
frameSize)
      
      -- Skip APIC frames in this text-only parser
      if ByteString
frameId ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"APIC"
        then Maybe (Text, Text) -> Get (Maybe (Text, Text))
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Text, Text)
forall a. Maybe a
Nothing  -- Skip picture frames but continue parsing
        else do
          let frameIdText :: Text
frameIdText = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode ByteString
frameId
          let (Text
finalId, Text
frameValue) = 
                if ByteString
frameId ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"COMM" Bool -> Bool -> Bool
|| ByteString
frameId ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"COM"
                then (Text
frameIdText, ByteString -> Text
parseCOMMFrame ByteString
frameData)
                else if ByteString
frameId ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"TXXX"
                then ByteString -> (Text, Text)
parseTXXXFrame ByteString
frameData
                else if ByteString
frameId ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"USLT"  -- Add support for lyrics
                then (Text
frameIdText, ByteString -> Text
parseUSLTFrame ByteString
frameData)
                else (Text
frameIdText, ByteString -> Text
parseFrameContent ByteString
frameData)
          Maybe (Text, Text) -> Get (Maybe (Text, Text))
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Text, Text) -> Get (Maybe (Text, Text)))
-> Maybe (Text, Text) -> Get (Maybe (Text, Text))
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
finalId, Text
frameValue)

-- | Parse frame content (simplified - handles text frames)
parseFrameContent :: BS.ByteString -> Text
parseFrameContent :: ByteString -> Text
parseFrameContent ByteString
bs
  | ByteString -> Bool
BS.null ByteString
bs = Text
""
  | Bool
otherwise = 
      let encoding :: Word8
encoding = HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.head ByteString
bs
          content :: ByteString
content = HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BS.tail ByteString
bs
      in (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\0') (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ case Word8
encoding of  -- Strip null terminators after decoding
        Word8
0 -> -- ISO-8859-1: treat as Latin-1
          ByteString -> Text
TE.decodeLatin1 ByteString
content
        Word8
1 -> -- UTF-16 with BOM
          ByteString -> Text
decodeUtf16 ByteString
content
        Word8
2 -> -- UTF-16BE without BOM
          OnDecodeError -> ByteString -> Text
TE.decodeUtf16BEWith OnDecodeError
TEE.lenientDecode ByteString
content
        Word8
3 -> -- UTF-8
          OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode ByteString
content
        Word8
_ -> -- Unknown, try UTF-8
          OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode ByteString
content
  where
    decodeUtf16 :: ByteString -> Text
decodeUtf16 ByteString
bytes = 
      -- Check for BOM and decode accordingly
      if ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
        then case (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bytes Int
0, HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bytes Int
1) of
          (Word8
0xFF, Word8
0xFE) -> OnDecodeError -> ByteString -> Text
TE.decodeUtf16LEWith OnDecodeError
TEE.lenientDecode (Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
bytes)
          (Word8
0xFE, Word8
0xFF) -> OnDecodeError -> ByteString -> Text
TE.decodeUtf16BEWith OnDecodeError
TEE.lenientDecode (Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
bytes)
          (Word8, Word8)
_ -> OnDecodeError -> ByteString -> Text
TE.decodeUtf16LEWith OnDecodeError
TEE.lenientDecode ByteString
bytes
        else Text
""
    _decodeUtf16BE :: ByteString -> Text
_decodeUtf16BE = OnDecodeError -> ByteString -> Text
TE.decodeUtf16BEWith OnDecodeError
TEE.lenientDecode

-- | Parse COMM (comment) frame which has special structure
parseCOMMFrame :: BS.ByteString -> Text
parseCOMMFrame :: ByteString -> Text
parseCOMMFrame ByteString
bs
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5 = Text
""  -- Need at least encoding + language (3) + content
  | Bool
otherwise = 
      let encoding :: Word8
encoding = HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.head ByteString
bs
          rest :: ByteString
rest = Int -> ByteString -> ByteString
BS.drop Int
4 ByteString
bs  -- Skip encoding + 3-byte language code
          -- Find the null terminator after the short description
          (ByteString
_description, ByteString
afterDesc) = case Word8
encoding of
            Word8
1 -> ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
"\0\0" ByteString
rest  -- UTF-16 uses double null
            Word8
2 -> ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
"\0\0" ByteString
rest  -- UTF-16BE uses double null
            Word8
_ -> ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
"\0" ByteString
rest     -- ISO-8859-1 and UTF-8 use single null
          -- Skip the description and null terminator(s)
          content :: ByteString
content = case Word8
encoding of
            Word8
1 -> if ByteString -> Bool
BS.null ByteString
afterDesc then ByteString
BS.empty else Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
afterDesc  -- Skip \0\0
            Word8
2 -> if ByteString -> Bool
BS.null ByteString
afterDesc then ByteString
BS.empty else Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
afterDesc  -- Skip \0\0
            Word8
_ -> if ByteString -> Bool
BS.null ByteString
afterDesc then ByteString
BS.empty else Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
afterDesc  -- Skip \0
          -- Decode the actual comment text
      in case Word8
encoding of
        Word8
0 -> ByteString -> Text
TE.decodeLatin1 ByteString
content  -- ISO-8859-1 (Latin-1)
        Word8
1 -> ByteString -> Text
decodeUtf16 ByteString
content  -- UTF-16 with BOM
        Word8
2 -> OnDecodeError -> ByteString -> Text
TE.decodeUtf16BEWith OnDecodeError
TEE.lenientDecode ByteString
content  -- UTF-16BE
        Word8
3 -> OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode ByteString
content  -- UTF-8
        Word8
_ -> OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode ByteString
content
  where
    decodeUtf16 :: ByteString -> Text
decodeUtf16 ByteString
content = 
      if ByteString -> Int
BS.length ByteString
content Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
        then case (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
content Int
0, HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
content Int
1) of
          (Word8
0xFF, Word8
0xFE) -> OnDecodeError -> ByteString -> Text
TE.decodeUtf16LEWith OnDecodeError
TEE.lenientDecode (Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
content)
          (Word8
0xFE, Word8
0xFF) -> OnDecodeError -> ByteString -> Text
TE.decodeUtf16BEWith OnDecodeError
TEE.lenientDecode (Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
content)
          (Word8, Word8)
_ -> OnDecodeError -> ByteString -> Text
TE.decodeUtf16LEWith OnDecodeError
TEE.lenientDecode ByteString
content
        else Text
""

-- | Parse TXXX frame (user-defined text information frame)
-- Returns (frameId with description, value)
parseTXXXFrame :: BS.ByteString -> (Text, Text)
parseTXXXFrame :: ByteString -> (Text, Text)
parseTXXXFrame ByteString
bs
  | ByteString -> Bool
BS.null ByteString
bs = (Text
"TXXX", Text
"")
  | Bool
otherwise = 
      let encoding :: Word8
encoding = HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.head ByteString
bs
          rest :: ByteString
rest = HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BS.tail ByteString
bs
          -- Find the null terminator after the description
          (ByteString
descBytes, ByteString
afterDesc) = case Word8
encoding of
            Word8
1 -> ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
"\0\0" ByteString
rest  -- UTF-16 uses double null
            Word8
2 -> ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
"\0\0" ByteString
rest  -- UTF-16BE uses double null
            Word8
_ -> ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
"\0" ByteString
rest     -- ISO-8859-1 and UTF-8 use single null
          -- Skip the description and null terminator(s)
          valueBytes :: ByteString
valueBytes = case Word8
encoding of
            Word8
1 -> if ByteString -> Bool
BS.null ByteString
afterDesc then ByteString
BS.empty else Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
afterDesc  -- Skip \0\0
            Word8
2 -> if ByteString -> Bool
BS.null ByteString
afterDesc then ByteString
BS.empty else Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
afterDesc  -- Skip \0\0
            Word8
_ -> if ByteString -> Bool
BS.null ByteString
afterDesc then ByteString
BS.empty else Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
afterDesc  -- Skip \0
          -- Decode both description and value
          description :: Text
description = (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\0') (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> Text
forall {a}. (Eq a, Num a) => a -> ByteString -> Text
decodeByEncoding Word8
encoding ByteString
descBytes
          value :: Text
value = (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\0') (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> Text
forall {a}. (Eq a, Num a) => a -> ByteString -> Text
decodeByEncoding Word8
encoding ByteString
valueBytes
          frameId :: Text
frameId = if Text -> Bool
T.null Text
description then Text
"TXXX" else Text
"TXXX:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
description
      in (Text
frameId, Text
value)
  where
    decodeByEncoding :: a -> ByteString -> Text
decodeByEncoding a
0 ByteString
bytes = ByteString -> Text
TE.decodeLatin1 ByteString
bytes  -- ISO-8859-1
    decodeByEncoding a
1 ByteString
bytes = ByteString -> Text
decodeUtf16 ByteString
bytes  -- UTF-16 with BOM
    decodeByEncoding a
2 ByteString
bytes = OnDecodeError -> ByteString -> Text
TE.decodeUtf16BEWith OnDecodeError
TEE.lenientDecode ByteString
bytes  -- UTF-16BE
    decodeByEncoding a
3 ByteString
bytes = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode ByteString
bytes  -- UTF-8
    decodeByEncoding a
_ ByteString
bytes = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode ByteString
bytes
    
    decodeUtf16 :: ByteString -> Text
decodeUtf16 ByteString
bytes = 
      if ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
        then case (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bytes Int
0, HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bytes Int
1) of
          (Word8
0xFF, Word8
0xFE) -> OnDecodeError -> ByteString -> Text
TE.decodeUtf16LEWith OnDecodeError
TEE.lenientDecode (Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
bytes)
          (Word8
0xFE, Word8
0xFF) -> OnDecodeError -> ByteString -> Text
TE.decodeUtf16BEWith OnDecodeError
TEE.lenientDecode (Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
bytes)
          (Word8, Word8)
_ -> OnDecodeError -> ByteString -> Text
TE.decodeUtf16LEWith OnDecodeError
TEE.lenientDecode ByteString
bytes
        else Text
""

-- | Parse USLT frame (unsynchronized lyrics/text transcription)
parseUSLTFrame :: BS.ByteString -> Text
parseUSLTFrame :: ByteString -> Text
parseUSLTFrame ByteString
bs
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5 = Text
""  -- Need at least encoding + language (3) + content
  | Bool
otherwise = 
      let encoding :: Word8
encoding = HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.head ByteString
bs
          rest :: ByteString
rest = Int -> ByteString -> ByteString
BS.drop Int
4 ByteString
bs  -- Skip encoding + 3-byte language code
          -- Find the null terminator after the content descriptor
          (ByteString
_, ByteString
afterDesc) = case Word8
encoding of
            Word8
1 -> ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
"\0\0" ByteString
rest  -- UTF-16 uses double null
            Word8
2 -> ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
"\0\0" ByteString
rest  -- UTF-16BE uses double null
            Word8
_ -> ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
"\0" ByteString
rest     -- ISO-8859-1 and UTF-8 use single null
          -- Skip the descriptor and null terminator(s)
          lyricsBytes :: ByteString
lyricsBytes = case Word8
encoding of
            Word8
1 -> if ByteString -> Bool
BS.null ByteString
afterDesc then ByteString
BS.empty else Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
afterDesc  -- Skip \0\0
            Word8
2 -> if ByteString -> Bool
BS.null ByteString
afterDesc then ByteString
BS.empty else Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
afterDesc  -- Skip \0\0
            Word8
_ -> if ByteString -> Bool
BS.null ByteString
afterDesc then ByteString
BS.empty else Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
afterDesc  -- Skip \0
          -- Decode lyrics
      in (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\0') (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> Text
forall {a}. (Eq a, Num a) => a -> ByteString -> Text
decodeByEncoding Word8
encoding ByteString
lyricsBytes
  where
    decodeByEncoding :: a -> ByteString -> Text
decodeByEncoding a
0 ByteString
bytes = ByteString -> Text
TE.decodeLatin1 ByteString
bytes
    decodeByEncoding a
1 ByteString
bytes = ByteString -> Text
decodeUtf16 ByteString
bytes 
    decodeByEncoding a
2 ByteString
bytes = OnDecodeError -> ByteString -> Text
TE.decodeUtf16BEWith OnDecodeError
TEE.lenientDecode ByteString
bytes
    decodeByEncoding a
3 ByteString
bytes = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode ByteString
bytes
    decodeByEncoding a
_ ByteString
bytes = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode ByteString
bytes
    
    decodeUtf16 :: ByteString -> Text
decodeUtf16 ByteString
bytes = 
      if ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
        then case (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bytes Int
0, HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bytes Int
1) of
          (Word8
0xFF, Word8
0xFE) -> OnDecodeError -> ByteString -> Text
TE.decodeUtf16LEWith OnDecodeError
TEE.lenientDecode (Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
bytes)
          (Word8
0xFE, Word8
0xFF) -> OnDecodeError -> ByteString -> Text
TE.decodeUtf16BEWith OnDecodeError
TEE.lenientDecode (Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
bytes)
          (Word8, Word8)
_ -> OnDecodeError -> ByteString -> Text
TE.decodeUtf16LEWith OnDecodeError
TEE.lenientDecode ByteString
bytes
        else Text
""

-- | Parse ID3v1 tag from file handle if present
parseID3v1FromHandle :: Handle -> Metadata -> IO Metadata
parseID3v1FromHandle :: Handle -> Metadata -> IO Metadata
parseID3v1FromHandle Handle
handle Metadata
metadata = do
  Integer
fileSize <- Handle -> IO Integer
hFileSize Handle
handle
  if Integer
fileSize Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
128
    then do
      Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
AbsoluteSeek (Integer
fileSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
128)
      ByteString
id3v1Data <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle Int
128
      if Int -> ByteString -> ByteString
BS.take Int
3 ByteString
id3v1Data ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"TAG"
        then Metadata -> IO Metadata
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Metadata -> IO Metadata) -> Metadata -> IO Metadata
forall a b. (a -> b) -> a -> b
$ ByteString -> Metadata -> Metadata
parseID3v1Tag ByteString
id3v1Data Metadata
metadata
        else Metadata -> IO Metadata
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Metadata
metadata
    else Metadata -> IO Metadata
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Metadata
metadata

-- | Parse ID3v1 tag
parseID3v1Tag :: BS.ByteString -> Metadata -> Metadata
parseID3v1Tag :: ByteString -> Metadata -> Metadata
parseID3v1Tag ByteString
bs Metadata
metadata = Metadata
metadata
  { title = title metadata <|> parseID3v1Field bs 3 30
  , artist = artist metadata <|> parseID3v1Field bs 33 30
  , album = album metadata <|> parseID3v1Field bs 63 30
  , year = year metadata <|> (parseID3v1Field bs 93 4 >>= readInt)
  , comment = comment metadata <|> parseID3v1Field bs 97 28
  , trackNumber = trackNumber metadata <|>
      if BS.index bs 125 == 0 && BS.index bs 126 /= 0
      then Just (fromIntegral $ BS.index bs 126)
      else Nothing
  }
  where
    parseID3v1Field :: ByteString -> Int -> Int -> Maybe Text
parseID3v1Field ByteString
bytes Int
offset Int
len =
      let field :: ByteString
field = Int -> ByteString -> ByteString
BS.take Int
len (Int -> ByteString -> ByteString
BS.drop Int
offset ByteString
bytes)
          cleaned :: ByteString
cleaned = (Word8 -> Bool) -> ByteString -> ByteString
BS.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) ByteString
field
      in if ByteString -> Bool
BS.null ByteString
cleaned
         then Maybe Text
forall a. Maybe a
Nothing
         else Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode ByteString
cleaned

-- | Parse MP3 audio properties from file handle
parseMP3AudioPropertiesFromHandle :: Handle -> IO AudioProperties
parseMP3AudioPropertiesFromHandle :: Handle -> IO AudioProperties
parseMP3AudioPropertiesFromHandle Handle
handle = do
  -- Skip ID3v2 tag if present
  Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
AbsoluteSeek Integer
0
  Integer
startPos <- Handle -> IO Integer
skipID3v2 Handle
handle
  
  -- Get file size for duration calculation
  Integer
fileSize <- Handle -> IO Integer
hFileSize Handle
handle
  
  -- Seek to where audio should start
  Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
AbsoluteSeek Integer
startPos
  
  -- Search for MP3 frame sync within first 1MB (like mutagen)
  Maybe ByteString
frameHeader <- Handle -> Int -> IO (Maybe ByteString)
findMP3FrameSync Handle
handle (Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024)
  
  case Maybe ByteString
frameHeader of
    Just ByteString
header -> do
      -- Parse basic frame info
      let props :: AudioProperties
props = ByteString -> AudioProperties
parseMP3FrameHeader ByteString
header
      -- Try to find VBR headers (Xing/Info or VBRI)
      Integer
currentPos <- Handle -> IO Integer
hTell Handle
handle
      Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
AbsoluteSeek (Integer
currentPos Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
4)  -- Go back to frame start
      AudioProperties
vbrProps <- Handle -> AudioProperties -> IO AudioProperties
parseVBRHeaders Handle
handle AudioProperties
props
      
      -- If no duration calculated yet (CBR file), calculate from file size and bitrate
      let finalProps :: AudioProperties
finalProps = case (AudioProperties -> Maybe Int
duration AudioProperties
vbrProps, AudioProperties -> Maybe Int
bitrate AudioProperties
vbrProps) of
            (Maybe Int
Nothing, Just Int
br) | Int
br Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> 
              let audioSize :: Integer
audioSize = Integer
fileSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
startPos  -- Exclude ID3 tags
                  durationSecs :: Double
durationSecs = (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
audioSize Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
8) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
br Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000) :: Double
                  durationMs :: Int
durationMs = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
durationSecs Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000) :: Int
              in AudioProperties
vbrProps { duration = Just durationMs }
            (Maybe Int, Maybe Int)
_ -> AudioProperties
vbrProps
      
      AudioProperties -> IO AudioProperties
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AudioProperties
finalProps
    Maybe ByteString
Nothing -> AudioProperties -> IO AudioProperties
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AudioProperties
emptyAudioProperties

-- | Skip ID3v2 tag and return position after it
skipID3v2 :: Handle -> IO Integer
skipID3v2 :: Handle -> IO Integer
skipID3v2 Handle
handle = do
  ByteString
header <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle Int
10
  if ByteString -> Int
BS.length ByteString
header Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 Bool -> Bool -> Bool
|| Int -> ByteString -> ByteString
BS.take Int
3 ByteString
header ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"ID3"
    then Integer -> IO Integer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
    else do
      let size :: Word32
size = ByteString -> Word32
parseSynchsafeInt (Int -> ByteString -> ByteString
BS.drop Int
6 ByteString
header)
      Integer -> IO Integer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> IO Integer) -> Integer -> IO Integer
forall a b. (a -> b) -> a -> b
$ Integer
10 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size

-- | Find MP3 frame sync
findMP3FrameSync :: Handle -> Int -> IO (Maybe BS.ByteString)
findMP3FrameSync :: Handle -> Int -> IO (Maybe ByteString)
findMP3FrameSync Handle
handle Int
maxBytes = Int -> IO (Maybe ByteString)
searchSync Int
0
  where
    searchSync :: Int -> IO (Maybe ByteString)
searchSync Int
bytesRead'
      | Int
bytesRead' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxBytes = Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
      | Bool
otherwise = do
          ByteString
chunk <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
4096 (Int
maxBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bytesRead'))
          if ByteString -> Bool
BS.null ByteString
chunk
            then Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
            else case ByteString -> Maybe Int
findSync ByteString
chunk of
              Just Int
pos -> do
                Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
RelativeSeek (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pos Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
chunk))
                ByteString
header <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle Int
4
                Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
header
              Maybe Int
Nothing -> Int -> IO (Maybe ByteString)
searchSync (Int
bytesRead' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
chunk)
    
    findSync :: ByteString -> Maybe Int
findSync ByteString
bs = 
      let indices :: [Int]
indices = [Int
i | Int
i <- [Int
0..ByteString -> Int
BS.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2]
                       , HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
i Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xFF
                       , (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xE0) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xE0]
      in case [Int]
indices of
        (Int
i:[Int]
_) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
        [Int]
_ -> Maybe Int
forall a. Maybe a
Nothing

-- | Parse MP3 frame header
parseMP3FrameHeader :: BS.ByteString -> AudioProperties
parseMP3FrameHeader :: ByteString -> AudioProperties
parseMP3FrameHeader ByteString
header =
  let byte2 :: Word8
byte2 = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
header Int
1
      versionBits :: Word8
versionBits = (Word8
byte2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
3) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x03
      layerBits :: Word8
layerBits = (Word8
byte2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x03
      
      byte3 :: Word8
byte3 = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
header Int
2
      bitrateBits :: Word8
bitrateBits = (Word8
byte3 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0F
      sampleRateBits :: Word8
sampleRateBits = (Word8
byte3 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x03
      _paddingBit :: Word8
_paddingBit = (Word8
byte3 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x01
      
      byte4 :: Word8
byte4 = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
header Int
3
      channelMode :: Word8
channelMode = (Word8
byte4 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x03
      
      -- Determine MPEG version
      version :: Double
version = case Word8
versionBits of
        Word8
0 -> Double
2.5 :: Double  -- MPEG 2.5
        Word8
2 -> Double
2    -- MPEG 2
        Word8
3 -> Double
1    -- MPEG 1
        Word8
_ -> Double
1    -- Invalid, default to 1
      
      -- Determine layer
      layer :: Int
layer = case Word8
layerBits of
        Word8
1 -> Int
3 :: Int -- Layer III
        Word8
2 -> Int
2  -- Layer II
        Word8
3 -> Int
1  -- Layer I
        Word8
_ -> Int
0  -- Invalid
      
      -- Look up sample rate
      sampleRate' :: Int
sampleRate' = case (Word8
versionBits, Word8
sampleRateBits) of
        (Word8
0, Word8
0) -> Int
11025  -- MPEG 2.5
        (Word8
0, Word8
1) -> Int
12000
        (Word8
0, Word8
2) -> Int
8000
        (Word8
2, Word8
0) -> Int
22050  -- MPEG 2
        (Word8
2, Word8
1) -> Int
24000
        (Word8
2, Word8
2) -> Int
16000
        (Word8
3, Word8
0) -> Int
44100  -- MPEG 1
        (Word8
3, Word8
1) -> Int
48000
        (Word8
3, Word8
2) -> Int
32000
        (Word8, Word8)
_ -> Int
44100
      
      -- Look up bitrate (in kbps)
      -- This is for Layer III (MP3)
      bitrate' :: Int
bitrate' = if Int
layer Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 Bool -> Bool -> Bool
&& Word8
bitrateBits Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0 Bool -> Bool -> Bool
&& Word8
bitrateBits Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
15
        then case Double
version of
          Double
1 -> [Int
0, Int
32, Int
40, Int
48, Int
56, Int
64, Int
80, Int
96, Int
112, Int
128, Int
160, Int
192, Int
224, Int
256, Int
320, Int
0] [Int] -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
bitrateBits
          Double
_ -> [Int
0, Int
8, Int
16, Int
24, Int
32, Int
40, Int
48, Int
56, Int
64, Int
80, Int
96, Int
112, Int
128, Int
144, Int
160, Int
0] [Int] -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
bitrateBits
        else Int
0  -- Free bitrate or invalid
      
      channels' :: Int
channels' = if Word8
channelMode Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
3 then Int
1 else Int
2
      
  in AudioProperties
emptyAudioProperties
    { sampleRate = Just sampleRate'
    , channels = Just channels'
    , bitrate = if bitrate' > 0 then Just bitrate' else Nothing
    }

-- | Parse VBR headers (Xing/Info or VBRI)
parseVBRHeaders :: Handle -> AudioProperties -> IO AudioProperties
parseVBRHeaders :: Handle -> AudioProperties -> IO AudioProperties
parseVBRHeaders Handle
handle AudioProperties
props = do
  -- Read frame header + side info
  ByteString
frameData <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle Int
200  -- Should be enough for frame header + VBR headers
  
  if ByteString -> Int
BS.length ByteString
frameData Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
40
    then AudioProperties -> IO AudioProperties
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AudioProperties
props
    else do
      -- Check for Xing/Info header (usually at offset 36 for stereo, 21 for mono)
      let numChannels :: Int
numChannels = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
2 (AudioProperties -> Maybe Int
channels AudioProperties
props)
          xingOffset :: Int
xingOffset = if Int
numChannels Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Int
21 else Int
36
      
      if ByteString -> Int
BS.length ByteString
frameData Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
xingOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12
        then do
          let xingHeader :: ByteString
xingHeader = Int -> ByteString -> ByteString
BS.take Int
4 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
xingOffset ByteString
frameData
          if ByteString
xingHeader ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString
"Xing", ByteString
"Info"]
            then ByteString -> AudioProperties -> Handle -> IO AudioProperties
parseXingHeader (Int -> ByteString -> ByteString
BS.drop (Int
xingOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) ByteString
frameData) AudioProperties
props Handle
handle
            else
              -- Check for VBRI header (always at offset 36)
              if ByteString -> Int
BS.length ByteString
frameData Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
36 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
26
                then do
                  let vbriHeader :: ByteString
vbriHeader = Int -> ByteString -> ByteString
BS.take Int
4 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
36 ByteString
frameData
                  if ByteString
vbriHeader ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"VBRI"
                    then ByteString -> AudioProperties -> Handle -> IO AudioProperties
parseVBRIHeader (Int -> ByteString -> ByteString
BS.drop Int
40 ByteString
frameData) AudioProperties
props Handle
handle
                    else AudioProperties -> IO AudioProperties
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AudioProperties
props
                else AudioProperties -> IO AudioProperties
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AudioProperties
props
        else AudioProperties -> IO AudioProperties
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AudioProperties
props

-- | Parse Xing/Info VBR header
parseXingHeader :: BS.ByteString -> AudioProperties -> Handle -> IO AudioProperties
parseXingHeader :: ByteString -> AudioProperties -> Handle -> IO AudioProperties
parseXingHeader ByteString
bs AudioProperties
props Handle
_handle = do
  if ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8
    then AudioProperties -> IO AudioProperties
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AudioProperties
props
    else do
      let flags :: Word32
flags = Get Word32 -> ByteString -> Word32
forall a. Get a -> ByteString -> a
runGet Get Word32
getWord32be (ByteString -> ByteString
L.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
4 ByteString
bs)
          hasFrames :: Bool
hasFrames = (Word32
flags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x01) Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0
          hasBytes :: Bool
hasBytes = (Word32
flags Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x02) Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0
          
      -- Parse frame count and byte count if present
      let offset1 :: Int
offset1 = Int
4
          (Maybe Word32
frameCount, Int
offset2) = if Bool
hasFrames
            then (Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> Maybe Word32) -> Word32 -> Maybe Word32
forall a b. (a -> b) -> a -> b
$ Get Word32 -> ByteString -> Word32
forall a. Get a -> ByteString -> a
runGet Get Word32
getWord32be (ByteString -> ByteString
L.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
4 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
offset1 ByteString
bs), Int
offset1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
            else (Maybe Word32
forall a. Maybe a
Nothing, Int
offset1)
          (Maybe Word32
byteCount, Int
_) = if Bool
hasBytes
            then (Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> Maybe Word32) -> Word32 -> Maybe Word32
forall a b. (a -> b) -> a -> b
$ Get Word32 -> ByteString -> Word32
forall a. Get a -> ByteString -> a
runGet Get Word32
getWord32be (ByteString -> ByteString
L.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
4 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
offset2 ByteString
bs), Int
offset2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
            else (Maybe Word32
forall a. Maybe a
Nothing, Int
offset2)
      
      -- Calculate average bitrate and duration for VBR
      case (Maybe Word32
frameCount, Maybe Word32
byteCount, AudioProperties -> Maybe Int
sampleRate AudioProperties
props) of
        (Just Word32
frames, Just Word32
bytes, Just Int
sr) -> do
          -- MP3 frame is 1152 samples for Layer III
          let durationSecs :: Double
durationSecs = (Word32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
frames Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1152) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sr :: Double
              durationMs :: Int
durationMs = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
durationSecs Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000) :: Int  -- Convert to milliseconds
              avgBitrate :: Int
avgBitrate = if Double
durationSecs Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0
                then Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ (Word32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
bytes Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
8) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
durationSecs Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000
                else Int
0
          AudioProperties -> IO AudioProperties
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AudioProperties
props { bitrate = if avgBitrate > 0 then Just avgBitrate else bitrate props
                       , duration = if durationMs > 0 then Just durationMs else duration props }
        (Maybe Word32, Maybe Word32, Maybe Int)
_ -> AudioProperties -> IO AudioProperties
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AudioProperties
props

-- | Parse VBRI VBR header  
parseVBRIHeader :: BS.ByteString -> AudioProperties -> Handle -> IO AudioProperties
parseVBRIHeader :: ByteString -> AudioProperties -> Handle -> IO AudioProperties
parseVBRIHeader ByteString
bs AudioProperties
props Handle
_handle = do
  if ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
22
    then AudioProperties -> IO AudioProperties
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AudioProperties
props
    else do
      -- fileSize <- hFileSize _handle
      let _version :: Word16
_version = Get Word16 -> ByteString -> Word16
forall a. Get a -> ByteString -> a
runGet Get Word16
getWord16be (ByteString -> ByteString
L.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
2 ByteString
bs)
          -- Skip delay and quality (2 + 2 bytes)
          bytes :: Word32
bytes = Get Word32 -> ByteString -> Word32
forall a. Get a -> ByteString -> a
runGet Get Word32
getWord32be (ByteString -> ByteString
L.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
4 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
6 ByteString
bs)
          frames :: Word32
frames = Get Word32 -> ByteString -> Word32
forall a. Get a -> ByteString -> a
runGet Get Word32
getWord32be (ByteString -> ByteString
L.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
4 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
10 ByteString
bs)
      
      -- Calculate average bitrate and duration
      case AudioProperties -> Maybe Int
sampleRate AudioProperties
props of
        Just Int
sr -> do
          let durationSecs :: Double
durationSecs = (Word32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
frames Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1152) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sr :: Double
              durationMs :: Int
durationMs = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
durationSecs Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000) :: Int  -- Convert to milliseconds
              avgBitrate :: Int
avgBitrate = if Double
durationSecs Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0
                then Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ (Word32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
bytes Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
8) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
durationSecs Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000
                else Int
0
          AudioProperties -> IO AudioProperties
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AudioProperties
props { bitrate = if avgBitrate > 0 then Just avgBitrate else bitrate props
                       , duration = if durationMs > 0 then Just durationMs else duration props }
        Maybe Int
_ -> AudioProperties -> IO AudioProperties
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AudioProperties
props

-- | Find and parse APIC frame info in ID3v2 tag data (metadata only, no image data)
findAndParseAPICInfo :: Word8 -> L.ByteString -> Maybe AlbumArtInfo
findAndParseAPICInfo :: Word8 -> ByteString -> Maybe AlbumArtInfo
findAndParseAPICInfo Word8
version ByteString
bs
  | Word8
version Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
3 = Maybe AlbumArtInfo
forall a. Maybe a
Nothing  -- APIC only in ID3v2.3+
  | Bool
otherwise = ByteString -> Maybe AlbumArtInfo
go ByteString
bs
  where
    go :: ByteString -> Maybe AlbumArtInfo
go ByteString
bytes
      | ByteString -> Int64
L.length ByteString
bytes Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
10 = Maybe AlbumArtInfo
forall a. Maybe a
Nothing
      | Bool
otherwise =
          case Get (Maybe AlbumArtInfo)
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, Maybe AlbumArtInfo)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail (Word8 -> Get (Maybe AlbumArtInfo)
findAPICFrame Word8
version) ByteString
bytes of
            Left (ByteString, Int64, String)
_ -> Maybe AlbumArtInfo
forall a. Maybe a
Nothing
            Right (ByteString
_, Int64
_, Just AlbumArtInfo
pic) -> AlbumArtInfo -> Maybe AlbumArtInfo
forall a. a -> Maybe a
Just AlbumArtInfo
pic
            Right (ByteString
rest, Int64
consumed, Maybe AlbumArtInfo
Nothing)
              | Int64
consumed Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 -> Maybe AlbumArtInfo
forall a. Maybe a
Nothing  -- No bytes consumed, stop to avoid infinite loop
              | Bool
otherwise -> ByteString -> Maybe AlbumArtInfo
go ByteString
rest

    findAPICFrame :: Word8 -> Get (Maybe AlbumArtInfo)
    findAPICFrame :: Word8 -> Get (Maybe AlbumArtInfo)
findAPICFrame Word8
_version = do
      ByteString
frameId <- Get ByteString -> Get ByteString
forall a. Get a -> Get a
lookAhead (Get ByteString -> Get ByteString)
-> Get ByteString -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Get ByteString
getByteString Int
4
      if ByteString
frameId ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"APIC"
        then do
          -- Parse the APIC frame
          ByteString
_ <- Int -> Get ByteString
getByteString Int
4  -- Consume frame ID
          Word32
frameSize <- if Word8
version Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
4
            then do
              Word8
b1 <- Get Word8
getWord8
              Word8
b2 <- Get Word8
getWord8
              Word8
b3 <- Get Word8
getWord8
              Word8
b4 <- Get Word8
getWord8
              Word32 -> Get Word32
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Get Word32) -> Word32 -> Get Word32
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
21) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                       (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
14) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                       (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b3 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
7) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                       Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b4
            else Get Word32
getWord32be
          Word16
_ <- Get Word16
getWord16be  -- Skip flags
          ByteString
frameData <- Int -> Get ByteString
getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
frameSize)
          Maybe AlbumArtInfo -> Get (Maybe AlbumArtInfo)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AlbumArtInfo -> Get (Maybe AlbumArtInfo))
-> Maybe AlbumArtInfo -> Get (Maybe AlbumArtInfo)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe AlbumArtInfo
parseAPICFrameInfo ByteString
frameData
        else if (Word8 -> Bool) -> ByteString -> Bool
BS.all (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
frameId
          then Maybe AlbumArtInfo -> Get (Maybe AlbumArtInfo)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AlbumArtInfo
forall a. Maybe a
Nothing  -- Padding reached
          else do
            -- Skip this frame
            ByteString
_ <- Int -> Get ByteString
getByteString Int
4
            Word32
frameSize <- if Word8
version Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
4
              then do
                Word8
b1 <- Get Word8
getWord8
                Word8
b2 <- Get Word8
getWord8
                Word8
b3 <- Get Word8
getWord8
                Word8
b4 <- Get Word8
getWord8
                Word32 -> Get Word32
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Get Word32) -> Word32 -> Get Word32
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
21) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                         (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
14) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                         (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b3 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
7) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                         Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b4
              else Get Word32
getWord32be
            Word16
_ <- Get Word16
getWord16be
            Int -> Get ()
skip (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
frameSize)
            Maybe AlbumArtInfo -> Get (Maybe AlbumArtInfo)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AlbumArtInfo
forall a. Maybe a
Nothing

-- | Parse APIC (Attached Picture) frame info (metadata only, not image data for performance)
parseAPICFrameInfo :: BS.ByteString -> Maybe AlbumArtInfo
parseAPICFrameInfo :: ByteString -> Maybe AlbumArtInfo
parseAPICFrameInfo ByteString
bs =
  if ByteString -> Bool
BS.null ByteString
bs
    then Maybe AlbumArtInfo
forall a. Maybe a
Nothing
    else
      let _encoding :: Word8
_encoding = HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.head ByteString
bs
          rest :: ByteString
rest = HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BS.tail ByteString
bs
      in case ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
"\0" ByteString
rest of
        (ByteString
mimeType, ByteString
afterMime) ->
          if ByteString -> Bool
BS.null ByteString
afterMime
            then Maybe AlbumArtInfo
forall a. Maybe a
Nothing
            else
              let rest2 :: ByteString
rest2 = Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
afterMime  -- Skip null terminator
                  pictureType :: Word8
pictureType = if ByteString -> Bool
BS.null ByteString
rest2 then Word8
0 else HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.head ByteString
rest2
                  rest3 :: ByteString
rest3 = if ByteString -> Bool
BS.null ByteString
rest2 then ByteString
BS.empty else HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BS.tail ByteString
rest2
              in case ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
"\0" ByteString
rest3 of
                (ByteString
description, ByteString
afterDesc) ->
                  if ByteString -> Bool
BS.null ByteString
afterDesc
                    then Maybe AlbumArtInfo
forall a. Maybe a
Nothing
                    else
                      -- Don't read image data, just calculate its size
                      let imageDataSize :: Int
imageDataSize = ByteString -> Int
BS.length (Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
afterDesc)
                      in AlbumArtInfo -> Maybe AlbumArtInfo
forall a. a -> Maybe a
Just (AlbumArtInfo -> Maybe AlbumArtInfo)
-> AlbumArtInfo -> Maybe AlbumArtInfo
forall a b. (a -> b) -> a -> b
$ AlbumArtInfo
                        { albumArtInfoMimeType :: Text
albumArtInfoMimeType = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode ByteString
mimeType
                        , albumArtInfoPictureType :: Word8
albumArtInfoPictureType = Word8
pictureType
                        , albumArtInfoDescription :: Text
albumArtInfoDescription = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode ByteString
description
                        , albumArtInfoSizeBytes :: Int
albumArtInfoSizeBytes = Int
imageDataSize
                        }

-- | Load album art from MP3 file (full binary data for writing)
loadAlbumArtMP3 :: OsPath -> Parser (Maybe AlbumArt)
loadAlbumArtMP3 :: OsPath -> Parser (Maybe AlbumArt)
loadAlbumArtMP3 OsPath
filePath = do
  Either ParseError (Maybe AlbumArt)
result <- IO (Either ParseError (Maybe AlbumArt))
-> ExceptT ParseError IO (Either ParseError (Maybe AlbumArt))
forall a. IO a -> ExceptT ParseError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ParseError (Maybe AlbumArt))
 -> ExceptT ParseError IO (Either ParseError (Maybe AlbumArt)))
-> IO (Either ParseError (Maybe AlbumArt))
-> ExceptT ParseError IO (Either ParseError (Maybe AlbumArt))
forall a b. (a -> b) -> a -> b
$ OsPath
-> IOMode
-> (Handle -> IO (Either ParseError (Maybe AlbumArt)))
-> IO (Either ParseError (Maybe AlbumArt))
forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile OsPath
filePath IOMode
ReadMode ((Handle -> IO (Either ParseError (Maybe AlbumArt)))
 -> IO (Either ParseError (Maybe AlbumArt)))
-> (Handle -> IO (Either ParseError (Maybe AlbumArt)))
-> IO (Either ParseError (Maybe AlbumArt))
forall a b. (a -> b) -> a -> b
$ \Handle
handle -> do
    -- Parse ID3v2 tag at beginning if present
    Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
AbsoluteSeek Integer
0
    ByteString
header <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle Int
10

    if ByteString -> Int
BS.length ByteString
header Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 Bool -> Bool -> Bool
|| Int -> ByteString -> ByteString
BS.take Int
3 ByteString
header ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
id3v2Signature
      then Either ParseError (Maybe AlbumArt)
-> IO (Either ParseError (Maybe AlbumArt))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError (Maybe AlbumArt)
 -> IO (Either ParseError (Maybe AlbumArt)))
-> Either ParseError (Maybe AlbumArt)
-> IO (Either ParseError (Maybe AlbumArt))
forall a b. (a -> b) -> a -> b
$ Maybe AlbumArt -> Either ParseError (Maybe AlbumArt)
forall a b. b -> Either a b
Right Maybe AlbumArt
forall a. Maybe a
Nothing  -- No ID3v2 tag
      else do
        -- Parse header to get tag size
        let version :: Word8
version = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
header Int
3
            size :: Word32
size = ByteString -> Word32
parseSynchsafeInt (Int -> ByteString -> ByteString
BS.drop Int
6 ByteString
header)

        -- Read only the ID3v2 tag data
        ByteString
tagData <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size)

        -- Find and parse APIC frame with full data
        Either ParseError (Maybe AlbumArt)
-> IO (Either ParseError (Maybe AlbumArt))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError (Maybe AlbumArt)
 -> IO (Either ParseError (Maybe AlbumArt)))
-> Either ParseError (Maybe AlbumArt)
-> IO (Either ParseError (Maybe AlbumArt))
forall a b. (a -> b) -> a -> b
$ Maybe AlbumArt -> Either ParseError (Maybe AlbumArt)
forall a b. b -> Either a b
Right (Maybe AlbumArt -> Either ParseError (Maybe AlbumArt))
-> Maybe AlbumArt -> Either ParseError (Maybe AlbumArt)
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> Maybe AlbumArt
findAndParseAPICFull Word8
version (ByteString -> ByteString
L.fromStrict ByteString
tagData)

  case Either ParseError (Maybe AlbumArt)
result of
    Left ParseError
err -> ParseError -> Parser (Maybe AlbumArt)
forall a. ParseError -> ExceptT ParseError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ParseError
err
    Right Maybe AlbumArt
maybeArt -> Maybe AlbumArt -> Parser (Maybe AlbumArt)
forall a. a -> ExceptT ParseError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AlbumArt
maybeArt
  where
    findAndParseAPICFull :: Word8 -> L.ByteString -> Maybe AlbumArt
    findAndParseAPICFull :: Word8 -> ByteString -> Maybe AlbumArt
findAndParseAPICFull Word8
version ByteString
bs
      | Word8
version Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
3 = Maybe AlbumArt
forall a. Maybe a
Nothing  -- APIC only in ID3v2.3+
      | Bool
otherwise = ByteString -> Maybe AlbumArt
go ByteString
bs
      where
        go :: ByteString -> Maybe AlbumArt
go ByteString
bytes
          | ByteString -> Int64
L.length ByteString
bytes Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
10 = Maybe AlbumArt
forall a. Maybe a
Nothing
          | Bool
otherwise =
              case Get (Maybe AlbumArt)
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, Maybe AlbumArt)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail (Word8 -> Get (Maybe AlbumArt)
findAPICFrame Word8
version) ByteString
bytes of
                Left (ByteString, Int64, String)
_ -> Maybe AlbumArt
forall a. Maybe a
Nothing
                Right (ByteString
_, Int64
_, Just AlbumArt
pic) -> AlbumArt -> Maybe AlbumArt
forall a. a -> Maybe a
Just AlbumArt
pic
                Right (ByteString
rest, Int64
consumed, Maybe AlbumArt
Nothing)
                  | Int64
consumed Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 -> Maybe AlbumArt
forall a. Maybe a
Nothing
                  | Bool
otherwise -> ByteString -> Maybe AlbumArt
go ByteString
rest

        findAPICFrame :: Word8 -> Get (Maybe AlbumArt)
        findAPICFrame :: Word8 -> Get (Maybe AlbumArt)
findAPICFrame Word8
_version = do
          ByteString
frameId <- Get ByteString -> Get ByteString
forall a. Get a -> Get a
lookAhead (Get ByteString -> Get ByteString)
-> Get ByteString -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Get ByteString
getByteString Int
4
          if ByteString
frameId ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"APIC"
            then do
              ByteString
_ <- Int -> Get ByteString
getByteString Int
4  -- Consume frame ID
              Word32
frameSize <- if Word8
version Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
4
                then do
                  Word8
b1 <- Get Word8
getWord8
                  Word8
b2 <- Get Word8
getWord8
                  Word8
b3 <- Get Word8
getWord8
                  Word8
b4 <- Get Word8
getWord8
                  Word32 -> Get Word32
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Get Word32) -> Word32 -> Get Word32
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
21) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                           (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
14) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                           (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b3 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
7) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                           Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b4
                else Get Word32
getWord32be
              Word16
_ <- Get Word16
getWord16be  -- Skip flags
              ByteString
frameData <- Int -> Get ByteString
getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
frameSize)
              Maybe AlbumArt -> Get (Maybe AlbumArt)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AlbumArt -> Get (Maybe AlbumArt))
-> Maybe AlbumArt -> Get (Maybe AlbumArt)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe AlbumArt
parseAPICFrameFull ByteString
frameData
            else if (Word8 -> Bool) -> ByteString -> Bool
BS.all (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
frameId
              then Maybe AlbumArt -> Get (Maybe AlbumArt)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AlbumArt
forall a. Maybe a
Nothing
              else do
                ByteString
_ <- Int -> Get ByteString
getByteString Int
4
                Word32
frameSize <- if Word8
version Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
4
                  then do
                    Word8
b1 <- Get Word8
getWord8
                    Word8
b2 <- Get Word8
getWord8
                    Word8
b3 <- Get Word8
getWord8
                    Word8
b4 <- Get Word8
getWord8
                    Word32 -> Get Word32
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Get Word32) -> Word32 -> Get Word32
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
21) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                             (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
14) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                             (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b3 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
7) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                             Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b4
                  else Get Word32
getWord32be
                Word16
_ <- Get Word16
getWord16be
                Int -> Get ()
skip (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
frameSize)
                Maybe AlbumArt -> Get (Maybe AlbumArt)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AlbumArt
forall a. Maybe a
Nothing

    parseAPICFrameFull :: BS.ByteString -> Maybe AlbumArt
    parseAPICFrameFull :: ByteString -> Maybe AlbumArt
parseAPICFrameFull ByteString
bs =
      if ByteString -> Bool
BS.null ByteString
bs
        then Maybe AlbumArt
forall a. Maybe a
Nothing
        else
          let _encoding :: Word8
_encoding = HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.head ByteString
bs
              rest :: ByteString
rest = HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BS.tail ByteString
bs
          in case ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
"\0" ByteString
rest of
            (ByteString
mimeType, ByteString
afterMime) ->
              if ByteString -> Bool
BS.null ByteString
afterMime
                then Maybe AlbumArt
forall a. Maybe a
Nothing
                else
                  let rest2 :: ByteString
rest2 = Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
afterMime
                      pictureType :: Word8
pictureType = if ByteString -> Bool
BS.null ByteString
rest2 then Word8
0 else HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.head ByteString
rest2
                      rest3 :: ByteString
rest3 = if ByteString -> Bool
BS.null ByteString
rest2 then ByteString
BS.empty else HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BS.tail ByteString
rest2
                  in case ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
"\0" ByteString
rest3 of
                    (ByteString
description, ByteString
afterDesc) ->
                      if ByteString -> Bool
BS.null ByteString
afterDesc
                        then Maybe AlbumArt
forall a. Maybe a
Nothing
                        else
                          let imageData :: ByteString
imageData = Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
afterDesc
                          in AlbumArt -> Maybe AlbumArt
forall a. a -> Maybe a
Just (AlbumArt -> Maybe AlbumArt) -> AlbumArt -> Maybe AlbumArt
forall a b. (a -> b) -> a -> b
$ AlbumArt
                            { albumArtMimeType :: Text
albumArtMimeType = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode ByteString
mimeType
                            , albumArtPictureType :: Word8
albumArtPictureType = Word8
pictureType
                            , albumArtDescription :: Text
albumArtDescription = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode ByteString
description
                            , albumArtData :: ByteString
albumArtData = ByteString
imageData
                            }

-- | Extract year from TDRC date field (YYYY-MM-DD or just YYYY)
extractYearFromDate :: T.Text -> Maybe Int
extractYearFromDate :: Text -> Maybe Int
extractYearFromDate Text
dateText =
  let yearStr :: Text
yearStr = (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') Text
dateText
  in Text -> Maybe Int
readInt Text
yearStr