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

module Monatone.FLAC
  ( parseFLAC
  , parseVorbisComments
  , loadAlbumArtFLAC
  ) where

import Control.Applicative ((<|>))
import Control.Monad.Except (throwError)
import Control.Monad.IO.Class (liftIO)
import Data.Binary.Get
import Data.Bits
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as L
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 Data.Word
import System.IO (Handle, IOMode(..), hSeek, SeekMode(..))
import System.OsPath
import System.File.OsPath (withBinaryFile)

import Monatone.Metadata
import Monatone.Types

-- | FLAC file signature "fLaC" in bytes
flacSignature :: BS.ByteString
flacSignature :: ByteString
flacSignature = ByteString
"fLaC"

-- | FLAC metadata block type constants
blockTypeStreamInfo, blockTypePadding, blockTypeApplication :: Word8
blockTypeSeekTable, blockTypeVorbisComment, blockTypeCueSheet, blockTypePicture :: Word8
blockTypeStreamInfo :: Word8
blockTypeStreamInfo    = Word8
0
blockTypePadding :: Word8
blockTypePadding       = Word8
1
blockTypeApplication :: Word8
blockTypeApplication   = Word8
2
blockTypeSeekTable :: Word8
blockTypeSeekTable     = Word8
3
blockTypeVorbisComment :: Word8
blockTypeVorbisComment = Word8
4
blockTypeCueSheet :: Word8
blockTypeCueSheet      = Word8
5
blockTypePicture :: Word8
blockTypePicture       = Word8
6

-- | FLAC metadata block types
data BlockType 
  = StreamInfo     -- 0
  | Padding        -- 1  
  | Application    -- 2
  | SeekTable      -- 3
  | VorbisComment  -- 4
  | CueSheet       -- 5
  | Picture        -- 6
  | Reserved Word8
  deriving (Int -> BlockType -> ShowS
[BlockType] -> ShowS
BlockType -> String
(Int -> BlockType -> ShowS)
-> (BlockType -> String)
-> ([BlockType] -> ShowS)
-> Show BlockType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockType -> ShowS
showsPrec :: Int -> BlockType -> ShowS
$cshow :: BlockType -> String
show :: BlockType -> String
$cshowList :: [BlockType] -> ShowS
showList :: [BlockType] -> ShowS
Show, BlockType -> BlockType -> Bool
(BlockType -> BlockType -> Bool)
-> (BlockType -> BlockType -> Bool) -> Eq BlockType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockType -> BlockType -> Bool
== :: BlockType -> BlockType -> Bool
$c/= :: BlockType -> BlockType -> Bool
/= :: BlockType -> BlockType -> Bool
Eq)

-- | Block header info
data BlockHeader = BlockHeader
  { BlockHeader -> Bool
isLast :: Bool
  , BlockHeader -> BlockType
blockType :: BlockType
  , BlockHeader -> Word32
blockLength :: Word32
  } deriving (Int -> BlockHeader -> ShowS
[BlockHeader] -> ShowS
BlockHeader -> String
(Int -> BlockHeader -> ShowS)
-> (BlockHeader -> String)
-> ([BlockHeader] -> ShowS)
-> Show BlockHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockHeader -> ShowS
showsPrec :: Int -> BlockHeader -> ShowS
$cshow :: BlockHeader -> String
show :: BlockHeader -> String
$cshowList :: [BlockHeader] -> ShowS
showList :: [BlockHeader] -> ShowS
Show, BlockHeader -> BlockHeader -> Bool
(BlockHeader -> BlockHeader -> Bool)
-> (BlockHeader -> BlockHeader -> Bool) -> Eq BlockHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockHeader -> BlockHeader -> Bool
== :: BlockHeader -> BlockHeader -> Bool
$c/= :: BlockHeader -> BlockHeader -> Bool
/= :: BlockHeader -> BlockHeader -> Bool
Eq)

-- | Parse FLAC file efficiently - only read metadata blocks, not entire file
parseFLAC :: OsPath -> Parser Metadata
parseFLAC :: OsPath -> Parser Metadata
parseFLAC OsPath
filePath = do
  Either ParseError Metadata
metadata <- 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
    -- Read and verify FLAC signature (4 bytes)
    ByteString
sig <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle Int
4
    if ByteString
sig ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
flacSignature
      then 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
