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

module Monatone.OGG
  ( parseOGG
  , loadAlbumArtOGG
  ) where

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

-- | OGG page header is always 27 bytes (before segment table)
oggPageHeaderSize :: Int
oggPageHeaderSize :: Int
oggPageHeaderSize = Int
27

-- | Parse OGG file efficiently - only read metadata pages
parseOGG :: OsPath -> Parser Metadata
parseOGG :: OsPath -> Parser Metadata
parseOGG 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
    -- Read first page to check OGG signature
    ByteString
firstHeader <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle Int
27
    if ByteString -> Int
BS.length ByteString
firstHeader Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
27 Bool -> Bool -> Bool
|| Int -> ByteString -> ByteString
BS.take Int
4 ByteString
firstHeader ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"OggS"
      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
UnsupportedFormat Text
"Not an OGG file"
      else do
        -- Parse pages until we find what we need
        Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
AbsoluteSeek Integer
0
        Metadata
metadata <- Handle -> Metadata -> Bool -> Bool -> IO Metadata
parseOggPages Handle
handle (AudioFormat -> Metadata
emptyMetadata AudioFormat
OGG) Bool
False Bool
False
        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
metadata
  
  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 OGG pages looking for Vorbis headers
parseOggPages :: Handle -> Metadata -> Bool -> Bool -> IO Metadata
parseOggPages :: Handle -> Metadata -> Bool -> Bool -> IO Metadata
parseOggPages Handle
handle Metadata
metadata Bool
foundIdent Bool
foundComment
  -- Stop when we have both headers
  | Bool
foundIdent Bool -> Bool -> Bool
&& Bool
foundComment = Metadata -> IO Metadata
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Metadata
metadata
  | Bool
otherwise = do
      -- Read page header
      ByteString
headerBytes <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle Int
oggPageHeaderSize
      
      if ByteString -> Int
BS.length ByteString
headerBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
oggPageHeaderSize
        then Metadata -> IO Metadata
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Metadata
metadata  -- EOF
        else do
          -- Verify OGG page signature
          if Int -> ByteString -> ByteString
BS.take Int
4 ByteString
headerBytes ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"OggS"
            then Metadata -> IO Metadata
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Metadata
metadata  -- Invalid page, stop
            else do
              -- Parse header to get segment table size
              let numSegments :: Int
numSegments = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
headerBytes Int
26
              
              -- Read segment table
              ByteString
segmentTable <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle Int
numSegments
              
              -- Calculate total page data size
              let pageDataSize :: Int
pageDataSize = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Word8 -> Int) -> [Word8] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word8] -> [Int]) -> [Word8] -> [Int]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack ByteString
segmentTable
              
              -- For the first few pages, read and check for Vorbis headers
              -- Vorbis headers are always in the first 3 pages
              if Bool -> Bool
not Bool
foundIdent Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
foundComment
                then do
                  ByteString
pageData <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle Int
pageDataSize
                  
                  -- Check packet type
                  let (Metadata
newMetadata, Bool
newFoundIdent, Bool
newFoundComment) = 
                        if ByteString
"\x01vorbis" ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString
pageData Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
foundIdent
                        then (ByteString -> Metadata -> Metadata
parseVorbisInfo ByteString
pageData Metadata
metadata, Bool
True, Bool
foundComment)
                        else if ByteString
"\x03vorbis" ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString
pageData Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
foundComment  
                        then (ByteString -> Metadata -> Metadata
parseVorbisComment ByteString
pageData Metadata
metadata, Bool
foundIdent, Bool
True)
                        else (Metadata
metadata, Bool
foundIdent, Bool
foundComment)
                  
                  -- Continue to next page
                  Handle -> Metadata -> Bool -> Bool -> IO Metadata
parseOggPages Handle
handle Metadata
newMetadata Bool
newFoundIdent Bool
newFoundComment
                else do
                  -- Skip this page's data since we have what we need
                  Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
RelativeSeek (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pageDataSize)
                  Metadata -> IO Metadata
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Metadata
metadata

-- | Parse Vorbis identification header (packet type 1)
parseVorbisInfo :: BS.ByteString -> Metadata -> Metadata
parseVorbisInfo :: ByteString -> Metadata -> Metadata
parseVorbisInfo ByteString
bs Metadata
metadata =
  if ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
