{-# LANGUAGE OverloadedStrings #-}

-- | Main module for audio metadata parsing and representation.
-- 
-- This module provides the core types and functions for working with
-- audio metadata across different formats (FLAC, MP3, OGG/Vorbis, Opus).
module Monatone.Metadata
  ( AudioFormat(..)
  , Metadata(..)
  , AudioProperties(..)
  , MusicBrainzIds(..)
  , AlbumArtInfo(..)
  , AlbumArt(..)
  , emptyMetadata
  , emptyAudioProperties
  , emptyMusicBrainzIds
  ) where

import Data.ByteString (ByteString)
import Data.Text (Text)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.Word (Word8)
import Data.Aeson

-- | Supported audio formats
data AudioFormat 
  = FLAC
  | OGG
  | Opus  
  | MP3
  deriving (Int -> AudioFormat -> ShowS
[AudioFormat] -> ShowS
AudioFormat -> String
(Int -> AudioFormat -> ShowS)
-> (AudioFormat -> String)
-> ([AudioFormat] -> ShowS)
-> Show AudioFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AudioFormat -> ShowS
showsPrec :: Int -> AudioFormat -> ShowS
$cshow :: AudioFormat -> String
show :: AudioFormat -> String
$cshowList :: [AudioFormat] -> ShowS
showList :: [AudioFormat] -> ShowS
Show, AudioFormat -> AudioFormat -> Bool
(AudioFormat -> AudioFormat -> Bool)
-> (AudioFormat -> AudioFormat -> Bool) -> Eq AudioFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AudioFormat -> AudioFormat -> Bool
== :: AudioFormat -> AudioFormat -> Bool
$c/= :: AudioFormat -> AudioFormat -> Bool
/= :: AudioFormat -> AudioFormat -> Bool
Eq, Eq AudioFormat
Eq AudioFormat =>
(AudioFormat -> AudioFormat -> Ordering)
-> (AudioFormat -> AudioFormat -> Bool)
-> (AudioFormat -> AudioFormat -> Bool)
-> (AudioFormat -> AudioFormat -> Bool)
-> (AudioFormat -> AudioFormat -> Bool)
-> (AudioFormat -> AudioFormat -> AudioFormat)
-> (AudioFormat -> AudioFormat -> AudioFormat)
-> Ord AudioFormat
AudioFormat -> AudioFormat -> Bool
AudioFormat -> AudioFormat -> Ordering
AudioFormat -> AudioFormat -> AudioFormat
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AudioFormat -> AudioFormat -> Ordering
compare :: AudioFormat -> AudioFormat -> Ordering
$c< :: AudioFormat -> AudioFormat -> Bool
< :: AudioFormat -> AudioFormat -> Bool
$c<= :: AudioFormat -> AudioFormat -> Bool
<= :: AudioFormat -> AudioFormat -> Bool
$c> :: AudioFormat -> AudioFormat -> Bool
> :: AudioFormat -> AudioFormat -> Bool
$c>= :: AudioFormat -> AudioFormat -> Bool
>= :: AudioFormat -> AudioFormat -> Bool
$cmax :: AudioFormat -> AudioFormat -> AudioFormat
max :: AudioFormat -> AudioFormat -> AudioFormat
$cmin :: AudioFormat -> AudioFormat -> AudioFormat
min :: AudioFormat -> AudioFormat -> AudioFormat
Ord, ReadPrec [AudioFormat]
ReadPrec AudioFormat
Int -> ReadS AudioFormat
ReadS [AudioFormat]
(Int -> ReadS AudioFormat)
-> ReadS [AudioFormat]
-> ReadPrec AudioFormat
-> ReadPrec [AudioFormat]
-> Read AudioFormat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AudioFormat
readsPrec :: Int -> ReadS AudioFormat
$creadList :: ReadS [AudioFormat]
readList :: ReadS [AudioFormat]
$creadPrec :: ReadPrec AudioFormat
readPrec :: ReadPrec AudioFormat
$creadListPrec :: ReadPrec [AudioFormat]
readListPrec :: ReadPrec [AudioFormat]
Read)

instance ToJSON AudioFormat where
  toJSON :: AudioFormat -> Value
toJSON AudioFormat
FLAC = Value
"flac"
  toJSON AudioFormat
OGG = Value
"ogg"
  toJSON AudioFormat
Opus = Value
"opus"
  toJSON AudioFormat
MP3 = Value
"mp3"

instance FromJSON AudioFormat where
  parseJSON :: Value -> Parser AudioFormat
parseJSON = String
-> (Text -> Parser AudioFormat) -> Value -> Parser AudioFormat
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"AudioFormat" ((Text -> Parser AudioFormat) -> Value -> Parser AudioFormat)
-> (Text -> Parser AudioFormat) -> Value -> Parser AudioFormat
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"flac" -> AudioFormat -> Parser AudioFormat
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return AudioFormat
FLAC
    Text
"ogg" -> AudioFormat -> Parser AudioFormat
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return AudioFormat
OGG
    Text
"opus" -> AudioFormat -> Parser AudioFormat
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return AudioFormat
Opus
    Text
"mp3" -> AudioFormat -> Parser AudioFormat
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return AudioFormat
MP3
    Text
_ -> String -> Parser AudioFormat
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser AudioFormat) -> String -> Parser AudioFormat
forall a b. (a -> b) -> a -> b
$ String
"Unknown audio format: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t