$ ParseError -> Either ParseError Metadata
forall a b. a -> Either a b
Left (ParseError -> Either ParseError Metadata)
-> ParseError -> Either ParseError Metadata
forall a b. (a -> b) -> a -> b
$ Text -> ParseError
CorruptedFile Text
"Invalid FLAC signature"
      else do
        -- Parse metadata blocks one by one until we hit the last one
        Metadata -> Either ParseError Metadata
forall a b. b -> Either a b
Right (Metadata -> Either ParseError Metadata)
-> IO Metadata -> IO (Either ParseError Metadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Metadata -> IO Metadata
parseMetadataBlocks Handle
handle (AudioFormat -> Metadata
emptyMetadata AudioFormat
FLAC)
  
  case Either ParseError Metadata
metadata 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 metadata blocks from file handle (streaming)
parseMetadataBlocks :: Handle -> Metadata -> IO Metadata
parseMetadataBlocks :: Handle -> Metadata -> IO Metadata
parseMetadataBlocks Handle
handle Metadata
metadata = do
  -- Read block header (4 bytes)
  ByteString
headerBytes <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle Int
4
  if ByteString -> Int
BS.length ByteString
headerBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4
    then Metadata -> IO Metadata
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Metadata
metadata  -- EOF
    else do
      let header :: BlockHeader
header = ByteString -> BlockHeader
parseBlockHeader ByteString
headerBytes
      
      -- Process block based on type
      Metadata
updatedMetadata <- case BlockHeader -> BlockType
blockType BlockHeader
header of
        BlockType
StreamInfo -> do
          ByteString
streamInfoData <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ BlockHeader -> Word32
blockLength BlockHeader
header)
          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
parseStreamInfo ByteString
streamInfoData Metadata
metadata
          
        BlockType
VorbisComment -> do
          ByteString
vorbisData <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ BlockHeader -> Word32
blockLength BlockHeader
header)
          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
parseVorbisCommentsBlock ByteString
vorbisData Metadata
metadata
          
        BlockType
Picture -> do
          -- Parse picture block for album art
          ByteString
pictureData <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ BlockHeader -> Word32
blockLength BlockHeader
header)
          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
parsePictureBlock ByteString
pictureData Metadata
metadata
              
        BlockType
_ -> do
          -- Unknown/unneeded block type - skip it
          Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
RelativeSeek (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Integer) -> Word32 -> Integer
forall a b. (a -> b) -> a -> b
$ BlockHeader -> Word32
blockLength BlockHeader
header)
          Metadata -> IO Metadata
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Metadata
metadata
      
      -- Stop if this was the last metadata block
      if BlockHeader -> Bool
isLast BlockHeader
header
        then Metadata -> IO Metadata
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Metadata
updatedMetadata
        else Handle -> Metadata -> IO Metadata
parseMetadataBlocks Handle
handle Metadata
updatedMetadata

-- | Parse block header from 4 bytes
parseBlockHeader :: BS.ByteString -> BlockHeader
parseBlockHeader :: ByteString -> BlockHeader
parseBlockHeader ByteString
bs =
  let firstByte :: Word8
firstByte = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
0
      isLastBlock :: Bool
isLastBlock = (Word8
firstByte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x80) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0
      blockTypeNum :: Word8
blockTypeNum = Word8
firstByte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F
      -- Next 3 bytes are block size (big-endian 24-bit integer)
      sizeByte1 :: Word32
sizeByte1 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
1) :: Word32
      sizeByte2 :: Word32
sizeByte2 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
2) :: Word32
      sizeByte3 :: Word32
sizeByte3 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
3) :: Word32
      size :: Word32