30  -- Minimum size for valid header
    then Metadata
metadata
    else
      let lazyBs :: LazyByteString
lazyBs = ByteString -> LazyByteString
L.fromStrict ByteString
bs
      in case Get Metadata
-> LazyByteString
-> Either
     (LazyByteString, Int64, String) (LazyByteString, Int64, Metadata)
forall a.
Get a
-> LazyByteString
-> Either
     (LazyByteString, Int64, String) (LazyByteString, Int64, a)
runGetOrFail (Metadata -> Get Metadata
parseVorbisInfoGet Metadata
metadata) (Int64 -> LazyByteString -> LazyByteString
L.drop Int64
7 LazyByteString
lazyBs) of
        Left (LazyByteString, Int64, String)
_ -> Metadata
metadata
        Right (LazyByteString
_, Int64
_, Metadata
result) -> Metadata
result

parseVorbisInfoGet :: Metadata -> Get Metadata
parseVorbisInfoGet :: Metadata -> Get Metadata
parseVorbisInfoGet Metadata
metadata = do
  Word32
_ <- Get Word32
getWord32le  -- vorbisVersion
  Word8
audioChannels <- Get Word8
getWord8
  Word32
audioSampleRate <- Get Word32
getWord32le
  Word32
bitrateMaximum <- Get Word32
getWord32le
  Word32
bitrateNominal <- Get Word32
getWord32le
  Word32
bitrateMinimum <- Get Word32
getWord32le
  
  -- The nominal bitrate is the average bitrate
  let bitrate' :: Maybe Int
bitrate' = if Word32
bitrateNominal Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
                then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ Word32
bitrateNominal Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
1000
                else if Word32
bitrateMaximum Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0 Bool -> Bool -> Bool
&& Word32
bitrateMinimum Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
                then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ (Word32
bitrateMaximum Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
bitrateMinimum) Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
2000
                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 $ fromIntegral audioSampleRate
      , channels = Just $ fromIntegral audioChannels
      , bitrate = bitrate'
      , bitsPerSample = Nothing  -- Not in Vorbis info
      , duration = Nothing  -- Would need granule position from last page
      }
    }

-- | Parse Vorbis comment (packet type 3)
parseVorbisComment :: BS.ByteString -> Metadata -> Metadata
parseVorbisComment :: ByteString -> Metadata -> Metadata
parseVorbisComment ByteString
bs Metadata
metadata =
  if ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
7
    then Metadata
metadata
    else
      let lazyBs :: LazyByteString
lazyBs = ByteString -> LazyByteString
L.fromStrict ByteString
bs
      in case Get Metadata
-> LazyByteString
-> Either
     (LazyByteString, Int64, String) (LazyByteString, Int64, Metadata)
forall a.
Get a
-> LazyByteString
-> Either
     (LazyByteString, Int64, String) (LazyByteString, Int64, a)
runGetOrFail (Metadata -> Get Metadata
parseVorbisCommentGet Metadata
metadata) (Int64 -> LazyByteString -> LazyByteString
L.drop Int64
7 LazyByteString
lazyBs) of
        Left (LazyByteString, Int64, String)
_ -> Metadata
metadata
        Right (LazyByteString
_, Int64
_, Metadata
result) -> Metadata
result

parseVorbisCommentGet :: Metadata -> Get Metadata
parseVorbisCommentGet :: Metadata -> Get Metadata
parseVorbisCommentGet 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
    , albumArtInfo = HM.lookup "METADATA_BLOCK_PICTURE" tagMap >>= parseVorbisPictureInfo
    , 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
      }
    }
  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]
rest') -> 
              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]
:[ByteString]
rest'))
              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 Vorbis picture info (base64-encoded FLAC picture block, metadata only)
parseVorbisPictureInfo :: Text -> Maybe AlbumArtInfo
parseVorbisPictureInfo :: Text -> Maybe AlbumArtInfo
parseVorbisPictureInfo Text
encodedData =
  case ByteString -> Either String ByteString
B64.decode (Text -> ByteString
TE.encodeUtf8 Text
encodedData) of
    Left String
_ -> Maybe AlbumArtInfo
forall a. Maybe a
Nothing
    Right ByteString