-- | Audio file properties
data AudioProperties = AudioProperties
  { AudioProperties -> Maybe Int
duration :: Maybe Int        -- Duration in milliseconds
  , AudioProperties -> Maybe Int
bitrate :: Maybe Int         -- Bitrate in kbps (only for lossy formats like MP3)
  , AudioProperties -> Maybe Int
sampleRate :: Maybe Int      -- Sample rate in Hz
  , AudioProperties -> Maybe Int
channels :: Maybe Int        -- Number of channels
  , AudioProperties -> Maybe Int
bitsPerSample :: Maybe Int   -- Bits per sample (bit depth)
  } deriving (Int -> AudioProperties -> ShowS
[AudioProperties] -> ShowS
AudioProperties -> String
(Int -> AudioProperties -> ShowS)
-> (AudioProperties -> String)
-> ([AudioProperties] -> ShowS)
-> Show AudioProperties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AudioProperties -> ShowS
showsPrec :: Int -> AudioProperties -> ShowS
$cshow :: AudioProperties -> String
show :: AudioProperties -> String
$cshowList :: [AudioProperties] -> ShowS
showList :: [AudioProperties] -> ShowS
Show, AudioProperties -> AudioProperties -> Bool
(AudioProperties -> AudioProperties -> Bool)
-> (AudioProperties -> AudioProperties -> Bool)
-> Eq AudioProperties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AudioProperties -> AudioProperties -> Bool
== :: AudioProperties -> AudioProperties -> Bool
$c/= :: AudioProperties -> AudioProperties -> Bool
/= :: AudioProperties -> AudioProperties -> Bool
Eq)

-- | MusicBrainz identifiers
data MusicBrainzIds = MusicBrainzIds
  { MusicBrainzIds -> Maybe Text
mbRecordingId :: Maybe Text
  , MusicBrainzIds -> Maybe Text
mbTrackId :: Maybe Text
  , MusicBrainzIds -> Maybe Text
mbReleaseId :: Maybe Text
  , MusicBrainzIds -> Maybe Text
mbArtistId :: Maybe Text
  , MusicBrainzIds -> Maybe Text
mbAlbumArtistId :: Maybe Text  -- Album artist can differ from track artist
  , MusicBrainzIds -> Maybe Text
mbReleaseGroupId :: Maybe Text
  , MusicBrainzIds -> Maybe Text
mbWorkId :: Maybe Text          -- For classical works
  , MusicBrainzIds -> Maybe Text
mbDiscId :: Maybe Text          -- CD TOC-based disc ID
  } deriving (Int -> MusicBrainzIds -> ShowS
[MusicBrainzIds] -> ShowS
MusicBrainzIds -> String
(Int -> MusicBrainzIds -> ShowS)
-> (MusicBrainzIds -> String)
-> ([MusicBrainzIds] -> ShowS)
-> Show MusicBrainzIds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MusicBrainzIds -> ShowS
showsPrec :: Int -> MusicBrainzIds -> ShowS
$cshow :: MusicBrainzIds -> String
show :: MusicBrainzIds -> String
$cshowList :: [MusicBrainzIds] -> ShowS
showList :: [MusicBrainzIds] -> ShowS
Show, MusicBrainzIds -> MusicBrainzIds -> Bool
(MusicBrainzIds -> MusicBrainzIds -> Bool)
-> (MusicBrainzIds -> MusicBrainzIds -> Bool) -> Eq MusicBrainzIds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MusicBrainzIds -> MusicBrainzIds -> Bool
== :: MusicBrainzIds -> MusicBrainzIds -> Bool
$c/= :: MusicBrainzIds -> MusicBrainzIds -> Bool
/= :: MusicBrainzIds -> MusicBrainzIds -> Bool
Eq)

