Writer.hs

{-# LANGUAGE CPP #-}
{-# 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)

#ifdef USE_UNIX_FSYNC
import System.Posix.IO (openFd, closeFd, defaultFileFlags, OpenMode(ReadWrite))
import System.Posix.Unistd (fileSynchronise)
import Control.Exception (bracket)
#endif

import Monatone.Metadata
import Monatone.Common (parseMetadata)
import qualified Monatone.MP3.Writer as MP3Writer
import qualified Monatone.FLAC.Writer as FLACWriter
import qualified Monatone.M4A.Writer as M4AWriter
import qualified Monatone.OGG.Writer as OGGWriter

-- | 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 -> AlbumArtUpdate -> OsPath -> Writer ()
writeMetadata metadata artUpdate 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 artUpdate tmpPath
      case writeResult of
        Left err -> do
          discardTemp tmpPath
          throwError err
        Right () -> do
          -- Flush the temp file to stable storage before the rename
          -- commits it, so a power loss cannot leave a half-written
          -- file behind the new name
          syncResult <- liftIO $ try $ syncFile tmpPath
          case syncResult of
            Left (ioErr :: IOException) -> do
              discardTemp tmpPath
              throwError $ WriteIOError $ "Failed to sync file: " <> T.pack (show ioErr)
            Right () -> pure ()
          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 ()

-- | Flush a file's contents to stable storage (no-op where unsupported)
syncFile :: OsPath -> IO ()
#ifdef USE_UNIX_FSYNC
syncFile path = do
  fp <- decodeFS path
  bracket (openFd fp ReadWrite defaultFileFlags) closeFd fileSynchronise
#else
syncFile _ = return ()
#endif

-- | Dispatch to the format-specific writer, which modifies the file in place
dispatchWrite :: Metadata -> AlbumArtUpdate -> OsPath -> Writer ()
dispatchWrite metadata artUpdate filePath =
  case format metadata of
    MP3 -> writeMP3Metadata metadata artUpdate filePath
    FLAC -> writeFLACMetadata metadata artUpdate filePath
    M4A -> writeM4AMetadata metadata artUpdate filePath
    OGG -> writeOGGMetadata metadata artUpdate filePath
    Opus -> writeOGGMetadata metadata artUpdate filePath

-- | Update existing file with metadata changes. The format is detected
-- from the file content, not the extension.
updateMetadata :: OsPath -> MetadataUpdate -> Writer ()
updateMetadata filePath update = do
  -- Read existing metadata
  existingResult <- liftIO $ parseMetadata 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)

      -- Album art: unchanged art is carried through verbatim by the
      -- format writers, so nothing needs to be reloaded here
      let artUpdate = case updateAlbumArt update of
            Nothing -> KeepExistingArt
            Just Nothing -> RemoveAlbumArt
            Just (Just art) -> SetAlbumArt art

      -- Write back
      writeMetadata updatedMetadata artUpdate filePath

-- | Write MP3 metadata using the MP3Writer module
writeMP3Metadata :: Metadata -> AlbumArtUpdate -> OsPath -> Writer ()
writeMP3Metadata metadata artUpdate filePath = do
  result <- liftIO $ runExceptT $ MP3Writer.writeMP3Metadata metadata artUpdate 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 -> AlbumArtUpdate -> OsPath -> Writer ()
writeFLACMetadata metadata artUpdate filePath = do
  result <- liftIO $ runExceptT $ FLACWriter.writeFLACMetadata metadata artUpdate 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 -> AlbumArtUpdate -> OsPath -> Writer ()
writeM4AMetadata metadata artUpdate filePath = do
  result <- liftIO $ runExceptT $ M4AWriter.writeM4AMetadata metadata artUpdate 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

-- | Write OGG/Opus metadata using the OGGWriter module
writeOGGMetadata :: Metadata -> AlbumArtUpdate -> OsPath -> Writer ()
writeOGGMetadata metadata artUpdate filePath = do
  result <- liftIO $ runExceptT $ OGGWriter.writeOGGMetadata metadata artUpdate filePath
  case result of
    Left oggErr -> throwError $ convertOGGError oggErr
    Right () -> return ()
  where
    convertOGGError :: OGGWriter.WriteError -> WriteError
    convertOGGError (OGGWriter.WriteIOError msg) = WriteIOError msg
    convertOGGError (OGGWriter.UnsupportedWriteFormat fmt) = UnsupportedWriteFormat fmt
    convertOGGError (OGGWriter.InvalidMetadata msg) = InvalidMetadata msg
    convertOGGError (OGGWriter.CorruptedWrite msg) = CorruptedWrite msg