Writer.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE QuasiQuotes #-}

module Monatone.Writer
  ( -- * Write errors
    WriteError(..)
  , Writer
    -- * Metadata updates
  , MetadataUpdate(..)
  , emptyUpdate
    -- * Building updates
  , setTitle
  , setArtist
  , setAlbum
  , setAlbumArtist
  , setTrackNumber
  , setDiscNumber
  , setYear
  , setDate
  , setGenre
  , setPublisher
  , setComment
  , setReleaseCountry
  , setLabel
  , setCatalogNumber
  , setBarcode
  , setAlbumArt
    -- * Clearing fields
  , clearTitle
  , clearArtist
  , clearAlbum
  , clearComment
  , removeAlbumArt
    -- * Writing operations
  , writeMetadata
  , updateMetadata
  ) where

import Control.Monad.Except (ExceptT, throwError, runExceptT)
import Control.Monad.IO.Class (liftIO)
import Data.Text (Text)
import qualified Data.Text as T
import System.OsPath
import System.Directory.OsPath (copyFile, renameFile, removeFile)
import Control.Exception (try, IOException, evaluate)

import Monatone.Metadata
import Monatone.Types (Parser, ParseError(..))
import Monatone.Common (loadAlbumArt)
import qualified Monatone.MP3 as MP3
import qualified Monatone.FLAC as FLAC
import qualified Monatone.M4A as M4A
import qualified Monatone.MP3.Writer as MP3Writer
import qualified Monatone.FLAC.Writer as FLACWriter
import qualified Monatone.M4A.Writer as M4AWriter

-- | Write operation errors
data WriteError
  = WriteIOError Text                    -- File I/O error
  | UnsupportedWriteFormat AudioFormat   -- Format not supported for writing
  | InvalidMetadata Text                 -- Metadata validation failed
  | CorruptedWrite Text                  -- Something went wrong during write
  deriving (Show, Eq)

-- | Writer monad for write operations
type Writer = ExceptT WriteError IO

-- | Metadata update specification
-- This represents what changes to make to existing metadata
data MetadataUpdate = MetadataUpdate
  { updateTitle :: Maybe (Maybe Text)        -- Nothing = no change, Just Nothing = clear, Just (Just x) = set to x
  , updateArtist :: Maybe (Maybe Text)
  , updateAlbum :: Maybe (Maybe Text)
  , updateAlbumArtist :: Maybe (Maybe Text)
  , updateTrackNumber :: Maybe (Maybe Int)
  , updateDiscNumber :: Maybe (Maybe Int)
  , updateYear :: Maybe (Maybe Int)
  , updateDate :: Maybe (Maybe Text)
  , updateGenre :: Maybe (Maybe Text)
  , updatePublisher :: Maybe (Maybe Text)
  , updateComment :: Maybe (Maybe Text)
  , updateReleaseCountry :: Maybe (Maybe Text)
  , updateRecordLabel :: Maybe (Maybe Text)
  , updateCatalogNumber :: Maybe (Maybe Text)
  , updateBarcode :: Maybe (Maybe Text)
  , updateAlbumArt :: Maybe (Maybe AlbumArt) -- Nothing = no change, Just Nothing = remove, Just (Just art) = set
  } deriving (Show, Eq)

-- | Empty metadata update (no changes)
emptyUpdate :: MetadataUpdate
emptyUpdate = MetadataUpdate
  { updateTitle = Nothing
  , updateArtist = Nothing
  , updateAlbum = Nothing
  , updateAlbumArtist = Nothing
  , updateTrackNumber = Nothing
  , updateDiscNumber = Nothing
  , updateYear = Nothing
  , updateDate = Nothing
  , updateGenre = Nothing
  , updatePublisher = Nothing
  , updateComment = Nothing
  , updateReleaseCountry = Nothing
  , updateRecordLabel = Nothing
  , updateCatalogNumber = Nothing
  , updateBarcode = Nothing
  , updateAlbumArt = Nothing
  }

-- | Set title
setTitle :: Text -> MetadataUpdate -> MetadataUpdate
setTitle newTitle update = update { updateTitle = Just (Just newTitle) }

-- | Set artist
setArtist :: Text -> MetadataUpdate -> MetadataUpdate
setArtist newArtist update = update { updateArtist = Just (Just newArtist) }