-- | Album art metadata without binary data (lightweight for scanning)
data AlbumArtInfo = AlbumArtInfo
  { AlbumArtInfo -> Text
albumArtInfoMimeType :: Text           -- e.g., "image/jpeg", "image/png"
  , AlbumArtInfo -> Word8
albumArtInfoPictureType :: Word8       -- ID3v2 picture type (0 = Other, 3 = Cover Front, etc.)
  , AlbumArtInfo -> Text
albumArtInfoDescription :: Text        -- Textual description
  , AlbumArtInfo -> Int
albumArtInfoSizeBytes :: Int           -- Size of image data in bytes
  } deriving (Int -> AlbumArtInfo -> ShowS
[AlbumArtInfo] -> ShowS
AlbumArtInfo -> String
(Int -> AlbumArtInfo -> ShowS)
-> (AlbumArtInfo -> String)
-> ([AlbumArtInfo] -> ShowS)
-> Show AlbumArtInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AlbumArtInfo -> ShowS
showsPrec :: Int -> AlbumArtInfo -> ShowS
$cshow :: AlbumArtInfo -> String
show :: AlbumArtInfo -> String
$cshowList :: [AlbumArtInfo] -> ShowS
showList :: [AlbumArtInfo] -> ShowS
Show, AlbumArtInfo -> AlbumArtInfo -> Bool
(AlbumArtInfo -> AlbumArtInfo -> Bool)
-> (AlbumArtInfo -> AlbumArtInfo -> Bool) -> Eq AlbumArtInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AlbumArtInfo -> AlbumArtInfo -> Bool
== :: AlbumArtInfo -> AlbumArtInfo -> Bool
$c/= :: AlbumArtInfo -> AlbumArtInfo -> Bool
/= :: AlbumArtInfo -> AlbumArtInfo -> Bool
Eq)

-- | Album art / attached picture (includes full binary data)
data AlbumArt = AlbumArt
  { AlbumArt -> Text
albumArtMimeType :: Text           -- e.g., "image/jpeg", "image/png"
  , AlbumArt -> Word8
albumArtPictureType :: Word8       -- ID3v2 picture type (0 = Other, 3 = Cover Front, etc.)
  , AlbumArt -> Text
albumArtDescription :: Text        -- Textual description
  , AlbumArt -> ByteString
albumArtData :: ByteString         -- Binary image data
  } deriving (Int -> AlbumArt -> ShowS
[AlbumArt] -> ShowS
AlbumArt -> String
(Int -> AlbumArt -> ShowS)
-> (AlbumArt -> String) -> ([AlbumArt] -> ShowS) -> Show AlbumArt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AlbumArt -> ShowS
showsPrec :: Int -> AlbumArt -> ShowS
$cshow :: AlbumArt -> String
show :: AlbumArt -> String
$cshowList :: [AlbumArt] -> ShowS
showList :: [AlbumArt] -> ShowS
Show, AlbumArt -> AlbumArt -> Bool
(AlbumArt -> AlbumArt -> Bool)
-> (AlbumArt -> AlbumArt -> Bool) -> Eq AlbumArt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AlbumArt -> AlbumArt -> Bool
== :: AlbumArt -> AlbumArt -> Bool
$c/= :: AlbumArt -> AlbumArt -> Bool
/= :: AlbumArt -> AlbumArt -> Bool
Eq)