pictureData -> ByteString -> Maybe AlbumArtInfo
parseFLACPictureBlockInfo ByteString
pictureData
  where
    parseFLACPictureBlockInfo :: BS.ByteString -> Maybe AlbumArtInfo
    parseFLACPictureBlockInfo :: ByteString -> Maybe AlbumArtInfo
parseFLACPictureBlockInfo ByteString
bs =
      let lazyBs :: LazyByteString
lazyBs = ByteString -> LazyByteString
L.fromStrict ByteString
bs
      in case Get AlbumArtInfo
-> LazyByteString
-> Either
     (LazyByteString, Int64, String)
     (LazyByteString, Int64, AlbumArtInfo)
forall a.
Get a
-> LazyByteString
-> Either
     (LazyByteString, Int64, String) (LazyByteString, Int64, a)
runGetOrFail Get AlbumArtInfo
parsePictureInfo LazyByteString
lazyBs of
        Left (LazyByteString, Int64, String)
_ -> Maybe AlbumArtInfo
forall a. Maybe a
Nothing
        Right (LazyByteString
_, Int64
_, AlbumArtInfo
artInfo) -> AlbumArtInfo -> Maybe AlbumArtInfo
forall a. a -> Maybe a
Just AlbumArtInfo
artInfo

    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 reading the actual picture data for performance
      -- 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 OGG file (full binary data for writing)
loadAlbumArtOGG :: OsPath -> Parser (Maybe AlbumArt)
loadAlbumArtOGG :: OsPath -> Parser (Maybe AlbumArt)
loadAlbumArtOGG 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 first page to check OGG signature
    ByteString
firstHeader <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle Int
27
    if ByteString -> Int
BS.length ByteString
firstHeader Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
27 Bool -> Bool -> Bool
|| Int -> ByteString -> ByteString
BS.take Int
4 ByteString
firstHeader ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"OggS"
      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
      else do
        -- Parse pages looking for Vorbis comment with METADATA_BLOCK_PICTURE
        Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
AbsoluteSeek Integer
0
        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 -> Bool -> Bool -> IO (Maybe AlbumArt)
searchForPicture Handle
handle Bool
False Bool
False

  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
    searchForPicture :: Handle -> Bool -> Bool -> IO (Maybe AlbumArt)
    searchForPicture :: Handle -> Bool -> Bool -> IO (Maybe AlbumArt)
searchForPicture Handle
handle Bool
foundIdent Bool
foundComment
      | Bool
foundIdent Bool -> Bool -> Bool
&& Bool
foundComment = 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  -- Checked all metadata, no picture
      | Bool
otherwise = do
          ByteString
headerBytes <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle Int
oggPageHeaderSize
          if ByteString -> Int
BS.length ByteString
headerBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
oggPageHeaderSize
            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 do
              if Int -> ByteString -> ByteString
BS.take Int
4 ByteString
headerBytes ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"OggS"
                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 do
                  let numSegments :: Int
numSegments = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
headerBytes Int
26
                  ByteString
segmentTable <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle Int
numSegments
                  let pageDataSize :: Int
pageDataSize = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Word8 -> Int) -> [Word8] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word8] -> [Int]) -> [Word8] -> [Int]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack ByteString
segmentTable

                  if Bool -> Bool
not Bool
foundIdent Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
foundComment
                    then do
                      ByteString
pageData <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle Int
pageDataSize
                      let (Bool
newFoundIdent, Bool
newFoundComment, Maybe AlbumArt
maybePicture) =
                            if ByteString
"\x01vorbis" ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString
pageData Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
foundIdent
                            then (Bool
True, Bool
foundComment, Maybe AlbumArt
forall a. Maybe a
Nothing)
                            else if ByteString
"\x03vorbis" ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString
pageData Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
foundComment
                            then (Bool
foundIdent, Bool
True, ByteString -> Maybe AlbumArt
extractPictureFromComment ByteString
pageData)
                            else (Bool
foundIdent, Bool
foundComment, Maybe AlbumArt
forall a. Maybe a
Nothing)

                      case Maybe AlbumArt
maybePicture of
                        Just AlbumArt
art -> Maybe AlbumArt -> IO (Maybe AlbumArt)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AlbumArt -> Maybe AlbumArt
forall a. a -> Maybe a
Just AlbumArt
art)
                        Maybe AlbumArt