-- | Set album
setAlbum :: Text -> MetadataUpdate -> MetadataUpdate
setAlbum newAlbum update = update { updateAlbum = Just (Just newAlbum) }

-- | Set album artist
setAlbumArtist :: Text -> MetadataUpdate -> MetadataUpdate
setAlbumArtist newAlbumArtist update = update { updateAlbumArtist = Just (Just newAlbumArtist) }

-- | Set track number
setTrackNumber :: Int -> MetadataUpdate -> MetadataUpdate
setTrackNumber newTrackNumber update = update { updateTrackNumber = Just (Just newTrackNumber) }

-- | Set disc number
setDiscNumber :: Int -> MetadataUpdate -> MetadataUpdate
setDiscNumber newDiscNumber update = update { updateDiscNumber = Just (Just newDiscNumber) }

-- | Set year
setYear :: Int -> MetadataUpdate -> MetadataUpdate
setYear newYear update = update
  { updateYear = Just (Just newYear)
  , updateDate = Just (Just (T.pack $ show newYear))  -- Also update date field for formats that use it
  }

-- | Set genre
setGenre :: Text -> MetadataUpdate -> MetadataUpdate
setGenre newGenre update = update { updateGenre = Just (Just newGenre) }

-- | Set publisher
setPublisher :: Text -> MetadataUpdate -> MetadataUpdate
setPublisher newPublisher update = update { updatePublisher = Just (Just newPublisher) }

-- | Set comment
setComment :: Text -> MetadataUpdate -> MetadataUpdate
setComment newComment update = update { updateComment = Just (Just newComment) }

-- | Set album art
setAlbumArt :: AlbumArt -> MetadataUpdate -> MetadataUpdate
setAlbumArt art update = update { updateAlbumArt = Just (Just art) }

-- | Set date
setDate :: Text -> MetadataUpdate -> MetadataUpdate
setDate newDate update = update { updateDate = Just (Just newDate) }

-- | Set release country
setReleaseCountry :: Text -> MetadataUpdate -> MetadataUpdate
setReleaseCountry newCountry update = update { updateReleaseCountry = Just (Just newCountry) }

-- | Set record label
setLabel :: Text -> MetadataUpdate -> MetadataUpdate
setLabel newLabel update = update { updateRecordLabel = Just (Just newLabel) }

-- | Set catalog number
setCatalogNumber :: Text -> MetadataUpdate -> MetadataUpdate
setCatalogNumber newCatalog update = update { updateCatalogNumber = Just (Just newCatalog) }

-- | Set barcode
setBarcode :: Text -> MetadataUpdate -> MetadataUpdate
setBarcode newBarcode update = update { updateBarcode = Just (Just newBarcode) }

-- | Clear title field
clearTitle :: MetadataUpdate -> MetadataUpdate
clearTitle update = update { updateTitle = Just Nothing }

-- | Clear artist field  
clearArtist :: MetadataUpdate -> MetadataUpdate
clearArtist update = update { updateArtist = Just Nothing }

-- | Clear album field
clearAlbum :: MetadataUpdate -> MetadataUpdate  
clearAlbum update = update { updateAlbum = Just Nothing }

-- | Clear comment field
clearComment :: MetadataUpdate -> MetadataUpdate
clearComment update = update { updateComment = Just Nothing }

-- | Remove album art
removeAlbumArt :: MetadataUpdate -> MetadataUpdate
removeAlbumArt update = update { updateAlbumArt = Just Nothing }