size = (Word32
sizeByte1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
sizeByte2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
sizeByte3
  in BlockHeader
    { isLast :: Bool
isLast = Bool
isLastBlock
    , blockType :: BlockType
blockType = Word8 -> BlockType
numberToBlockType Word8
blockTypeNum
    , blockLength :: Word32
blockLength = Word32
size
    }

-- | Convert number to block type
numberToBlockType :: Word8 -> BlockType
numberToBlockType :: Word8 -> BlockType
numberToBlockType Word8
t 
  | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
blockTypeStreamInfo    = BlockType
StreamInfo
  | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
blockTypePadding       = BlockType
Padding
  | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
blockTypeApplication   = BlockType
Application
  | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
blockTypeSeekTable     = BlockType
SeekTable
  | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
blockTypeVorbisComment = BlockType
VorbisComment
  | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
blockTypeCueSheet      = BlockType
CueSheet
  | Word8
t Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
blockTypePicture       = BlockType
Picture
  | Bool
otherwise                   = Word8 -> BlockType
Reserved Word8
t

-- | Parse StreamInfo block
parseStreamInfo :: BS.ByteString -> Metadata -> Metadata
parseStreamInfo :: ByteString -> Metadata -> Metadata
parseStreamInfo ByteString
bs Metadata
metadata = 
  let lazyBs :: LazyByteString
lazyBs = ByteString -> LazyByteString
L.fromStrict ByteString
bs
  in Get Metadata -> LazyByteString -> Metadata
forall a. Get a -> LazyByteString -> a
runGet (Metadata -> Get Metadata
parseStreamInfoGet Metadata
metadata) LazyByteString
lazyBs

parseStreamInfoGet :: Metadata -> Get Metadata
parseStreamInfoGet :: Metadata -> Get Metadata
parseStreamInfoGet Metadata
metadata = do
  -- Min block size (16 bits)
  Word16
_ <- Get Word16
getWord16be  -- minBlockSize
  -- Max block size (16 bits)  
  Word16
_ <- Get Word16
getWord16be  -- maxBlockSize
  -- Min frame size (24 bits)
  Word32
_ <- Get Word32
getWord24be  -- minFrameSize
  -- Max frame size (24 bits)
  Word32
_ <- Get Word32
getWord24be  -- maxFrameSize
  
  -- Sample rate (20 bits), channels (3 bits), bits per sample (5 bits), total samples (36 bits)
  -- This is packed into 8 bytes
  Word64
packed <- Get Word64
getWord64be
  
  let sampleRate' :: Int
sampleRate' = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
packed Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
44) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xFFFFF)
      channels' :: Int
channels' = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
packed Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
41) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x7) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      bitsPerSample' :: Int
bitsPerSample' = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
packed Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
36) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x1F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      totalSamples :: Integer
totalSamples = Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
packed Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xFFFFFFFFF) :: Integer
      
  -- MD5 signature (16 bytes) - we'll skip this
  Int -> Get ()
skip Int
16
  
  -- Calculate duration in seconds
  let duration' :: Maybe Int
duration' = if Int
sampleRate' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 
                 then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
totalSamples Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
sampleRate'
                 else Maybe Int
forall a. Maybe a
Nothing
  
  Metadata -> Get Metadata
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Metadata -> Get Metadata) -> Metadata -> Get Metadata
forall a b. (a -> b) -> a -> b
$ Metadata
metadata 
    { audioProperties = AudioProperties
      { sampleRate = Just sampleRate'
      , channels = Just channels'
      , bitsPerSample = Just bitsPerSample'
      , bitrate = Nothing  -- Will be calculated later if needed
      , duration = duration'
      }
    }
  where
    getWord24be :: Get Word32
    getWord24be :: Get Word32
getWord24be = do
      Word8
b1 <- Get Word8
getWord8
      Word8
b2 <- Get Word8
getWord8
      Word8
b3 <- 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
16) 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
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. 
               Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b3

-- | Parse Vorbis Comments block
parseVorbisCommentsBlock :: BS.ByteString -> Metadata -> Metadata
parseVorbisCommentsBlock :: ByteString -> Metadata -> Metadata
parseVorbisCommentsBlock ByteString
bs Metadata
metadata = 
  let lazyBs :: LazyByteString
lazyBs = ByteString -> LazyByteString
L.fromStrict ByteString
bs
  in Get Metadata -> LazyByteString -> Metadata
forall a. Get a -> LazyByteString -> a
runGet (Metadata -> Get Metadata
parseVorbisCommentsGet Metadata
metadata) LazyByteString
lazyBs

-- | Parse Vorbis Comments (for compatibility)
parseVorbisComments :: L.ByteString -> Metadata -> Parser Metadata
parseVorbisComments :: LazyByteString -> Metadata -> Parser Metadata
parseVorbisComments LazyByteString
bs Metadata
metadata = 
  Metadata -> Parser Metadata