-- | Complete metadata for an audio file
data Metadata = Metadata
  { Metadata -> AudioFormat
format :: AudioFormat
  , Metadata -> Maybe Text
title :: Maybe Text
  , Metadata -> Maybe Text
artist :: Maybe Text
  , Metadata -> Maybe Text
album :: Maybe Text
  , Metadata -> Maybe Text
albumArtist :: Maybe Text
  , Metadata -> Maybe Int
trackNumber :: Maybe Int
  , Metadata -> Maybe Int
totalTracks :: Maybe Int      -- Total tracks in album
  , Metadata -> Maybe Int
discNumber :: Maybe Int
  , Metadata -> Maybe Int
totalDiscs :: Maybe Int       -- Total discs in album
  , Metadata -> Maybe Text
date :: Maybe Text
  , Metadata -> Maybe Int
year :: Maybe Int
  , Metadata -> Maybe Text
genre :: Maybe Text
  , Metadata -> Maybe Text
publisher :: Maybe Text
  , Metadata -> Maybe Text
comment :: Maybe Text
  , Metadata -> Maybe Text
releaseCountry :: Maybe Text  -- Country of release
  , Metadata -> Maybe Text
recordLabel :: Maybe Text     -- Record label  
  , Metadata -> Maybe Text
catalogNumber :: Maybe Text   -- Catalog number
  , Metadata -> Maybe Text
barcode :: Maybe Text         -- Barcode/UPC
  , Metadata -> Maybe Text
releaseStatus :: Maybe Text   -- Official, Promotional, etc.
  , Metadata -> Maybe Text
releaseType :: Maybe Text     -- Album, Single, EP, etc.
  , Metadata -> Maybe AlbumArtInfo
albumArtInfo :: Maybe AlbumArtInfo  -- Album artwork metadata (lightweight)
  , Metadata -> AudioProperties
audioProperties :: AudioProperties
  , Metadata -> MusicBrainzIds
musicBrainzIds :: MusicBrainzIds
  , Metadata -> Maybe Text
acoustidFingerprint :: Maybe Text  -- Chromaprint/AcoustID fingerprint
  , Metadata -> Maybe Text
acoustidId :: Maybe Text           -- AcoustID identifier
  , Metadata -> HashMap Text Text
rawTags :: HashMap Text Text  -- All raw tags from the file
  } deriving (Int -> Metadata -> ShowS
[Metadata] -> ShowS
Metadata -> String
(Int -> Metadata -> ShowS)
-> (Metadata -> String) -> ([Metadata] -> ShowS) -> Show Metadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Metadata -> ShowS
showsPrec :: Int -> Metadata -> ShowS
$cshow :: Metadata -> String
show :: Metadata -> String
$cshowList :: [Metadata] -> ShowS
showList :: [Metadata] -> ShowS
Show, Metadata -> Metadata -> Bool
(Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool) -> Eq Metadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Metadata -> Metadata -> Bool
== :: Metadata -> Metadata -> Bool
$c/= :: Metadata -> Metadata -> Bool
/= :: Metadata -> Metadata -> Bool
Eq)