-- | Apply metadata update to existing metadata
applyUpdate :: MetadataUpdate -> Metadata -> Metadata
applyUpdate update metadata =
  let !fmt = format metadata
      !props = audioProperties metadata
      !mbids = musicBrainzIds metadata
      !acoustFP = acoustidFingerprint metadata
      !acoustID = acoustidId metadata
      !tags = rawTags metadata
      !totTracks = totalTracks metadata
      !totDiscs = totalDiscs metadata
      !relStatus = releaseStatus metadata
      !relType = releaseType metadata
      -- Album art info is read-only (no writing support for now, as Metadata only stores info not data)
      !artInfo = albumArtInfo metadata
  in Metadata
    { format = fmt
    , title = applyMaybeUpdate (updateTitle update) (title metadata)
    , artist = applyMaybeUpdate (updateArtist update) (artist metadata)
    , album = applyMaybeUpdate (updateAlbum update) (album metadata)
    , albumArtist = applyMaybeUpdate (updateAlbumArtist update) (albumArtist metadata)
    , trackNumber = applyMaybeUpdate (updateTrackNumber update) (trackNumber metadata)
    , totalTracks = totTracks
    , discNumber = applyMaybeUpdate (updateDiscNumber update) (discNumber metadata)
    , totalDiscs = totDiscs
    , date = applyMaybeUpdate (updateDate update) (date metadata)
    , year = applyMaybeUpdate (updateYear update) (year metadata)
    , genre = applyMaybeUpdate (updateGenre update) (genre metadata)
    , publisher = applyMaybeUpdate (updatePublisher update) (publisher metadata)
    , comment = applyMaybeUpdate (updateComment update) (comment metadata)
    , releaseCountry = applyMaybeUpdate (updateReleaseCountry update) (releaseCountry metadata)
    , recordLabel = applyMaybeUpdate (updateRecordLabel update) (recordLabel metadata)
    , catalogNumber = applyMaybeUpdate (updateCatalogNumber update) (catalogNumber metadata)
    , barcode = applyMaybeUpdate (updateBarcode update) (barcode metadata)
    , releaseStatus = relStatus
    , releaseType = relType
    , albumArtInfo = artInfo  -- Read-only, no writing support
    , audioProperties = props
    , musicBrainzIds = mbids
    , acoustidFingerprint = acoustFP
    , acoustidId = acoustID
    , rawTags = tags
    }
  where
    applyMaybeUpdate :: Maybe (Maybe a) -> Maybe a -> Maybe a
    applyMaybeUpdate Nothing current = current          -- No change
    applyMaybeUpdate (Just newValue) _ = newValue       -- Apply change (including clearing)

-- | Write complete metadata to a file, atomically.
--
-- The file is copied to a temporary sibling, the format writer modifies the
-- copy, and the copy is renamed over the original. A crash or failed write
-- leaves the original untouched (at worst a stray @.monatone.tmp@ file).
writeMetadata :: Metadata -> Maybe AlbumArt -> OsPath -> Writer ()
writeMetadata metadata maybeAlbumArt filePath = do
  -- The temp file must be a sibling of the target: rename is only atomic
  -- within a filesystem
  let tmpPath = filePath <> [osp|.monatone.tmp|]

  copyResult <- liftIO $ try $ copyFile filePath tmpPath
  case copyResult of
    Left (ioErr :: IOException) ->
      throwError $ WriteIOError $ "Failed to create temporary copy: " <> T.pack (show ioErr)
    Right () -> do
      writeResult <- liftIO $ runExceptT $ dispatchWrite metadata maybeAlbumArt tmpPath
      case writeResult of
        Left err -> do
          discardTemp tmpPath
          throwError err
        Right () -> do
          renameResult <- liftIO $ try $ renameFile tmpPath filePath
          case renameResult of
            Left (ioErr :: IOException) -> do
              discardTemp tmpPath
              throwError $ WriteIOError $ "Failed to replace file: " <> T.pack (show ioErr)
            Right () -> return ()
  where
    discardTemp :: OsPath -> Writer ()
    discardTemp path = do
      _ <- liftIO $ (try :: IO () -> IO (Either IOException ())) $ removeFile path
      return ()

-- | Dispatch to the format-specific writer, which modifies the file in place
dispatchWrite :: Metadata -> Maybe AlbumArt -> OsPath -> Writer ()
dispatchWrite metadata maybeAlbumArt filePath = do
  let audioFormat = format metadata
  case audioFormat of
    MP3 -> writeMP3Metadata metadata maybeAlbumArt filePath
    FLAC -> writeFLACMetadata metadata maybeAlbumArt filePath
    M4A -> writeM4AMetadata metadata maybeAlbumArt filePath
    _ -> throwError $ UnsupportedWriteFormat audioFormat