forall a. a -> ExceptT ParseError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Metadata -> Parser Metadata) -> Metadata -> Parser Metadata
forall a b. (a -> b) -> a -> b
$ Get Metadata -> LazyByteString -> Metadata
forall a. Get a -> LazyByteString -> a
runGet (Metadata -> Get Metadata
parseVorbisCommentsGet Metadata
metadata) LazyByteString
bs

-- | Parse Vorbis Comments using Get monad
parseVorbisCommentsGet :: Metadata -> Get Metadata
parseVorbisCommentsGet :: Metadata -> Get Metadata
parseVorbisCommentsGet Metadata
metadata = do
  -- Read vendor string length (little-endian 32-bit)
  Word32
vendorLength <- Get Word32
getWord32le
  -- Skip vendor string
  Int -> Get ()
skip (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
vendorLength)
  
  -- Read number of comments
  Word32
numComments <- Get Word32
getWord32le
  
  -- Read each comment
  [(Text, Text)]
comments <- Int -> Get [(Text, Text)]
parseCommentList (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
numComments)
  
  -- Convert to HashMap for efficient lookup
  let 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)]
comments
  
  -- Extract standard fields
  Metadata -> Get Metadata
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Metadata -> Get Metadata) -> Metadata -> Get Metadata
forall a b. (a -> b) -> a -> b
$ Metadata
metadata
    { title = HM.lookup "TITLE" tagMap
    , artist = HM.lookup "ARTIST" tagMap
    , album = HM.lookup "ALBUM" tagMap
    , albumArtist = HM.lookup "ALBUMARTIST" tagMap
    , year = (HM.lookup "YEAR" tagMap >>= readInt)
             <|> (HM.lookup "DATE" tagMap >>= extractYearFromDate)
    , date = HM.lookup "DATE" tagMap
    , comment = HM.lookup "COMMENT" tagMap
    , genre = HM.lookup "GENRE" tagMap
    , trackNumber = HM.lookup "TRACKNUMBER" tagMap >>= readInt
    , totalTracks = HM.lookup "TRACKTOTAL" tagMap >>= readInt
    , discNumber = HM.lookup "DISCNUMBER" tagMap >>= readInt
    , totalDiscs = HM.lookup "DISCTOTAL" tagMap >>= readInt
    , releaseCountry = HM.lookup "RELEASECOUNTRY" tagMap
    , recordLabel = HM.lookup "LABEL" tagMap
    , catalogNumber = HM.lookup "CATALOGNUMBER" tagMap
    , barcode = HM.lookup "BARCODE" tagMap
    , releaseStatus = HM.lookup "RELEASESTATUS" tagMap
    , releaseType = HM.lookup "RELEASETYPE" tagMap
    , musicBrainzIds = MusicBrainzIds
      { mbTrackId = HM.lookup "MUSICBRAINZ_RELEASETRACKID" tagMap
      , mbRecordingId = HM.lookup "MUSICBRAINZ_TRACKID" tagMap
      , mbReleaseId = HM.lookup "MUSICBRAINZ_ALBUMID" tagMap
      , mbReleaseGroupId = HM.lookup "MUSICBRAINZ_RELEASEGROUPID" tagMap
      , mbArtistId = HM.lookup "MUSICBRAINZ_ARTISTID" tagMap
      , mbAlbumArtistId = HM.lookup "MUSICBRAINZ_ALBUMARTISTID" tagMap
      , mbWorkId = HM.lookup "MUSICBRAINZ_WORKID" tagMap
      , mbDiscId = HM.lookup "MUSICBRAINZ_DISCID" tagMap
      }
    , acoustidFingerprint = HM.lookup "ACOUSTID_FINGERPRINT" tagMap <|>
                           HM.lookup "acoustid_fingerprint" tagMap
    , acoustidId = HM.lookup "ACOUSTID_ID" tagMap <|>
                  HM.lookup "acoustid_id" tagMap
    }
  where
    parseCommentList :: Int -> Get [(Text, Text)]
    parseCommentList :: Int -> Get [(Text, Text)]
parseCommentList Int
0 = [(Text, Text)] -> Get [(Text, Text)]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    parseCommentList Int
n = do
      -- Read comment length
      Word32
commentLength <- Get Word32
getWord32le
      -- Read comment data
      ByteString
commentBytes <- Int -> Get ByteString
getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
commentLength)
      -- Parse the comment (format: "KEY=value")
      let comment' :: Maybe (Text, Text)