-- | Empty metadata with only format specified
emptyMetadata :: AudioFormat -> Metadata
emptyMetadata :: AudioFormat -> Metadata
emptyMetadata AudioFormat
fmt = Metadata
  { format :: AudioFormat
format = AudioFormat
fmt
  , title :: Maybe Text
title = Maybe Text
forall a. Maybe a
Nothing
  , artist :: Maybe Text
artist = Maybe Text
forall a. Maybe a
Nothing
  , album :: Maybe Text
album = Maybe Text
forall a. Maybe a
Nothing
  , albumArtist :: Maybe Text
albumArtist = Maybe Text
forall a. Maybe a
Nothing
  , trackNumber :: Maybe Int
trackNumber = Maybe Int
forall a. Maybe a
Nothing
  , totalTracks :: Maybe Int
totalTracks = Maybe Int
forall a. Maybe a
Nothing
  , discNumber :: Maybe Int
discNumber = Maybe Int
forall a. Maybe a
Nothing
  , totalDiscs :: Maybe Int
totalDiscs = Maybe Int
forall a. Maybe a
Nothing
  , date :: Maybe Text
date = Maybe Text
forall a. Maybe a
Nothing
  , year :: Maybe Int
year = Maybe Int
forall a. Maybe a
Nothing
  , genre :: Maybe Text
genre = Maybe Text
forall a. Maybe a
Nothing
  , publisher :: Maybe Text
publisher = Maybe Text
forall a. Maybe a
Nothing
  , comment :: Maybe Text
comment = Maybe Text
forall a. Maybe a
Nothing
  , releaseCountry :: Maybe Text
releaseCountry = Maybe Text
forall a. Maybe a
Nothing
  , recordLabel :: Maybe Text
recordLabel = Maybe Text
forall a. Maybe a
Nothing
  , catalogNumber :: Maybe Text
catalogNumber = Maybe Text
forall a. Maybe a
Nothing
  , barcode :: Maybe Text
barcode = Maybe Text
forall a. Maybe a
Nothing
  , releaseStatus :: Maybe Text
releaseStatus = Maybe Text
forall a. Maybe a
Nothing
  , releaseType :: Maybe Text
releaseType = Maybe Text
forall a. Maybe a
Nothing
  , albumArtInfo :: Maybe AlbumArtInfo
albumArtInfo = Maybe AlbumArtInfo
forall a. Maybe a
Nothing
  , audioProperties :: AudioProperties
audioProperties = AudioProperties
emptyAudioProperties
  , musicBrainzIds :: MusicBrainzIds
musicBrainzIds = MusicBrainzIds
emptyMusicBrainzIds
  , acoustidFingerprint :: Maybe Text
acoustidFingerprint = Maybe Text
forall a. Maybe a
Nothing
  , acoustidId :: Maybe Text
acoustidId = Maybe Text
forall a. Maybe a
Nothing
  , rawTags :: HashMap Text Text
rawTags = HashMap Text Text
forall k v. HashMap k v
HM.empty
  }

-- | Empty audio properties
emptyAudioProperties :: AudioProperties
emptyAudioProperties :: AudioProperties
emptyAudioProperties = AudioProperties
  { duration :: Maybe Int
duration = Maybe Int
forall a. Maybe a
Nothing
  , bitrate :: Maybe Int
bitrate = Maybe Int
forall a. Maybe a
Nothing
  , sampleRate :: Maybe Int
sampleRate = Maybe Int
forall a. Maybe a
Nothing
  , channels :: Maybe Int
channels = Maybe Int
forall a. Maybe a
Nothing
  , bitsPerSample :: Maybe Int
bitsPerSample = Maybe Int
forall a. Maybe a
Nothing
  }

-- | Empty MusicBrainz IDs
emptyMusicBrainzIds :: MusicBrainzIds
emptyMusicBrainzIds :: MusicBrainzIds
emptyMusicBrainzIds = MusicBrainzIds
  { mbRecordingId :: Maybe Text
mbRecordingId = Maybe Text
forall a. Maybe a
Nothing
  , mbTrackId :: Maybe Text
mbTrackId = Maybe Text
forall a. Maybe a
Nothing
  , mbReleaseId :: Maybe Text
mbReleaseId = Maybe Text
forall a. Maybe a
Nothing
  , mbArtistId :: Maybe Text
mbArtistId = Maybe Text
forall a. Maybe a
Nothing
  , mbAlbumArtistId :: Maybe Text
mbAlbumArtistId = Maybe Text
forall a. Maybe a
Nothing
  , mbReleaseGroupId :: Maybe Text
mbReleaseGroupId = Maybe Text
forall a. Maybe a
Nothing
  , mbWorkId :: Maybe Text
mbWorkId = Maybe Text
forall a. Maybe a
Nothing
  , mbDiscId :: Maybe Text
mbDiscId = Maybe Text
forall a. Maybe a
Nothing
  }