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

module Monatone.Common
  ( detectFormat
  , parseMetadata
  , loadAlbumArt
  ) where

import Control.Monad.Except (runExceptT)
import Data.Bits
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import System.IO (IOMode(..))
import System.OsPath
import System.File.OsPath (withBinaryFile)

import Monatone.Metadata
import Monatone.Types
import qualified Monatone.FLAC as FLAC
import qualified Monatone.OGG as OGG
import qualified Monatone.MP3 as MP3

-- | Detect audio format from file header
detectFormat :: ByteString -> Maybe AudioFormat
detectFormat :: ByteString -> Maybe AudioFormat
detectFormat ByteString
bs
  | ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
"fLaC" ByteString
bs = AudioFormat -> Maybe AudioFormat
forall a. a -> Maybe a
Just AudioFormat
FLAC
  | ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
"OggS" ByteString
bs = ByteString -> Maybe AudioFormat
detectOggFormat ByteString
bs
  | ByteString -> Bool
hasMP3Header ByteString
bs = AudioFormat -> Maybe AudioFormat
forall a. a -> Maybe a
Just AudioFormat
MP3
  | Bool
otherwise = Maybe AudioFormat
forall a. Maybe a
Nothing

-- | Detect specific OGG format (Vorbis vs Opus)
detectOggFormat :: ByteString -> Maybe AudioFormat
detectOggFormat :: ByteString -> Maybe AudioFormat
detectOggFormat ByteString
bs
  | ByteString -> ByteString -> Bool
BS.isInfixOf ByteString
"OpusHead" ByteString
bs = AudioFormat -> Maybe AudioFormat
forall a. a -> Maybe a
Just AudioFormat
Opus
  | ByteString -> ByteString -> Bool
BS.isInfixOf ByteString
"vorbis" ByteString
bs = AudioFormat -> Maybe AudioFormat
forall a. a -> Maybe a
Just AudioFormat
OGG
  | Bool
otherwise = AudioFormat -> Maybe AudioFormat
forall a. a -> Maybe a
Just AudioFormat
OGG  -- Default to OGG for unknown OGG streams

-- | Check for MP3 header (ID3 or sync frame)
hasMP3Header :: ByteString -> Bool
hasMP3Header :: ByteString -> Bool
hasMP3Header ByteString
bs
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 = Bool
False
  | ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
"ID3" ByteString
bs = Bool
True
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 = 
      let firstByte :: Word8
firstByte = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
0
          secondByte :: Word8
secondByte = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
1
      in Word8
firstByte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xFF Bool -> Bool -> Bool
&& (Word8
secondByte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xE0) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xE0
  | Bool
otherwise = Bool
False

-- | Parse metadata from file
parseMetadata :: OsPath -> IO (Either ParseError Metadata)
parseMetadata :: OsPath -> IO (Either ParseError Metadata)
parseMetadata OsPath
filePath = do
  -- Only read first 12 bytes for format detection
  ByteString
header <- OsPath -> IOMode -> (Handle -> IO ByteString) -> IO ByteString
forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile OsPath
filePath IOMode
ReadMode ((Handle -> IO ByteString) -> IO ByteString)
-> (Handle -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Handle
h -> Handle -> Int -> IO ByteString
BS.hGet Handle
h Int
12
  case ByteString -> Maybe AudioFormat
detectFormat ByteString
header of
    Maybe AudioFormat
Nothing -> 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
"Unknown audio format"
    Just AudioFormat
fmt -> ExceptT ParseError IO Metadata -> IO (Either ParseError Metadata)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ParseError IO Metadata -> IO (Either ParseError Metadata))
-> ExceptT ParseError IO Metadata
-> IO (Either ParseError Metadata)
forall a b. (a -> b) -> a -> b
$ case AudioFormat
fmt of
      AudioFormat
FLAC -> OsPath -> ExceptT ParseError IO Metadata
FLAC.parseFLAC OsPath
filePath
      AudioFormat
OGG -> OsPath -> ExceptT ParseError IO Metadata
OGG.parseOGG OsPath
filePath
      AudioFormat
Opus -> OsPath -> ExceptT ParseError IO Metadata
OGG.parseOGG OsPath
filePath  -- Opus uses same OGG container format
      AudioFormat
MP3 -> OsPath -> ExceptT ParseError IO Metadata
MP3.parseMP3 OsPath
filePath

-- | Load full album art from file on-demand (for writing)
-- This reads only the album art data, not all metadata
loadAlbumArt :: OsPath -> IO (Either ParseError (Maybe AlbumArt))
loadAlbumArt :: OsPath -> IO (Either ParseError (Maybe AlbumArt))
loadAlbumArt OsPath
filePath = do
  -- Only read first 12 bytes for format detection
  ByteString
header <- OsPath -> IOMode -> (Handle -> IO ByteString) -> IO ByteString
forall r. OsPath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile OsPath
filePath IOMode
ReadMode ((Handle -> IO ByteString) -> IO ByteString)
-> (Handle -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Handle
h -> Handle -> Int -> IO ByteString
BS.hGet Handle
h Int
12
  case ByteString -> Maybe AudioFormat
detectFormat ByteString
header of
    Maybe AudioFormat
Nothing -> 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
UnsupportedFormat Text
"Unknown audio format"
    Just AudioFormat
fmt -> ExceptT ParseError IO (Maybe AlbumArt)
-> IO (Either ParseError (Maybe AlbumArt))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ParseError IO (Maybe AlbumArt)
 -> IO (Either ParseError (Maybe AlbumArt)))
-> ExceptT ParseError IO (Maybe AlbumArt)
-> IO (Either ParseError (Maybe AlbumArt))
forall a b. (a -> b) -> a -> b
$ case AudioFormat
fmt of
      AudioFormat
FLAC -> OsPath -> ExceptT ParseError IO (Maybe AlbumArt)
FLAC.loadAlbumArtFLAC OsPath
filePath
      AudioFormat
OGG -> OsPath -> ExceptT ParseError IO (Maybe AlbumArt)
OGG.loadAlbumArtOGG OsPath
filePath
      AudioFormat
Opus -> OsPath -> ExceptT ParseError IO (Maybe AlbumArt)
OGG.loadAlbumArtOGG OsPath
filePath
      AudioFormat
MP3 -> OsPath -> ExceptT ParseError IO (Maybe AlbumArt)
MP3.loadAlbumArtMP3 OsPath
filePath