comment' = case Word8 -> ByteString -> [ByteString]
BS.split Word8
0x3D ByteString
commentBytes of -- Split on '='
            (ByteString
key:ByteString
value:[ByteString]
_) -> 
              let keyText :: Text
keyText = Text -> Text
T.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode ByteString
key
                  valueText :: Text
valueText = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode (ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"=" (ByteString
valueByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[]))
              in (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
keyText, Text
valueText)
            [ByteString]
_ -> Maybe (Text, Text)
forall a. Maybe a
Nothing
      [(Text, Text)]
rest <- Int -> Get [(Text, Text)]
parseCommentList (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      [(Text, Text)] -> Get [(Text, Text)]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Text)] -> Get [(Text, Text)])
-> [(Text, Text)] -> Get [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ case Maybe (Text, Text)
comment' of
        Just (Text, Text)
c -> (Text, Text)
c (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
rest
        Maybe (Text, Text)
Nothing -> [(Text, Text)]
rest

-- | Parse Picture block according to FLAC specification
-- Only extracts metadata, not the actual image data (for performance)
parsePictureBlock :: BS.ByteString -> Metadata -> Metadata
parsePictureBlock :: ByteString -> Metadata -> Metadata
parsePictureBlock ByteString
bs Metadata
metadata =
  let lazyBs :: LazyByteString
lazyBs = ByteString -> LazyByteString
L.fromStrict ByteString
bs
  in case Get AlbumArtInfo
-> LazyByteString
-> Either
     (LazyByteString, ByteOffset, String)
     (LazyByteString, ByteOffset, AlbumArtInfo)
forall a.
Get a
-> LazyByteString
-> Either
     (LazyByteString, ByteOffset, String)
     (LazyByteString, ByteOffset, a)
runGetOrFail Get AlbumArtInfo
parsePictureInfo LazyByteString
lazyBs of
    Left (LazyByteString, ByteOffset, String)
_ -> Metadata
metadata
    Right (LazyByteString
_, ByteOffset
_, AlbumArtInfo
artInfo) -> Metadata
metadata { albumArtInfo = Just artInfo }
  where
    parsePictureInfo :: Get AlbumArtInfo
    parsePictureInfo :: Get AlbumArtInfo
parsePictureInfo = do
      Word32
pictureType <- Get Word32
getWord32be
      Word32
mimeLength <- Get Word32
getWord32be
      ByteString
mimeType <- Int -> Get ByteString
getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
mimeLength)
      Word32
descLength <- Get Word32
getWord32be
      ByteString
description <- Int -> Get ByteString
getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
descLength)
      Word32
_width <- Get Word32
getWord32be
      Word32
_height <- Get Word32
getWord32be
      Word32
_colorDepth <- Get Word32
getWord32be
      Word32
_numColors <- Get Word32
getWord32be
      Word32
pictureDataLength <- Get Word32
getWord32be
      -- Skip the actual picture data instead of reading it
      -- skip (fromIntegral pictureDataLength)

      AlbumArtInfo -> Get AlbumArtInfo
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (AlbumArtInfo -> Get AlbumArtInfo)
-> AlbumArtInfo -> Get 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 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
pictureType
        , albumArtInfoDescription :: Text
albumArtInfoDescription = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode ByteString
description
        , albumArtInfoSizeBytes :: Int
albumArtInfoSizeBytes = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
pictureDataLength
        }

-- | Load album art from FLAC file (full binary data for writing)
loadAlbumArtFLAC :: OsPath -> Parser (Maybe AlbumArt)
loadAlbumArtFLAC :: OsPath -> Parser (Maybe AlbumArt)
loadAlbumArtFLAC 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
    -- Read and verify FLAC signature (4 bytes)
    ByteString
sig <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle Int
4
    if ByteString
sig ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
flacSignature
      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
$ ParseError -> Either ParseError (Maybe AlbumArt)
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (Maybe AlbumArt))
-> ParseError -> Either ParseError (Maybe AlbumArt)
forall a b. (a -> b) -> a -> b
$ Text -> ParseError
CorruptedFile Text
"Invalid FLAC signature"
      else do
        -- Search for Picture block
        Maybe AlbumArt -> Either ParseError (Maybe AlbumArt)