Nothing -> Handle -> Bool -> Bool -> IO (Maybe AlbumArt)
searchForPicture Handle
handle Bool
newFoundIdent Bool
newFoundComment
                    else do
                      Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
RelativeSeek (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pageDataSize)
                      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

    extractPictureFromComment :: BS.ByteString -> Maybe AlbumArt
    extractPictureFromComment :: ByteString -> Maybe AlbumArt
extractPictureFromComment ByteString
bs =
      if ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
7
        then Maybe AlbumArt
forall a. Maybe a
Nothing
        else
          let lazyBs :: LazyByteString
lazyBs = ByteString -> LazyByteString
L.fromStrict ByteString
bs
          in case Get (Maybe AlbumArt)
-> LazyByteString
-> Either
     (LazyByteString, Int64, String)
     (LazyByteString, Int64, Maybe AlbumArt)
forall a.
Get a
-> LazyByteString
-> Either
     (LazyByteString, Int64, String) (LazyByteString, Int64, a)
runGetOrFail (Get (Maybe AlbumArt)
parseVorbisCommentForPicture) (Int64 -> LazyByteString -> LazyByteString
L.drop Int64
7 LazyByteString
lazyBs) of
            Left (LazyByteString, Int64, String)
_ -> Maybe AlbumArt
forall a. Maybe a
Nothing
            Right (LazyByteString
_, Int64
_, Maybe AlbumArt
result) -> Maybe AlbumArt
result

    parseVorbisCommentForPicture :: Get (Maybe AlbumArt)
    parseVorbisCommentForPicture :: Get (Maybe AlbumArt)
parseVorbisCommentForPicture = do
      Word32
vendorLength <- Get Word32
getWord32le
      Int -> Get ()
skip (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
vendorLength)
      Word32
numComments <- Get Word32
getWord32le
      Int -> Get (Maybe AlbumArt)
findPictureComment (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
numComments)

    findPictureComment :: Int -> Get (Maybe AlbumArt)
    findPictureComment :: Int -> Get (Maybe AlbumArt)
findPictureComment Int
0 = 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
    findPictureComment Int
n = do
      Word32
commentLength <- Get Word32
getWord32le
      ByteString
commentBytes <- Int -> Get ByteString
getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
commentLength)
      case Word8 -> ByteString -> [ByteString]
BS.split Word8
0x3D ByteString
commentBytes of
        (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
value
          in if Text
keyText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"METADATA_BLOCK_PICTURE"
             then 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
$ Text -> Maybe AlbumArt
parseVorbisPictureFull Text
valueText
             else Int -> Get (Maybe AlbumArt)
findPictureComment (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        [ByteString]
_ -> Int -> Get (Maybe AlbumArt)
findPictureComment (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

    parseVorbisPictureFull :: Text -> Maybe AlbumArt
    parseVorbisPictureFull :: Text -> Maybe AlbumArt
parseVorbisPictureFull Text
encodedData =
      case ByteString -> Either String ByteString
B64.decode (Text -> ByteString
TE.encodeUtf8 Text
encodedData) of
        Left String
_ -> Maybe AlbumArt
forall a. Maybe a
Nothing
        Right ByteString
pictureData -> ByteString -> Maybe AlbumArt
parseFLACPictureBlockFull ByteString
pictureData

    parseFLACPictureBlockFull :: BS.ByteString -> Maybe AlbumArt
    parseFLACPictureBlockFull :: ByteString -> Maybe AlbumArt
parseFLACPictureBlockFull ByteString
bs =
      let lazyBs :: LazyByteString
lazyBs = ByteString -> LazyByteString
L.fromStrict ByteString
bs
      in case Get AlbumArt
-> LazyByteString
-> Either
     (LazyByteString, Int64, String) (LazyByteString, Int64, AlbumArt)
forall a.
Get a
-> LazyByteString
-> Either
     (LazyByteString, Int64, String) (LazyByteString, Int64, a)
runGetOrFail Get AlbumArt
parsePictureData LazyByteString
lazyBs of
        Left (LazyByteString, Int64, String)
_ -> Maybe AlbumArt
forall a. Maybe a
Nothing
        Right (LazyByteString
_, Int64
_, 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