-- | Update existing file with metadata changes
updateMetadata :: OsPath -> MetadataUpdate -> Writer ()
updateMetadata filePath update = do
  -- Read existing metadata
  existingResult <- liftIO $ runExceptT $ parseFile filePath
  case existingResult of
    Left parseErr -> throwError $ CorruptedWrite $ "Failed to read existing metadata: " <> T.pack (show parseErr)
    Right existingMetadata -> do
      -- Apply update
      let updatedMetadata = applyUpdate update existingMetadata

      -- Force evaluation of the format field to ensure metadata is constructed
      _ <- liftIO $ evaluate (format updatedMetadata)

      -- Determine album art to write
      maybeArt <- case updateAlbumArt update of
        Just Nothing -> return Nothing  -- Explicitly removing artwork
        Just (Just art) -> return (Just art)  -- Explicitly setting artwork
        Nothing -> do  -- No change to artwork - preserve existing
          case albumArtInfo existingMetadata of
            Nothing -> return Nothing  -- No existing artwork
            Just _ -> do
              -- Load existing artwork from file
              artResult <- liftIO $ loadAlbumArt filePath
              case artResult of
                Left _ -> return Nothing  -- Failed to load, continue without it
                Right art -> return art

      -- Write back
      writeMetadata updatedMetadata maybeArt filePath

-- | Write MP3 metadata using the MP3Writer module
writeMP3Metadata :: Metadata -> Maybe AlbumArt -> OsPath -> Writer ()
writeMP3Metadata metadata maybeAlbumArt filePath = do
  result <- liftIO $ runExceptT $ MP3Writer.writeMP3Metadata metadata maybeAlbumArt filePath
  case result of
    Left mp3Err -> throwError $ convertMP3Error mp3Err
    Right () -> return ()
  where
    convertMP3Error :: MP3Writer.WriteError -> WriteError
    convertMP3Error (MP3Writer.WriteIOError msg) = WriteIOError msg
    convertMP3Error (MP3Writer.UnsupportedWriteFormat fmt) = UnsupportedWriteFormat fmt
    convertMP3Error (MP3Writer.InvalidMetadata msg) = InvalidMetadata msg
    convertMP3Error (MP3Writer.CorruptedWrite msg) = CorruptedWrite msg

-- | Write FLAC metadata using the FLACWriter module
writeFLACMetadata :: Metadata -> Maybe AlbumArt -> OsPath -> Writer ()
writeFLACMetadata metadata maybeAlbumArt filePath = do
  result <- liftIO $ runExceptT $ FLACWriter.writeFLACMetadata metadata maybeAlbumArt filePath
  case result of
    Left flacErr -> throwError $ convertFLACError flacErr
    Right () -> return ()
  where
    convertFLACError :: FLACWriter.WriteError -> WriteError
    convertFLACError (FLACWriter.WriteIOError msg) = WriteIOError msg
    convertFLACError (FLACWriter.UnsupportedWriteFormat fmt) = UnsupportedWriteFormat fmt
    convertFLACError (FLACWriter.InvalidMetadata msg) = InvalidMetadata msg
    convertFLACError (FLACWriter.CorruptedWrite msg) = CorruptedWrite msg

-- | Write M4A metadata using the M4AWriter module
writeM4AMetadata :: Metadata -> Maybe AlbumArt -> OsPath -> Writer ()
writeM4AMetadata metadata maybeAlbumArt filePath = do
  result <- liftIO $ runExceptT $ M4AWriter.writeM4AMetadata metadata maybeAlbumArt filePath
  case result of
    Left m4aErr -> throwError $ convertM4AError m4aErr
    Right () -> return ()
  where
    convertM4AError :: M4AWriter.WriteError -> WriteError
    convertM4AError (M4AWriter.WriteIOError msg) = WriteIOError msg
    convertM4AError (M4AWriter.UnsupportedWriteFormat fmt) = UnsupportedWriteFormat fmt
    convertM4AError (M4AWriter.InvalidMetadata msg) = InvalidMetadata msg
    convertM4AError (M4AWriter.CorruptedWrite msg) = CorruptedWrite msg

-- | Parse file using existing parsers based on extension
parseFile :: OsPath -> Parser Metadata
parseFile filePath = do
  -- Convert extension to lowercase for comparison
  let ext = takeExtension filePath
  if ext == [osp|.mp3|] || ext == [osp|.MP3|]
    then MP3.parseMP3 filePath
    else if ext == [osp|.flac|] || ext == [osp|.FLAC|]
    then FLAC.parseFLAC filePath
    else if ext == [osp|.m4a|] || ext == [osp|.M4A|] || ext == [osp|.mp4|] || ext == [osp|.MP4|]
    then M4A.parseM4A filePath
    else throwError $ UnsupportedFormat "Unsupported file extension"