forall a b. b -> Either a b
Right (Maybe AlbumArt -> Either ParseError (Maybe AlbumArt))
-> IO (Maybe AlbumArt) -> IO (Either ParseError (Maybe AlbumArt))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO (Maybe AlbumArt)
findPictureBlock Handle
handle

  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
    findPictureBlock :: Handle -> IO (Maybe AlbumArt)
    findPictureBlock :: Handle -> IO (Maybe AlbumArt)
findPictureBlock Handle
handle = do
      -- Read block header (4 bytes)
      ByteString
headerBytes <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle Int
4
      if ByteString -> Int
BS.length ByteString
headerBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4
        then Maybe AlbumArt -> IO (Maybe AlbumArt)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AlbumArt
forall a. Maybe a
Nothing  -- EOF
        else do
          let header :: BlockHeader
header = ByteString -> BlockHeader
parseBlockHeader ByteString
headerBytes

          -- Check if this is a Picture block
          if BlockHeader -> BlockType
blockType BlockHeader
header BlockType -> BlockType -> Bool
forall a. Eq a => a -> a -> Bool
== BlockType
Picture
            then do
              -- Parse the picture block with full data
              ByteString
pictureData <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ BlockHeader -> Word32
blockLength BlockHeader
header)
              Maybe AlbumArt -> IO (Maybe AlbumArt)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AlbumArt -> IO (Maybe AlbumArt))
-> Maybe AlbumArt -> IO (Maybe AlbumArt)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe AlbumArt
parsePictureBlockFull ByteString
pictureData
            else do
              -- Skip this block and continue
              Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
RelativeSeek (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Integer) -> Word32 -> Integer
forall a b. (a -> b) -> a -> b
$ BlockHeader -> Word32
blockLength BlockHeader
header)
              -- Stop if this was the last metadata block
              if BlockHeader -> Bool
isLast BlockHeader
header
                then Maybe AlbumArt -> IO (Maybe AlbumArt)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AlbumArt
forall a. Maybe a
Nothing
                else Handle -> IO (Maybe AlbumArt)
findPictureBlock Handle
handle

    parsePictureBlockFull :: BS.ByteString -> Maybe AlbumArt
    parsePictureBlockFull :: ByteString -> Maybe AlbumArt
parsePictureBlockFull ByteString
bs =
      let lazyBs :: LazyByteString
lazyBs = ByteString -> LazyByteString
L.fromStrict ByteString
bs
      in case Get AlbumArt
-> LazyByteString
-> Either
     (LazyByteString, ByteOffset, String)
     (LazyByteString, ByteOffset, AlbumArt)
forall a.
Get a
-> LazyByteString
-> Either
     (LazyByteString, ByteOffset, String)
     (LazyByteString, ByteOffset, a)
runGetOrFail Get AlbumArt
parsePictureData LazyByteString
lazyBs of
        Left (LazyByteString, ByteOffset, String)
_ -> Maybe AlbumArt
forall a. Maybe a
Nothing
        Right (LazyByteString
_, ByteOffset
_, AlbumArt
art) -> AlbumArt -> Maybe AlbumArt
forall a. a -> Maybe a
Just AlbumArt
art

    parsePictureData :: Get AlbumArt
    parsePictureData :: Get AlbumArt
parsePictureData = do
      Word32
pictureType <- Get Word32
getWord32be
      Word32
mimeLength <- Get Word32
getWord32be
      ByteString
mimeType <- Int -> Get ByteString
getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
mimeLength)
      Word32
descLength <- Get Word32
getWord32be
      ByteString
description <- Int -> Get ByteString
getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
descLength)
      Word32
_width <- Get Word32
getWord32be
      Word32
_height <- Get Word32
getWord32be
      Word32
_colorDepth <- Get Word32
getWord32be
      Word32
_numColors <- Get Word32
getWord32be
      Word32
pictureDataLength <- Get Word32
getWord32be
      ByteString
pictureData <- Int -> Get ByteString
getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
pictureDataLength)

      AlbumArt -> Get AlbumArt
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (AlbumArt -> Get AlbumArt) -> AlbumArt -> Get 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 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
pictureType
        , albumArtDescription :: Text
albumArtDescription = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode ByteString
description
        , albumArtData :: ByteString
albumArtData = ByteString
pictureData
        }

-- | Extract year from 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